COMPILATION LISTING OF SEGMENT lisp_io_fns_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/11/84 1039.5 mst Tue Options: optimize map 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_io_fns_: procedure; 7 8 /* 9* * This module contains miscellaneous functions of the New I/O System. 10* * 11* * The lisp functions implemented by this module are: 12* * allfiles, chrct, eoffn, filepos, inpush, linel, names, 13* * namelist, namestring, shortnamestring. 14* * 15* * Coded 14 Mar 73 by DAM 16* * ** kludges removed 5/9/80 by BSG, 'cause Multics does that right now. 17* * Modified September 1982 by Richard Lamson to add cursorpos lsubr 18* */ 19 20 21 dcl esw fixed bin, 22 myname fixed bin, 23 stack ptr, 24 nargs fixed bin, 25 tsp ptr, /* top of stack ptr */ 26 err fixed bin, 27 n fixed bin, 28 (m, i, len) fixed bin, 29 vcs char(208) varying, /* big enough to hold largest imaginable pathname */ 30 vcso char(length(vcs)) based(addrel(addr(vcs),1)), /* so vcs can be passed to a char(*) paraemeter */ 31 p ptr; 32 33 dcl (lisp_error_table_$bad_arg_correctable, 34 lisp_error_table_$io_wrong_direction, 35 lisp_error_table_$cant_filepos, 36 lisp_error_table_$filepos_oob) fixed bin external, 37 bad_arg_correctable fixed bin defined lisp_error_table_$bad_arg_correctable, 38 io_wrong_direction fixed bin defined lisp_error_table_$io_wrong_direction, 39 cant_filepos fixed bin defined lisp_error_table_$cant_filepos, 40 filepos_oob fixed bin defined lisp_error_table_$filepos_oob; 41 42 declare 43 (addr, addrel, char, divide, fixed, index, length, null, search, size, string, substr, verify) builtin, 44 V$infile fixed bin(71) aligned based(addr(addr(lisp_static_vars_$infile) -> based_ptr -> atom.value)), 45 V$instack fixed bin(71) aligned based(addr(addr(lisp_static_vars_$instack) -> based_ptr -> atom.value)), 46 Vp$instack pointer aligned based(addr(V$instack)), 47 lisp_static_vars_$infile fixed bin(71) external, 48 lisp_static_vars_$eof_atom fixed bin(71) external, 49 lisp_static_vars_$instack fixed bin(71) external, 50 (k, j) fixed bin, 51 lisp_alloc_ entry(fixed bin, fixed bin(71)), 52 lisp_io_control_$fix_not_ok_iochan entry(pointer, bit(1) aligned, bit(1) aligned), 53 msf_manager_$get_ptr ext entry(pointer, fixed bin, bit(1) aligned, pointer, fixed bin, fixed bin(35)), 54 hcs_$star_ ext entry(char(*), char(*), fixed bin(2), ptr, fixed bin, ptr, ptr, fixed bin(35)), 55 code fixed bin(35), 56 lisp_special_fns_$ncons entry, 57 lisp_special_fns_$xcons entry, 58 expand_path_ ext entry (pointer, fixed bin, pointer, pointer, fixed bin(35)), 59 get_pdir_ ext entry (char(168)), 60 dn char(168), 61 en char(32), 62 (get_default_wdir_, get_wdir_) ext entry (char(*)), 63 blank char(3) static init(" 64 "), /* NL, HT, SP - the 'blank' characters */ 65 point_blank char(4) static init(". 66 "), /* dot || blank */ 67 get_at_entry_ ext entry (char(*) aligned, char(*), char(*), char(*), fixed bin(35)), 68 enl fixed bin, 69 lisp_get_atom_ entry(char(*), fixed bin(71)), 70 star fixed bin(71) def (lisp_static_vars_$STAR), 71 lisp_static_vars_$STAR fixed bin(71) external, 72 stream fixed bin(71) def (lisp_static_vars_$stream), 73 lisp_static_vars_$stream fixed bin(71) external, 74 lisp_special_fns_$cons entry, 75 lisp_static_vars_$filepos fixed bin(71) external, 76 sgp pointer, 77 fail_act_f bit(1) aligned; 78 79 1 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 1 2 1 3 /* data structures used by the lisp i/o system */ 1 4 2 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 2 2 2 3 /* This include file describes the format of the 'iochan' block, 2 4* which is used to implement lisp file-objects. The iochan 2 5* is the central data base of the i/o system. When open 2 6* is used, an iochan is created in lisp static storage. 2 7* When the lisp environment is booted, 2 iochans for input and 2 8* output on the tty are created. Iochans are saved and restored 2 9* by the save mechanism */ 2 10 2 11 /* open i/o channel information */ 2 12 2 13 dcl 1 iochan based aligned, /* format of a file object */ 2 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 2 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 2 16 2 ioptr pointer, /* -> block */ 2 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 2 18 2 fcbp pointer, /* for tssi_ */ 2 19 2 aclinfop pointer, /* .. */ 2 20 2 component fixed bin, /* .. */ 2 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 2 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 2 23 2 flags unaligned, 2 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 2 25 3 read bit(1), /* 0 => openi, 1 => not */ 2 26 3 write bit(1), /* 0 => openo, 1 => not */ 2 27 3 gc_mark bit(1), /* for use by the garbage collector */ 2 28 3 interactive bit(1), /* 1 => input => this is the tty 2 29* output => flush buff after each op */ 2 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 2 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 2 32 3 charmode bit(1), /* enables instant ios_$write */ 2 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 2 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 2 35 3 image_mode bit(1), /* just suppresses auto-cr */ 2 36 3 not_yet_used bit(25), 2 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 2 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 2 39 2 name char(32) unaligned, /* stream name or entry name */ 2 40 2 pagel fixed bin, /* number of lines per page */ 2 41 2 linenum fixed bin, /* current line number, starting from 0 */ 2 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 2 43 2 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 2 45 "111011110111111111"b); 2 46 2 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 1 5 1 6 1 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 1 8 1 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 1 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 1 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 1 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 1 13 1 14 1 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 1 16 1 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 1 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 1 19 lisp_static_vars_$ibase ext fixed bin(71), 1 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 1 21 1 22 lisp_static_vars_$quote_atom ext fixed bin (71), 1 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 1 24 1 25 lisp_static_vars_$base ext fixed bin(71), 1 26 base fixed bin(71) defined ( lisp_static_vars_$base), 1 27 1 28 lisp_static_vars_$stnopoint ext fixed bin(71), 1 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 1 30 1 31 lisp_static_vars_$tty_atom ext fixed bin(71), 1 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 1 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 1 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 1 35 1 36 lisp_static_vars_$s_atom ext fixed bin(71), 1 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 1 38 1 39 lisp_static_vars_$readtable ext fixed bin(71), 1 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 1 41 1 42 lisp_static_vars_$plus_status ext fixed bin(71), 1 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 1 44 3 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 3 2 3 3 /* Last modified D. Reed 6/29/72 */ 3 4 3 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 3 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 3 7 3 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 3 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 3 10 3 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 3 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 3 13 3 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 3 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 3 16 3 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 3 18 1 45 1 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 1 47 80 4 1 /* Include file lisp_ptr_fmt.incl.pl1; 4 2* describes the format of lisp pointers as 4 3* a bit string overlay on the double word ITS pair 4 4* which allows lisp to access some unused bits in 4 5* the standard ITS pointer format. It should be noted that 4 6* this is somewhat of a kludge, since 4 7* it is quite machine dependent. However, to store type 4 8* fields in the pointer, saves 2 words in each cons, 4 9* plus some efficiency problems. 4 10* 4 11* D.Reed 4/1/71 */ 4 12 /* modified to move type field to other half of ptr */ 4 13 /* D.Reed 5/31/72 */ 4 14 4 15 4 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 4 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 4 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 4 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 4 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 4 21 2 type bit(9) unaligned, /* type field */ 4 22 2 itsmod bit(6) unaligned, 4 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 4 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 4 25 4 26 /* manifest constant strings for testing above type field */ 4 27 4 28 ( 4 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 4 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 4 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 4 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 4 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 4 34 Bignum init("000001000"b), /* a multiple-precision number */ 4 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 4 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 4 37* means a special internal uncollectable weird object */ 4 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 4 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 4 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 4 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 4 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 4 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 4 44 ) bit(9) static, 4 45 4 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 4 47 4 48 4 49 ( 4 50 Cons36 init("000000000000000000000000000000"b), 4 51 Fixed36 init("000000000000000000000100000000"b), 4 52 Float36 init("000000000000000000000010000000"b), 4 53 Atsym36 init("000000000000000000000001000000"b), 4 54 Atomic36 init("000000000000000000000111111100"b), 4 55 Bignum36 init("000000000000000000000000001000"b), 4 56 System_Subr36 4 57 init("000000000000000000000000000100"b), 4 58 Bigfix36 init("000000000000000000000000001000"b), 4 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 4 60 NotConsOrAtsym36 4 61 init("000000000000000000000110111111"b), 4 62 SubrNumeric36 4 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 4 64 String36 init("000000000000000000000000100000"b), 4 65 Subr36 init("000000000000000000000000010000"b), 4 66 File36 init("000000000000000000000000000001"b), 4 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 4 68 4 69 /* undefined pointer value is double word of zeros */ 4 70 4 71 Undefined bit(72) static init(""b); 4 72 4 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 81 5 1 /* include file lisp_stack_fmt.incl.pl1 -- 5 2* describes the format of the pushdown list 5 3* used by the lisp evaluator and lisp subrs 5 4* for passing arguments, saving atom bindings, 5 5* and as temporaries */ 5 6 5 7 dcl 5 8 temp(10000) fixed bin(71) aligned based, 5 9 5 10 temp_ptr(10000) ptr aligned based, 5 11 1 push_down_list_ptr_types(10000) based aligned, 5 12 2 junk bit(21) unaligned, 5 13 2 temp_type bit(9) unaligned, 5 14 2 more_junk bit(42) unaligned, 5 15 5 16 1 pdl_ptr_types36(10000) based aligned, 5 17 2 temp_type36 bit(36), 5 18 2 junk bit(36), 5 19 5 20 1 binding_block aligned based, 5 21 2 top_block bit(18) unaligned, 5 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 5 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 5 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 5 25 5 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 5 27 2 old_val fixed bin(71) aligned, 5 28 2 atom fixed bin(71) aligned; 5 29 5 30 5 31 5 32 /* end include file lisp_stack_fmt.incl.pl1 */ 82 6 1 /* Include file lisp_atom_fmt.incl.pl1; 6 2* describes internal format of atoms in the lisp system 6 3* D.Reed 4/1/71 */ 6 4 6 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 6 6 2 value fixed bin(71), /* atom's value */ 6 7 2 plist fixed bin(71), /* property list */ 6 8 2 pnamel fixed bin, /* length of print name */ 6 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 6 10 6 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 6 12 2 value ptr, 6 13 2 plist ptr, 6 14 6 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 6 16 2 value bit(72), 6 17 2 plist bit(72); 6 18 6 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 83 7 1 /* Include file lisp_cons_fmt.incl.pl1; 7 2* defines the format for a cons within the lisp system 7 3* D.Reed 4/1/71 */ 7 4 7 5 dcl consptr ptr, 7 6 1 cons aligned based (consptr), /* structure defining format for cons */ 7 7 2 car fixed bin(71), 7 8 2 cdr fixed bin(71), 7 9 7 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 7 11 2 car ptr, 7 12 2 cdr ptr, 7 13 7 14 7 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 7 16 2 padding bit(21) unaligned, 7 17 2 car bit(9) unaligned, 7 18 2 padding2 bit(63) unaligned, 7 19 2 cdr bit(9) unaligned, 7 20 2 padend bit(42) unaligned; 7 21 7 22 dcl 1 cons_types36 aligned based, 7 23 2 car bit(36), 7 24 2 pada bit(36), 7 25 2 cdr bit(36), 7 26 2 padd bit(36); 7 27 7 28 7 29 /* end include file lisp_cons_fmt.incl.pl1 */ 84 8 1 /* lisp number format -- overlaid on standard its pointer. */ 8 2 8 3 8 4 dcl 1 fixnum_fmt based aligned, 8 5 2 type_info bit(36) aligned, 8 6 2 fixedb fixed bin, 8 7 8 8 1 flonum_fmt based aligned, 8 9 2 type_info bit(36) aligned, 8 10 2 floatb float bin, 8 11 8 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 8 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 8 14 8 15 /* end of lisp number format */ 8 16 85 9 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 9 2* describes format of storage for lisp 9 3* character strings. 9 4* D. Reed 4/1/71 */ 9 5 9 6 dcl 1 lisp_string based aligned, 9 7 2 string_length fixed bin, 9 8 2 string char(1 refer(string_length)); 9 9 9 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 86 10 1 /* Include file lisp_common_vars.incl.pl1; 10 2* describes the external static variables which may be referenced 10 3* by lisp routines. 10 4* D. Reed 4/1/71 */ 10 5 10 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 10 7 2 cclist_ptr ptr, /* pointer to list of constants kept 10 8* by compiled programs */ 10 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 10 10 10 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 10 12 err_recp ptr defined (lisp_static_vars_$err_recp), 10 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 10 14 lisp_static_vars_$eval_frame ptr ext static, 10 15 lisp_static_vars_$prog_frame ptr ext aligned, 10 16 lisp_static_vars_$err_frame ptr ext aligned, 10 17 lisp_static_vars_$catch_frame ptr ext aligned, 10 18 lisp_static_vars_$unwp_frame ptr ext aligned, 10 19 lisp_static_vars_$stack_ptr ptr ext aligned, 10 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 10 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 10 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 10 23 lisp_static_vars_$binding_top ptr ext aligned, 10 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 10 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 10 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 10 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 10 28 binding_top ptr defined (lisp_static_vars_$binding_top), 10 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 10 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 10 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 10 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 10 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 10 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 10 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 10 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 10 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 10 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 10 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 10 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 10 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 10 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 10 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 10 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 10 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 10 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 10 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 10 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 10 49 10 50 10 51 /* end include file lisp_common_vars.incl.pl1 */ 87 11 1 11 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 11 3 11 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 11 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 11 6* are used so that the name of the function which is rejecting its argument 11 7* can be printed. Please note that all these codes are negative. */ 11 8 11 9 dcl ( 11 10 fn_do init (-10), 11 11 fn_arg init (-11), 11 12 fn_setarg init (-12), 11 13 fn_status init (-13), 11 14 fn_sstatus init (-14), 11 15 fn_errprint init (-15), 11 16 fn_errframe init (-16), 11 17 fn_evalframe init (-17), 11 18 fn_defaultf init (-18), 11 19 fn_tyo init (-22), 11 20 fn_ascii init (-23), 11 21 fn_rplaca init (-24), 11 22 fn_definedp init (-25), 11 23 fn_setq init (-26), 11 24 fn_set init (-27), 11 25 fn_delete init (-28), 11 26 fn_delq init (-29), 11 27 fn_stringlength init (-30), 11 28 fn_catenate init (-31), 11 29 fn_array init (-32), 11 30 fn_substr init (-33), 11 31 fn_index init (-34), 11 32 fn_get_pname init (-35), 11 33 fn_make_atom init (-36), 11 34 fn_ItoC init (-37), 11 35 fn_CtoI init (-38), 11 36 fn_defsubr init (-39), 11 37 fn_star_array init (-40), 11 38 fn_args init (-41), 11 39 fn_sysp init (-42), 11 40 fn_get init (-43), 11 41 fn_getl init (-44), 11 42 fn_putprop init (-45), 11 43 fn_remprop init (-46), 11 44 fn_save init (-47), 11 45 fn_add1 init (-48), 11 46 fn_sub1 init (-49), 11 47 fn_greaterp init (-50), 11 48 fn_lessp init (-51), 11 49 fn_minus init (-52), 11 50 fn_plus init (-53), 11 51 fn_times init (-54), 11 52 fn_difference init (-55), 11 53 fn_quotient init (-56), 11 54 fn_abs init (-57), 11 55 fn_expt init (-58), 11 56 fn_boole init (-59), 11 57 fn_rot init (-60), 11 58 fn_lsh init (-61), 11 59 fn_signp init (-62), 11 60 fn_fix init (-63), 11 61 fn_float init (-64), 11 62 fn_remainder init (-65), 11 63 fn_max init (-66), 11 64 fn_min init (-67), 11 65 fn_add1_fix init (-68), 11 66 fn_add1_flo init (-69), 11 67 fn_sub1_fix init (-70), 11 68 fn_sub1_flo init (-71), 11 69 fn_plus_fix init (-72), 11 70 fn_plus_flo init (-73), 11 71 fn_times_fix init (-74), 11 72 fn_times_flo init (-75), 11 73 fn_diff_fix init (-76), 11 74 fn_diff_flo init (-77), 11 75 fn_quot_fix init (-78), 11 76 fn_quot_flo init (-79), 11 77 fn_eval init (-80), 11 78 fn_apply init (-81), 11 79 fn_prog init (-82), 11 80 fn_errset init (-83), 11 81 fn_catch init (-84), 11 82 fn_throw init (-85), 11 83 fn_store init (-86), 11 84 fn_defun init (-87), 11 85 fn_baktrace init (-88), 11 86 fn_bltarray init (-89), 11 87 fn_star_rearray init (-90), 11 88 fn_gensym init (-91), 11 89 fn_makunbound init (-92), 11 90 fn_boundp init (-93), 11 91 fn_star_status init (-94), 11 92 fn_star_sstatus init (-95), 11 93 fn_freturn init (-96), 11 94 fn_cos init (-97), 11 95 fn_sin init (-98), 11 96 fn_exp init (-99), 11 97 fn_log init (-100), 11 98 fn_sqrt init (-101), 11 99 fn_isqrt init (-102), 11 100 fn_atan init (-103), 11 101 fn_sleep init (-104), 11 102 fn_oddp init (-105), 11 103 fn_tyipeek init (-106), 11 104 fn_alarmclock init (-107), 11 105 fn_plusp init (-108), 11 106 fn_minusp init (-109), 11 107 fn_ls init (-110), 11 108 fn_eql init (-111), 11 109 fn_gt init (-112), 11 110 fn_alphalessp init (-113), 11 111 fn_samepnamep init (-114), 11 112 fn_getchar init (-115), 11 113 fn_opena init (-116), 11 114 fn_sxhash init (-117), 11 115 fn_gcd init (-118), 11 116 fn_allfiles init (-119), 11 117 fn_chrct init (-120), 11 118 fn_close init (-121), 11 119 fn_deletef init (-122), 11 120 fn_eoffn init (-123), 11 121 fn_filepos init (-124), 11 122 fn_inpush init (-125), 11 123 fn_linel init (-126), 11 124 fn_mergef init (-127), 11 125 fn_namelist init (-128), 11 126 fn_names init (-129), 11 127 fn_namestring init (-130), 11 128 fn_openi init (-131), 11 129 fn_openo init (-132), 11 130 fn_prin1 init (-133), 11 131 fn_princ init (-134), 11 132 fn_print init (-135), 11 133 fn_read init (-136), 11 134 fn_readch init (-137), 11 135 fn_readstring init (-138), 11 136 fn_rename init (-139), 11 137 fn_shortnamestring init (-140), 11 138 fn_tyi init (-141), 11 139 fn_setsyntax init (-142), 11 140 fn_cursorpos init (-143), 11 141 fn_force_output init (-144), 11 142 fn_clear_input init (-145), 11 143 fn_random init (-146), 11 144 fn_haulong init (-147), 11 145 fn_haipart init (-148), 11 146 fn_cline init (-149), 11 147 fn_fillarray init (-150), 11 148 fn_listarray init (-151), 11 149 fn_sort init (-152), 11 150 fn_sortcar init (-153), 11 151 fn_zerop init (-154), 11 152 fn_listify init (-155), 11 153 fn_charpos init (-156), 11 154 fn_pagel init (-157), 11 155 fn_linenum init (-158), 11 156 fn_pagenum init (-159), 11 157 fn_endpagefn init (-160), 11 158 fn_arraydims init (-161), 11 159 fn_loadarrays init (-162), 11 160 fn_dumparrays init (-163), 11 161 fn_expt_fix init (-164), 11 162 fn_expt_flo init (-165), 11 163 fn_nointerrupt init (-166), 11 164 fn_open init (-167), 11 165 fn_in init (-168), 11 166 fn_out init (-169), 11 167 fn_truename init (-170), 11 168 fn_ifix init (-171), 11 169 fn_fsc init (-172), 11 170 fn_progv init (-173), 11 171 fn_mapatoms init (-174), 11 172 fn_unwind_protect init (-175), 11 173 fn_eval_when init (-176), 11 174 fn_read_from_string init (-177), 11 175 fn_displace init (-178), 11 176 fn_nth init (-179), 11 177 fn_nthcdr init (-180), 11 178 fn_includef init (-181) 11 179 ) fixed bin static; 11 180 11 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 88 89 90 91 /* The trivial functions to access components of a file object -- also filepos since it has similar args */ 92 93 chrct: entry; 94 95 esw = 1; 96 myname = fn_chrct; 97 go to one_two_fns; 98 99 eoffn: entry; 100 101 esw = 2; 102 myname = fn_eoffn; 103 go to one_two_fns; 104 105 filepos: entry; 106 107 esw = 3; 108 myname = fn_filepos; 109 go to one_two_fns; 110 111 linel: entry; 112 113 esw = 4; 114 myname = fn_linel; 115 go to one_two_fns; 116 117 names: entry; /* this entry is to be removed eventually - use namelist */ 118 119 120 esw = 5; 121 myname = fn_names; 122 go to one_two_fns; 123 124 charpos: entry; 125 126 esw = 6; 127 myname = fn_charpos; 128 go to one_two_fns; 129 130 pagel: entry; 131 132 esw = 7; 133 myname = fn_pagel; 134 go to one_two_fns; 135 136 linenum: entry; 137 138 esw = 8; 139 myname = fn_linenum; 140 go to one_two_fns; 141 142 pagenum: entry; 143 144 esw = 9; 145 myname = fn_pagenum; 146 go to one_two_fns; 147 148 endpagefn: entry; 149 150 esw = 10; 151 myname = fn_endpagefn; 152 go to one_two_fns; 153 154 155 /* 156* * Common code for the functions which take 1 or 2 args. 157* * The first arg is a file. If only one arg dispatch via transfer vector get, 158* * if two args dispatch via transfer vector put 159* */ 160 161 one_two_fns: 162 tsp = addrel(stack_ptr, -2); /* these are all lsubrs (1 . 2) */ 163 nargs = tsp -> fixedb; 164 stack = addrel(tsp, nargs); 165 166 /* make sure first arg is a file */ 167 168 agn12: if stack -> temp_type36(1) & File36 then; 169 else if stack -> temp(1) = nil then do; /* nil means the defaults, kept on tty_output_chan */ 170 if esw = 2 then p = tty_input_chan; /* exception for eoffn */ 171 else p = tty_output_chan; 172 go to defjoin; 173 end; 174 else do; 175 file_arg_loss: call badarg(stack -> temp(1)); 176 go to agn12; 177 end; 178 179 /* now dispatch through transfer vector selected by num of args */ 180 181 p = stack -> temp_ptr(1); /* -> iochan block for file */ 182 defjoin: 183 if nargs = -2 then go to get(esw); /* one arg */ 184 else go to put(esw); /* two args */ 185 186 /* Error Routines */ 187 188 badarg: proc(loser); 189 190 dcl loser fixed bin(71); /* the stack cell containing the bad arg */ 191 192 tsp -> temp(1) = loser; 193 err = bad_arg_correctable; 194 call error; 195 loser = tsp -> temp(1); /* replacement value */ 196 end; 197 198 error: proc; 199 200 201 dcl unm ptr, 202 ercode(2) fixed bin aligned based(unm), 203 lisp_error_ entry; 204 205 unm = unmkd_ptr; 206 unmkd_ptr = addrel(unm, size(ercode)); 207 ercode(1) = err; 208 ercode(2) = myname; 209 call lisp_error_; 210 end; 211 212 213 wrong_direction_for_setting_iochan_function: 214 215 stack_ptr = addr(stack -> temp(4)); 216 stack -> temp(3) = nil; 217 call lisp_special_fns_$cons; 218 call lisp_special_fns_$cons; 219 stack_ptr = addr(stack -> temp(3)); 220 if myname = fn_eoffn 221 then call lisp_get_atom_("eoffn", stack -> temp(2)); 222 else call lisp_get_atom_("endpagefn", stack -> temp(2)); 223 call lisp_special_fns_$xcons; 224 /* top of marked stack now has neat form to print out */ 225 err = io_wrong_direction; 226 call error; 227 228 /* here are the routines for accessing components of files (or iochan blocks) */ 229 230 get(1): n = p -> iochan.linel - p -> iochan.charpos; 231 go to nexit; 232 233 put(1): call get_numeric_arg; 234 p -> iochan.charpos = p -> iochan.linel - n; 235 go to nexit; 236 237 get(2): if p -> iochan.read = "0"b then stack -> temp(1) = p -> iochan.function; 238 else stack -> temp(1) = nil; 239 go to exit; 240 241 put(2): if p -> iochan.read = "0"b then p -> iochan.function = stack -> temp(2); 242 else go to wrong_direction_for_setting_iochan_function; 243 go to pexit; 244 245 get(4): n = p -> iochan.linel; 246 go to nexit; 247 248 put(4): call get_numeric_arg; 249 p -> iochan.linel = n; 250 go to nexit; 251 252 get(5): stack -> temp(1) = p -> iochan.namelist; 253 go to exit; 254 255 put(5): if stack -> temp(1) ^= nil then go to file_arg_loss; 256 if stack -> temp_type(2) = Cons then if stack -> temp_ptr(2) -> cons_types.car = Atsym then go to put5ok; 257 call badarg(stack -> temp(2)); /* the new default namelist had better look like a name list */ 258 go to put(5); 259 put5ok: 260 p -> iochan.namelist = stack -> temp(2); /* can only change default name list */ 261 go to pexit; 262 263 get(6): n = p -> iochan.charpos; 264 go to nexit; 265 266 put(6): call get_numeric_arg; 267 p -> iochan.charpos = n; 268 go to nexit; 269 270 get(7): n = p -> iochan.pagel; 271 go to nexit; 272 273 put(7): call get_numeric_arg; 274 p -> iochan.pagel = n; 275 go to nexit; 276 277 get(8): n = p -> iochan.linenum; 278 go to nexit; 279 280 put(8): call get_numeric_arg; 281 p -> iochan.linenum = n; 282 go to nexit; 283 284 get(9): n = p -> iochan.pagenum; 285 go to nexit; 286 287 put(9): call get_numeric_arg; 288 p -> iochan.pagenum = n; 289 go to nexit; 290 291 get(10): if p -> iochan.write = "0"b then stack -> temp(1) = p -> iochan.function; 292 else stack -> temp(1) = nil; 293 go to exit; 294 295 put(10): if p -> iochan.write = "0"b then p -> iochan.function = stack -> temp(2); 296 else go to wrong_direction_for_setting_iochan_function; 297 go to pexit; 298 299 300 301 /* exit routines for the above */ 302 303 exit: stack_ptr = addr(stack -> temp(2)); 304 return; 305 306 nexit: /* numberic exit */ 307 308 stack -> fixnum_fmt.type_info = fixnum_type; 309 stack -> fixedb = n; 310 go to exit; 311 312 pexit: /* exit, value in stack -> temp(2) */ 313 314 stack -> temp(1) = stack -> temp(2); 315 go to exit; 316 317 318 /* Numeric argument getter - from 2nd arg */ 319 320 get_numeric_arg: proc; 321 322 do while("1"b); /* loop until valid arg received */ 323 324 if addr(stack -> temp(2)) -> fixnum_fmt.type_info = fixnum_type 325 then do; 326 n = addr(stack -> temp(2)) -> fixedb; 327 return; 328 end; 329 else if addr(stack -> temp(2)) -> flonum_fmt.type_info = flonum_type 330 then do; 331 n = addr(stack -> temp(2)) -> floatb; 332 return; 333 end; 334 call badarg(stack -> temp(2)); 335 end; 336 337 end; 338 339 /* routines for random access input - filepos */ 340 341 get(3): /* (filepos ff) gets current char position of file ff */ 342 343 call filepos_ok; 344 len = 0; 345 do i = 0 by 1 while (i < p -> iochan.component); /* add up lengths of preceding components */ 346 call getlength; 347 if fail_act_f then go to filepos_loss_1; 348 len = len + m; 349 end; 350 n = len + p -> iochan.ioindex; /* n := position in characters from beginning of file */ 351 go to nexit; 352 353 put(3): /* (filepos ff n) sets character position of file ff to n */ 354 355 call filepos_ok; 356 if stack -> temp(2) = lisp_static_vars_$eof_atom then do; /* 5/10/80 -BSG */ 357 n = 0; 358 do i = 0 by 1; 359 call getlength; 360 if fail_act_f then go to got_it; 361 n = n + m; 362 end; 363 end; 364 call get_numeric_arg; /* get n */ 365 do i = 0 by 1; /* scan through components looking for right one */ 366 call getlength; 367 if fail_act_f then go to filepos_loss_2; /* must habe been o.o.b. (either minus or too big) */ 368 if m < n then n = n - m; /* not right one */ 369 else go to got_it; /* right one */ 370 end; 371 got_it: 372 p -> iochan.component = i; 373 p -> iochan.ioindex = n; 374 p -> iochan.iolength = m; 375 p -> iochan.ioptr = sgp; 376 go to pexit; 377 378 379 /* filepos error handling */ 380 381 filepos_loss_1: /* this file can't filepos */ 382 383 err = cant_filepos; 384 stack_ptr = addr(stack -> temp(4)); 385 stack -> temp(3) = nil; 386 filepos_loss: 387 stack -> temp(2) = stack -> temp(1); 388 stack -> temp(1) = lisp_static_vars_$filepos; 389 call lisp_special_fns_$cons; 390 call lisp_special_fns_$cons; 391 if err = filepos_oob then call lisp_special_fns_$cons; 392 call error; 393 return; 394 395 filepos_loss_2: /* (filepos ff n) -- n out of bounds */ 396 397 err = filepos_oob; 398 stack_ptr = addr(stack -> temp(5)); 399 stack -> temp(4) = nil; 400 stack -> temp(3) = stack -> temp(2); 401 go to filepos_loss; 402 403 404 /* int proc to make sure a file is really filepos'able */ 405 406 filepos_ok: proc; 407 408 if ^ p -> iochan.seg then go to filepos_loss_1; /* streams can't random access */ 409 if string(p -> iochan.flags) & not_ok_to_read then do; /* and the file better be open */ 410 call lisp_io_control_$fix_not_ok_iochan(p, "0"b, fail_act_f); 411 if fail_act_f then do; 412 stack -> temp(1) = addrel(stack_ptr, -2) -> temp(1); /* value of fail-act */ 413 go to exit; 414 end; 415 end; 416 end; 417 418 419 /* int proc to get length in chars of component i of msf */ 420 /* returns m = length, sgp = ptr, fail_act_f = "1"b if err */ 421 422 getlength: proc; 423 424 fail_act_f = "0"b; 425 call msf_manager_$get_ptr(p -> iochan.fcbp, i, "0"b, sgp, m, 0); 426 if sgp = null then fail_act_f = "1"b; /* err - probably ran off end of msf */ 427 else m = divide(m, 9, 21, 0); /* bit count --> char count */ 428 end; 429 430 /* 431* * subrs for conversion between namestrings and namelists 432* */ 433 434 truename: entry; 435 436 myname = fn_truename; /* return actual pathname */ 437 go to namstr_aa; 438 439 namestring: entry; 440 441 myname = fn_namestring; 442 go to namstr_aa; /* join with shortnamestring */ 443 444 shortnamestring: entry; 445 446 myname = fn_shortnamestring; 447 448 namstr_aa: 449 450 stack = addrel(stack_ptr, -2); /* subr 1 */ 451 do while (stack -> temp_type(1) ^= Cons); /* make sure arg is a list */ 452 if stack -> temp_type36(1) & File36 then do; /* also accept files */ 453 stack -> temp(1) = stack -> temp_ptr(1) -> iochan.namelist; 454 go to take_namelist_of_file_arg; 455 end; 456 else if stack -> temp(1) = nil then do; /* default namestring */ 457 stack -> temp(1) = tty_output_chan -> iochan.namelist; 458 go to take_namelist_of_file_arg; 459 end; 460 461 namstr_wta: 462 err = bad_arg_correctable; 463 call error; 464 end; 465 466 if stack -> temp_ptr(1) -> cons_types36.car & Atsym36 then; /* whose car is an atom */ 467 else if stack -> temp_ptr(1) -> cons_types36.car & String36 then do; /* or a string */ 468 if myname = fn_shortnamestring then vcs = ""; /* this is all a bit gross */ 469 else vcs = stack -> temp_ptr(1) -> cons_ptrs.car -> lisp_string.string || ">"; 470 end; 471 else go to namstr_wta; 472 take_namelist_of_file_arg: 473 if myname ^= fn_shortnamestring then /* look at car only if namestring entry */ 474 if stack -> temp_ptr(1) -> cons.car = stream then 475 vcs = "$"; /* stream marker */ 476 else vcs = stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname || ">"; /* directory, lose if root: OK */ 477 else vcs = ""; 478 479 call namestringer; 480 481 namestringer: proc; /* so that allfiles can use it too */ 482 483 fail_act_f = "0"b; 484 do stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr 485 repeat( stack -> temp_ptr(1) -> cons.cdr ) 486 while( stack -> temp_type(1) = Cons ); 487 if stack -> temp_ptr(1) -> cons_types36.car & Numeric36 then begin; /* convert number to atom */ 488 dcl ts ptr, unm ptr, (lisp_reader_$maknam, lisp_print_$exploden) entry; 489 490 unm = unmkd_ptr; 491 unmkd_ptr = addrel(unm, 2); 492 ts = stack_ptr; 493 stack_ptr = addr(ts -> temp(4)); 494 495 /* bind *nopoint to t */ 496 497 unm -> binding_block.bot_block = rel(addr(ts -> temp(1))); 498 unm -> binding_block.top_block = rel(addr(ts -> temp(3))); 499 unm -> binding_block.back_ptr = rel(binding_top); 500 ts -> temp(2) = lisp_static_vars_$stnopoint; 501 ts -> temp(1) = ts -> temp_ptr(2) -> atom.value; 502 binding_top = unm; 503 ts -> temp_ptr(2) -> atom.value = t_atom; 504 505 /* call exploden on the number */ 506 507 ts -> temp(3) = stack -> temp_ptr(1) -> cons.car; 508 call lisp_print_$exploden; 509 510 /* maknam up the result */ 511 512 call lisp_reader_$maknam; 513 514 /* catenate it onto vcs */ 515 516 vcs = vcs || ts -> temp_ptr(3) -> atom.pname || "."; 517 518 /* get rid of the binding */ 519 520 ts -> temp_ptr(2) -> atom.value = ts -> temp(1); 521 binding_top = ptr(binding_top, unm -> binding_block.back_ptr); 522 unmkd_ptr = unm; 523 stack_ptr = ts; 524 end; 525 526 else if stack -> temp_ptr(1) -> cons_types36.car & Atsym36 then 527 vcs = vcs || stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname || "."; 528 else if stack -> temp_ptr(1) -> cons_types36.car & String36 then 529 vcs = vcs || stack -> temp_ptr(1) -> cons_ptrs.car -> lisp_string.string || "."; 530 end; 531 532 if (stack -> temp(1) ^= nil) & 533 (stack -> temp_type36(1) & Atsym36) ^= ""b then /* dotted list */ 534 if stack -> temp(1) = star then vcs = vcs || "**"; /* .* */ 535 else vcs = vcs || "**." || stack -> temp_ptr(1) -> atom.pname; 536 /* (x>foo . bar) => x>foo.**.bar */ 537 /* Multics does this now 5/9/80 - BSG */ 538 else if substr(vcs, length(vcs), 1) = "." then 539 vcs = substr(vcs, 1, length(vcs)-1); /* if not dotted, drop last dot */ 540 541 return; 542 end namestringer; 543 544 /* for truename, get the actual path name */ 545 546 if myname = fn_truename then call find_true_name(vcs); 547 548 /* convert vcs to a lisp string & return it */ 549 550 call make_a_string(vcso, stack -> temp(1)); 551 go to exit; 552 553 defaultf: entry; /**** function to set the default namelist - replaces (names nil f) ****/ 554 555 call internal_namelist(fn_defaultf); /* get a namelist at the top of the stack, by hook or by crook */ 556 557 tsp = addrel(stack_ptr, -2); /* subr 1*/ 558 559 /* stash it away */ 560 561 tty_output_chan -> iochan.namelist = tsp -> temp(1); /* where we keep the defaults */ 562 return; /* value is argument */ 563 564 namelist: entry; /**** convert a string specifying a file into a list ****/ 565 566 myname = fn_namelist; 567 go to namelist_join; 568 569 570 internal_namelist: entry(a_myname); /* same as namelist, except different myname since called 571* on behalf of some other function */ 572 dcl a_myname fixed bin; 573 574 myname = a_myname; 575 namelist_join: 576 stack = addrel(stack_ptr, -2); /* subr 1 */ 577 namlstaa: if stack -> temp(1) = nil then do; /* get default namelist */ 578 stack -> temp(1) = tty_output_chan -> iochan.namelist; 579 go to exit; 580 end; 581 else if stack -> temp_type36(1) & String36 then p = stack -> temp_ptr(1); 582 else if stack -> temp_type36(1) & Atsym36 then p = addr(stack -> temp_ptr(1) -> atom.pnamel); 583 else if stack -> temp_type36(1) & File36 then do; /* namelist of a file */ 584 stack -> temp(1) = stack -> temp_ptr(1) -> iochan.namelist; 585 go to exit; 586 end; 587 else if stack -> temp_type(1) then do; 588 namlsterr: err = bad_arg_correctable; 589 call error; 590 go to namlstaa; 591 end; 592 else if stack -> temp_ptr(1) -> cons_types36.car & Atsym36 593 then go to exit; /* legal name list */ 594 else go to namlsterr; /* list, but car was not an atom */ 595 596 /* parse string and cons up a list */ 597 598 599 i = verify(p -> lisp_string.string, blank); /* skip leading blanks: NL, HT, SP */ 600 if i = 0 then go to namlsterr; /* barf at all-blank string */ 601 j = search(substr(p -> lisp_string.string, i), blank)-1; /* find end of non-blank part of string */ 602 if j < 0 then j = p -> lisp_string.string_length - i + 1; 603 if j > 208 then go to namlsterr; /* too long - barf at it */ 604 vcs = substr(p -> lisp_string.string, i, j); /* copy non-blank portion of string */ 605 606 if substr(vcs, 1, 1) = "$" then do; /* stream specifier */ 607 stack_ptr = addr(stack -> temp(4)); 608 stack -> temp(3) = nil; 609 stack -> temp(1) = stream; 610 call lisp_get_atom_(substr(vcs, 2), stack -> temp(2)); 611 call lisp_special_fns_$cons; 612 call lisp_special_fns_$cons; 613 go to exit; 614 end; 615 616 /* segment specifier - parse it up into dir>a.b.c and make list */ 617 618 if length(vcs) > 5 /* this is for the benefit of lap, mostly */ 619 then if substr(vcs, 1, 5) = "[pd]>" 620 then do; 621 call get_pdir_(dn); 622 vcs = substr(dn, 1, index(dn, " ")-1) || substr(vcs, 5); 623 end; 624 625 call expand_path_(addr(vcso), /* boy, expand_path_ sure is a kludge! */ 626 length(vcs), 627 addr(dn), 628 addr(en), 629 code); 630 if code ^= 0 then go to namlsterr; 631 if search(vcs, "<>") = 0 then stack -> temp(1) = star; /* no dir specified, use * instead of wdir */ 632 else do; 633 j = search(dn, blank)-1; 634 if j < 0 then j = length(dn); 635 call lisp_get_atom_(char(dn, j), stack -> temp(1)); 636 end; 637 638 /* en has entry name, stack -> temp(1) has directory */ 639 640 k = 1; 641 tsp = stack; /* tsp will advance as name components are pushed onto stack */ 642 643 644 entry_names_loop: 645 tsp = addrel(tsp, 2); 646 stack_ptr = addr(tsp -> temp(2)); 647 j = search(substr(en, k), point_blank); /* find period, or else blank which ends name */ 648 if j ^= 0 then /* get another entry name */ 649 if substr(en, k+j-1, 1) ^= "." then; /* as j = 0, this is the end */ 650 else if substr(en, k, j-1) = "**" then do; /* embedded ** special construction: foo.**.bar => (-- foo . bar) */ 651 k = k + j; /* skip over the .**. */ 652 j = search(en, blank)-1; 653 if j < 0 then j = length(en); 654 call lisp_get_atom_(substr(en, k, j-k+1), tsp -> temp(1)); /* get the rest (e.g. bar) */ 655 go to cons_it_up; /* and this is the end */ 656 end; 657 else do; /* single dot, get preceding name, and continue */ 658 call lisp_get_atom_(substr(en, k, j-1), tsp -> temp(1)); 659 k = k + j; 660 go to entry_names_loop; 661 end; 662 /* do final entry name component */ 663 664 if j = 0 then j = length(en)-k+2; 665 if substr(en, k, j-1) = "**" then do; /* ends with .**, put dotted star in namelist */ 666 tsp -> temp(1) = star; 667 go to cons_it_up; 668 end; 669 call lisp_get_atom_(substr(en, k, j-1), tsp -> temp(1)); 670 671 stack_ptr = addr(tsp -> temp(3)); 672 tsp -> temp(2) = nil; 673 674 cons_it_up: 675 /* Now make a list out of all this junk */ 676 677 do while (stack_ptr ^= addr(stack -> temp(2))); 678 call lisp_special_fns_$cons; 679 end; 680 go to exit; 681 682 683 /* 684* * Subr to manipulate the input-source stack 685* */ 686 687 inpush: entry; 688 689 stack = addrel(stack_ptr, -2); /* subr 1 */ 690 inpaa: if stack -> temp_type36(1) & File36 then do; /* (inpush file) */ 691 stack_ptr = addr(stack -> temp(4)); 692 stack -> temp(3) = V$instack; 693 stack -> temp(2) = V$infile; 694 call lisp_special_fns_$cons; /* push infile onto instack */ 695 V$instack = stack -> temp(2); 696 V$infile = stack -> temp(1); 697 end; 698 else if stack -> flonum_fmt.type_info = flonum_type then do; 699 stack -> fixedb = fixed(stack -> floatb); 700 go to inpbb; 701 end; 702 else if stack -> fixnum_fmt.type_info = fixnum_type then 703 inpbb: if stack -> fixedb = 0 then do; /* (inpush 0) */ 704 stack -> temp(1) = V$infile; 705 go to exit; 706 end; 707 else if stack -> fixedb < 0 then /* (inpush -n) */ 708 do n = stack -> fixedb by 1 while(n < 0); 709 if V$instack = nil then V$infile = t_atom; 710 else do; 711 V$infile = Vp$instack -> cons.car; 712 V$instack = Vp$instack -> cons.cdr; 713 end; 714 end; 715 else /* (inpush +n) */ 716 do n = stack -> fixedb by -1 to 1; 717 stack_ptr = addr(stack -> temp(3)); 718 stack -> temp(1) = V$infile; 719 stack -> temp(2) = V$instack; 720 call lisp_special_fns_$cons; /* push infile onto instack */ 721 V$instack = stack -> temp(1); 722 end; 723 else do; /*** wrng-type-arg error ***/ 724 myname = fn_inpush; 725 err = bad_arg_correctable; 726 call error; 727 go to inpaa; 728 end; 729 730 /* return the value of infile, and adjust ^q */ 731 732 stack -> temp(1) = V$infile; 733 if stack -> temp(1) = nil | stack -> temp(1) = t_atom 734 then addr(ctrlQ) -> based_ptr -> atom.value = nil; 735 go to exit; 736 737 /* 738* * The Allfiles subr, which returns a list of namelists for all the files which 739* * match a given namelist. 740* */ 741 742 allfiles: entry; 743 744 myname = fn_allfiles; 745 stack = addrel(stack_ptr, -2); /* subr 1 */ 746 allfiles_aa: 747 if stack -> temp_type(1) ^= Cons then call internal_namelist(myname); 748 if stack -> temp_ptr(1) -> cons_types36.car & (Atsym36 | String36) then;else 749 allfiles_err: do; 750 err = bad_arg_correctable; 751 call error; 752 go to allfiles_aa; 753 end; 754 755 stack_ptr = addr(stack -> temp(3)); 756 stack -> temp(2) = nil; /* init result: consed-up list of namelists */ 757 758 if stack -> temp_ptr(1) -> cons.car = star then do; 759 760 761 /* 762* * Starred Directory: use lisp search rules: 763* * 1) working dir 764* * 2) default wdir 765* * 3) >lisp 766* * 767* * (these ought to be changeable by the user) 768* * 769* * The actual search is done in reverse order so that the car of the resulting 770* * list will be the one that comes first in the search rules. 771* */ 772 773 dn = ">lisp"; 774 call somefiles; 775 call get_default_wdir_(dn); 776 call somefiles; 777 call get_wdir_(dn); 778 call somefiles; 779 end; 780 781 else if stack -> temp_ptr(1) -> cons.car = stream then do; /* stream is nil, or list of it if attached */ 782 call get_at_entry_(stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_ptrs.car -> atom.pname, 783 "", "", "", code); 784 if code ^= 0 then go to pexit; /* not attached, return nil */ 785 stack_ptr = addr(stack -> temp(2)); 786 call lisp_special_fns_$ncons; /* attached, return list of argument */ 787 go to exit; 788 end; 789 790 else if stack -> temp_ptr(1) -> cons_types36.car & String36 then do; 791 dn = stack -> temp_ptr(1) -> cons_ptrs.car -> lisp_string.string; 792 call somefiles; 793 end; 794 795 else do; 796 dn = stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname; /* use specified directory */ 797 call somefiles; 798 end; 799 800 go to pexit; /* return the list in stack -> temp(2) */ 801 802 803 804 805 /* 806* * routine to do allfiles on one directory 807* * 808* * dn = pathname of the directory 809* * stack -> temp(1) = namelist (pattern) 810* * results are consed onto stack -> temp(2) 811* */ 812 813 somefiles: proc; 814 815 dcl an_area area(4096); /* plenty big enough */ 816 /* Made 4096 BSG 5/9/80 */ 817 dcl dnl fixed bin; /* non-blank length of dn */ 818 819 dcl ecount fixed bin, (eptr, nptr) ptr, 820 1 entries (ecount) based(eptr) aligned, 821 2 type bit(2) unaligned, 822 2 nname fixed bin(15) unaligned, 823 2 nindex fixed bin(17) unaligned, 824 names_str (1) char(32) aligned based(nptr); 825 826 stack_ptr = addr(stack -> temp(4)); 827 stack -> temp(3) = stack -> temp(1); 828 stack = addr(stack -> temp(3)); 829 dnl= length (rtrim (dn)); 830 vcs = ""; 831 call namestringer; /* get back the starred entry name in vcs */ 832 stack = addrel(stack, -4); 833 call hcs_$star_(dn, vcso, 2, addr(an_area), ecount, eptr, nptr, code); 834 835 if code ^= 0 then return; /* some kind of lossage, assume not found */ 836 837 do i = 1 to ecount; /* put all the entries on the list */ 838 j = search(names_str(nindex(i)), " ")-1; if j < 0 then j = 32; 839 dcl bug_fixer char(168), bug_fixer_aa based(addr(bug_fixer)) char(dnl+j+1); 840 bug_fixer = char(names_str(nindex(i)), j); /* fix v2pl1 bug */ 841 bug_fixer = char(dn, dnl) || ">" || bug_fixer; 842 call make_a_string(bug_fixer_aa, stack -> temp(3)); 843 call internal_namelist(myname); /* expand this string into a list */ 844 call lisp_special_fns_$xcons; /* and cons onto the results list */ 845 stack_ptr = addr(stack -> temp(4));/* and fix stack_ptr */ 846 end; 847 return; 848 849 end; 850 851 make_a_string: proc(the_string, where_to_put_it); 852 853 dcl the_string char(*) unaligned, where_to_put_it fixed bin(71); 854 855 call lisp_alloc_(divide(length(the_string)+7, 4, 17, 0), where_to_put_it); 856 addr(where_to_put_it) -> lisp_ptr.type = String; 857 addr(where_to_put_it)->based_ptr -> lisp_string.string_length = length(the_string); 858 addr(where_to_put_it)->based_ptr -> lisp_string.string = the_string; 859 end; 860 861 cursorpos: entry; 862 863 /* the LISP cussorpos lsubr, which sets or get the 864* zero-origin (line . char) position of a display terminal. */ 865 866 declare (X, Y) fixed binary; 867 declare vcs_bit_bucket char (1) varying; 12 1 /* BEGIN INCLUDE FILE ... window_control_info.incl.pl1 JRD */ 12 2 /* format: style3 */ 12 3 12 4 /* Modified 26 January 1982 by William York to add the set_more_handler 12 5* and reset_more_handler control orders. */ 12 6 /* Modified October 1982 by WMY to add set and get_token_characters, 12 7* set and get_more_prompt. */ 12 8 /* Modified February 1983 by WMY to add the line_editor_key_binding_info 12 9* structure. */ 12 10 /* Modified 30 September 1983 by Jon A. Rochlis to add the origin.column for 12 11* partial screen width windows. */ 12 12 /* Modified 9 October 1983 by JR to add version 1 window_edit_line_info. 12 13* This should be removed when window_info.incl.pl1 is created. */ 12 14 /* Modified 29 February 1984 by Barmar to add version 1 12 15* get_editor_key_bindings_info. */ 12 16 /* Modified 1 March 1984 by Barmar to add version 1 12 17* set_editor_key_bindings_info. */ 12 18 /* Modified 2 March 1984 by Barmar to upgrade to version 3 12 19* line_editor_key_bindings_info, which includes the name, description, and 12 20* info path */ 12 21 12 22 /* structure for the set_window_info and get_window_info 12 23* control orders. */ 12 24 12 25 dcl 1 window_position_info 12 26 based (window_position_info_ptr), 12 27 2 version fixed bin, 12 28 2 origin, 12 29 3 column fixed bin, 12 30 3 line fixed bin, 12 31 2 extent, 12 32 3 width fixed bin, 12 33 3 height fixed bin; 12 34 12 35 dcl (window_position_info_version, window_position_info_version_1) 12 36 fixed bin internal static init (1) options (constant); 12 37 dcl window_position_info_ptr 12 38 pointer; 12 39 12 40 /* structure for the set_window_status and get_window_status 12 41* control orders */ 12 42 12 43 declare window_status_info_ptr 12 44 pointer; 12 45 declare 1 window_status_info 12 46 aligned based (window_status_info_ptr), 12 47 2 version fixed bin, 12 48 2 status_string bit (36) aligned; /* string (window_status) */ 12 49 /* see window_status.incl.pl1 for the contents of this string */ 12 50 12 51 12 52 declare (window_status_version, window_status_version_1) 12 53 fixed bin internal static init (1) options (constant); 12 54 12 55 /* info structure for the set_more_responses and get_more_responses control 12 56* orders */ 12 57 12 58 12 59 dcl 1 more_responses_info 12 60 aligned based (more_responses_info_ptr), 12 61 2 version fixed bin, 12 62 2 n_yeses fixed bin, /* how many valid characters in the strings below */ 12 63 2 n_noes fixed bin, 12 64 2 yeses char (32) unaligned, 12 65 2 noes char (32) unaligned; 12 66 12 67 dcl (more_responses_info_version_1, more_responses_version) 12 68 fixed bin internal static init (1) options (constant); 12 69 dcl more_responses_info_ptr 12 70 pointer; 12 71 12 72 /* structure for the set_break_table and get_break_table 12 73* control orders */ 12 74 12 75 declare break_table_ptr pointer; 12 76 declare 1 break_table_info aligned based (break_table_ptr), 12 77 2 version fixed bin, 12 78 2 breaks (0:127) bit (1) unaligned; 12 79 12 80 declare (break_table_info_version, break_table_info_version_1) 12 81 fixed bin init (1) internal static options (constant); 12 82 12 83 declare 1 more_handler_info aligned based (more_handler_info_ptr), 12 84 2 version fixed bin, 12 85 2 flags unaligned, 12 86 3 old_handler_valid 12 87 bit(1), 12 88 3 pad bit(35), 12 89 2 more_handler entry (pointer, bit(1) aligned), 12 90 2 old_more_handler entry (pointer, bit(1) aligned); 12 91 12 92 declare more_handler_info_ptr pointer; 12 93 12 94 declare (more_handler_info_version, more_handler_info_version_3) 12 95 fixed bin internal static options (constant) init (3); 12 96 12 97 declare 1 token_characters_info aligned based (token_characters_info_ptr), 12 98 2 version char(8), 12 99 2 token_character_count 12 100 fixed bin, 12 101 2 token_characters 12 102 char (128) unaligned; 12 103 12 104 declare token_characters_info_ptr pointer; 12 105 12 106 declare token_characters_info_version_1 char(8) internal static options (constant) init ("wtci0001"); 12 107 12 108 declare 1 more_prompt_info aligned based (more_prompt_info_ptr), 12 109 2 version char(8), 12 110 2 more_prompt char(80); 12 111 12 112 declare more_prompt_info_ptr pointer; 12 113 12 114 declare more_prompt_info_version_1 char(8) static options (constant) init ("wsmp0001"); 12 115 12 116 /* Line editor stuff ... */ 12 117 12 118 dcl line_editor_key_binding_info_ptr 12 119 pointer; 12 120 12 121 dcl line_editor_binding_count 12 122 fixed bin; 12 123 dcl line_editor_longest_sequence 12 124 fixed bin; 12 125 /* For each binding, action defines what to do for that sequence. Constants 12 126* are defined in window_editor_values.incl.pl1. Only if action is set to 12 127* EXTERNAL_ROUTINE does the editor_routine entry variable get examined. */ 12 128 12 129 dcl 1 line_editor_key_binding_info 12 130 aligned based (line_editor_key_binding_info_ptr), 12 131 2 version char(8), 12 132 2 binding_count fixed bin, 12 133 2 longest_sequence fixed bin, 12 134 2 bindings (line_editor_binding_count refer 12 135 (line_editor_key_binding_info.binding_count)), 12 136 3 sequence char(line_editor_longest_sequence refer 12 137 (line_editor_key_binding_info.longest_sequence)) varying, 12 138 3 action fixed bin, 12 139 3 numarg_action fixed binary, 12 140 3 editor_routine entry (pointer, fixed bin(35)), 12 141 3 name char (64) varying unaligned, 12 142 3 description char (256) varying unaligned, 12 143 3 info_path unaligned, 12 144 4 info_dir char (168), 12 145 4 info_entry char (32); 12 146 12 147 12 148 dcl line_editor_key_binding_info_version_3 12 149 char(8) static options (constant) init ("lekbi003"); 12 150 12 151 dcl 1 get_editor_key_bindings_info aligned based (get_editor_key_bindings_info_ptr), 12 152 2 version char (8), 12 153 2 flags, 12 154 3 entire_state bit (1) unaligned, 12 155 3 mbz bit (35) unaligned, 12 156 2 key_binding_info_ptr ptr, 12 157 2 entire_state_ptr ptr; 12 158 12 159 dcl get_editor_key_bindings_info_ptr ptr; 12 160 dcl get_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("gekbi_01"); 12 161 12 162 dcl 1 set_editor_key_bindings_info aligned 12 163 based (set_editor_key_bindings_info_ptr), 12 164 2 version char (8), 12 165 2 flags, 12 166 3 replace bit (1) unaligned, 12 167 3 update bit (1) unaligned, 12 168 3 mbz bit (34) unaligned, 12 169 2 key_binding_info_ptr ptr; 12 170 12 171 dcl set_editor_key_bindings_info_ptr ptr; 12 172 dcl set_editor_key_bindings_info_version_1 char (8) int static options (constant) init ("sekbi_01"); 12 173 12 174 /* This should be moved to window_info.incl.pl1 when that include file is 12 175* created. JR 2/1/84 */ 12 176 12 177 dcl 1 window_edit_line_info 12 178 based (window_edit_line_info_ptr), 12 179 2 version char (8), 12 180 2 line_ptr ptr, 12 181 2 line_length fixed bin (21); /* later we will hack initial cursor position, key bindings, etc. */ 12 182 12 183 dcl window_edit_line_info_version_1 12 184 char (8) static options (constant) init ("wedl0001"); 12 185 12 186 dcl window_edit_line_info_ptr 12 187 ptr; 12 188 12 189 /* END INCLUDE FILE window_control_info.incl.pl1 */ 868 869 declare 1 window_info auto aligned like window_position_info; 870 declare iox_$control entry (ptr, char(*), ptr, fixed bin(35)); 871 declare iox_$look_iocb entry (char(*), ptr, fixed bin(35)); 872 declare window_$clear_region entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin(35)); 873 declare window_$clear_to_end_of_line entry (ptr, fixed bin(35)); 874 declare window_$clear_to_end_of_window entry (ptr, fixed bin(35)); 875 declare window_$clear_window entry (ptr, fixed bin(35)); 876 declare window_$delete_chars entry (ptr, fixed bin, fixed bin(35)); 877 declare window_$get_cursor_position entry (ptr, fixed bin, fixed bin, fixed bin(35)); 878 declare window_$get_one_unechoed_char entry (ptr, char(1) var, bit(1) aligned, fixed bin(35)); 879 declare window_$insert_text entry (ptr, char(*), fixed bin(35)); 880 declare window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin(35)); 881 declare window_$scroll_region entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin(35)); 882 883 884 stack = addrel(stack_ptr, -2); 885 nargs = stack -> fixedb; 886 stack = addrel(stack, nargs); 887 888 nargs = divide (nargs, -2, 17, 0); /* Get real number of args. */ 889 if nargs = 0 890 then p = tty_output_chan; 891 else do; 892 nargs = nargs - 1; /* File argument omitted. */ 893 if stack -> temp (nargs+1) = t_atom then p = tty_output_chan; 894 else if stack -> temp_type36 (nargs+1) & File36 895 then p = stack -> temp_ptr (nargs+1); 896 else do; 897 nargs = nargs + 1; /* No file argument really present. */ 898 p = tty_output_chan; 899 end; 900 end; 901 902 if p -> iochan.seg then go to cursorpos_returns_nil; /* Can't do (cursorpos) to segment. */ 903 904 if p -> iochan.fcbp = null () /* Must have an IOCB ptr to work with. */ 905 then do; 906 call iox_$look_iocb (p -> iochan.name, p -> iochan.fcbp, code); 907 if code ^= 0 then go to cursorpos_returns_nil; 908 end; 909 910 p = p -> iochan.fcbp; /* Get iocb ptr */ 911 912 call window_$get_cursor_position (p, Y, X, code); 913 if code ^= 0 then go to cursorpos_returns_nil; 914 915 if nargs = 0 916 then do; 917 stack_ptr = addr (stack -> temp (3)); 918 stack -> temp_type36 (1), stack -> temp_type36 (2) = fixnum_type; 919 addr (stack -> temp (1)) -> fixedb = Y - 1; 920 addr (stack -> temp (2)) -> fixedb = X - 1; 921 call lisp_special_fns_$cons; /* return (LINE . COLUMN) */ 922 go to exit; 923 end; 924 925 926 if nargs = 2 927 then do; 928 if stack -> temp (1) = nil then; 929 else if stack -> temp_type36 (1) & Fixed36 930 then Y = 1 + addr (stack -> temp (1)) -> fixedb; 931 else go to cursorpos_arg_symbol; 932 if stack -> temp (2) = nil then; 933 else if stack -> temp_type36 (2) & Fixed36 934 then X = 1 + addr (stack -> temp (2)) -> fixedb; 935 else go to cursorpos_returns_nil; 936 position_cursor_bounded: call get_window_info; 937 X = min (max (X, 1), window_info.extent.width); 938 Y = min (max (Y, 1), window_info.extent.height); 939 call window_$position_cursor (p, Y, X, code); 940 go to cursorpos_check_code; 941 end; 942 943 cursorpos_arg_symbol: 944 if stack -> temp_type36 (1) & Atsym36 then en = stack -> temp_ptr (1) -> atom.pname; 945 else if stack -> temp_type36 (1) & String36 then en = stack -> temp_ptr (1) -> lisp_string.string; 946 else go to cursorpos_returns_nil; 947 go to cursorpos_function (index 948 ("ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_", 949 translate (substr (en, 1, 1), 950 "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 951 "abcdefghijklmnopqrstuvwxyz"))); 952 953 cursorpos_function (1): /* A: fresh line */ 954 if X = 1 then go to cursorpos_returns_t; 955 X = 1; 956 Y = Y + 1; 957 position_cursor_wrap: 958 call get_window_info; 959 if X < 1 then X = window_info.extent.width; 960 else if X > window_info.extent.width then X = 1; 961 if Y < 1 then Y = window_info.extent.height; 962 else if Y > window_info.extent.height then Y = 1; 963 call window_$position_cursor (p, Y, X, code); 964 cursorpos_check_code: 965 if code ^= 0 then go to cursorpos_returns_nil; 966 go to cursorpos_returns_t; 967 968 cursorpos_function (2): /* B: cursor backspace */ 969 X = X - 1; 970 go to position_cursor_wrap; 971 972 cursorpos_function (3): /* C: Home & clear */ 973 call window_$clear_window (p, code); 974 go to cursorpos_check_code; 975 976 cursorpos_function (4): /* D: cursor Down */ 977 Y = Y + 1; 978 go to position_cursor_wrap; 979 980 cursorpos_function (5): /* E: Clear to end of screen */ 981 call window_$clear_to_end_of_window (p, code); 982 go to cursorpos_check_code; 983 984 cursorpos_function (6): /* F: cursor Forward */ 985 X = X + 1; 986 go to position_cursor_wrap; 987 988 cursorpos_function (8): /* H: move to column (arg 2) */ 989 if nargs < 2 then go to cursorpos_returns_nil; 990 if stack -> temp_type36 (2) & Fixed36 then X = 1 + addr (stack -> temp (2)) -> fixedb; 991 else go to cursorpos_returns_nil; 992 go to position_cursor_bounded; 993 994 cursorpos_function (11): /* K: Erase 1 character forward */ 995 cursorpos_K: 996 call window_$clear_region (p, Y, X, 1, 1, code); 997 go to cursorpos_check_code; 998 999 cursorpos_function (12): /* L: clear to end of line */ 1000 cursorpos_function (29): /* ]: same as L (obsolete) */ 1001 call window_$clear_to_end_of_line (p, code); 1002 go to cursorpos_check_code; 1003 1004 cursorpos_function (13): /* M: More wait, then home up */ 1005 Y = 0; /* Go to row 1 */ 1006 cursorpos_function (14): /* N: More wait, then (TERPRI) */ 1007 X = 1; /* Go to left of column */ 1008 Y = Y + 1; /* In next row */ 1009 call window_$get_one_unechoed_char (p, vcs_bit_bucket, "1"b, code); 1010 if code ^= 0 then go to cursorpos_returns_nil; 1011 go to position_cursor_wrap; 1012 1013 cursorpos_function (20): /* T: (also 'TOP) home cursor to (0 0) */ 1014 X, Y = 1; 1015 go to position_cursor_wrap; 1016 1017 cursorpos_function (21): /* U: cursor Up */ 1018 Y = Y - 1; 1019 go to position_cursor_wrap; 1020 1021 cursorpos_function (22): /* V: Move to line (arg 2) */ 1022 if nargs < 2 then go to cursorpos_returns_nil; 1023 if stack -> temp_type36 (2) & Fixed36 then Y = 1 + addr (stack -> temp (2)) -> fixedb; 1024 else go to cursorpos_returns_nil; 1025 go to position_cursor_bounded; 1026 1027 cursorpos_function (24): /* X: (cursorpos B) (cursorpos K) */ 1028 if X = 1 then go to cursorpos_K; 1029 X = X - 1; 1030 call window_$position_cursor (p, Y, X, code); 1031 if code ^= 0 then go to cursorpos_returns_nil; 1032 go to cursorpos_K; 1033 1034 cursorpos_function (26): /* Z: position to lower-left corner */ 1035 X = 1; 1036 Y = 100000; /* Make sure it's out of bounds */ 1037 go to position_cursor_bounded; 1038 1039 cursorpos_function (27): /* [: insert line */ 1040 i = -1; 1041 go to idel_lines_common; 1042 1043 cursorpos_function (28): /* \: delete line */ 1044 i = 1; 1045 1046 idel_lines_common: 1047 call get_window_info; 1048 call window_$scroll_region (p, Y, (window_info.extent.height - Y + 1), i, code); 1049 go to cursorpos_check_code; 1050 1051 cursorpos_function (30): /* ^: insert char */ 1052 call window_$insert_text (p, " ", code); 1053 if code ^= 0 then go to cursorpos_returns_nil; 1054 call window_$position_cursor (p, Y, X, code); 1055 go to cursorpos_check_code; 1056 1057 cursorpos_function (31): /* _: delete char */ 1058 call window_$delete_chars (p, 1, code); 1059 go to cursorpos_check_code; 1060 1061 cursorpos_function (0): /* Undefined cursorpos function */ 1062 cursorpos_function (7): /* G: unused */ 1063 cursorpos_function (9): /* I: outut character (arg 2) -- 1064* not implemented on Multics */ 1065 cursorpos_function (10): /* J: unused */ 1066 cursorpos_function (15): /* O: unused */ 1067 cursorpos_function (16): /* P: output ^P -- unused in Multics */ 1068 cursorpos_function (17): /* Q: output ^C -- unused in Multics */ 1069 cursorpos_function (18): /* R: unused */ 1070 cursorpos_function (19): /* S: unused */ 1071 cursorpos_function (23): /* W: unused */ 1072 cursorpos_function (25): /* Y: unused */ 1073 cursorpos_returns_nil: 1074 stack -> temp(1) = nil; /* indicate not display tty */ 1075 go to exit; 1076 1077 cursorpos_returns_t: 1078 stack -> temp (1) = t_atom; /* It worked. */ 1079 go to exit; 1080 1081 1082 get_window_info: 1083 procedure; 1084 1085 window_info.version = window_position_info_version_1; 1086 call iox_$control (p, "get_window_info", addr (window_info), code); 1087 if code ^= 0 then go to cursorpos_returns_nil; 1088 1089 end; 1090 1091 /* subroutine to find true pathname, clobber into arg */ 1092 1093 find_true_name: procedure(vcs); 1094 1095 dcl vcs char(*) varying parameter; 1096 1097 dcl dn char(168), 1098 en char(32), 1099 fn char(168), 1100 rnl fixed bin, 1101 sgp pointer, 1102 code fixed bin(35), 1103 hcs_$fs_get_path_name entry(pointer, char(*), fixed bin, char(*), fixed bin(35)), 1104 hcs_$initiate entry(char(*), char(*), char(*), fixed bin, fixed bin, pointer, fixed bin(35)), 1105 expand_path_ entry(pointer, fixed bin, pointer, pointer, fixed bin(35)), 1106 hcs_$terminate_noname entry(pointer, fixed bin(35)); 1107 1108 dcl (null, substr, length, verify, reverse) builtin; 1109 1110 if substr(vcs, 1, 1) ^= ">" then return; 1111 fn = vcs; 1112 call expand_path_(addr(fn), 168, addr(dn), addr(en), code); 1113 if code ^= 0 then return; 1114 call hcs_$initiate(dn, en, "", 0, 0, sgp, code); 1115 if sgp = null then return; 1116 call hcs_$fs_get_path_name(sgp, dn, rnl, en, code); 1117 if code ^= 0 then return; 1118 call hcs_$terminate_noname(sgp, code); 1119 1120 if rnl > 1 then do; 1121 rnl = rnl + 1; 1122 substr(dn, rnl, 1) = ">"; 1123 end; 1124 vcs = substr(dn, 1, rnl) || substr(en, 1, 1+length(en)-verify(reverse(en), " ")); 1125 end find_true_name; 1126 1127 end; 1128 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/04/84 1533.2 lisp_io_fns_.pl1 >spec>on>09/04/84-6762>lisp_io_fns_.pl1 80 1 03/27/82 0437.0 lisp_io.incl.pl1 >ldd>include>lisp_io.incl.pl1 1-5 2 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 1-45 3 03/27/82 0437.0 lisp_control_chars.incl.pl1 >ldd>include>lisp_control_chars.incl.pl1 81 4 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 82 5 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 83 6 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 84 7 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 85 8 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 86 9 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 87 10 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 88 11 07/06/83 1111.5 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 868 12 09/04/84 1513.8 window_control_info.incl.pl1 >spec>on>09/04/84-6762>window_control_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Atsym constant bit(9) initial unaligned dcl 4-17 ref 256 Atsym36 constant bit(36) initial dcl 4-17 ref 466 526 532 582 592 748 943 Cons constant bit(9) initial unaligned dcl 4-17 ref 256 451 484 746 File36 constant bit(36) initial dcl 4-17 ref 168 452 583 690 894 Fixed36 constant bit(36) initial dcl 4-17 ref 929 933 990 1023 Numeric36 constant bit(36) initial dcl 4-17 ref 487 String constant bit(9) initial unaligned dcl 4-17 ref 856 String36 constant bit(36) initial dcl 4-17 ref 467 528 581 748 790 945 V$infile based fixed bin(71,0) dcl 42 set ref 693 696* 704 709* 711* 718 732 V$instack based fixed bin(71,0) dcl 42 set ref 692 695* 709 711 712* 712 719 721* Vp$instack based pointer dcl 42 ref 711 712 X 000275 automatic fixed bin(17,0) dcl 866 set ref 912* 920 933* 937* 937 939* 953 955* 959 959* 960 960* 963* 968* 968 984* 984 990* 994* 1006* 1013* 1027 1029* 1029 1030* 1034* 1054* Y 000276 automatic fixed bin(17,0) dcl 866 set ref 912* 919 929* 938* 938 939* 956* 956 961 961* 962 962* 963* 976* 976 994* 1004* 1008* 1008 1013* 1017* 1017 1023* 1030* 1036* 1048* 1048 1054* a_myname parameter fixed bin(17,0) dcl 572 ref 570 574 addr builtin function dcl 42 ref 213 219 303 324 326 329 331 384 398 493 497 498 550 582 607 625 625 625 625 625 625 625 625 646 671 674 691 692 692 693 693 695 695 696 696 704 704 709 709 709 709 711 711 711 711 711 712 712 712 712 712 717 718 718 719 719 721 721 732 732 733 755 785 826 828 833 833 833 842 845 856 857 858 917 919 920 929 933 990 1023 1086 1086 1112 1112 1112 1112 1112 1112 addrel builtin function dcl 42 ref 161 164 206 412 448 491 550 557 575 625 625 644 689 745 832 833 884 886 an_area 000372 automatic area(4096) dcl 815 set ref 815* 833 833 atom based structure level 1 dcl 6-5 back_ptr 1 based bit(18) level 2 packed unaligned dcl 5-7 set ref 499* 521 bad_arg_correctable defined fixed bin(17,0) dcl 33 ref 193 461 588 725 750 based_ptr based pointer dcl 4-16 ref 692 693 695 696 704 709 709 711 711 712 712 718 719 721 732 733 857 858 binding_block based structure level 1 dcl 5-7 binding_top defined pointer dcl 10-6 set ref 499 502* 521* 521 blank 000065 constant char(3) initial unaligned dcl 42 ref 599 601 633 652 bot_block 0(18) based bit(18) level 2 packed unaligned dcl 5-7 set ref 497* bug_fixer 010400 automatic char(168) unaligned dcl 839 set ref 840* 841* 841 842 bug_fixer_aa based char unaligned dcl 839 set ref 842* cant_filepos defined fixed bin(17,0) dcl 33 ref 381 car based fixed bin(71,0) level 2 in structure "cons" dcl 7-5 in procedure "lisp_io_fns_" ref 472 507 711 758 781 car based pointer level 2 in structure "cons_ptrs" dcl 7-5 in procedure "lisp_io_fns_" ref 469 476 526 528 782 791 796 car based bit(36) level 2 in structure "cons_types36" dcl 7-22 in procedure "lisp_io_fns_" ref 466 467 487 526 528 592 748 790 car 0(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 7-5 in procedure "lisp_io_fns_" ref 256 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 7-5 in procedure "lisp_io_fns_" ref 484 530 712 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 7-5 in procedure "lisp_io_fns_" ref 782 char builtin function dcl 42 ref 635 635 840 841 charpos 13 based fixed bin(17,0) level 2 dcl 2-13 set ref 230 234* 263 267* code 010636 automatic fixed bin(35,0) dcl 1097 in procedure "find_true_name" set ref 1112* 1113 1114* 1116* 1117 1118* code 000206 automatic fixed bin(35,0) dcl 42 in procedure "lisp_io_fns_" set ref 625* 630 782* 784 833* 835 906* 907 912* 913 939* 963* 964 972* 980* 994* 999* 1009* 1010 1030* 1031 1048* 1051* 1053 1054* 1057* 1086* 1087 component 12 based fixed bin(17,0) level 2 dcl 2-13 set ref 345 371* cons based structure level 1 dcl 7-5 cons_ptrs based structure level 1 dcl 7-5 cons_types based structure level 1 dcl 7-5 cons_types36 based structure level 1 dcl 7-22 ctrlQ defined fixed bin(71,0) dcl 3-8 set ref 733 divide builtin function dcl 42 ref 427 855 855 888 dn 010476 automatic char(168) unaligned dcl 1097 in procedure "find_true_name" set ref 1112 1112 1114* 1116* 1122* 1124 dn 000207 automatic char(168) unaligned dcl 42 in procedure "lisp_io_fns_" set ref 621* 622 622 625 625 633 634 635 635 773* 775* 777* 791* 796* 829 833* 841 dnl 010372 automatic fixed bin(17,0) dcl 817 set ref 829* 841 842 842 ecount 010373 automatic fixed bin(17,0) dcl 819 set ref 833* 837 en 010550 automatic char(32) unaligned dcl 1097 in procedure "find_true_name" set ref 1112 1112 1114* 1116* 1124 1124 1124 en 000261 automatic char(32) unaligned dcl 42 in procedure "lisp_io_fns_" set ref 625 625 647 648 650 652 653 654 654 658 658 664 665 669 669 943* 945* 947 entries based structure array level 1 dcl 819 eptr 010374 automatic pointer dcl 819 set ref 833* 838 840 ercode based fixed bin(17,0) array dcl 201 set ref 206 207* 208* err 000110 automatic fixed bin(17,0) dcl 21 set ref 193* 207 225* 381* 391 395* 461* 588* 725* 750* esw 000100 automatic fixed bin(17,0) dcl 21 set ref 95* 101* 107* 113* 120* 126* 132* 138* 144* 150* 170 182 184 expand_path_ 000044 constant entry external dcl 42 in procedure "lisp_io_fns_" ref 625 expand_path_ 000154 constant entry external dcl 1097 in procedure "find_true_name" ref 1112 extent 3 000302 automatic structure level 2 dcl 869 fail_act_f 000274 automatic bit(1) dcl 42 set ref 347 360 367 410* 411 424* 426* 483* fcbp 6 based pointer level 2 dcl 2-13 set ref 425* 904 906* 910 filepos_oob defined fixed bin(17,0) dcl 33 ref 391 395 fixed builtin function dcl 42 ref 699 fixedb 1 based fixed bin(17,0) level 2 dcl 8-4 set ref 163 309* 326 699* 702 707 707 715 885 919* 920* 929 933 990 1023 fixnum_fmt based structure level 1 dcl 8-4 fixnum_type constant bit(36) initial dcl 8-4 ref 306 324 702 918 flags 15 based structure level 2 packed unaligned dcl 2-13 ref 409 floatb 1 based float bin(27) level 2 dcl 8-4 ref 331 699 flonum_fmt based structure level 1 dcl 8-4 flonum_type constant bit(36) initial dcl 8-4 ref 329 698 fn 010560 automatic char(168) unaligned dcl 1097 set ref 1111* 1112 1112 fn_allfiles constant fixed bin(17,0) initial dcl 11-9 ref 744 fn_charpos constant fixed bin(17,0) initial dcl 11-9 ref 127 fn_chrct constant fixed bin(17,0) initial dcl 11-9 ref 96 fn_defaultf 000010 internal static fixed bin(17,0) initial dcl 11-9 set ref 555* fn_endpagefn constant fixed bin(17,0) initial dcl 11-9 ref 151 fn_eoffn 006550 constant fixed bin(17,0) initial dcl 11-9 ref 102 220 fn_filepos constant fixed bin(17,0) initial dcl 11-9 ref 108 fn_inpush constant fixed bin(17,0) initial dcl 11-9 ref 724 fn_linel constant fixed bin(17,0) initial dcl 11-9 ref 114 fn_linenum constant fixed bin(17,0) initial dcl 11-9 ref 139 fn_namelist constant fixed bin(17,0) initial dcl 11-9 ref 566 fn_names constant fixed bin(17,0) initial dcl 11-9 ref 121 fn_namestring constant fixed bin(17,0) initial dcl 11-9 ref 441 fn_pagel constant fixed bin(17,0) initial dcl 11-9 ref 133 fn_pagenum constant fixed bin(17,0) initial dcl 11-9 ref 145 fn_shortnamestring 006547 constant fixed bin(17,0) initial dcl 11-9 ref 446 468 472 fn_truename 006546 constant fixed bin(17,0) initial dcl 11-9 ref 436 546 function 16 based fixed bin(71,0) level 2 dcl 2-13 set ref 237 241* 291 295* get_at_entry_ 000054 constant entry external dcl 42 ref 782 get_default_wdir_ 000050 constant entry external dcl 42 ref 775 get_pdir_ 000046 constant entry external dcl 42 ref 621 get_wdir_ 000052 constant entry external dcl 42 ref 777 hcs_$fs_get_path_name 000150 constant entry external dcl 1097 ref 1116 hcs_$initiate 000152 constant entry external dcl 1097 ref 1114 hcs_$star_ 000036 constant entry external dcl 42 ref 833 hcs_$terminate_noname 000156 constant entry external dcl 1097 ref 1118 height 4 000302 automatic fixed bin(17,0) level 3 dcl 869 set ref 938 961 962 1048 i 000113 automatic fixed bin(17,0) dcl 21 set ref 345* 345* 358* 365* 371 425* 599* 600 601 602 604 837* 838 840* 1039* 1043* 1048* index builtin function dcl 42 ref 622 947 io_wrong_direction defined fixed bin(17,0) dcl 33 ref 225 iochan based structure level 1 dcl 2-13 ioindex based fixed bin(24,0) level 2 dcl 2-13 set ref 350 373* iolength 1 based fixed bin(24,0) level 2 dcl 2-13 set ref 374* ioptr 2 based pointer level 2 dcl 2-13 set ref 375* iox_$control 000112 constant entry external dcl 870 ref 1086 iox_$look_iocb 000114 constant entry external dcl 871 ref 906 j 000205 automatic fixed bin(17,0) dcl 42 set ref 601* 602 602* 603 604 633* 634 634* 635 635 647* 648 648 650 651 652* 653 653* 654 654 658 658 659 664 664* 665 669 669 838* 838 838* 840 842 842 k 000204 automatic fixed bin(17,0) dcl 42 set ref 640* 647 648 650 651* 651 654 654 654 654 658 658 659* 659 664 665 669 669 len 000114 automatic fixed bin(17,0) dcl 21 set ref 344* 348* 348 350 length builtin function dcl 42 in procedure "lisp_io_fns_" ref 538 538 550 550 618 625 625 625 625 634 653 664 829 833 833 855 855 857 length builtin function dcl 1108 in procedure "find_true_name" ref 1124 linel 14 based fixed bin(17,0) level 2 dcl 2-13 set ref 230 234 245 249* linenum 33 based fixed bin(17,0) level 2 dcl 2-13 set ref 277 281* lisp_alloc_ 000030 constant entry external dcl 42 ref 855 lisp_error_ 000142 constant entry external dcl 201 ref 209 lisp_error_table_$bad_arg_correctable 000012 external static fixed bin(17,0) dcl 33 ref 193 193 461 461 588 588 725 725 750 750 lisp_error_table_$cant_filepos 000016 external static fixed bin(17,0) dcl 33 ref 381 381 lisp_error_table_$filepos_oob 000020 external static fixed bin(17,0) dcl 33 ref 391 391 395 395 lisp_error_table_$io_wrong_direction 000014 external static fixed bin(17,0) dcl 33 ref 225 225 lisp_get_atom_ 000056 constant entry external dcl 42 ref 220 222 610 635 654 658 669 lisp_io_control_$fix_not_ok_iochan 000032 constant entry external dcl 42 ref 410 lisp_print_$exploden 000146 constant entry external dcl 488 ref 508 lisp_ptr based structure level 1 dcl 4-17 lisp_reader_$maknam 000144 constant entry external dcl 488 ref 512 lisp_special_fns_$cons 000064 constant entry external dcl 42 ref 217 218 389 390 391 611 612 678 694 720 921 lisp_special_fns_$ncons 000040 constant entry external dcl 42 ref 786 lisp_special_fns_$xcons 000042 constant entry external dcl 42 ref 223 844 lisp_static_vars_$STAR 000060 external static fixed bin(71,0) dcl 42 ref 532 532 631 631 666 666 758 758 lisp_static_vars_$binding_top 000102 external static pointer dcl 10-6 set ref 499 499 502* 502 521* 521 521 521 lisp_static_vars_$ctrlQ 000072 external static fixed bin(71,0) dcl 3-8 ref 733 733 lisp_static_vars_$eof_atom 000024 external static fixed bin(71,0) dcl 42 ref 356 lisp_static_vars_$filepos 000066 external static fixed bin(71,0) dcl 42 ref 388 lisp_static_vars_$infile 000022 external static fixed bin(71,0) dcl 42 set ref 693 696 704 709 711 718 732 lisp_static_vars_$instack 000026 external static fixed bin(71,0) dcl 42 set ref 692 695 709 711 712 712 719 721 lisp_static_vars_$nil 000104 external static fixed bin(71,0) dcl 10-6 ref 169 169 216 216 238 238 255 255 292 292 385 385 399 399 456 456 532 532 577 577 608 608 672 672 709 709 733 733 733 733 756 756 928 928 932 932 1061 1061 lisp_static_vars_$stack_ptr 000074 external static pointer dcl 10-6 set ref 161 161 213* 213 219* 219 303* 303 384* 384 398* 398 412 412 448 448 492 492 493* 493 523* 523 557 557 575 575 607* 607 646* 646 671* 671 674 674 689 689 691* 691 717* 717 745 745 755* 755 785* 785 826* 826 845* 845 884 884 917* 917 lisp_static_vars_$stnopoint 000070 external static fixed bin(71,0) dcl 1-17 ref 500 lisp_static_vars_$stream 000062 external static fixed bin(71,0) dcl 42 ref 472 472 609 609 781 781 lisp_static_vars_$t_atom 000076 external static fixed bin(71,0) dcl 10-6 ref 503 503 709 709 733 733 893 893 1077 1077 lisp_static_vars_$tty_input_chan 000106 external static pointer dcl 10-6 ref 170 170 lisp_static_vars_$tty_output_chan 000110 external static pointer dcl 10-6 ref 171 171 457 457 561 561 578 578 889 889 893 893 898 898 lisp_static_vars_$unmkd_ptr 000100 external static pointer dcl 10-6 set ref 205 205 206* 206 490 490 491* 491 522* 522 lisp_string based structure level 1 dcl 9-6 loser parameter fixed bin(71,0) dcl 190 set ref 188 192 195* m 000112 automatic fixed bin(17,0) dcl 21 set ref 348 361 368 368 374 425* 427* 427 msf_manager_$get_ptr 000034 constant entry external dcl 42 ref 425 myname 000101 automatic fixed bin(17,0) dcl 21 set ref 96* 102* 108* 114* 121* 127* 133* 139* 145* 151* 208 220 436* 441* 446* 468 472 546 566* 574* 724* 744* 746* 843* n 000111 automatic fixed bin(17,0) dcl 21 set ref 230* 234 245* 249 263* 267 270* 274 277* 281 284* 288 309 326* 331* 350* 357* 361* 361 368 368* 368 373 707* 707* 715* name 22 based char(32) level 2 packed unaligned dcl 2-13 set ref 906* namelist 20 based fixed bin(71,0) level 2 dcl 2-13 set ref 252 259* 453 457 561* 578 584 names_str based char(32) array dcl 819 ref 838 840 nargs 000104 automatic fixed bin(17,0) dcl 21 set ref 163* 164 182 885* 886 888* 888 889 892* 892 893 894 894 897* 897 915 926 988 1021 nil defined fixed bin(71,0) dcl 10-6 ref 169 216 238 255 292 385 399 456 532 577 608 672 709 733 733 756 928 932 1061 nindex 0(18) based fixed bin(17,0) array level 2 packed unaligned dcl 819 ref 838 840 not_ok_to_read constant bit(36) initial unaligned dcl 1-9 ref 409 nptr 010376 automatic pointer dcl 819 set ref 833* 838 840 null builtin function dcl 1108 in procedure "find_true_name" ref 1115 null builtin function dcl 42 in procedure "lisp_io_fns_" ref 426 904 p 000202 automatic pointer dcl 21 set ref 170* 171* 181* 230 230 234 234 237 237 241 241 245 249 252 259 263 267 270 274 277 281 284 288 291 291 295 295 345 350 371 373 374 375 408 409 410* 425 581* 582* 599 601 602 604 889* 893* 894* 898* 902 904 906 906 910* 910 912* 939* 963* 972* 980* 994* 999* 1009* 1030* 1048* 1051* 1054* 1057* 1086* pagel 32 based fixed bin(17,0) level 2 dcl 2-13 set ref 270 274* pagenum 34 based fixed bin(17,0) level 2 dcl 2-13 set ref 284 288* pdl_ptr_types36 based structure array level 1 dcl 5-7 pname 5 based char level 2 dcl 6-5 set ref 476 516 526 535 782* 796 943 pnamel 4 based fixed bin(17,0) level 2 dcl 6-5 set ref 476 516 526 535 582 782 782 796 943 point_blank 000064 constant char(4) initial unaligned dcl 42 ref 647 push_down_list_ptr_types based structure array level 1 dcl 5-7 read 15(01) based bit(1) level 3 packed unaligned dcl 2-13 ref 237 241 reverse builtin function dcl 1108 ref 1124 rnl 010632 automatic fixed bin(17,0) dcl 1097 set ref 1116* 1120 1121* 1121 1122 1124 search builtin function dcl 42 ref 601 631 633 647 652 838 seg 15 based bit(1) level 3 packed unaligned dcl 2-13 ref 408 902 sgp 000272 automatic pointer dcl 42 in procedure "lisp_io_fns_" set ref 375 425* 426 sgp 010634 automatic pointer dcl 1097 in procedure "find_true_name" set ref 1114* 1115 1116* 1118* size builtin function dcl 42 ref 206 stack 000102 automatic pointer dcl 21 set ref 164* 168 169 175 181 213 216 219 220 222 237 238 241 252 255 256 256 257 259 291 292 295 303 306 309 312 312 324 326 329 331 334 356 384 385 386 386 388 398 399 400 400 412 448* 451 452 453 453 456 457 466 467 469 472 476 484 484 484 487 507 526 526 528 528 530 532 532 532 535 550 575* 577 578 581 581 582 582 583 584 584 587 592 607 608 609 610 631 635 641 674 689* 690 691 692 693 695 696 698 699 699 702 702 704 707 707 715 717 718 719 721 732 733 733 745* 746 748 755 756 758 781 782 785 790 791 796 826 827 827 828* 828 832* 832 842 845 884* 885 886* 886 893 894 894 917 918 918 919 920 928 929 929 932 933 933 943 943 945 945 990 990 1023 1023 1061 1077 stack_ptr defined pointer dcl 10-6 set ref 161 213* 219* 303* 384* 398* 412 448 492 493* 523* 557 575 607* 646* 671* 674 689 691* 717* 745 755* 785* 826* 845* 884 917* star defined fixed bin(71,0) dcl 42 ref 532 631 666 758 stream defined fixed bin(71,0) dcl 42 ref 472 609 781 string builtin function dcl 42 in procedure "lisp_io_fns_" ref 409 string 1 based char level 2 in structure "lisp_string" dcl 9-6 in procedure "lisp_io_fns_" set ref 469 528 599 601 604 791 858* 945 string_length based fixed bin(17,0) level 2 dcl 9-6 set ref 469 528 599 601 602 604 791 857* 858 945 substr builtin function dcl 1108 in procedure "find_true_name" set ref 1110 1122* 1124 1124 substr builtin function dcl 42 in procedure "lisp_io_fns_" ref 538 538 601 604 606 610 610 618 622 622 647 648 650 654 654 658 658 665 669 669 947 t_atom defined fixed bin(71,0) dcl 10-6 ref 503 709 733 893 1077 temp based fixed bin(71,0) array dcl 5-7 set ref 169 175* 192* 195 213 216* 219 220* 222* 237* 238* 241 252* 255 257* 259 291* 292* 295 303 312* 312 324 326 329 331 334* 356 384 385* 386* 386 388* 398 399* 400* 400 412* 412 453* 456 457* 484* 493 497 498 500* 501* 507* 520 532 532 550* 561 577 578* 584* 607 608* 609* 610* 631* 635* 646 654* 658* 666* 669* 671 672* 674 691 692* 693* 695 696 704* 717 718* 719* 721 732* 733 733 755 756* 785 826 827* 827 828 842* 845 893 917 919 920 928 929 932 933 990 1023 1061* 1077* temp_ptr based pointer array dcl 5-7 ref 181 256 453 466 467 469 472 476 484 487 501 503 507 516 520 526 526 528 528 530 535 581 582 584 592 748 758 781 782 790 791 796 894 943 945 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 5-7 ref 256 451 484 587 746 temp_type36 based bit(36) array level 2 dcl 5-7 set ref 168 452 532 581 582 583 690 894 918* 918* 929 933 943 945 990 1023 the_string parameter char unaligned dcl 853 ref 851 855 855 857 858 top_block based bit(18) level 2 packed unaligned dcl 5-7 set ref 498* ts 000360 automatic pointer dcl 488 set ref 492* 493 497 498 500 501 501 503 507 516 520 520 523 tsp 000106 automatic pointer dcl 21 set ref 161* 163 164 192 195 557* 561 641* 644* 644 646 654 658 666 669 671 672 tty_input_chan defined pointer dcl 10-6 ref 170 tty_output_chan defined pointer dcl 10-6 ref 171 457 561 578 889 893 898 type 0(21) based bit(9) level 2 packed unaligned dcl 4-17 set ref 856* type_info based bit(36) level 2 in structure "flonum_fmt" dcl 8-4 in procedure "lisp_io_fns_" ref 329 698 type_info based bit(36) level 2 in structure "fixnum_fmt" dcl 8-4 in procedure "lisp_io_fns_" set ref 306* 324 702 unm 000324 automatic pointer dcl 201 in procedure "error" set ref 205* 206 206 207 208 unm 000362 automatic pointer dcl 488 in begin block on line 487 set ref 490* 491 497 498 499 502 521 522 unmkd_ptr defined pointer dcl 10-6 set ref 205 206* 490 491* 522* value based fixed bin(71,0) level 2 dcl 6-5 set ref 501 503* 520* 692 693 695 696 704 709 709 711 711 712 712 718 719 721 732 733* vcs 000115 automatic varying char(208) dcl 21 in procedure "lisp_io_fns_" set ref 468* 469* 472* 476* 477* 516* 516 526* 526 528* 528 532* 532 535* 535 538 538 538* 538 538 546* 550 550 550 604* 606 610 610 618 618 622* 622 625 625 625 625 625 625 631 830* 833 833 833 vcs parameter varying char dcl 1095 in procedure "find_true_name" set ref 1093 1110 1111 1124* vcs_bit_bucket 000300 automatic varying char(1) dcl 867 set ref 1009* vcso based char unaligned dcl 21 set ref 550* 625 625 833* verify builtin function dcl 42 in procedure "lisp_io_fns_" ref 599 verify builtin function dcl 1108 in procedure "find_true_name" ref 1124 version 000302 automatic fixed bin(17,0) level 2 dcl 869 set ref 1085* where_to_put_it parameter fixed bin(71,0) dcl 853 set ref 851 855* 856 857 858 width 3 000302 automatic fixed bin(17,0) level 3 dcl 869 set ref 937 959 960 window_$clear_region 000116 constant entry external dcl 872 ref 994 window_$clear_to_end_of_line 000120 constant entry external dcl 873 ref 999 window_$clear_to_end_of_window 000122 constant entry external dcl 874 ref 980 window_$clear_window 000124 constant entry external dcl 875 ref 972 window_$delete_chars 000126 constant entry external dcl 876 ref 1057 window_$get_cursor_position 000130 constant entry external dcl 877 ref 912 window_$get_one_unechoed_char 000132 constant entry external dcl 878 ref 1009 window_$insert_text 000134 constant entry external dcl 879 ref 1051 window_$position_cursor 000136 constant entry external dcl 880 ref 939 963 1030 1054 window_$scroll_region 000140 constant entry external dcl 881 ref 1048 window_info 000302 automatic structure level 1 dcl 869 set ref 1086 1086 window_position_info based structure level 1 unaligned dcl 12-25 window_position_info_version_1 constant fixed bin(17,0) initial dcl 12-35 ref 1085 write 15(02) based bit(1) level 3 packed unaligned dcl 2-13 ref 291 295 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Array internal static bit(9) initial unaligned dcl 4-17 Array36 internal static bit(36) initial dcl 4-17 Atomic internal static bit(9) initial unaligned dcl 4-17 Atomic36 internal static bit(36) initial dcl 4-17 Bigfix internal static bit(9) initial unaligned dcl 4-17 Bigfix36 internal static bit(36) initial dcl 4-17 Bignum internal static bit(9) initial unaligned dcl 4-17 Bignum36 internal static bit(36) initial dcl 4-17 Cons36 internal static bit(36) initial dcl 4-17 File internal static bit(9) initial unaligned dcl 4-17 Fixed internal static bit(9) initial unaligned dcl 4-17 Float internal static bit(9) initial unaligned dcl 4-17 Float36 internal static bit(36) initial dcl 4-17 NotConsOrAtsym36 internal static bit(36) initial dcl 4-17 Numeric internal static bit(9) initial unaligned dcl 4-17 Subr internal static bit(9) initial unaligned dcl 4-17 Subr36 internal static bit(36) initial dcl 4-17 SubrNumeric36 internal static bit(36) initial dcl 4-17 System_Subr internal static bit(9) initial unaligned dcl 4-17 System_Subr36 internal static bit(36) initial dcl 4-17 Uncollectable internal static bit(9) initial unaligned dcl 4-17 Undefined internal static bit(72) initial unaligned dcl 4-17 array_atom defined fixed bin(71,0) dcl 10-6 atom_double_words based structure level 1 dcl 6-5 atom_ptrs based structure level 1 dcl 6-5 base defined fixed bin(71,0) dcl 1-17 bindings based structure array level 1 dcl 5-7 break_table_info based structure level 1 dcl 12-76 break_table_info_version internal static fixed bin(17,0) initial dcl 12-80 break_table_info_version_1 internal static fixed bin(17,0) initial dcl 12-80 break_table_ptr automatic pointer dcl 12-75 catch_frame defined pointer dcl 10-6 consptr automatic pointer dcl 7-5 ctrlD defined fixed bin(71,0) dcl 3-5 ctrlR defined fixed bin(71,0) dcl 3-11 ctrlW defined fixed bin(71,0) dcl 3-14 enl automatic fixed bin(17,0) dcl 42 err_frame defined pointer dcl 10-6 err_recp defined pointer dcl 10-6 eval_frame defined pointer dcl 10-6 flag_reset_mask internal static bit(36) initial dcl 2-13 fn_CtoI internal static fixed bin(17,0) initial dcl 11-9 fn_ItoC internal static fixed bin(17,0) initial dcl 11-9 fn_abs internal static fixed bin(17,0) initial dcl 11-9 fn_add1 internal static fixed bin(17,0) initial dcl 11-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 11-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 11-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 11-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 11-9 fn_apply internal static fixed bin(17,0) initial dcl 11-9 fn_arg internal static fixed bin(17,0) initial dcl 11-9 fn_args internal static fixed bin(17,0) initial dcl 11-9 fn_array internal static fixed bin(17,0) initial dcl 11-9 fn_arraydims internal static fixed bin(17,0) initial dcl 11-9 fn_ascii internal static fixed bin(17,0) initial dcl 11-9 fn_atan internal static fixed bin(17,0) initial dcl 11-9 fn_baktrace internal static fixed bin(17,0) initial dcl 11-9 fn_bltarray internal static fixed bin(17,0) initial dcl 11-9 fn_boole internal static fixed bin(17,0) initial dcl 11-9 fn_boundp internal static fixed bin(17,0) initial dcl 11-9 fn_catch internal static fixed bin(17,0) initial dcl 11-9 fn_catenate internal static fixed bin(17,0) initial dcl 11-9 fn_clear_input internal static fixed bin(17,0) initial dcl 11-9 fn_cline internal static fixed bin(17,0) initial dcl 11-9 fn_close internal static fixed bin(17,0) initial dcl 11-9 fn_cos internal static fixed bin(17,0) initial dcl 11-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 11-9 fn_definedp internal static fixed bin(17,0) initial dcl 11-9 fn_defsubr internal static fixed bin(17,0) initial dcl 11-9 fn_defun internal static fixed bin(17,0) initial dcl 11-9 fn_delete internal static fixed bin(17,0) initial dcl 11-9 fn_deletef internal static fixed bin(17,0) initial dcl 11-9 fn_delq internal static fixed bin(17,0) initial dcl 11-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 11-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 11-9 fn_difference internal static fixed bin(17,0) initial dcl 11-9 fn_displace internal static fixed bin(17,0) initial dcl 11-9 fn_do internal static fixed bin(17,0) initial dcl 11-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 11-9 fn_eql internal static fixed bin(17,0) initial dcl 11-9 fn_errframe internal static fixed bin(17,0) initial dcl 11-9 fn_errprint internal static fixed bin(17,0) initial dcl 11-9 fn_errset internal static fixed bin(17,0) initial dcl 11-9 fn_eval internal static fixed bin(17,0) initial dcl 11-9 fn_eval_when internal static fixed bin(17,0) initial dcl 11-9 fn_evalframe internal static fixed bin(17,0) initial dcl 11-9 fn_exp internal static fixed bin(17,0) initial dcl 11-9 fn_expt internal static fixed bin(17,0) initial dcl 11-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 11-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 11-9 fn_fillarray internal static fixed bin(17,0) initial dcl 11-9 fn_fix internal static fixed bin(17,0) initial dcl 11-9 fn_float internal static fixed bin(17,0) initial dcl 11-9 fn_force_output internal static fixed bin(17,0) initial dcl 11-9 fn_freturn internal static fixed bin(17,0) initial dcl 11-9 fn_fsc internal static fixed bin(17,0) initial dcl 11-9 fn_gcd internal static fixed bin(17,0) initial dcl 11-9 fn_gensym internal static fixed bin(17,0) initial dcl 11-9 fn_get internal static fixed bin(17,0) initial dcl 11-9 fn_get_pname internal static fixed bin(17,0) initial dcl 11-9 fn_getchar internal static fixed bin(17,0) initial dcl 11-9 fn_getl internal static fixed bin(17,0) initial dcl 11-9 fn_greaterp internal static fixed bin(17,0) initial dcl 11-9 fn_gt internal static fixed bin(17,0) initial dcl 11-9 fn_haipart internal static fixed bin(17,0) initial dcl 11-9 fn_haulong internal static fixed bin(17,0) initial dcl 11-9 fn_ifix internal static fixed bin(17,0) initial dcl 11-9 fn_in internal static fixed bin(17,0) initial dcl 11-9 fn_includef internal static fixed bin(17,0) initial dcl 11-9 fn_index internal static fixed bin(17,0) initial dcl 11-9 fn_isqrt internal static fixed bin(17,0) initial dcl 11-9 fn_lessp internal static fixed bin(17,0) initial dcl 11-9 fn_listarray internal static fixed bin(17,0) initial dcl 11-9 fn_listify internal static fixed bin(17,0) initial dcl 11-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 11-9 fn_log internal static fixed bin(17,0) initial dcl 11-9 fn_ls internal static fixed bin(17,0) initial dcl 11-9 fn_lsh internal static fixed bin(17,0) initial dcl 11-9 fn_make_atom internal static fixed bin(17,0) initial dcl 11-9 fn_makunbound internal static fixed bin(17,0) initial dcl 11-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 11-9 fn_max internal static fixed bin(17,0) initial dcl 11-9 fn_mergef internal static fixed bin(17,0) initial dcl 11-9 fn_min internal static fixed bin(17,0) initial dcl 11-9 fn_minus internal static fixed bin(17,0) initial dcl 11-9 fn_minusp internal static fixed bin(17,0) initial dcl 11-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 11-9 fn_nth internal static fixed bin(17,0) initial dcl 11-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 11-9 fn_oddp internal static fixed bin(17,0) initial dcl 11-9 fn_open internal static fixed bin(17,0) initial dcl 11-9 fn_opena internal static fixed bin(17,0) initial dcl 11-9 fn_openi internal static fixed bin(17,0) initial dcl 11-9 fn_openo internal static fixed bin(17,0) initial dcl 11-9 fn_out internal static fixed bin(17,0) initial dcl 11-9 fn_plus internal static fixed bin(17,0) initial dcl 11-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 11-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 11-9 fn_plusp internal static fixed bin(17,0) initial dcl 11-9 fn_prin1 internal static fixed bin(17,0) initial dcl 11-9 fn_princ internal static fixed bin(17,0) initial dcl 11-9 fn_print internal static fixed bin(17,0) initial dcl 11-9 fn_prog internal static fixed bin(17,0) initial dcl 11-9 fn_progv internal static fixed bin(17,0) initial dcl 11-9 fn_putprop internal static fixed bin(17,0) initial dcl 11-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 11-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 11-9 fn_quotient internal static fixed bin(17,0) initial dcl 11-9 fn_random internal static fixed bin(17,0) initial dcl 11-9 fn_read internal static fixed bin(17,0) initial dcl 11-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 11-9 fn_readch internal static fixed bin(17,0) initial dcl 11-9 fn_readstring internal static fixed bin(17,0) initial dcl 11-9 fn_remainder internal static fixed bin(17,0) initial dcl 11-9 fn_remprop internal static fixed bin(17,0) initial dcl 11-9 fn_rename internal static fixed bin(17,0) initial dcl 11-9 fn_rot internal static fixed bin(17,0) initial dcl 11-9 fn_rplaca internal static fixed bin(17,0) initial dcl 11-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 11-9 fn_save internal static fixed bin(17,0) initial dcl 11-9 fn_set internal static fixed bin(17,0) initial dcl 11-9 fn_setarg internal static fixed bin(17,0) initial dcl 11-9 fn_setq internal static fixed bin(17,0) initial dcl 11-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 11-9 fn_signp internal static fixed bin(17,0) initial dcl 11-9 fn_sin internal static fixed bin(17,0) initial dcl 11-9 fn_sleep internal static fixed bin(17,0) initial dcl 11-9 fn_sort internal static fixed bin(17,0) initial dcl 11-9 fn_sortcar internal static fixed bin(17,0) initial dcl 11-9 fn_sqrt internal static fixed bin(17,0) initial dcl 11-9 fn_sstatus internal static fixed bin(17,0) initial dcl 11-9 fn_star_array internal static fixed bin(17,0) initial dcl 11-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 11-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 11-9 fn_star_status internal static fixed bin(17,0) initial dcl 11-9 fn_status internal static fixed bin(17,0) initial dcl 11-9 fn_store internal static fixed bin(17,0) initial dcl 11-9 fn_stringlength internal static fixed bin(17,0) initial dcl 11-9 fn_sub1 internal static fixed bin(17,0) initial dcl 11-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 11-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 11-9 fn_substr internal static fixed bin(17,0) initial dcl 11-9 fn_sxhash internal static fixed bin(17,0) initial dcl 11-9 fn_sysp internal static fixed bin(17,0) initial dcl 11-9 fn_throw internal static fixed bin(17,0) initial dcl 11-9 fn_times internal static fixed bin(17,0) initial dcl 11-9 fn_times_fix internal static fixed bin(17,0) initial dcl 11-9 fn_times_flo internal static fixed bin(17,0) initial dcl 11-9 fn_tyi internal static fixed bin(17,0) initial dcl 11-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 11-9 fn_tyo internal static fixed bin(17,0) initial dcl 11-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 11-9 fn_zerop internal static fixed bin(17,0) initial dcl 11-9 get_editor_key_bindings_info based structure level 1 dcl 12-151 get_editor_key_bindings_info_ptr automatic pointer dcl 12-159 get_editor_key_bindings_info_version_1 internal static char(8) initial unaligned dcl 12-160 ibase defined fixed bin(71,0) dcl 1-17 line_editor_binding_count automatic fixed bin(17,0) dcl 12-121 line_editor_key_binding_info based structure level 1 dcl 12-129 line_editor_key_binding_info_ptr automatic pointer dcl 12-118 line_editor_key_binding_info_version_3 internal static char(8) initial unaligned dcl 12-148 line_editor_longest_sequence automatic fixed bin(17,0) dcl 12-123 lisp_ptr_type based bit(36) dcl 4-17 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 10-6 lisp_static_vars_$base external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$catch_frame external static pointer dcl 10-6 lisp_static_vars_$ctrlD external static fixed bin(71,0) dcl 3-5 lisp_static_vars_$ctrlR external static fixed bin(71,0) dcl 3-11 lisp_static_vars_$ctrlW external static fixed bin(71,0) dcl 3-14 lisp_static_vars_$err_frame external static pointer dcl 10-6 lisp_static_vars_$err_recp external static pointer dcl 10-6 lisp_static_vars_$eval_frame external static pointer dcl 10-6 lisp_static_vars_$ibase external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$iochan_list external static pointer dcl 10-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 10-6 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 10-6 lisp_static_vars_$plus_status external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$prog_frame external static pointer dcl 10-6 lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$read_print_nl_sync external static bit(36) unaligned dcl 1-17 lisp_static_vars_$readtable external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 10-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$top_level external static label variable dcl 10-6 lisp_static_vars_$tty_atom external static fixed bin(71,0) dcl 1-17 lisp_static_vars_$unwp_frame external static pointer dcl 10-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 10-45 more_handler_info based structure level 1 dcl 12-83 more_handler_info_ptr automatic pointer dcl 12-92 more_handler_info_version internal static fixed bin(17,0) initial dcl 12-94 more_handler_info_version_3 internal static fixed bin(17,0) initial dcl 12-94 more_prompt_info based structure level 1 dcl 12-108 more_prompt_info_ptr automatic pointer dcl 12-112 more_prompt_info_version_1 internal static char(8) initial unaligned dcl 12-114 more_responses_info based structure level 1 dcl 12-59 more_responses_info_ptr automatic pointer dcl 12-69 more_responses_info_version_1 internal static fixed bin(17,0) initial dcl 12-67 more_responses_version internal static fixed bin(17,0) initial dcl 12-67 nil_ptr based pointer dcl 10-6 not_ok_to_read_fixnum internal static bit(36) initial unaligned dcl 1-11 not_ok_to_write internal static bit(36) initial unaligned dcl 1-9 not_ok_to_write_fixnum internal static bit(36) initial unaligned dcl 1-11 obarray defined fixed bin(71,0) dcl 10-6 plus_status defined fixed bin(71,0) dcl 1-17 prog_frame defined pointer dcl 10-6 quote_atom defined fixed bin(71,0) dcl 1-17 read_print_nl_sync defined bit(36) unaligned dcl 1-17 readtable defined fixed bin(71,0) dcl 1-17 s_atom defined fixed bin(71,0) dcl 1-17 set_editor_key_bindings_info based structure level 1 dcl 12-162 set_editor_key_bindings_info_ptr automatic pointer dcl 12-171 set_editor_key_bindings_info_version_1 internal static char(8) initial unaligned dcl 12-172 star_rset defined fixed bin(71,0) dcl 10-45 status_gctwa defined fixed bin(71,0) dcl 1-17 stnopoint defined fixed bin(71,0) dcl 1-17 t_atom_ptr based pointer dcl 10-6 token_characters_info based structure level 1 dcl 12-97 token_characters_info_ptr automatic pointer dcl 12-104 token_characters_info_version_1 internal static char(8) initial unaligned dcl 12-106 tty_atom defined fixed bin(71,0) dcl 1-17 unwp_frame defined pointer dcl 10-6 user_intr_array defined fixed bin(71,0) array dcl 10-45 window_edit_line_info based structure level 1 unaligned dcl 12-177 window_edit_line_info_ptr automatic pointer dcl 12-186 window_edit_line_info_version_1 internal static char(8) initial unaligned dcl 12-183 window_position_info_ptr automatic pointer dcl 12-37 window_position_info_version internal static fixed bin(17,0) initial dcl 12-35 window_status_info based structure level 1 dcl 12-45 window_status_info_ptr automatic pointer dcl 12-43 window_status_version internal static fixed bin(17,0) initial dcl 12-52 window_status_version_1 internal static fixed bin(17,0) initial dcl 12-52 NAMES DECLARED BY EXPLICIT CONTEXT. agn12 000354 constant label dcl 168 ref 176 allfiles 002424 constant entry external dcl 742 allfiles_aa 002440 constant label dcl 746 ref 752 allfiles_err 002457 constant label dcl 748 badarg 003535 constant entry internal dcl 188 ref 175 257 334 charpos 000254 constant entry external dcl 124 chrct 000165 constant entry external dcl 93 cons_it_up 002202 constant label dcl 674 ref 655 667 cursorpos 002624 constant entry external dcl 861 cursorpos_K 003251 constant label dcl 994 ref 1027 1032 cursorpos_arg_symbol 003070 constant label dcl 943 ref 929 cursorpos_check_code 003200 constant label dcl 964 ref 940 974 982 997 1002 1049 1055 1059 cursorpos_function 000024 constant label array(0:31) dcl 953 ref 947 cursorpos_returns_nil 003525 constant label dcl 1061 ref 902 907 913 933 945 964 988 990 1010 1021 1023 1031 1053 1087 cursorpos_returns_t 003531 constant label dcl 1077 ref 953 966 defaultf 001320 constant entry external dcl 553 defjoin 000411 constant label dcl 182 ref 172 endpagefn 000330 constant entry external dcl 148 entry_names_loop 001771 constant label dcl 644 ref 660 eoffn 000200 constant entry external dcl 99 error 003551 constant entry internal dcl 198 ref 194 226 392 463 589 726 751 exit 000701 constant label dcl 303 ref 239 253 293 310 315 413 551 579 585 592 613 680 705 735 787 922 1075 1079 file_arg_loss 000377 constant label dcl 175 ref 255 filepos 000213 constant entry external dcl 105 filepos_loss 001024 constant label dcl 386 ref 401 filepos_loss_1 001013 constant label dcl 381 ref 347 408 filepos_loss_2 001055 constant label dcl 395 ref 367 filepos_ok 003625 constant entry internal dcl 406 ref 341 353 find_true_name 004673 constant entry internal dcl 1093 ref 546 get 000000 constant label array(10) dcl 230 set ref 182 get_numeric_arg 003572 constant entry internal dcl 320 ref 233 248 266 273 280 287 364 get_window_info 004631 constant entry internal dcl 1082 ref 936 957 1046 getlength 003665 constant entry internal dcl 422 ref 346 359 366 got_it 001001 constant label dcl 371 ref 360 368 idel_lines_common 003417 constant label dcl 1046 ref 1041 inpaa 002233 constant label dcl 690 ref 727 inpbb 002301 constant label dcl 702 ref 700 inpush 002221 constant entry external dcl 687 internal_namelist 001362 constant entry external dcl 570 ref 555 746 843 linel 000226 constant entry external dcl 111 linenum 000302 constant entry external dcl 136 lisp_io_fns_ 000156 constant entry external dcl 6 make_a_string 004565 constant entry internal dcl 851 ref 550 842 namelist 001347 constant entry external dcl 564 namelist_join 001372 constant label dcl 575 ref 567 names 000241 constant entry external dcl 117 namestring 001103 constant entry external dcl 439 namestringer 003727 constant entry internal dcl 481 ref 479 831 namlstaa 001377 constant label dcl 577 ref 590 namlsterr 001440 constant label dcl 588 ref 594 600 603 630 namstr_aa 001123 constant label dcl 448 ref 437 442 namstr_wta 001154 constant label dcl 461 ref 467 nexit 000706 constant label dcl 306 ref 231 235 246 250 264 268 271 275 278 282 285 289 351 one_two_fns 000342 constant label dcl 161 ref 97 103 109 115 122 128 134 140 146 152 pagel 000267 constant entry external dcl 130 pagenum 000315 constant entry external dcl 142 pexit 000714 constant label dcl 312 ref 243 261 297 376 784 800 position_cursor_bounded 003031 constant label dcl 936 set ref 992 1025 1037 position_cursor_wrap 003136 constant label dcl 957 ref 970 978 986 1011 1015 1019 put 000012 constant label array(10) dcl 233 ref 184 258 put5ok 000614 constant label dcl 259 ref 256 shortnamestring 001114 constant entry external dcl 444 somefiles 004307 constant entry internal dcl 813 ref 774 776 778 792 797 take_namelist_of_file_arg 001221 constant label dcl 472 ref 454 458 truename 001072 constant entry external dcl 434 wrong_direction_for_setting_iochan_function 000420 constant label dcl 213 ref 241 295 NAMES DECLARED BY CONTEXT OR IMPLICATION. empty builtin function ref 815 max builtin function ref 937 938 min builtin function ref 937 938 ptr builtin function ref 521 rel builtin function ref 497 498 499 rtrim builtin function ref 829 translate builtin function ref 947 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7522 7702 6555 7532 Length 10532 6555 160 614 744 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_io_fns_ 4740 external procedure is an external procedure. badarg internal procedure shares stack frame of external procedure lisp_io_fns_. error internal procedure shares stack frame of external procedure lisp_io_fns_. get_numeric_arg internal procedure shares stack frame of external procedure lisp_io_fns_. filepos_ok internal procedure shares stack frame of external procedure lisp_io_fns_. getlength internal procedure shares stack frame of external procedure lisp_io_fns_. namestringer internal procedure shares stack frame of external procedure lisp_io_fns_. begin block on line 487 begin block shares stack frame of external procedure lisp_io_fns_. somefiles internal procedure shares stack frame of external procedure lisp_io_fns_. make_a_string internal procedure shares stack frame of external procedure lisp_io_fns_. get_window_info internal procedure shares stack frame of external procedure lisp_io_fns_. find_true_name internal procedure shares stack frame of external procedure lisp_io_fns_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 fn_defaultf lisp_io_fns_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_io_fns_ 000100 esw lisp_io_fns_ 000101 myname lisp_io_fns_ 000102 stack lisp_io_fns_ 000104 nargs lisp_io_fns_ 000106 tsp lisp_io_fns_ 000110 err lisp_io_fns_ 000111 n lisp_io_fns_ 000112 m lisp_io_fns_ 000113 i lisp_io_fns_ 000114 len lisp_io_fns_ 000115 vcs lisp_io_fns_ 000202 p lisp_io_fns_ 000204 k lisp_io_fns_ 000205 j lisp_io_fns_ 000206 code lisp_io_fns_ 000207 dn lisp_io_fns_ 000261 en lisp_io_fns_ 000272 sgp lisp_io_fns_ 000274 fail_act_f lisp_io_fns_ 000275 X lisp_io_fns_ 000276 Y lisp_io_fns_ 000300 vcs_bit_bucket lisp_io_fns_ 000302 window_info lisp_io_fns_ 000324 unm error 000360 ts begin block on line 487 000362 unm begin block on line 487 000372 an_area somefiles 010372 dnl somefiles 010373 ecount somefiles 010374 eptr somefiles 010376 nptr somefiles 010400 bug_fixer somefiles 010476 dn find_true_name 010550 en find_true_name 010560 fn find_true_name 010632 rnl find_true_name 010634 sgp find_true_name 010636 code find_true_name THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_in call_ext_out_desc call_ext_out return fl2_to_fx1 shorten_stack ext_entry empty THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_path_ expand_path_ get_at_entry_ get_default_wdir_ get_pdir_ get_wdir_ hcs_$fs_get_path_name hcs_$initiate hcs_$star_ hcs_$terminate_noname iox_$control iox_$look_iocb lisp_alloc_ lisp_error_ lisp_get_atom_ lisp_io_control_$fix_not_ok_iochan lisp_print_$exploden lisp_reader_$maknam lisp_special_fns_$cons lisp_special_fns_$ncons lisp_special_fns_$xcons msf_manager_$get_ptr window_$clear_region window_$clear_to_end_of_line window_$clear_to_end_of_window window_$clear_window window_$delete_chars window_$get_cursor_position window_$get_one_unechoed_char window_$insert_text window_$position_cursor window_$scroll_region THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_error_table_$bad_arg_correctable lisp_error_table_$cant_filepos lisp_error_table_$filepos_oob lisp_error_table_$io_wrong_direction lisp_static_vars_$STAR lisp_static_vars_$binding_top lisp_static_vars_$ctrlQ lisp_static_vars_$eof_atom lisp_static_vars_$filepos lisp_static_vars_$infile lisp_static_vars_$instack lisp_static_vars_$nil lisp_static_vars_$stack_ptr lisp_static_vars_$stnopoint lisp_static_vars_$stream lisp_static_vars_$t_atom lisp_static_vars_$tty_input_chan lisp_static_vars_$tty_output_chan lisp_static_vars_$unmkd_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000155 93 000163 95 000172 96 000174 97 000176 99 000177 101 000205 102 000207 103 000211 105 000212 107 000220 108 000222 109 000224 111 000225 113 000233 114 000235 115 000237 117 000240 120 000246 121 000250 122 000252 124 000253 126 000261 127 000263 128 000265 130 000266 132 000274 133 000276 134 000300 136 000301 138 000307 139 000311 140 000313 142 000314 144 000322 145 000324 146 000326 148 000327 150 000335 151 000337 152 000341 161 000342 163 000347 164 000351 168 000354 169 000360 170 000364 171 000373 172 000376 175 000377 176 000405 181 000406 182 000411 184 000416 213 000420 216 000424 217 000427 218 000433 219 000440 220 000444 222 000467 223 000510 225 000515 226 000520 230 000521 231 000525 233 000526 234 000527 235 000533 237 000534 238 000542 239 000545 241 000546 243 000554 245 000555 246 000557 248 000560 249 000561 250 000564 252 000565 253 000567 255 000570 256 000574 257 000605 258 000613 259 000614 261 000617 263 000620 264 000622 266 000623 267 000624 268 000627 270 000630 271 000632 273 000633 274 000634 275 000637 277 000640 278 000642 280 000643 281 000644 282 000647 284 000650 285 000652 287 000653 288 000654 289 000657 291 000660 292 000666 293 000671 295 000672 297 000700 303 000701 304 000705 306 000706 309 000710 310 000713 312 000714 315 000717 341 000720 344 000721 345 000722 346 000730 347 000731 348 000734 349 000736 350 000740 351 000743 353 000744 356 000745 357 000752 358 000753 359 000754 360 000755 361 000760 362 000762 364 000764 365 000765 366 000766 367 000767 368 000772 370 000777 371 001001 373 001004 374 001006 375 001010 376 001012 381 001013 384 001016 385 001021 386 001024 388 001027 389 001032 390 001036 391 001043 392 001053 393 001054 395 001055 398 001060 399 001063 400 001066 401 001070 434 001071 436 001077 437 001101 439 001102 441 001110 442 001112 444 001113 446 001121 448 001123 451 001130 452 001133 453 001136 454 001142 456 001143 457 001147 458 001153 461 001154 463 001157 464 001160 466 001161 467 001166 468 001170 469 001175 470 001220 472 001221 476 001236 477 001262 479 001264 546 001265 550 001273 551 001316 553 001317 555 001325 557 001334 561 001341 562 001345 564 001346 566 001354 567 001356 570 001357 574 001367 575 001372 577 001377 578 001403 579 001407 581 001410 582 001417 583 001426 584 001430 585 001434 587 001435 588 001440 589 001443 590 001444 592 001445 594 001451 599 001452 600 001465 601 001466 602 001504 603 001511 604 001513 606 001522 607 001526 608 001531 609 001534 610 001536 611 001563 612 001571 613 001576 618 001577 621 001606 622 001614 623 001650 625 001651 630 001704 631 001706 633 001725 634 001736 635 001741 636 001764 640 001765 641 001767 644 001771 646 001774 647 001777 648 002017 650 002026 651 002035 652 002037 653 002050 654 002053 655 002101 658 002103 659 002125 660 002130 664 002131 665 002137 666 002145 667 002147 669 002150 671 002172 672 002177 674 002202 678 002212 679 002216 680 002217 687 002220 689 002226 690 002233 691 002236 692 002242 693 002246 694 002251 695 002255 696 002262 697 002265 698 002266 699 002271 700 002275 702 002276 704 002304 705 002310 707 002311 709 002316 711 002331 712 002334 714 002341 715 002344 717 002351 718 002355 719 002360 720 002364 721 002370 722 002374 724 002400 725 002402 726 002405 727 002406 732 002407 733 002413 735 002422 742 002423 744 002431 745 002433 746 002440 748 002451 750 002457 751 002462 752 002463 755 002464 756 002470 758 002473 773 002476 774 002501 775 002502 776 002513 777 002514 778 002525 779 002526 781 002527 782 002531 784 002565 785 002567 786 002573 787 002577 790 002600 791 002603 792 002611 793 002612 796 002613 797 002621 800 002622 861 002623 884 002631 885 002636 886 002640 888 002642 889 002644 892 002651 893 002653 894 002665 897 002674 898 002675 902 002700 904 002703 906 002707 907 002727 910 002731 912 002734 913 002751 915 002753 917 002755 918 002761 919 002765 920 002770 921 002773 922 002777 926 003000 928 003002 929 003007 932 003016 933 003023 936 003031 937 003032 938 003042 939 003052 940 003067 943 003070 945 003102 947 003112 953 003130 955 003133 956 003135 957 003136 959 003137 960 003145 961 003151 962 003157 963 003163 964 003200 966 003202 968 003203 970 003205 972 003206 974 003217 976 003220 978 003221 980 003222 982 003233 984 003234 986 003235 988 003236 990 003241 992 003250 994 003251 997 003275 999 003276 1002 003307 1004 003310 1006 003311 1008 003313 1009 003314 1010 003333 1011 003335 1013 003336 1015 003341 1017 003342 1019 003344 1021 003345 1023 003350 1025 003357 1027 003360 1029 003363 1030 003365 1031 003402 1032 003404 1034 003405 1036 003407 1037 003411 1039 003412 1041 003414 1043 003415 1046 003417 1048 003420 1049 003443 1051 003444 1053 003467 1054 003471 1055 003506 1057 003507 1059 003524 1061 003525 1075 003530 1077 003531 1079 003534 188 003535 192 003537 193 003541 194 003544 195 003545 196 003550 198 003551 205 003552 206 003556 207 003561 208 003563 209 003565 210 003571 320 003572 322 003573 324 003574 326 003602 327 003604 329 003605 331 003610 332 003613 334 003614 335 003623 337 003624 406 003625 408 003626 409 003632 410 003635 411 003652 412 003655 413 003663 416 003664 422 003665 424 003666 425 003667 426 003714 427 003723 428 003726 481 003727 483 003730 484 003731 487 003741 490 003745 491 003751 492 003754 493 003757 497 003761 498 003765 499 003770 500 003774 501 003777 502 004001 503 004002 507 004004 508 004007 512 004015 516 004022 520 004060 521 004063 522 004073 523 004074 487 004075 526 004076 528 004137 530 004200 532 004206 535 004233 538 004272 541 004306 813 004307 815 004310 826 004313 827 004317 828 004322 829 004324 830 004336 831 004337 832 004340 833 004343 835 004421 837 004424 838 004433 838 004454 840 004457 841 004466 842 004517 843 004543 844 004551 845 004556 846 004562 847 004564 851 004565 855 004576 856 004613 857 004620 858 004623 859 004630 1082 004631 1085 004632 1086 004634 1087 004670 1089 004672 1093 004673 1110 004704 1111 004712 1112 004717 1113 004746 1114 004751 1115 005013 1116 005020 1117 005051 1118 005054 1120 005065 1121 005070 1122 005071 1124 005075 1125 005135 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved