COMPILATION LISTING OF SEGMENT lisp_io_control_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1123.97_Tue_mdt Options: optimize map 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_io_control_: procedure; 7 8 /* 9* * This module contains the central core of the new LISP I/O System. 10* * This includes the lisp functions openi, openo, close, rename, deletef, and mergef, 11* * as well as several subroutines that are called by other lisp 12* * functions and by the garbage collector, saver, booter, etc. 13* * 14* * Written March, 1973 by D.A.Moon 15* * modified 73.10.25 by DAM for new iochan format 16* * modified 74.05.14 by DAM for EIS, and to not suspend acl on output files. 17* * instead, the fact that msf_manager_ gives access if it creates the file is relied upon 18* * thus iochan.aclinfop is no longer used 19* * modified 74.09.21 by DAM to accept t for tty as well as nil 20* * modified 74.12.20 by DAM for new 'open' function 21* * modified 78.05.18 by BSG for 256-char mode string 22* * modified 81.02.25 by PCK to use mode_string_$get_mode to parse mode strings and for 512-char mode string 23* * modified 1982.10.05 by Richard Lamson to add (includef ...) 24* */ 25 26 /********************************************** 27* 28*The i/o system operates with file objects, which are 29*lisp objects pointed at by a pointer with the 'File' type 30*bit turned on. The format of a file object is declared 31*as the structure 'iochan.' An iochan is created when 32*a file is "opened," and effectively destroyed when it is 33*"closed." Some of the information in the iochan is used 34*by this module to interface with the Multics file system, 35*multi-segment file manager, and i/o switch. Other information 36*is used by the other i/o modules to control formatting, 37*e-o-f handling, etc. All files are divided into "blocks," 38*which are either one segment of a multi-segment file or one 39*buffer-load of a stream. The beginning of a block is pointed 40*at by iochan.ioptr, and iochan.ioindex is used as the character 41*position within the block. The length of the block, in characters 42*is kept in iochan.iolength. When the end of a block is reached, 43*lisp_io_control_$end_of_block is invoked by one of the lisp i/o 44*functions to advance to the next block. The other entry points 45*in this module are concerned with exceptional conditions such as 46*creation and destruction of iochans (open/close), garbage 47*collection, saving, and file system errors. 48* 49***********************************************/ 50 51 declare 52 addr builtin, 53 reverse builtin, 54 addrel builtin, 55 1 amv like mode_value aligned, /* Automatic storage for mode_value structure */ 56 bc fixed bin(24), /* bit count */ 57 binary builtin, 58 buffer_size fixed bin static init(256), /* number o chars in a stream buffer */ 59 code fixed bin(35), /* status return code */ 60 codde fixed bin, 61 com_err_ ext entry options(variable), 62 delete_$path ext entry (char(*), char(*), bit(6), char(*), fixed bin(35)), 63 divide builtin, 64 dname char(168), /* directory pathname of file being opened */ 65 ename char(36) varying, /* place to suffix_cs up the entryname of the file being opened */ 66 err fixed bin(35), /* lisp error code, used by int proc error */ 67 error_table_$end_of_info ext fixed bin(35), 68 error_table_$long_record ext fixed bin(35), 69 error_table_$dirseg external fixed bin(35), 70 error_table_$no_space external fixed bin(35), /* used when eof bit is lit up for output stream */ 71 error_table_$entlong external fixed bin(35), 72 error_table_$noentry external fixed bin(35), 73 esw fixed bin, /* entry switch controls error proc: >0 = fcn, 0 = save, <0 = internal subroutine */ 74 expand_path_ ext entry(ptr, fixed bin, ptr, ptr, fixed bin(35)), 75 find_include_file_$initiate_count entry(char(*)aligned, pointer, char(*)aligned, fixed bin(24), pointer, fixed bin(35)), 76 get_wdir_ ext entry returns(char(168)), 77 hcs_$chname_file ext entry (char(*), char(*), char(*), char(*), fixed bin(35)), 78 hcs_$fs_get_path_name ext entry (pointer, char(*), fixed bin, char(*), fixed bin(35)), 79 hcs_$get_max_length_seg ext entry (pointer, fixed bin(19), fixed bin(35)), 80 hcs_$status_minf ext entry (char(*), char(*), fixed bin, fixed bin, fixed bin(24), fixed bin(35)), 81 i fixed bin, 82 index builtin, 83 infile fixed bin(71) def (lisp_static_vars_$infile), 84 instack fixed bin(71) def (lisp_static_vars_$instack), 85 iox_$modes entry(ptr, char(*), char(*), fixed bin(35)), 86 iox_$get_line entry(ptr, ptr, fixed bin(24), fixed bin(24), fixed bin(35)), 87 iox_$get_chars entry(ptr, ptr, fixed bin(24), fixed bin(24), fixed bin(35)), 88 iox_$control entry(ptr, char(*), ptr, fixed bin(35)), 89 iox_$put_chars entry(ptr, ptr, fixed bin(24), fixed bin(35)), 90 iox_$look_iocb entry(char(*), ptr, fixed bin(35)), 91 j fixed bin, 92 length builtin, 93 lisp_$apply entry, 94 lisp_get_atom_ entry(char(*) aligned, fixed bin(71)), 95 lisp_io_control_$close entry, /* recurse to close iochan on eof */ 96 lisp_io_fns_$inpush entry, 97 lisp_io_fns_$internal_namelist entry(fixed bin), 98 lisp_list_utils_$nreverse entry, 99 lisp_reader_$maknam entry, 100 lisp_print_$exploden entry, 101 lisp_special_fns_$cons entry, 102 lisp_special_fns_$xcons entry, 103 lisp_static_vars_$STAR fixed bin(71) external, 104 lisp_static_vars_$close fixed bin(71) external, 105 lisp_static_vars_$deletef fixed bin(71) external, 106 lisp_static_vars_$infile fixed bin(71) external, 107 lisp_static_vars_$instack fixed bin(71) external, 108 lisp_static_vars_$mergef fixed bin(71) external, 109 lisp_static_vars_$old_io_defaults external pointer, 110 lisp_static_vars_$open fixed bin(71) external, 111 lisp_static_vars_$outfile fixed bin(71) external, 112 lisp_static_vars_$outfiles fixed bin(71) external, 113 lisp_static_vars_$rdr_label external label, 114 lisp_static_vars_$rdr_ptr external pointer, 115 lisp_static_vars_$rdr_state external fixed binary, 116 lisp_static_vars_$rename fixed bin(71) external, 117 lisp_static_vars_$stream fixed bin(71) external, 118 lisp_static_man_$allocate entry(pointer, fixed bin(18)), 119 maxlen fixed bin(19), /* maximum - length attrib */ 120 min builtin, 121 mode_string_$get_mode entry (char(*), char(*), ptr, fixed bin(35)), 122 msf_manager_$adjust ext entry (ptr, fixed bin, fixed bin(24), bit(3) aligned, fixed bin(35)), 123 msf_manager_$get_ptr ext entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(24), fixed bin(35)), 124 msf_manager_$open entry(char(*), char(*), pointer, fixed bin(35)), 125 msf_manager_$close entry(pointer), 126 myname fixed bin, /* fn_ code for function entry point */ 127 nargs fixed bin, /* number of args to mergef */ 128 null builtin, 129 other_ename char(32), /* for rename */ 130 outfiles fixed bin(71) def (lisp_static_vars_$outfiles), 131 p ptr, /* points at iochan currently being processed */ 132 p2 ptr, 133 p_fb fixed bin(71) aligned based(addr(p)), 134 ptr builtin, 135 q ptr, 136 rdr_label label def(lisp_static_vars_$rdr_label), 137 rdr_ptr pointer def(lisp_static_vars_$rdr_ptr), 138 rdr_state fixed bin def(lisp_static_vars_$rdr_state), 139 rel builtin, 140 rnstack ptr, /* orig value of 'stack,' used by rename */ 141 size builtin, 142 stack ptr, 143 star fixed bin(71) def (lisp_static_vars_$STAR), 144 status fixed bin(35) aligned, 145 stream fixed bin(71) def (lisp_static_vars_$stream), 146 string builtin, 147 substr builtin, 148 type fixed bin, /* return arg of hcs_$status_minf */ 149 user_io_modes char(512), 150 verify builtin; 151 152 153 /* based overlay for setting the type bits of the pointer p 154* so that it can be put in the marked pdl as a file object */ 155 156 dcl 1 p_ aligned based(addr(p)) like lisp_ptr; 157 158 159 160 161 /* Variables used by open */ 162 163 dcl direction fixed bin, 164 (In init(0), Out init(1), Append init(2)) fixed bin static; 165 166 dcl data_mode fixed bin, 167 (Ascii init(0), Fixnum init(1), Image init(2)) fixed bin static; 168 169 dcl buffer_mode fixed bin, 170 (Block init(0), Single init(1)) fixed bin static; 171 172 dcl device_type fixed bin, 173 (Ordinary init(0), Terminal init(1)) fixed bin static; 174 175 dcl openx_sim_arg char(8) aligned; /* "read", "print", or "append" */ 176 177 /* Error Codes */ 178 179 dcl (lisp_error_table_$bad_item_in_modelist, 180 lisp_error_table_$reopen_inconsistent, 181 lisp_error_table_$io_wrong_direction, 182 lisp_error_table_$file_is_closed, 183 lisp_error_table_$file_sys_fun_err, 184 lisp_error_table_$stars_left_in_name, 185 lisp_error_table_$bad_arg_correctable, 186 lisp_error_table_$bad_entry_name, 187 lisp_error_table_$include_file_error) fixed bin external; 188 189 1 1 /* Include file lisp_common_vars.incl.pl1; 1 2* describes the external static variables which may be referenced 1 3* by lisp routines. 1 4* D. Reed 4/1/71 */ 1 5 1 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 1 7 2 cclist_ptr ptr, /* pointer to list of constants kept 1 8* by compiled programs */ 1 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 1 10 1 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 1 12 err_recp ptr defined (lisp_static_vars_$err_recp), 1 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 1 14 lisp_static_vars_$eval_frame ptr ext static, 1 15 lisp_static_vars_$prog_frame ptr ext aligned, 1 16 lisp_static_vars_$err_frame ptr ext aligned, 1 17 lisp_static_vars_$catch_frame ptr ext aligned, 1 18 lisp_static_vars_$unwp_frame ptr ext aligned, 1 19 lisp_static_vars_$stack_ptr ptr ext aligned, 1 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 1 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 1 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 1 23 lisp_static_vars_$binding_top ptr ext aligned, 1 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 1 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 1 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 1 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 1 28 binding_top ptr defined (lisp_static_vars_$binding_top), 1 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 1 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 1 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 1 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 1 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 1 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 1 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 1 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 1 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 1 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 1 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 1 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 1 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 1 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 1 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 1 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 1 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 1 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 1 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 1 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 1 49 1 50 1 51 /* end include file lisp_common_vars.incl.pl1 */ 190 2 1 /* include file lisp_stack_fmt.incl.pl1 -- 2 2* describes the format of the pushdown list 2 3* used by the lisp evaluator and lisp subrs 2 4* for passing arguments, saving atom bindings, 2 5* and as temporaries */ 2 6 2 7 dcl 2 8 temp(10000) fixed bin(71) aligned based, 2 9 2 10 temp_ptr(10000) ptr aligned based, 2 11 1 push_down_list_ptr_types(10000) based aligned, 2 12 2 junk bit(21) unaligned, 2 13 2 temp_type bit(9) unaligned, 2 14 2 more_junk bit(42) unaligned, 2 15 2 16 1 pdl_ptr_types36(10000) based aligned, 2 17 2 temp_type36 bit(36), 2 18 2 junk bit(36), 2 19 2 20 1 binding_block aligned based, 2 21 2 top_block bit(18) unaligned, 2 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 2 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 2 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 2 25 2 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 2 27 2 old_val fixed bin(71) aligned, 2 28 2 atom fixed bin(71) aligned; 2 29 2 30 2 31 2 32 /* end include file lisp_stack_fmt.incl.pl1 */ 191 3 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 3 2 3 3 /* data structures used by the lisp i/o system */ 3 4 4 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 4 2 4 3 /* This include file describes the format of the 'iochan' block, 4 4* which is used to implement lisp file-objects. The iochan 4 5* is the central data base of the i/o system. When open 4 6* is used, an iochan is created in lisp static storage. 4 7* When the lisp environment is booted, 2 iochans for input and 4 8* output on the tty are created. Iochans are saved and restored 4 9* by the save mechanism */ 4 10 4 11 /* open i/o channel information */ 4 12 4 13 dcl 1 iochan based aligned, /* format of a file object */ 4 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 4 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 4 16 2 ioptr pointer, /* -> block */ 4 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 4 18 2 fcbp pointer, /* for tssi_ */ 4 19 2 aclinfop pointer, /* .. */ 4 20 2 component fixed bin, /* .. */ 4 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 4 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 4 23 2 flags unaligned, 4 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 4 25 3 read bit(1), /* 0 => openi, 1 => not */ 4 26 3 write bit(1), /* 0 => openo, 1 => not */ 4 27 3 gc_mark bit(1), /* for use by the garbage collector */ 4 28 3 interactive bit(1), /* 1 => input => this is the tty 4 29* output => flush buff after each op */ 4 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 4 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 4 32 3 charmode bit(1), /* enables instant ios_$write */ 4 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 4 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 4 35 3 image_mode bit(1), /* just suppresses auto-cr */ 4 36 3 not_yet_used bit(25), 4 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 4 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 4 39 2 name char(32) unaligned, /* stream name or entry name */ 4 40 2 pagel fixed bin, /* number of lines per page */ 4 41 2 linenum fixed bin, /* current line number, starting from 0 */ 4 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 4 43 4 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 4 45 "111011110111111111"b); 4 46 4 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 3 5 3 6 3 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 3 8 3 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 3 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 3 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 3 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 3 13 3 14 3 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 3 16 3 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 3 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 3 19 lisp_static_vars_$ibase ext fixed bin(71), 3 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 3 21 3 22 lisp_static_vars_$quote_atom ext fixed bin (71), 3 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 3 24 3 25 lisp_static_vars_$base ext fixed bin(71), 3 26 base fixed bin(71) defined ( lisp_static_vars_$base), 3 27 3 28 lisp_static_vars_$stnopoint ext fixed bin(71), 3 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 3 30 3 31 lisp_static_vars_$tty_atom ext fixed bin(71), 3 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 3 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 3 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 3 35 3 36 lisp_static_vars_$s_atom ext fixed bin(71), 3 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 3 38 3 39 lisp_static_vars_$readtable ext fixed bin(71), 3 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 3 41 3 42 lisp_static_vars_$plus_status ext fixed bin(71), 3 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 3 44 5 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 2 5 3 /* Last modified D. Reed 6/29/72 */ 5 4 5 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 5 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 5 7 5 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 5 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 5 10 5 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 5 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 5 13 5 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 5 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 5 16 5 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 18 3 45 3 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 3 47 192 6 1 6 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 6 3 6 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 6 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 6 6* are used so that the name of the function which is rejecting its argument 6 7* can be printed. Please note that all these codes are negative. */ 6 8 6 9 dcl ( 6 10 fn_do init (-10), 6 11 fn_arg init (-11), 6 12 fn_setarg init (-12), 6 13 fn_status init (-13), 6 14 fn_sstatus init (-14), 6 15 fn_errprint init (-15), 6 16 fn_errframe init (-16), 6 17 fn_evalframe init (-17), 6 18 fn_defaultf init (-18), 6 19 fn_tyo init (-22), 6 20 fn_ascii init (-23), 6 21 fn_rplaca init (-24), 6 22 fn_definedp init (-25), 6 23 fn_setq init (-26), 6 24 fn_set init (-27), 6 25 fn_delete init (-28), 6 26 fn_delq init (-29), 6 27 fn_stringlength init (-30), 6 28 fn_catenate init (-31), 6 29 fn_array init (-32), 6 30 fn_substr init (-33), 6 31 fn_index init (-34), 6 32 fn_get_pname init (-35), 6 33 fn_make_atom init (-36), 6 34 fn_ItoC init (-37), 6 35 fn_CtoI init (-38), 6 36 fn_defsubr init (-39), 6 37 fn_star_array init (-40), 6 38 fn_args init (-41), 6 39 fn_sysp init (-42), 6 40 fn_get init (-43), 6 41 fn_getl init (-44), 6 42 fn_putprop init (-45), 6 43 fn_remprop init (-46), 6 44 fn_save init (-47), 6 45 fn_add1 init (-48), 6 46 fn_sub1 init (-49), 6 47 fn_greaterp init (-50), 6 48 fn_lessp init (-51), 6 49 fn_minus init (-52), 6 50 fn_plus init (-53), 6 51 fn_times init (-54), 6 52 fn_difference init (-55), 6 53 fn_quotient init (-56), 6 54 fn_abs init (-57), 6 55 fn_expt init (-58), 6 56 fn_boole init (-59), 6 57 fn_rot init (-60), 6 58 fn_lsh init (-61), 6 59 fn_signp init (-62), 6 60 fn_fix init (-63), 6 61 fn_float init (-64), 6 62 fn_remainder init (-65), 6 63 fn_max init (-66), 6 64 fn_min init (-67), 6 65 fn_add1_fix init (-68), 6 66 fn_add1_flo init (-69), 6 67 fn_sub1_fix init (-70), 6 68 fn_sub1_flo init (-71), 6 69 fn_plus_fix init (-72), 6 70 fn_plus_flo init (-73), 6 71 fn_times_fix init (-74), 6 72 fn_times_flo init (-75), 6 73 fn_diff_fix init (-76), 6 74 fn_diff_flo init (-77), 6 75 fn_quot_fix init (-78), 6 76 fn_quot_flo init (-79), 6 77 fn_eval init (-80), 6 78 fn_apply init (-81), 6 79 fn_prog init (-82), 6 80 fn_errset init (-83), 6 81 fn_catch init (-84), 6 82 fn_throw init (-85), 6 83 fn_store init (-86), 6 84 fn_defun init (-87), 6 85 fn_baktrace init (-88), 6 86 fn_bltarray init (-89), 6 87 fn_star_rearray init (-90), 6 88 fn_gensym init (-91), 6 89 fn_makunbound init (-92), 6 90 fn_boundp init (-93), 6 91 fn_star_status init (-94), 6 92 fn_star_sstatus init (-95), 6 93 fn_freturn init (-96), 6 94 fn_cos init (-97), 6 95 fn_sin init (-98), 6 96 fn_exp init (-99), 6 97 fn_log init (-100), 6 98 fn_sqrt init (-101), 6 99 fn_isqrt init (-102), 6 100 fn_atan init (-103), 6 101 fn_sleep init (-104), 6 102 fn_oddp init (-105), 6 103 fn_tyipeek init (-106), 6 104 fn_alarmclock init (-107), 6 105 fn_plusp init (-108), 6 106 fn_minusp init (-109), 6 107 fn_ls init (-110), 6 108 fn_eql init (-111), 6 109 fn_gt init (-112), 6 110 fn_alphalessp init (-113), 6 111 fn_samepnamep init (-114), 6 112 fn_getchar init (-115), 6 113 fn_opena init (-116), 6 114 fn_sxhash init (-117), 6 115 fn_gcd init (-118), 6 116 fn_allfiles init (-119), 6 117 fn_chrct init (-120), 6 118 fn_close init (-121), 6 119 fn_deletef init (-122), 6 120 fn_eoffn init (-123), 6 121 fn_filepos init (-124), 6 122 fn_inpush init (-125), 6 123 fn_linel init (-126), 6 124 fn_mergef init (-127), 6 125 fn_namelist init (-128), 6 126 fn_names init (-129), 6 127 fn_namestring init (-130), 6 128 fn_openi init (-131), 6 129 fn_openo init (-132), 6 130 fn_prin1 init (-133), 6 131 fn_princ init (-134), 6 132 fn_print init (-135), 6 133 fn_read init (-136), 6 134 fn_readch init (-137), 6 135 fn_readstring init (-138), 6 136 fn_rename init (-139), 6 137 fn_shortnamestring init (-140), 6 138 fn_tyi init (-141), 6 139 fn_setsyntax init (-142), 6 140 fn_cursorpos init (-143), 6 141 fn_force_output init (-144), 6 142 fn_clear_input init (-145), 6 143 fn_random init (-146), 6 144 fn_haulong init (-147), 6 145 fn_haipart init (-148), 6 146 fn_cline init (-149), 6 147 fn_fillarray init (-150), 6 148 fn_listarray init (-151), 6 149 fn_sort init (-152), 6 150 fn_sortcar init (-153), 6 151 fn_zerop init (-154), 6 152 fn_listify init (-155), 6 153 fn_charpos init (-156), 6 154 fn_pagel init (-157), 6 155 fn_linenum init (-158), 6 156 fn_pagenum init (-159), 6 157 fn_endpagefn init (-160), 6 158 fn_arraydims init (-161), 6 159 fn_loadarrays init (-162), 6 160 fn_dumparrays init (-163), 6 161 fn_expt_fix init (-164), 6 162 fn_expt_flo init (-165), 6 163 fn_nointerrupt init (-166), 6 164 fn_open init (-167), 6 165 fn_in init (-168), 6 166 fn_out init (-169), 6 167 fn_truename init (-170), 6 168 fn_ifix init (-171), 6 169 fn_fsc init (-172), 6 170 fn_progv init (-173), 6 171 fn_mapatoms init (-174), 6 172 fn_unwind_protect init (-175), 6 173 fn_eval_when init (-176), 6 174 fn_read_from_string init (-177), 6 175 fn_displace init (-178), 6 176 fn_nth init (-179), 6 177 fn_nthcdr init (-180), 6 178 fn_includef init (-181) 6 179 ) fixed bin static; 6 180 6 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 193 7 1 /* Include file lisp_ptr_fmt.incl.pl1; 7 2* describes the format of lisp pointers as 7 3* a bit string overlay on the double word ITS pair 7 4* which allows lisp to access some unused bits in 7 5* the standard ITS pointer format. It should be noted that 7 6* this is somewhat of a kludge, since 7 7* it is quite machine dependent. However, to store type 7 8* fields in the pointer, saves 2 words in each cons, 7 9* plus some efficiency problems. 7 10* 7 11* D.Reed 4/1/71 */ 7 12 /* modified to move type field to other half of ptr */ 7 13 /* D.Reed 5/31/72 */ 7 14 7 15 7 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 7 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 7 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 7 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 7 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 7 21 2 type bit(9) unaligned, /* type field */ 7 22 2 itsmod bit(6) unaligned, 7 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 7 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 7 25 7 26 /* manifest constant strings for testing above type field */ 7 27 7 28 ( 7 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 7 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 7 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 7 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 7 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 7 34 Bignum init("000001000"b), /* a multiple-precision number */ 7 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 7 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 7 37* means a special internal uncollectable weird object */ 7 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 7 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 7 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 7 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 7 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 7 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 7 44 ) bit(9) static, 7 45 7 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 7 47 7 48 7 49 ( 7 50 Cons36 init("000000000000000000000000000000"b), 7 51 Fixed36 init("000000000000000000000100000000"b), 7 52 Float36 init("000000000000000000000010000000"b), 7 53 Atsym36 init("000000000000000000000001000000"b), 7 54 Atomic36 init("000000000000000000000111111100"b), 7 55 Bignum36 init("000000000000000000000000001000"b), 7 56 System_Subr36 7 57 init("000000000000000000000000000100"b), 7 58 Bigfix36 init("000000000000000000000000001000"b), 7 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 7 60 NotConsOrAtsym36 7 61 init("000000000000000000000110111111"b), 7 62 SubrNumeric36 7 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 7 64 String36 init("000000000000000000000000100000"b), 7 65 Subr36 init("000000000000000000000000010000"b), 7 66 File36 init("000000000000000000000000000001"b), 7 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 7 68 7 69 /* undefined pointer value is double word of zeros */ 7 70 7 71 Undefined bit(72) static init(""b); 7 72 7 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 194 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 195 9 1 /* Include file lisp_cons_fmt.incl.pl1; 9 2* defines the format for a cons within the lisp system 9 3* D.Reed 4/1/71 */ 9 4 9 5 dcl consptr ptr, 9 6 1 cons aligned based (consptr), /* structure defining format for cons */ 9 7 2 car fixed bin(71), 9 8 2 cdr fixed bin(71), 9 9 9 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 9 11 2 car ptr, 9 12 2 cdr ptr, 9 13 9 14 9 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 9 16 2 padding bit(21) unaligned, 9 17 2 car bit(9) unaligned, 9 18 2 padding2 bit(63) unaligned, 9 19 2 cdr bit(9) unaligned, 9 20 2 padend bit(42) unaligned; 9 21 9 22 dcl 1 cons_types36 aligned based, 9 23 2 car bit(36), 9 24 2 pada bit(36), 9 25 2 cdr bit(36), 9 26 2 padd bit(36); 9 27 9 28 9 29 /* end include file lisp_cons_fmt.incl.pl1 */ 196 10 1 /* Include file lisp_atom_fmt.incl.pl1; 10 2* describes internal format of atoms in the lisp system 10 3* D.Reed 4/1/71 */ 10 4 10 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 10 6 2 value fixed bin(71), /* atom's value */ 10 7 2 plist fixed bin(71), /* property list */ 10 8 2 pnamel fixed bin, /* length of print name */ 10 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 10 10 10 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 10 12 2 value ptr, 10 13 2 plist ptr, 10 14 10 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 10 16 2 value bit(72), 10 17 2 plist bit(72); 10 18 10 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 197 11 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 11 2* describes format of storage for lisp 11 3* character strings. 11 4* D. Reed 4/1/71 */ 11 5 11 6 dcl 1 lisp_string based aligned, 11 7 2 string_length fixed bin, 11 8 2 string char(1 refer(string_length)); 11 9 11 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 198 12 1 /* BEGIN INCLUDE FILE mode_string_info.incl.pl1 */ 12 2 12 3 /* Structure for parse_mode_string_ JRDavis 20 October 1980 12 4* Last modified 12 January 1981 by J. Spencer Love for version 2, make char_value varying string */ 12 5 12 6 declare mode_value_ptr ptr, 12 7 number_of_modes fixed bin; 12 8 12 9 declare 1 mode_string_info aligned based (mode_string_info_ptr), 12 10 2 version fixed bin, 12 11 2 number fixed bin, 12 12 2 modes (number_of_modes refer (mode_string_info.number)) like mode_value; 12 13 12 14 declare mode_string_info_ptr ptr; 12 15 12 16 declare 1 mode_value aligned based (mode_value_ptr), 12 17 2 version fixed bin, 12 18 2 mode_name char (32) unaligned, 12 19 2 flags, 12 20 3 boolean_valuep bit (1) unaligned, 12 21 3 numeric_valuep bit (1) unaligned, 12 22 3 char_valuep bit (1) unaligned, 12 23 3 boolean_value bit (1) unaligned, 12 24 3 pad1 bit (32) unaligned, 12 25 2 numeric_value fixed bin (35), 12 26 2 char_value char (32) varying, 12 27 2 code fixed bin (35), 12 28 2 pad2 bit (36); 12 29 12 30 declare mode_string_info_version_2 fixed bin static options (constant) initial (2), 12 31 mode_value_version_3 fixed bin static options (constant) initial (3); 12 32 12 33 /* END INCLUDE FILE mode_string_info.incl.pl1 */ 199 200 201 /* 202* * The three lisp lsubrs for opening files (creating iochans). 203* */ 204 205 openi: entry; 206 207 myname = fn_openi; 208 openx_sim_arg = "read"; 209 go to openx; 210 211 openo: entry; 212 213 myname = fn_openo; 214 openx_sim_arg = "print"; 215 go to openx; 216 217 opena: entry; 218 219 myname = fn_opena; 220 openx_sim_arg = "append"; 221 222 223 openx: 224 esw = 1; 225 stack = addrel(stack_ptr,-2); /* get argument */ 226 call set_mode_defaults; 227 call modelist_process(openx_sim_arg); /* get proper mode */ 228 go to open_stuff; 229 230 /* 231* * General 'open' entry 232* */ 233 234 open: entry; 235 236 myname = fn_open; 237 esw = 2; 238 stack = addrel(stack_ptr, -2); 239 nargs = stack -> fixedb; /* lsubr */ 240 stack = addrel(stack, nargs); 241 if nargs = 0 then stack -> temp(1) = 242 tty_output_chan -> iochan.namelist; /* default names */ 243 else if nargs <= -4 then do; /* process modelist */ 244 do while(stack -> temp_type(2) = Cons); 245 call modelist_object(stack -> temp_ptr(2) -> cons.car); 246 stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr; 247 end; 248 if stack -> temp(2) ^= nil then call modelist_object(stack -> temp(2)); 249 end; 250 251 open_stuff: 252 253 /* 254* * create an iochan block in static storage, then initialize it from the defaults 255* */ 256 257 if stack -> temp_type36(1) & File36 then do; /* re-open file */ 258 p = stack -> temp_ptr(1); 259 go to gc_close; /* get the file closed */ 260 open_close_ret: 261 call init_an_iochan; 262 end; 263 else call make_an_iochan; 264 stack_ptr = addr(stack -> temp(3)); 265 stack -> temp(2) = tty_output_chan -> iochan.namelist; /* get the defaults */ 266 nargs = 2; 267 if stack -> temp_type36(1) & File36 /* if file passed in, now have it in p so */ 268 then stack -> temp(1) = p -> iochan.namelist; /* substitute its namelist */ 269 call umergef; /* merge arg with defaults, do err checking and all good things */ 270 p -> iochan.charpos, p -> iochan.linenum, p -> iochan.pagenum = 0; 271 /* set linel, pagel from device characteristics */ 272 p -> iochan.pagel = 59; /* random constant for Multics */ 273 p -> iochan.linel = 110; /* another random constant, for all but tty */ 274 /* set eoffn or endpagefn from default */ 275 if direction = In 276 then p -> iochan.function = tty_input_chan -> iochan.function; /* default eoffn */ 277 else p -> iochan.function = tty_output_chan -> iochan.function; /* default endpagefn */ 278 p -> iochan.namelist = stack -> temp(1); /* namelist gotten by umergef */ 279 if direction = In 280 then p -> iochan.write = "1"b; /* input chan - leave .read 0 */ 281 else p -> iochan.read = "1"b; /* output chan - leave .write 0 */ 282 283 /* 284* * decide whether this is a stream or a file, and apply appropriate special open code 285* */ 286 287 if stack -> temp_ptr(1) -> cons.car = stream then do; /* namelist specifies stream */ 288 p -> iochan.name = stack -> temp_ptr(1) -> cons_ptrs.cdr 289 -> cons_ptrs.car -> atom.pname; /* stream name is cadr of namelist */ 290 call lisp_static_man_$allocate(p -> iochan.ioptr, divide(buffer_size, 4, 18, 0)); 291 if direction = In then p -> iochan.iolength = 0; 292 else if data_mode = Fixnum then p -> iochan.iolength = divide(buffer_size, 4, 24, 0); 293 else p -> iochan.iolength = buffer_size; /* output or append */ 294 p -> iochan.aclinfop = null; /* not used for stream */ 295 call iox_$look_iocb(p->iochan.name, p -> iochan.fcbp, code); 296 if code ^= 0 then go to file_sys_fun_err_; 297 end; /* if stream not attached, we'll find out when we try to use it */ 298 299 else do; /* it's a file (msf), get dname and ename and call msf_manager_ */ 300 301 call get_path_name; 302 303 if direction = In then /* input file, easiest to open */ 304 call open_input_file; 305 306 else if direction = Out then do; /* output file, open, create, set up first seg */ 307 call open_output_file; 308 opena_new: call get_output_seg_ptr; 309 end; 310 else do; /* opena - append output to prev existing seg */ 311 312 call open_output_file; 313 314 /* now find last seg */ 315 316 call hcs_$status_minf(dname, p -> iochan.name, 1, type, bc, code); /* code must be 0!! */ 317 if code ^= 0 then go to opena_new; /* it's not there yet */ 318 if type = 2 then p -> iochan.component = bc-1; /* if msf, set to last component */ 319 call get_output_seg_ptr; /* get ptr to and bc of last seg */ 320 if data_mode = Fixnum 321 then p -> iochan.ioindex = min(divide(bc, 36, 24, 0), /* and set posn to append to what is there */ 322 p -> iochan.iolength); 323 else p -> iochan.ioindex = min(divide(bc, 9, 24, 0), /* and set posn to append to what is there */ 324 p -> iochan.iolength); 325 end; 326 end; 327 328 /* 329* * Set miscellaneous attributes in the iochan 330* */ 331 332 if data_mode = Fixnum then p -> iochan.fixnum_mode = "1"b; 333 else if data_mode = Image then p -> iochan.image_mode = "1"b; 334 335 if buffer_mode = Single then p -> iochan.charmode = "1"b; 336 337 if device_type = Terminal then p -> iochan.interactive = "1"b; 338 339 /* 340* * iochan has been successfully created 341* * so link it onto threaded list of all chans 342* * if an interrupt occurs at the wrong time here, the lossage won't be 343* * sufficiently bad to justify worrying 344* */ 345 346 p -> iochan.thread = lisp_static_vars_$iochan_list; 347 lisp_static_vars_$iochan_list = p; 348 349 /* 350* * All done, turn on type bit for file and return 351* */ 352 353 p_.type = File; 354 stack -> temp(1) = p_fb; 355 exit: 356 stack_ptr = addr(stack -> temp(2)); 357 return; 358 359 /* 360* * Internal procedure to set defaults for modelist 361* */ 362 363 set_mode_defaults: procedure; 364 365 dcl p pointer; 366 367 if stack -> temp_type36(1) & File36 then do; /* use prior attributes of file */ 368 p = stack -> temp_ptr(1); 369 if p -> iochan.read then direction = Out; else direction = In; 370 if p -> iochan.fixnum_mode then data_mode = Fixnum; 371 else if p -> iochan.image_mode then data_mode = Image; 372 else data_mode = Ascii; 373 if p -> iochan.charmode then buffer_mode = Single; 374 else buffer_mode = Block; 375 if p -> iochan.interactive then device_type = Terminal; 376 else device_type = Ordinary; 377 end; 378 else do; /* standard defaults */ 379 direction = In; 380 data_mode = Ascii; 381 buffer_mode = Block; 382 device_type = Ordinary; 383 end; 384 end; 385 386 /* 387* * Internal procedure to process one modelist entry 388* */ 389 390 modelist_process: procedure(item); 391 392 dcl item char(*) aligned; 393 394 if item = "in" then direction = In; 395 else if item = "read" then direction = In; 396 else if item = "out" then direction = Out; 397 else if item = "print" then direction = Out; 398 else if item = "append" then direction = Append; 399 400 else if item = "ascii" then data_mode = Ascii; 401 else if item = "fixnum" then data_mode = Fixnum; 402 else if item = "image" then data_mode = Image; 403 404 else if item = "dsk" then device_type = Ordinary; 405 else if item = "tty" then device_type = Terminal; 406 407 else if item = "block" then buffer_mode = Block; 408 else if item = "single" then buffer_mode = Single; 409 else err = lisp_error_table_$bad_item_in_modelist; /* caller sees */ 410 end; 411 412 /* 413* * Internal procedure to process an object in the modelist 414* */ 415 416 modelist_object: procedure(a_object); 417 418 dcl a_object fixed bin(71), 419 object fixed bin(71) init(a_object), 420 object_type bit(36) aligned based(addr(object)), 421 tsp pointer; 422 423 retry: err = 0; 424 if object_type & Atsym36 then call modelist_process(addr(object)-> based_ptr -> atom.pname); 425 else if object_type & String36 then call modelist_process(addr(object)-> based_ptr -> lisp_string.string); 426 else err = lisp_error_table_$bad_item_in_modelist; 427 428 if err = 0 then return; /* won */ 429 tsp = stack_ptr; /* otherwise fail correctably */ 430 stack_ptr = addr(tsp -> temp(2)); 431 tsp -> temp(1) = object; 432 call error; 433 object = tsp -> temp(1); 434 stack_ptr = tsp; 435 go to retry; 436 437 end; 438 439 /* 440* * Internal procedure to make an iochan block and do first initialization 441* */ 442 443 make_an_iochan: proc; 444 445 call lisp_static_man_$allocate(p, size(iochan)); 446 447 init_an_iochan: entry; 448 449 p -> iochan.component, p -> iochan.ioindex = 0; 450 string(p -> iochan.flags) = ""b; /* clear all flags in the iochan */ 451 end; 452 453 /* 454* * Internal procedure to get dir path name and entry name from name list 455* */ 456 457 get_path_name: proc; 458 459 p -> iochan.seg = "1"b; 460 call get_path_name_0; 461 462 p -> iochan.name = substr(ename, 1, length(ename)-1); /* drop last period */ 463 return; 464 465 466 end; 467 468 469 get_path_name_0: proc; 470 471 dcl tsp ptr; /* have to avoid munging stack -> temp(1) */ 472 473 tsp = stack_ptr; 474 stack_ptr = addr(tsp -> temp(2)); 475 tsp -> temp(1) = stack -> temp(1); 476 477 try_again: dname = tsp -> temp_ptr(1) -> cons_ptrs.car -> atom.pname; 478 /* dir pn is car of namelist */ 479 ename = ""; /* concatenate up ename from list of names, */ 480 do /* in cdr of namelist */ 481 tsp -> temp(1) = tsp -> temp_ptr(1) -> cons.cdr 482 repeat (tsp -> temp_ptr(1) -> cons.cdr) 483 while (tsp -> temp_type(1) = Cons); 484 ename = ename || tsp -> temp_ptr(1) -> cons_ptrs.car -> atom.pname || "."; 485 end; 486 if length(ename) = 0 then go to bad_ename; /* lose if no names */ 487 else if length(ename) >= 34 then go to bad_ename; /* or name longer than 32 chars (+1 for last ".") */ 488 stack_ptr = tsp; 489 return; 490 491 bad_ename: /* give a wrng-type-arg on the name list if the entry name is no good (too long or short) */ 492 493 err = lisp_error_table_$bad_entry_name; 494 call error; 495 go to try_again; 496 497 end; 498 499 500 /* 501* * Internal procedure to open an input seg, set up iochan block to point to it 502* */ 503 504 open_input_file: proc; 505 506 call msf_manager_$open(dname, p -> iochan.name, p -> iochan.fcbp, code); 507 if code ^= 0 then do; /* file not found or other lossage */ 508 fs_loss_close_maybe: if code ^= error_table_$dirseg then 509 fs_loss_close_it: call close_msf; /* flush FCB */ 510 go to file_sys_fun_err_; /* give a fail-act */ 511 end; 512 p -> iochan.aclinfop = null; 513 514 /* set up ptr to first seg of file */ 515 516 call msf_manager_$get_ptr(p -> iochan.fcbp, p -> iochan.component, /* or current comp if reopen */ 517 "0"b, p -> iochan.ioptr, bc, code); 518 if p -> iochan.ioptr = null then go to fs_loss_close_it; 519 /* can't really open, we don't have access */ 520 if data_mode = Fixnum 521 then p -> iochan.iolength = divide(bc, 36, 24, 0); /* get word count from bit count */ 522 else p -> iochan.iolength = divide(bc, 9, 24, 0); /* get char count from bit count */ 523 return; 524 525 526 527 /* 528* * Internal procedure to open an output file, saving acl and setting access to rwa 529* */ 530 531 open_output_file: entry; 532 533 call msf_manager_$open(dname, p -> iochan.name, p -> iochan.fcbp, code); 534 if p -> iochan.fcbp = null then go to fs_loss_close_maybe; 535 return; 536 537 /* 538* * Internal proc to get ptr to a component of an output msf 539* */ 540 541 get_output_seg_ptr: entry; 542 543 /* now get ptr to first seg */ 544 545 call msf_manager_$get_ptr(p -> iochan.fcbp, p -> iochan.component, "1"b, 546 p -> iochan.ioptr, bc, code); 547 if p -> iochan.ioptr = null then go to fs_loss_close_it; 548 /* couldn't create the seg, go clean and barf */ 549 550 /* set iochan.iolength from the maximum length attribute of the seg */ 551 552 call hcs_$get_max_length_seg(p -> iochan.ioptr, maxlen, code); 553 if code ^= 0 then go to fs_loss_close_it; /* !!! */ 554 555 if data_mode = Fixnum 556 then p -> iochan.iolength = maxlen; 557 else p -> iochan.iolength = maxlen*4; /* number of chars before o.o.b. fault */ 558 return; 559 560 end open_input_file; 561 562 563 /* 564* * lisp close subr - closes the file and gets rid of the iochan 565* * does not detach streams since open does not attach them 566* */ 567 568 close: entry; 569 570 esw = 4; 571 stack = addrel(stack_ptr, -2); /* get arg */ 572 myname = fn_close; 573 do while (^ stack -> temp_type36(1) & File36); 574 err = lisp_error_table_$bad_arg_correctable; 575 call error; 576 end; 577 578 /* garbage collector joins here */ 579 580 p = stack -> temp_ptr(1); 581 gc_close: if (string(p -> iochan.flags) & "011"b) ^= "011"b then do; /* if not already closed */ 582 if p -> iochan.seg then 583 if ^ p -> iochan.read then /* input file, just close the FCB */ 584 call close_msf; 585 else 586 call close_output_file; 587 else /* a stream: flush buffer if output, but don't have to do anything else */ 588 if ^ p -> iochan.write then call dump_buffer; 589 end; 590 591 if esw < 0 then go to gc_close_1; /* skip this if gc_flush entry */ 592 593 594 /* 595* * as far as the Multics environment is concerned, the iochan is closed 596* * but there are still some things left to do in the lisp environment 597* */ 598 599 600 /* (setq instack (delq p instack)) */ 601 602 stack_ptr = addr(stack -> temp(5)); 603 stack -> temp(2), stack -> temp(3) = addr(instack) -> based_ptr -> atom.value; 604 do while (stack -> temp_type(3) = Cons); 605 if stack -> temp_ptr(3) -> cons.car = stack -> temp(1) /* p appears in the list */ 606 then if stack -> temp(2) = stack -> temp(3) /* first in list is special case */ 607 then stack -> temp(2) = stack -> temp_ptr(3) -> cons.cdr; 608 else stack -> temp_ptr(4) -> cons.cdr = /* if not first in list, rplacd it out */ 609 stack -> temp_ptr(3) -> cons.cdr; 610 stack -> temp(4) = stack -> temp(3); 611 stack -> temp(3) = stack -> temp_ptr(3) -> cons.cdr; 612 end; 613 addr(instack) -> based_ptr -> atom.value = stack -> temp(2); 614 615 /* (and (eq p infile) (inpush -1)) */ 616 617 if stack -> temp(1) = addr(infile) -> based_ptr -> atom.value then do; 618 /* if addr(instack)-> based_ptr -> atom_types.value = Cons */ 619 if addr(instack)-> based_ptr -> lisp_ptr.type = Cons 620 then addr(infile) -> based_ptr -> atom.value = addr(instack) -> based_ptr -> atom_ptrs.value -> cons.car; 621 else addr(infile)-> based_ptr -> atom.value = t_atom; /* empty list -> tty */ 622 if addr(instack) -> based_ptr -> atom.value ^= nil 623 then addr(instack) -> based_ptr -> atom.value = 624 addr(instack) -> based_ptr -> atom_ptrs.value -> cons.cdr; 625 end; 626 627 if addr(infile) -> based_ptr -> atom.value = nil 628 | addr(infile) -> based_ptr -> atom.value = t_atom 629 then addr(ctrlQ) -> based_ptr -> atom.value = nil; 630 631 /* (setq outfiles (delq p outfiles)) */ 632 633 stack -> temp(2), stack -> temp(3) = addr(outfiles) -> based_ptr -> atom.value; 634 do while (stack -> temp_type(3) = Cons); 635 if stack -> temp_ptr(3) -> cons.car = stack -> temp(1) /* p appears in the list */ 636 then if stack -> temp(2) = stack -> temp(3) /* first in list is special case */ 637 then stack -> temp(2) = stack -> temp_ptr(3) -> cons.cdr; 638 else stack -> temp_ptr(4) -> cons.cdr = /* if not first in list, rplacd it out */ 639 stack -> temp_ptr(3) -> cons.cdr; 640 stack -> temp(4) = stack -> temp(3); 641 stack -> temp(3) = stack -> temp_ptr(3) -> cons.cdr; 642 end; 643 addr(outfiles) -> based_ptr -> atom.value = stack -> temp(2); 644 645 if stack -> temp(2) = nil 646 then addr(ctrlR) -> based_ptr -> atom.value = nil; 647 648 /* 649* * Mark iochan closed by setting both read and write 650* */ 651 652 gc_close_1: 653 p -> iochan.read, p -> iochan.write = "1"b; 654 655 /* 656* * unthread from system's iochan list 657* */ 658 659 errtn(-1): /* error return from lisp_io_control_$gc_flush -- unthread so error doesn't occur every gc */ 660 661 if lisp_static_vars_$iochan_list = p then 662 lisp_static_vars_$iochan_list = p -> iochan.thread; 663 else 664 do q = lisp_static_vars_$iochan_list 665 repeat (q -> iochan.thread) 666 while (q ^= null); 667 if q -> iochan.thread = p then do; 668 q -> iochan.thread = p -> iochan.thread; 669 go to exit_t; 670 end; 671 end; 672 /* if we normal-exit this loop, was weird err but who cares? */ 673 674 /* 675* * all done closing, so return 676* * value of close is t instead of argument because argument is no longer a valid file object 677* */ 678 679 exit_t: if esw < 0 then do; /* return from gc_flush entry */ 680 stack_ptr = stack; 681 return; 682 end; 683 else if esw < 3 then go to open_close_ret; 684 stack -> temp(1) = t_atom; 685 go to exit; 686 687 /* 688* * garbage collector calls this entry when it finds an unreachable iochan 689* * unless it is one of the tty iochans, it is automatically closed 690* */ 691 692 gc_flush: entry (a_iochan); 693 694 esw = -1; myname = 0; 695 stack = stack_ptr; 696 p = a_iochan; 697 if p -> iochan.seg then if p -> iochan.fcbp = null then return; /* already been flushed so don't try 698* to flush it again - interaction 699* with saver */ 700 go to gc_close; 701 702 703 close_msf: procedure; 704 705 if p -> iochan.fcbp ^= null() then call msf_manager_$close(p -> iochan.fcbp); 706 p -> iochan.fcbp = null(); 707 708 end; 709 710 close_output_file: procedure; 711 712 /* Set bit count on output file and close fcb */ 713 714 if p -> iochan.fcbp ^= null() 715 then do; 716 if p -> iochan.fixnum_mode /* cv words to chars */ 717 then p -> iochan.ioindex = p -> iochan.ioindex*4; 718 call msf_manager_$adjust(p -> iochan.fcbp, p -> iochan.component, p -> iochan.ioindex*9, "111"b, code); 719 if code ^= 0 then go to file_sys_fun_err_; 720 call msf_manager_$close (p -> iochan.fcbp); 721 p->iochan.fcbp = null(); 722 end; 723 end close_output_file; 724 725 726 /* 727* * This entry is called by reader or printer when an iochan has flags that say it is not OK to use 728* * 729* * This could be due to: 730* * 1) I/O in wrong direction 731* * 2) iochan has been closed 732* * 3) the lisp environment has been saved and this file needs to be re-opened 733* * This routine identifies the cause of the problem and fixes it or signals a fail-act 734* */ 735 736 fix_not_ok_iochan: entry(a_iochan, intended_dir, fail_act_f); 737 738 dcl intended_dir bit(1) aligned parameter, /* 1 = out, 0 = in */ 739 fail_act_f bit(1) aligned parameter; /* returned 1 if fail-act occurred */ 740 741 esw = -2; 742 stack = stack_ptr; 743 fail_act_f = "0"b; 744 if intended_dir = "1"b then myname = fn_openo; 745 else myname = fn_openi; 746 p = a_iochan; 747 if p -> iochan.fixnum_mode then data_mode = Fixnum; else data_mode = Ascii; 748 /* may be needed below */ 749 if p -> iochan.must_reopen then /* we unsave the iochan only now, not in lisp_unsave_, 750* because it is only now that the use has demonstrated 751* that he still wants to use this iochan. */ 752 753 if p -> iochan.seg then do; 754 stack_ptr = addr(stack -> temp(2)); 755 stack -> temp(1) = p -> iochan.namelist; /* re-open with same name as before */ 756 call get_path_name; 757 if ^ p -> iochan.read then call open_input_file; 758 else do; 759 call open_output_file; 760 call msf_manager_$get_ptr(p -> iochan.fcbp, /* get seg to which we were last outputting */ 761 p -> iochan.component, "0"b, /* but don't try to create it if it has gone */ 762 p -> iochan.ioptr, 0, code); 763 if p -> iochan.ioptr = null then go to file_sys_fun_err_; 764 end; 765 766 /* the component number and char position are set from before, just check that the 767* file has not gotten shorter somehow */ 768 769 if p -> iochan.ioindex > p -> iochan.iolength then do; 770 call close_msf; 771 go to reopen_inconsistent_; 772 end; 773 p -> iochan.must_reopen = "0"b; 774 return; 775 end; 776 else do; /* reopening a stream, have to get a new buffer */ 777 call lisp_static_man_$allocate(p -> iochan.ioptr, divide(buffer_size, 4, 18, 0)); 778 p -> iochan.must_reopen = "0"b; 779 return; 780 end; 781 else if (string(p -> iochan.flags) & "011"b) = "011"b then do; /* file has been closed! */ 782 go to iochan_has_been_closed_; 783 end; 784 else do; 785 go to io_wrong_direction_; 786 end; 787 788 /* 789* * Entry to make all iochans saveable - called near the beginning of the save process 790* */ 791 792 set_for_save: entry; 793 794 esw = 0; 795 do p = lisp_static_vars_$iochan_list 796 repeat (p -> iochan.thread) 797 while (p ^= null); 798 if p -> iochan.seg then /* streams are no problem since user has to reattach them */ 799 if ^(p -> iochan.read & p -> iochan.write) /* if still open */ 800 then if p -> iochan.must_reopen then; /* already saved from before */ 801 else do; 802 if ^p -> iochan.read then call close_msf; /* close input file */ 803 else call close_output_file; 804 set_for_save_err_ret: p -> iochan.ioptr, p -> iochan.fcbp, p -> iochan.aclinfop = null; 805 end; 806 else; /* already closed - no action */ 807 else do; 808 p -> iochan.ioptr = null; /* flush the buffer (completely) */ 809 p -> iochan.ioindex = 0; 810 p -> iochan.nlsync = "0"b; 811 if ^p -> iochan.read then p -> iochan.iolength = 0; 812 p->iochan.fcbp = null(); 813 end; 814 p -> iochan.must_reopen = "1"b; /* so fix_not_ok_iochan will get called on next reference */ 815 end; 816 return; 817 818 /* 819* * lisp_io_control_$boot called at environment-boot time to set up the two initial 820* * files, tty_input_chan and tty_output_chan. These are handled slightly 821* * differently from other files in some respets, so they have their 822* * interactive flag turned on. Fortunately no errors can occur here. 823* */ 824 825 boot: entry; 826 827 call make_an_iochan; /* tty_input_chan first */ 828 tty_input_chan = p; 829 p -> iochan.write = "1"b; /* input chan, leave flags.read = 0 */ 830 p -> iochan.interactive = "1"b; 831 p -> iochan.name = "user_input"; 832 call lisp_static_man_$allocate(p -> iochan.ioptr, divide(buffer_size, 4, 18, 0)); 833 p -> iochan.iolength = 0; 834 call iox_$look_iocb(p->iochan.name, p->iochan.fcbp, code); 835 p -> iochan.aclinfop, p -> iochan.thread = null; 836 p -> iochan.function = nil; /* default eoffn */ 837 p -> iochan.pagel = 0; /* page length for non-display tty's (no 'pl' mode) is infinite */ 838 p -> iochan.linel = 70; /* default line length for tty's */ 839 p -> iochan.charpos, p -> iochan.linenum, p -> iochan.pagenum = 0; 840 p -> iochan.namelist = nil; /* not ever used */ 841 842 q = p; 843 call make_an_iochan; 844 tty_output_chan = p; 845 p -> iochan.read = "1"b; 846 p -> iochan.interactive ="1"b; 847 p -> iochan.charmode = "1"b; 848 p -> iochan.name = "user_output"; 849 call lisp_static_man_$allocate(p -> iochan.ioptr, divide(buffer_size, 4, 18, 0)); 850 p -> iochan.iolength = buffer_size; 851 p -> iochan.charpos, p -> iochan.linenum, p -> iochan.pagenum = 0; 852 p -> iochan.pagel = q -> iochan.pagel; 853 p -> iochan.linel = q -> iochan.linel; 854 p -> iochan.function = nil; /* default endpagefn */ 855 /* p -> iochan.namelist will get set soon by init entry */ 856 call iox_$look_iocb(p->iochan.name, p->iochan.fcbp, code); 857 p -> iochan.aclinfop = null; 858 p -> iochan.thread = q; 859 addr(p -> iochan.thread)->lisp_ptr.type = File; /* turn on type bit */ 860 lisp_static_vars_$iochan_list = p; 861 addr(lisp_static_vars_$iochan_list)->lisp_ptr.type, /* turn on type bits since these ptrs are gc'ed */ 862 addr(lisp_static_vars_$tty_input_chan)->lisp_ptr.type, 863 addr(lisp_static_vars_$tty_output_chan)->lisp_ptr.type = File; 864 865 /* initialize the variables ^q, ^r, ^w, infile, outfiles */ 866 867 addr(ctrlQ)->based_ptr -> atom.value, 868 addr(ctrlR)->based_ptr -> atom.value, 869 addr(ctrlW)->based_ptr -> atom.value, 870 addr(instack)->based_ptr -> atom.value, 871 addr(outfiles)->based_ptr -> atom.value = nil; 872 addr(infile)->based_ptr -> atom.value = t_atom; 873 874 return; 875 876 877 /* 878* * Routine to dump buffer of output stream. p -> iochan. 879* */ 880 881 dump_buffer: proc; 882 883 if p->iochan.ioindex = 0 then do; p -> iochan.nlsync = "0"b; return; end; /* bugs in various io modules */ 884 if p->iochan.fcbp = null() then call get_iocb; 885 if p->iochan.fixnum_mode then p->iochan.ioindex = 4*p->iochan.ioindex; 886 call iox_$put_chars(p->iochan.fcbp, p->iochan.ioptr, p->iochan.ioindex, code); 887 if code ^= 0 then go to file_sys_fun_err_; 888 p -> iochan.ioindex = 0; /* the buffer is now empty */ 889 p -> iochan.nlsync = "0"b; /* .. */ 890 end dump_buffer; 891 892 get_iocb: procedure; 893 894 call iox_$look_iocb(p -> iochan.name, p -> iochan.fcbp, status); 895 if status ^= 0 then do; 896 code = status; 897 go to file_sys_fun_err_; 898 end; 899 end get_iocb; 900 901 902 903 /* 904* * Entry to empty all buffers of all output streams 905* */ 906 907 empty_all_buffers: entry; 908 909 esw = -4; 910 do p = lisp_static_vars_$iochan_list 911 repeat (p -> iochan.thread) 912 while (p ^= null); 913 if ^ p -> iochan.seg then if ^ p -> iochan.write /* open output stream */ 914 then call dump_buffer; 915 empty_all_err_ret: 916 end; 917 return; 918 919 920 /* 921* * Initialize entry 922* */ 923 924 init: entry; 925 926 927 /* initialize default namelist to (working-dir . *) */ 928 929 dname = get_wdir_(); 930 i = length(dname) + 1 - verify(reverse(dname), " "); 931 stack = stack_ptr; 932 stack_ptr = addr(stack -> temp(3)); 933 call lisp_get_atom_(substr(dname, 1, i), stack -> temp(1)); 934 stack -> temp(2) = star; 935 call lisp_special_fns_$cons; 936 tty_output_chan -> iochan.namelist = stack -> temp(1); 937 stack_ptr = stack; 938 939 /* get the real pagel and linel for the tty from the DIM */ 940 941 tty_input_chan -> iochan.charpos, tty_output_chan -> iochan.charpos = 0; /* also resetting all this cruft */ 942 tty_input_chan -> iochan.linenum, tty_output_chan -> iochan.linenum = 0; 943 tty_input_chan -> iochan.pagenum, tty_output_chan -> iochan.pagenum = 0; 944 tty_input_chan -> iochan.pagel, tty_output_chan -> iochan.pagel = 0; 945 tty_input_chan -> iochan.linel, tty_output_chan -> iochan.linel = 80; /* default should be 0 but for sake of Macsyma, ... */ 946 947 call iox_$look_iocb(tty_output_chan->iochan.name, tty_output_chan->iochan.fcbp, status); 948 if status ^= 0 then go to no_modes_available; 949 call iox_$modes(tty_output_chan->iochan.fcbp, "", user_io_modes, status); 950 if status ^= 0 then go to no_modes_available; 951 952 /* Extract line length and page length from mode string if possible */ 953 954 mode_value_ptr = addr (amv); 955 mode_value_ptr -> mode_value.version = mode_value_version_3; 956 mode_value_ptr -> mode_value.flags = "0"b; 957 958 call mode_string_$get_mode (user_io_modes,"ll",mode_value_ptr,status); 959 if status = 0 960 then if mode_value_ptr -> mode_value.numeric_valuep 961 then tty_input_chan -> iochan.linel,tty_output_chan -> iochan.linel = mode_value_ptr -> mode_value.numeric_value; 962 963 mode_value_ptr -> mode_value.flags = "0"b; 964 965 call mode_string_$get_mode (user_io_modes,"pl",mode_value_ptr,status); 966 967 if status = 0 968 then if mode_value_ptr -> mode_value.numeric_valuep 969 then tty_input_chan -> iochan.pagel,tty_output_chan -> iochan.pagel = mode_value_ptr -> mode_value.numeric_value; 970 971 /* flush tty buffers */ 972 973 no_modes_available: 974 tty_input_chan -> iochan.ioindex, tty_input_chan -> iochan.iolength = 0; 975 976 tty_output_chan -> iochan.ioindex = 0; 977 978 /* make uread, etc. default to working dir */ 979 980 lisp_static_vars_$old_io_defaults -> atom.value = nil; 981 982 return; 983 984 985 /* 986* * Called by other i/o functions when the end of a block (stream buffer or m.s.f. segment) 987* * is reached on either input or output. All good things are done, including handling 988* * of end-of-file. A return code is passed to the caller to tell him what action was taken. 989* */ 990 991 end_of_block: entry (a_iochan, eofval, cde); 992 993 dcl a_iochan ptr, eofval fixed bin(71) /* a lisp object */, cde fixed bin; 994 /* cde = 0 --> OK 995* 1 --> eof - continue reading 996* 2 --> eof - return eofval immediately (used for fail-act's too) 997* -1 --> select new input file 998* -2 --> error - must select new file. bad_input_source or bad_output_dest err has been done 999* */ 1000 1001 esw = -3; 1002 cde = 0; /* assuming eof or err is not going to happen */ 1003 p = a_iochan; 1004 if ^ p -> iochan.write then 1005 if p -> iochan.seg then do; 1006 1007 /* end of seg on output msf, call msf manager to get next seg */ 1008 1009 p -> iochan.component = p -> iochan.component + 1; 1010 call get_output_seg_ptr; 1011 p -> iochan.ioindex = 0; /* start at beginning of this seg */ 1012 end; 1013 else call dump_buffer; /* Buffer full on stream - dump it */ 1014 else 1015 if p -> iochan.seg then do; 1016 1017 /* End of input seg, try to get another one from msf manager */ 1018 1019 p -> iochan.component = p -> iochan.component + 1; 1020 call msf_manager_$get_ptr(p -> iochan.fcbp, p -> iochan.component, 1021 "0"b, p -> iochan.ioptr, bc, code); 1022 p -> iochan.ioindex, p -> iochan.iolength = 0; 1023 if p -> iochan.ioptr = null /* Error return */ 1024 then if code = error_table_$noentry then go to E_O_F; 1025 else go to file_sys_fun_err_; /* LOSE!! */ 1026 if p -> iochan.fixnum_mode 1027 then p -> iochan.iolength = divide(bc, 36, 24, 0); 1028 else p -> iochan.iolength = divide(bc, 9, 24, 0); 1029 end; 1030 else do; 1031 1032 /* End of stream buffer, call iox_$read */ 1033 1034 p -> iochan.ioindex, p -> iochan.iolength = 0; 1035 if p->iochan.fcbp = null() then call get_iocb; 1036 if p -> iochan.interactive then do; 1037 1038 /* tty_input_chan, flush tty_output_chan (before going blocked) */ 1039 1040 q = p; 1041 p = tty_output_chan; 1042 call dump_buffer; 1043 p -> iochan.charpos = 0; /* tty is now at left margin */ 1044 p = q; 1045 1046 /* fix up rdr state stuff so quit while blocked in iox_$read will work right */ 1047 1048 rdr_label = input_wait_ab_exit; 1049 rdr_state = 1; 1050 end; 1051 1052 if p->iochan.fixnum_mode 1053 then do; 1054 call iox_$get_chars(p->iochan.fcbp, p->iochan.ioptr, (buffer_size), p->iochan.iolength, code); 1055 p->iochan.iolength = divide(p->iochan.iolength+3,4,24,0); 1056 end; 1057 else call iox_$get_line(p->iochan.fcbp, p->iochan.ioptr, (buffer_size), p->iochan.iolength, code); 1058 1059 rdr_state = 0; 1060 1061 /* check status for eof, err */ 1062 1063 if code ^= 0 1064 then if code = error_table_$end_of_info then goto E_O_F; 1065 else if code = error_table_$long_record then return; 1066 else goto file_sys_fun_err_; 1067 else return; 1068 1069 /* come here if some kind of quit while blocked on user_input. Return a code -1 1070* to tell the caller to check whether he wants to input from a different file now */ 1071 input_wait_ab_exit: 1072 rdr_state = 0; 1073 cde = -1; 1074 return; 1075 1076 end; 1077 return; /* successfully got next block, continue the i/o operation */ 1078 1079 /* END OF FILE HANDLING 1080* * 1081* * come here with p -> iochan, eofval = nil or arg to read, cde will be set to 1 or 2 1082* */ 1083 1084 E_O_F: 1085 if eofval = t_atom then go to eof_imm_ret; /* this is tyipeek - don't use the eoffn */ 1086 if p -> iochan.function ^= nil then do; 1087 1088 /* Call user's eof function, args = p, eofval */ 1089 1090 stack = stack_ptr; 1091 stack_ptr = addr(stack -> temp(5)); 1092 stack -> temp(4) = nil; /* cons up arg list for apply */ 1093 stack -> temp(3) = eofval; 1094 p_.type = File; 1095 stack -> temp(2) = p_fb; 1096 stack -> temp(1) = p -> iochan.function; 1097 call lisp_special_fns_$cons; 1098 call lisp_special_fns_$cons; 1099 call lisp_$apply; 1100 1101 /* check the value returned by the eoffn */ 1102 1103 if stack -> temp(1) = nil then go to eof_nil_1; 1104 else if stack -> temp(1) = t_atom then do; 1105 stack_ptr = stack; 1106 cde = 1; /* proceed, eoffn has done insel */ 1107 return; 1108 end; 1109 eofval = stack -> temp(1); /* force read to return what the eoffn retturned */ 1110 stack_ptr = stack; 1111 go to eof_imm_ret; 1112 1113 end; 1114 1115 else do; 1116 1117 /* No eoffn -- default handling directed by eofval */ 1118 1119 if eofval ^= nil then go to eof_imm_ret; 1120 /* if eofval supplied on call to read, return it */ 1121 eof_nil: /* no eofval - close this file and continue reading from the one selected by close */ 1122 1123 stack = stack_ptr; 1124 stack_ptr = addr(stack -> temp(2)); 1125 eof_nil_1: 1126 p_.type = File; 1127 stack -> temp(1) = p_fb; 1128 call lisp_io_control_$close; 1129 cde = 1; 1130 return; 1131 1132 1133 eof_imm_ret: /* force read to return eofval immediately */ 1134 1135 cde = 2; 1136 return; 1137 1138 end; 1139 1140 /* 1141* * Error Handling 1142* * 1143* * all errors (almost) come to these routines. The stack is fiddled 1144* * and lisp_error_ is called. What happens when lisp_error_ returns 1145* * and what is put on the stack as an argument to the fail-act routine 1146* * is determined by esw, the entry switch. 1147* */ 1148 1149 /* routine to call lisp_error_ */ 1150 1151 error: proc; 1152 1153 dcl unm ptr, 1154 ercode(2) aligned based(unm) fixed bin, 1155 lisp_error_ entry; 1156 1157 unm = unmkd_ptr; 1158 unmkd_ptr = addrel(unm, 2); 1159 ercode(1) = err; 1160 ercode(2) = myname; 1161 call lisp_error_; 1162 end; 1163 1164 /* 1165* * Funny errors in fix_not_ok_iochan 1166* */ 1167 1168 reopen_inconsistent_: 1169 err = lisp_error_table_$reopen_inconsistent; 1170 stack_ptr = stack; 1171 go to inouterr1; 1172 1173 io_wrong_direction_: 1174 err = lisp_error_table_$io_wrong_direction; 1175 go to inouterr; 1176 1177 iochan_has_been_closed_: 1178 err = lisp_error_table_$file_is_closed; 1179 go to inouterr; 1180 1181 inouterr: 1182 /* make list (infile x) or (outfile x) as arg to fail-act */ 1183 1184 stack = stack_ptr; 1185 inouterr1: 1186 stack_ptr = addr(stack -> temp(4)); 1187 if p -> iochan.write 1188 then stack -> temp(1) = lisp_static_vars_$infile; 1189 else stack -> temp(1) = lisp_static_vars_$outfile; 1190 errproc_aa: /** other errors join here **/ 1191 stack -> temp(3) = nil; 1192 p_.type = File; 1193 stack -> temp(2) = p_fb; 1194 errproc_cc: /** and here **/ 1195 call lisp_special_fns_$cons; 1196 call lisp_special_fns_$cons; 1197 if esw = 7 then do; /* special kludgery for rename because 1198* it moves 'stack.' */ 1199 rnstack -> temp(1) = stack -> temp(1); 1200 stack = rnstack; 1201 stack_ptr = addrel(stack, 2); 1202 end; 1203 myname = code; /* fake out 'error' proc in case of file_sys_fun_err */ 1204 call error; 1205 go to errtn(esw); /* crawl out in entry-dependent way */ 1206 1207 /* error exit for lisp_io_control_$fix_not_ok_iochan -- reflect to caller */ 1208 1209 errtn(-2): 1210 if intended_dir = "1"b then addr(ctrlR)->based_ptr -> atom.value = t_atom; 1211 else addr(ctrlQ)->based_ptr -> atom.value = t_atom; 1212 stack_ptr = stack; 1213 fail_act_f = "1"b; 1214 return; /* value of fail-act has been pushed onto marked pdl */ 1215 1216 errtn(-4): /* lisp_io_control_$empty_all_buffers - just continue in do loop */ 1217 1218 stack_ptr = stack; 1219 go to empty_all_err_ret; 1220 1221 errtn(-3): /* lisp_io_control_$end_of_block -- tell caller and give him value of the fail-act */ 1222 1223 cde = -2; 1224 if ^ p -> iochan.read then addr(ctrlQ)->based_ptr -> atom.value = t_atom; 1225 if ^ p -> iochan.write then addr(ctrlR)->based_ptr -> atom.value = t_atom; 1226 stack_ptr = stack; 1227 return; 1228 1229 /* lisp fcn entry points just return value of fail-act as their value */ 1230 1231 errtn(7): errtn(1): errtn(2): errtn(3): errtn(5): errtn(4): errtn(6): 1232 1233 stack_ptr = addr(stack -> temp(2)); 1234 return; 1235 1236 1237 1238 /* 1239* * General file system errors come here 1240* * 1241* * We take a fail-act with args = a list of some fcn name and the file object 1242* * the action on return from the fail-act is controlled by esw 1243* * 'code' contains a Multics status code, from which the error message will be derived * myname is not used 1244* */ 1245 1246 file_sys_fun_err_: 1247 err = lisp_error_table_$file_sys_fun_err; 1248 go to errproc(esw); /* set up stack, get name of fcn */ 1249 1250 1251 errproc(1): 1252 errproc(2): 1253 errproc(3): 1254 errproc(4): 1255 errproc(5): 1256 stack_ptr = addr(stack -> temp(4)); 1257 call get_fname; 1258 go to errproc_aa; 1259 1260 1261 errproc(7): /* cons up list of 'rename and both (processed) args */ 1262 1263 stack_ptr = addr(stack -> temp(5)); 1264 stack -> temp(4) = nil; 1265 stack -> temp(3) = stack -> temp(2); 1266 stack -> temp(2) = stack -> temp(1); 1267 call get_fname; 1268 call lisp_special_fns_$cons; 1269 go to errproc_cc; 1270 1271 errproc(0): /* lisp_io_control_$set_for_save 1272* *** the lisp error mechanism is not in operation, 1273* *** so barf through com_err_ and continue with our do loop 1274* */ 1275 1276 call com_err_(code, "lisp_io_control_", "^/^-Trying to close and save file object ""^a"" at ^p", 1277 p -> iochan.name /* don't bother with full path name */, p); 1278 go to set_for_save_err_ret; 1279 1280 1281 errproc(-1): /* lisp_io_control_$gc_flush -- failed trying to auto-close */ 1282 1283 call com_err_(code, "lisp_io_control_", "^/^-Trying to auto-close file object ""^a"" at ^p", 1284 p -> iochan.name, p); 1285 go to gc_close_1; /* just ignore the error, except for now print kludgey message */ 1286 1287 errproc(-2): /* lisp_io_control_$fix_not_ok_iochan -- fcn name is infile or outfile */ 1288 1289 if intended_dir = "1"b then addr(ctrlR)->based_ptr -> atom.value = nil; 1290 else addr(ctrlQ)->based_ptr -> atom.value = nil; 1291 go to inouterr1; 1292 1293 errproc(-3): /* lisp_io_control_$end_of_block -- fcn name is again infile or outfile (still a hack) */ 1294 1295 if ^ p -> iochan.read then addr(ctrlQ)->based_ptr -> atom.value = nil; 1296 if ^ p -> iochan.write then addr(ctrlR)->based_ptr -> atom.value = nil; 1297 go to inouterr; 1298 1299 errproc(-4): /* lisp_io_control_$empty_all_buffers -- lisp error mechanism may not be working (quit or save), 1300* so just ignore the error and go on to the next buffer */ 1301 go to empty_all_err_ret; 1302 1303 errproc(-5): /* lisp_io_control_$cleanup -- ignore the error completely (what else would you do?) */ 1304 1305 go to cleanup_err_ret; 1306 1307 1308 /* 1309* * routine to put lisp atom qhich is name of function selected by esw into stack -> temp(1) -- used for errors 1310* */ 1311 1312 get_fname: proc; 1313 1314 go to gfn(esw); 1315 1316 gfn(1): 1317 gfn(2): 1318 gfn(3): stack -> temp(1) = lisp_static_vars_$open; 1319 return; 1320 1321 gfn(4): stack -> temp(1) = lisp_static_vars_$close; 1322 return; 1323 1324 gfn(5): stack -> temp(1) = lisp_static_vars_$mergef; 1325 return; 1326 1327 gfn(6): stack -> temp(1) = lisp_static_vars_$deletef; 1328 return; 1329 1330 gfn(7): stack -> temp(1) = lisp_static_vars_$rename; 1331 return; 1332 1333 end; 1334 1335 /* 1336* * cleanup entry called by lisp command cleanup handler 1337* * we close all files 1338* */ 1339 1340 cleanup: entry; 1341 1342 esw = -5; 1343 1344 do p = lisp_static_vars_$iochan_list 1345 repeat (p -> iochan.thread) 1346 while (p ^= null); 1347 1348 if (string(p -> iochan.flags) & "011"b) ^= "011"b then /* if still open */ 1349 if p -> iochan.seg then 1350 if p -> iochan.fcbp ^= null then 1351 if ^ p -> iochan.read then 1352 call close_msf; 1353 else call close_output_file; 1354 cleanup_err_ret: end; 1355 return; 1356 1357 /* 1358* * lisp mergef lsubr 1359* * calls same internal routine umergef as the open functions 1360* */ 1361 1362 mergef: entry; 1363 1364 stack = addrel(stack_ptr, -2); /* get arg count */ 1365 nargs = stack -> fixedb; 1366 stack = addrel(stack, nargs); 1367 nargs = divide(nargs, -2, 17, 0); 1368 esw = 5; 1369 myname = fn_mergef; 1370 1371 call umergef; 1372 1373 go to exit; 1374 1375 /* 1376* * Internal proc to perform application of defaults by mergeing of namelists 1377* * 1378* * called with stack -> array of namelists, nargs = how many 1379* * returns with stack -> one namelist result 1380* * also expands namestrings into namelists 1381* * in the case where this was called by a function other than 1382* * mergef itself, the result is checked for improper format. 1383* * otherwise no error checking is done; when you try to use 1384* * the result the presence of e.g. numbers will cause err msg 1385* */ 1386 1387 umergef: proc; 1388 1389 dcl sp ptr, /* -> arg being processed */ 1390 unm ptr, 1391 tp ptr; /* -> top of stack area for making arg lists to cons */ 1392 /* stack -> current result-list */ 1393 1394 sp = stack; 1395 tp = stack_ptr; 1396 if stack -> temp_type(1) then /* convert to a list */ 1397 do; 1398 stack_ptr = addrel(tp, 2); 1399 tp -> temp(1) = stack -> temp(1); 1400 call lisp_io_fns_$internal_namelist(myname); 1401 stack -> temp(1) = tp -> temp(1); 1402 end; 1403 do while (nargs >= 2); /* go through arguments */ 1404 if stack -> temp_ptr(1) -> cons.car = stream then go to exitloop; /* streams don't need all this 1405* lossage, just fall right through */ 1406 sp = addrel(sp, 2); /* next arg... */ 1407 nargs = nargs-1; 1408 if sp -> temp(1) = nil then do; /* special kludge - drop last name */ 1409 if stack -> temp_ptr(1) -> cons_types.cdr = Cons then do; 1410 stack_ptr = addrel(tp, 2); 1411 tp -> temp(1) = nil; 1412 do sp -> temp(1) = stack -> temp(1) /* copy the arg, except for last cons */ 1413 repeat(sp -> temp_ptr(1) -> cons.cdr) 1414 while(sp -> temp_ptr(1) -> cons_types.cdr = Cons); 1415 stack_ptr = addrel(tp, 4); 1416 tp -> temp(2) = sp -> temp_ptr(1) -> cons.car; 1417 call lisp_special_fns_$xcons; 1418 end; 1419 call lisp_list_utils_$nreverse; 1420 stack -> temp(1) = tp -> temp(1); /* move result down */ 1421 stack_ptr = tp; 1422 end; 1423 end; 1424 else do; 1425 if sp -> temp_type(1) then do; /* convert to a list */ 1426 stack_ptr = addrel(tp, 2); 1427 tp -> temp(1) = sp -> temp(1); 1428 call lisp_io_fns_$internal_namelist(myname); 1429 sp -> temp(1) = tp -> temp(1); 1430 end; 1431 1432 /* normal mergef case - (margef x y) where x and y are lists */ 1433 1434 stack_ptr = addrel(tp, 2); 1435 tp -> temp(1) = nil; /* going to cons up reverse output list */ 1436 do while (stack -> temp_type(1) = Cons & 1437 sp -> temp_type(1) = Cons); /* do while both lists hold out */ 1438 1439 stack_ptr = addrel(tp, 4); 1440 if stack -> temp_ptr(1) -> cons.car ^= star then 1441 tp -> temp(2) = stack -> temp_ptr(1) -> cons.car; 1442 else tp -> temp(2) = sp -> temp_ptr(1) -> cons.car; 1443 /* select from x unless *, in which case take from y */ 1444 call lisp_special_fns_$xcons; 1445 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 1446 sp -> temp(1) = sp -> temp_ptr(1) -> cons.cdr; 1447 end; 1448 1449 /* one or both of the lists has come to an end */ 1450 1451 if stack -> temp_type36(1) & Atsym36 then /* x has come to the end, */ 1452 if stack -> temp(1) ^= nil then do; /* x is dotted */ 1453 do while (sp -> temp_type(1) = Cons); /* copy rest of y over */ 1454 stack_ptr = addrel(tp, 4); 1455 tp -> temp(2) = sp -> temp_ptr(1) -> cons.car; 1456 call lisp_special_fns_$xcons; 1457 sp -> temp(1) = sp -> temp_ptr(1) -> cons.cdr; 1458 end; 1459 if stack -> temp(1) ^= star then /* x had dotted atom, make sure list ends with it */ 1460 if stack -> temp(1) ^= tp -> temp_ptr(1) -> cons.car 1461 then do; 1462 stack_ptr = addrel(tp, 4); 1463 tp -> temp(2) = stack -> temp(1); 1464 call lisp_special_fns_$xcons; 1465 end; 1466 go to x01; 1467 end; 1468 1469 /* copy rest of names in x */ 1470 1471 do while (stack -> temp_type(1) = Cons); 1472 stack_ptr = addrel(tp, 4); 1473 tp -> temp(2) = stack -> temp_ptr(1) -> cons.car; 1474 call lisp_special_fns_$xcons; 1475 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 1476 end; 1477 1478 if sp -> temp(1) ^= nil then /* if there is more to the list, */ 1479 if sp -> temp_type(1) ^= Cons then /* y ends with a dotted atom */ 1480 if sp -> temp(1) ^= star then /* other than .*, which is ignored */ 1481 if tp -> temp_ptr(1) -> cons.car /* then make sure the list ends with this */ 1482 ^= sp -> temp(1) then do; 1483 stack_ptr = addrel(tp, 4); 1484 tp -> temp(2) = sp -> temp(1); 1485 call lisp_special_fns_$xcons; 1486 go to x01; 1487 end; 1488 x01: call lisp_list_utils_$nreverse; /* the list was consed up in the wrong order */ 1489 stack -> temp(1) = tp -> temp(1); /* move result down */ 1490 end; 1491 end; 1492 1493 exitloop: /* all done processing args, maybe check for errors */ 1494 1495 if myname ^= fn_mergef then do; /* if called internally, make sure args to openi, etc. are OK */ 1496 nargs = 0; 1497 do tp -> temp(1) = stack -> temp(1) 1498 repeat (tp -> temp_ptr(1) -> cons.cdr) 1499 while (tp -> temp_type(1) = Cons); 1500 1501 nargs = nargs + 1; 1502 if tp -> temp_ptr(1) -> cons.car = star then go to stars_left; 1503 else if tp -> temp_ptr(1) -> cons_types36.car & String36 then do; /* string is ok */ 1504 call lisp_get_atom_(tp -> temp_ptr(1) -> cons_ptrs.car -> lisp_string.string, 1505 tp -> temp_ptr(1) -> cons.car); 1506 end; 1507 else if tp -> temp_ptr(1) -> cons_types36.car & Numeric36 then do; /* number is ok */ 1508 1509 /* bind *nopoint to t */ 1510 1511 unm = unmkd_ptr; 1512 unmkd_ptr = addrel(unm, 2); 1513 stack_ptr = addr(tp -> temp(5)); 1514 unm -> binding_block.bot_block = rel(addr(tp -> temp(2))); 1515 unm -> binding_block.top_block = rel(addr(tp -> temp(4))); 1516 unm -> binding_block.back_ptr = rel(binding_top); 1517 tp -> temp(3) = lisp_static_vars_$stnopoint; 1518 tp -> temp(2) = tp -> temp_ptr(3) -> atom.value; 1519 binding_top = unm; 1520 tp -> temp_ptr(3) -> atom.value = t_atom; 1521 1522 /* call exploden on the number */ 1523 1524 tp -> temp(4) = tp -> temp_ptr(1) -> cons.car; 1525 call lisp_print_$exploden; 1526 1527 /* maknam the result */ 1528 1529 call lisp_reader_$maknam; 1530 1531 /* rplaca it back into the namelist */ 1532 1533 tp -> temp_ptr(1) -> cons.car = tp -> temp(4); 1534 1535 /* get rid of the binding */ 1536 1537 tp -> temp_ptr(3) -> atom.value = tp -> temp(2); 1538 binding_top = ptr(binding_top, unm -> binding_block.back_ptr); 1539 unmkd_ptr = unm; 1540 stack_ptr = addr(tp -> temp(2)); 1541 end; 1542 1543 else if tp -> temp_ptr(1) -> cons_types.car & ^Atsym then go to stars_left; /* random - barf */ 1544 end; 1545 if tp -> temp(1) ^= nil then go to stars_left; /* dotted list is NG */ 1546 1547 /* expand the directory path name if necessary */ 1548 1549 if stack -> temp_ptr(1) -> cons.car ^= stream then 1550 if substr(stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname, 1, 1) ^= ">" then do; 1551 call expand_path_(addr(stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname), 1552 stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pnamel, 1553 addr(dname), 1554 null, 1555 code); 1556 nargs = index(dname, " ")-1; if nargs < 0 then nargs = length(dname); 1557 if code = 0 then call lisp_get_atom_(substr(dname, 1, nargs), stack -> temp_ptr(1) -> cons.car); 1558 /* ok to rplaca since was copied */ 1559 end; 1560 end; 1561 stack_ptr = addrel(stack, 2); /* flush args & stuff from stack */ 1562 return; 1563 end; 1564 1565 /* Error handling for umergef */ 1566 1567 stars_left: 1568 err = lisp_error_table_$stars_left_in_name; /* or any namelist format error */ 1569 errproc_6_join: 1570 stack_ptr = addr(stack -> temp(4)); 1571 stack -> temp(3) = nil; 1572 stack -> temp(2) = stack -> temp(1); 1573 call get_fname; 1574 go to errproc_cc; 1575 1576 /* 1577* * Lisp file deletion function 1578* */ 1579 1580 deletef: entry; 1581 1582 stack = addrel(stack_ptr, -2); /* subr 1 arg */ 1583 myname = fn_deletef; 1584 esw = 6; 1585 stack_ptr = addr(stack -> temp(3)); 1586 stack -> temp(2) = tty_output_chan -> iochan.namelist; /* mergef arg with defaults */ 1587 nargs = 2; 1588 call umergef; 1589 1590 call get_path_name_0; /* set dname, ename */ 1591 1592 call delete_$path(dname, substr(ename, 1, length(ename)-1), 1593 "000110"b, /* no questions, df seg & msf, don't chase links, don't force if ssw on */ 1594 "", code); 1595 if code = 0 then go to exit; 1596 1597 err = lisp_error_table_$file_sys_fun_err; 1598 errproc(6): 1599 go to errproc_6_join; /* previous page */ 1600 1601 /* 1602* * Lisp file renaming function 1603* */ 1604 1605 rename: entry; 1606 1607 rnstack, stack = addrel(stack_ptr, -4); /* subr 2 args */ 1608 myname = fn_rename; 1609 esw = 7; 1610 stack_ptr = addr(stack -> temp(5)); 1611 stack -> temp(4) = tty_output_chan -> iochan.namelist; 1612 stack -> temp(3) = stack -> temp(1); /* put first arg over the defaults */ 1613 nargs = 2; 1614 stack = addr(stack -> temp(3)); 1615 call umergef; 1616 rnstack -> temp(1) = stack -> temp(1); /* save processed first arg */ 1617 stack = addrel(stack, -2); 1618 nargs = 2; 1619 call umergef; /* put second arg over (first arg over defaults) */ 1620 call get_path_name_0; /* get ename for second arg */ 1621 other_ename = substr(ename, 1, length(ename)-1); 1622 1623 stack = rnstack; /* back where it was originally */ 1624 call get_path_name_0; /* get dname and ename for original name */ 1625 1626 call hcs_$chname_file(dname, substr(ename, 1, length(ename)-1), substr(ename, 1, length(ename)-1), 1627 other_ename, code); 1628 if code ^= 0 then go to file_sys_fun_err_; 1629 stack -> temp(1) = stack -> temp(2); /* return value is processed second arg */ 1630 go to exit; 1631 1632 force_output: entry; 1633 1634 /* the force output function, which forces an output file 1635* to disgorge its buffer */ 1636 1637 myname = fn_force_output; 1638 fo_ci_join: 1639 stack = addrel(stack_ptr, -2); /* subr, arg = file */ 1640 fo_ci_retry: 1641 if stack -> temp(1) = nil | stack -> temp(1) = t_atom 1642 then if myname = fn_force_output then p = tty_output_chan; 1643 else p = tty_input_chan; 1644 else if stack -> temp_type36(1) & File36 1645 then p = stack -> temp_ptr(1); 1646 else do; 1647 fo_ci_barf: 1648 err = lisp_error_table_$bad_arg_correctable; 1649 call error; 1650 go to fo_ci_retry; 1651 end; 1652 1653 if p -> iochan.seg then return; /* nugatory for files */ 1654 if p -> iochan.must_reopen then call lisp_io_control_$fix_not_ok_iochan(p, "1"b, ("0"b)); /* mung stream buffer if first use */ 1655 dcl lisp_io_control_$fix_not_ok_iochan entry(ptr, bit(1) aligned, bit(1) aligned); 1656 1657 /* check direction */ 1658 1659 if myname = fn_force_output then 1660 if p -> iochan.write then go to fo_ci_barf; 1661 else; 1662 else /* if myname = fn_clear_input then */ 1663 if p -> iochan.read then go to fo_ci_barf; 1664 else; 1665 1666 /* p -> iochan to be munged */ 1667 1668 if myname = fn_force_output then call dump_buffer; 1669 else do; /*(clear-input p)*/ 1670 p -> iochan.ioindex = 0; 1671 p -> iochan.iolength = 0; 1672 if p -> iochan.fcbp = null() then call get_iocb; 1673 call iox_$control (p->iochan.fcbp, "resetread", null(), status); 1674 end; 1675 return; 1676 1677 clear_input: entry; 1678 1679 myname = fn_clear_input; 1680 go to fo_ci_join; 1681 1682 /* this is the lisp %include function, which works like %include in pl/1 */ 1683 1684 percent_include: entry; 1685 1686 stack = addrel(stack_ptr, -2); /* fsubr - pick up argument */ 1687 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; 1688 go to include_common; 1689 1690 includef: entry; /*** (includef, same as %include except subr ***/ 1691 1692 stack = addrel (stack_ptr, -2); /* subr 1 arg */ 1693 1694 include_common: 1695 if stack -> temp_type36(1) & String36 1696 then ename = stack -> temp_ptr(1) -> lisp_string.string; 1697 else if stack -> temp_type36(1) & Atsym36 1698 then ename = stack -> temp_ptr(1) -> atom.pname; 1699 else go to include_file_not_found; /* no numbers, etc. */ 1700 1701 /* tack ".incl.lisp" on the end of ename */ 1702 1703 if length(ename) > 22 then go to include_file_name_truncated; 1704 other_ename = ename || ".incl.lisp"; 1705 1706 /* find the include file */ 1707 1708 call find_include_file_$initiate_count("lisp", null, /* phooey on referencing_dir rule */ 1709 (other_ename), (0), q, code); 1710 if q = null then go to include_file_not_found_but_have_code; 1711 1712 /* get the actual pathname of the include file (what a Kludge) */ 1713 1714 call hcs_$fs_get_path_name(q, dname, (0), other_ename, code); 1715 if code ^= 0 then go to include_file_not_found_but_have_code; /* (??) */ 1716 1717 /* create and initialize an iochan block (file object) */ 1718 1719 call make_an_iochan; 1720 p -> iochan.charpos, p -> iochan.linenum, p -> iochan.pagenum = 0; 1721 p -> iochan.pagel = 59; /* random constant - see open */ 1722 p -> iochan.linel = 110; /* random constant - see open */ 1723 p -> iochan.function = tty_input_chan -> iochan.function; /* default eoffn */ 1724 p -> iochan.write = "1"b; /* input channel!! */ 1725 1726 /* construct namelist - assume our argument contained no dots (Kludge?) */ 1727 1728 stack_ptr = addr(stack -> temp(7)); 1729 stack -> temp(6) = nil; 1730 call lisp_get_atom_("lisp", stack -> temp(5)); 1731 call lisp_get_atom_("incl", stack -> temp(4)); 1732 call lisp_get_atom_((ename), stack -> temp(3)); 1733 i = verify(reverse(dname), " "); /* strip trailing blanks for directory path name */ 1734 /* i /= 0 is assumed since all blank dname would be wierd */ 1735 call lisp_get_atom_(substr(dname, 1, length(dname)-i+1), stack -> temp(2)); 1736 do i = 0 to 3; 1737 call lisp_special_fns_$cons; 1738 end; 1739 p -> iochan.namelist = stack -> temp(2); /*** Note: assume p survives through g.c. ***/ 1740 1741 /* open the input file */ 1742 1743 p -> iochan.seg = "1"b; 1744 p -> iochan.name = other_ename; 1745 esw = -6; /* prepare error return */ 1746 call open_input_file; 1747 1748 /* all set, thread into iochan list */ 1749 1750 p -> iochan.thread = lisp_static_vars_$iochan_list; 1751 lisp_static_vars_$iochan_list = p; 1752 1753 /* turn on type bit and turn into lisp object in marked stack */ 1754 1755 p_.type = File; 1756 stack -> temp(1) = p_fb; 1757 1758 /* inpush it */ 1759 1760 stack_ptr = addr(stack -> temp(2)); 1761 call lisp_io_fns_$inpush; 1762 1763 /* turn on ^q flag so will start reading from this place (if %include from tty!!) */ 1764 1765 addr(ctrlQ) -> based_ptr -> atom.value = t_atom; 1766 return; /* inpush has left right things on stack */ 1767 1768 include_file_name_truncated: 1769 code = error_table_$entlong; 1770 go to include_file_not_found_but_have_code; 1771 1772 include_file_not_found: 1773 code = error_table_$noentry; 1774 include_file_not_found_but_have_code: 1775 errproc(-6): /* error exit from open_input_file */ 1776 /* signal uncorrectable lisp error */ 1777 1778 stack_ptr = addr(stack -> temp(4)); /* stack -> temp(1) = our arg */ 1779 stack -> temp(3) = nil; /* cons up kludgey error message */ 1780 stack -> temp(2) = stack -> temp(1); 1781 call lisp_get_atom_("%include", stack -> temp(1)); 1782 call lisp_special_fns_$cons; 1783 call lisp_special_fns_$cons; 1784 1785 myname = code; /* Gag! pass error_table_ code to lisp_error_ */ 1786 err = lisp_error_table_$include_file_error; 1787 call error; /* never returns - uncorrectable error */ 1788 return; 1789 1790 /* 1791* * Fixnum I/O Functions 1792* */ 1793 1794 in: entry; 1795 1796 dcl fail_flag bit(1) aligned, 1797 word fixed bin(35), 1798 words (0:1000) fixed bin(35) based; 1799 1800 myname = fn_in; 1801 1802 reget_in: stack = addrel(stack_ptr, -2); /* subr 1 arg */ 1803 do while((stack -> temp_type36(1) & File36) = ""b); 1804 err = lisp_error_table_$bad_arg_correctable; 1805 call error; 1806 end; 1807 p = stack -> temp_ptr(1); /* -> iochan */ 1808 if string(p -> iochan.flags) & not_ok_to_read_fixnum then go to in_loss; 1809 else if ^ p -> iochan.fixnum_mode then do; 1810 in_loss: call fix_not_ok_iochan(p, "0"b, fail_flag); 1811 if fail_flag then go to reget_in; 1812 end; 1813 1814 if p -> iochan.ioindex >= p -> iochan.iolength 1815 then do; 1816 call end_of_block(p, (nil), codde); 1817 if codde ^= 0 then return; /* foo. shouldn't happen */ 1818 end; 1819 1820 word = p -> iochan.ioptr -> words(p -> iochan.ioindex); 1821 in_out_ret: 1822 p -> iochan.ioindex = p -> iochan.ioindex + 1; 1823 stack -> fixnum_fmt.type_info = fixnum_type; 1824 stack -> fixedb = word; 1825 return; 1826 1827 1828 out: entry; 1829 1830 myname = fn_out; 1831 1832 reget_out:stack = addrel(stack_ptr, -4); /* subr 2 args */ 1833 do while((stack -> temp_type36(2) & Fixed36) = ""b); 1834 err = lisp_error_table_$bad_arg_correctable; 1835 call error; 1836 end; 1837 word = addr(stack -> temp(2)) -> fixedb; 1838 stack_ptr = addr(stack -> temp(2)); 1839 do while((stack -> temp_type36(1) & File36) = ""b); 1840 err = lisp_error_table_$bad_arg_correctable; 1841 call error; 1842 end; 1843 p = stack -> temp_ptr(1); 1844 if string(p -> iochan.flags) & not_ok_to_write_fixnum then go to out_loss; 1845 else if ^ p -> iochan.fixnum_mode then do; 1846 out_loss: call fix_not_ok_iochan(p, "1"b, fail_flag); 1847 if fail_flag then go to reget_out; 1848 end; 1849 1850 if p -> iochan.ioindex >= p -> iochan.iolength 1851 then do; 1852 call end_of_block(p, (nil), codde); 1853 if codde ^= 0 then return; 1854 end; 1855 1856 p -> iochan.ioptr -> words(p -> iochan.ioindex) = word; 1857 go to in_out_ret; 1858 end lisp_io_control_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1123.9 lisp_io_control_.pl1 >udd>sm>ds>w>ml>lisp_io_control_.pl1 190 1 03/27/82 0537.0 lisp_common_vars.incl.pl1 >ldd>incl>lisp_common_vars.incl.pl1 191 2 03/27/82 0537.0 lisp_stack_fmt.incl.pl1 >ldd>incl>lisp_stack_fmt.incl.pl1 192 3 03/27/82 0537.0 lisp_io.incl.pl1 >ldd>incl>lisp_io.incl.pl1 3-5 4 03/27/82 0537.0 lisp_iochan.incl.pl1 >ldd>incl>lisp_iochan.incl.pl1 3-45 5 03/27/82 0537.0 lisp_control_chars.incl.pl1 >ldd>incl>lisp_control_chars.incl.pl1 193 6 07/06/83 1211.5 lisp_name_codes.incl.pl1 >ldd>incl>lisp_name_codes.incl.pl1 194 7 03/27/82 0537.0 lisp_ptr_fmt.incl.pl1 >ldd>incl>lisp_ptr_fmt.incl.pl1 195 8 03/27/82 0537.0 lisp_nums.incl.pl1 >ldd>incl>lisp_nums.incl.pl1 196 9 03/27/82 0537.0 lisp_cons_fmt.incl.pl1 >ldd>incl>lisp_cons_fmt.incl.pl1 197 10 03/27/82 0537.1 lisp_atom_fmt.incl.pl1 >ldd>incl>lisp_atom_fmt.incl.pl1 198 11 03/27/82 0536.9 lisp_string_fmt.incl.pl1 >ldd>incl>lisp_string_fmt.incl.pl1 199 12 03/19/81 1306.8 mode_string_info.incl.pl1 >ldd>incl>mode_string_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. Append constant fixed bin(17,0) initial dcl 163 ref 398 Ascii constant fixed bin(17,0) initial dcl 166 ref 372 380 400 747 Atsym constant bit(9) initial packed unaligned dcl 7-17 ref 1543 Atsym36 constant bit(36) initial dcl 7-17 ref 424 1451 1697 Block constant fixed bin(17,0) initial dcl 169 ref 374 381 407 Cons constant bit(9) initial packed unaligned dcl 7-17 ref 244 480 604 619 634 1409 1412 1436 1436 1453 1471 1478 1497 File constant bit(9) initial packed unaligned dcl 7-17 ref 353 859 861 1094 1125 1192 1755 File36 constant bit(36) initial dcl 7-17 ref 251 267 367 573 1644 1803 1839 Fixed36 constant bit(36) initial dcl 7-17 ref 1833 Fixnum constant fixed bin(17,0) initial dcl 166 ref 292 320 332 370 401 520 555 747 Image constant fixed bin(17,0) initial dcl 166 ref 333 371 402 In constant fixed bin(17,0) initial dcl 163 ref 275 279 291 303 369 379 394 395 Numeric36 constant bit(36) initial dcl 7-17 ref 1507 Ordinary constant fixed bin(17,0) initial dcl 172 ref 376 382 404 Out constant fixed bin(17,0) initial dcl 163 ref 306 369 396 397 Single constant fixed bin(17,0) initial dcl 169 ref 335 373 408 String36 constant bit(36) initial dcl 7-17 ref 425 1503 1694 Terminal constant fixed bin(17,0) initial dcl 172 ref 337 375 405 a_iochan parameter pointer dcl 993 ref 692 696 736 746 991 1003 a_object parameter fixed bin(71,0) dcl 418 ref 416 418 aclinfop 10 based pointer level 2 dcl 4-13 set ref 294* 512* 804* 835* 857* addr builtin function dcl 51 ref 264 353 354 355 424 424 425 425 430 474 602 603 613 617 619 619 619 621 622 622 622 627 627 627 633 643 645 754 859 861 861 861 867 867 867 867 867 872 932 954 1091 1094 1095 1124 1125 1127 1185 1192 1193 1209 1211 1224 1225 1231 1251 1261 1287 1290 1293 1296 1513 1514 1515 1540 1551 1551 1551 1551 1569 1585 1610 1614 1728 1755 1756 1760 1765 1774 1837 1838 addrel builtin function dcl 51 ref 225 238 240 571 1158 1201 1364 1366 1398 1406 1410 1415 1426 1434 1439 1454 1462 1472 1483 1512 1561 1582 1607 1617 1638 1686 1692 1802 1832 amv 000100 automatic structure level 1 dcl 51 set ref 954 atom based structure level 1 dcl 10-5 atom_ptrs based structure level 1 dcl 10-5 back_ptr 1 based bit(18) level 2 packed packed unaligned dcl 2-7 set ref 1516* 1538 based_ptr based pointer dcl 7-16 ref 424 425 603 613 617 619 619 619 621 622 622 622 627 627 627 633 643 645 867 867 867 867 867 872 1209 1211 1224 1225 1287 1290 1293 1296 1765 bc 000126 automatic fixed bin(24,0) dcl 51 set ref 316* 318 320 323 516* 520 522 545* 1020* 1026 1028 binding_block based structure level 1 dcl 2-7 binding_top defined pointer dcl 1-6 set ref 1516 1519* 1538* 1538 bot_block 0(18) based bit(18) level 2 packed packed unaligned dcl 2-7 set ref 1514* buffer_mode 000450 automatic fixed bin(17,0) dcl 169 set ref 335 373* 374* 381* 407* 408* buffer_size constant fixed bin(17,0) initial dcl 51 ref 290 290 292 293 777 777 832 832 849 849 850 1054 1057 car based bit(36) level 2 in structure "cons_types36" dcl 9-22 in procedure "lisp_io_control_" ref 1503 1507 car 0(21) based bit(9) level 2 in structure "cons_types" packed packed unaligned dcl 9-5 in procedure "lisp_io_control_" ref 1543 car based fixed bin(71,0) level 2 in structure "cons" dcl 9-5 in procedure "lisp_io_control_" set ref 245* 287 605 619 635 1404 1416 1440 1440 1442 1455 1459 1473 1478 1502 1504* 1524 1533* 1549 1557* 1687 car based pointer level 2 in structure "cons_ptrs" dcl 9-5 in procedure "lisp_io_control_" ref 288 477 484 1504 1549 1551 1551 1551 cde parameter fixed bin(17,0) dcl 993 set ref 991 1002* 1073* 1106* 1129* 1133* 1221* cdr 2(21) based bit(9) level 2 in structure "cons_types" packed packed unaligned dcl 9-5 in procedure "lisp_io_control_" ref 1409 1412 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 9-5 in procedure "lisp_io_control_" set ref 246 480 485 605 608* 608 611 622 635 638* 638 641 1418 1445 1446 1457 1475 1544 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 9-5 in procedure "lisp_io_control_" ref 288 charmode 15(07) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 335* 373 847* charpos 13 based fixed bin(17,0) level 2 dcl 4-13 set ref 270* 839* 851* 941* 941* 1043* 1720* codde 000130 automatic fixed bin(17,0) dcl 51 set ref 1816* 1817 1852* 1853 code 000127 automatic fixed bin(35,0) dcl 51 set ref 295* 296 316* 317 506* 507 508 516* 533* 545* 552* 553 718* 719 760* 834* 856* 886* 887 896* 1020* 1023 1054* 1057* 1063 1063 1065 1203 1271* 1281* 1551* 1557 1592* 1595 1626* 1628 1708* 1714* 1715 1768* 1772* 1785 com_err_ 000010 constant entry external dcl 51 ref 1271 1281 component 12 based fixed bin(17,0) level 2 dcl 4-13 set ref 318* 449* 516* 545* 718* 760* 1009* 1009 1019* 1019 1020* cons based structure level 1 dcl 9-5 cons_ptrs based structure level 1 dcl 9-5 cons_types based structure level 1 dcl 9-5 cons_types36 based structure level 1 dcl 9-22 ctrlQ defined fixed bin(71,0) dcl 5-8 set ref 627 867 1211 1224 1290 1293 1765 ctrlR defined fixed bin(71,0) dcl 5-11 set ref 645 867 1209 1225 1287 1296 ctrlW defined fixed bin(71,0) dcl 5-14 set ref 867 data_mode 000447 automatic fixed bin(17,0) dcl 166 set ref 292 320 332 333 370* 371* 372* 380* 400* 401* 402* 520 555 747* 747* delete_$path 000012 constant entry external dcl 51 ref 1592 device_type 000451 automatic fixed bin(17,0) dcl 172 set ref 337 375* 376* 382* 404* 405* direction 000446 automatic fixed bin(17,0) dcl 163 set ref 275 279 291 303 306 369* 369* 379* 394* 395* 396* 397* 398* divide builtin function dcl 51 ref 290 290 292 320 323 520 522 777 777 832 832 849 849 1026 1028 1055 1367 dname 000131 automatic char(168) packed unaligned dcl 51 set ref 316* 477* 506* 533* 929* 930 930 933 933 1551 1551 1556 1556 1557 1557 1592* 1626* 1714* 1733 1735 1735 1735 1735 ename 000203 automatic varying char(36) dcl 51 set ref 462 462 479* 484* 484 486 487 1592 1592 1592 1592 1621 1621 1626 1626 1626 1626 1626 1626 1626 1626 1694* 1697* 1703 1704 1732 eofval parameter fixed bin(71,0) dcl 993 set ref 991 1084 1093 1109* 1119 ercode based fixed bin(17,0) array dcl 1153 set ref 1159* 1160* err 000215 automatic fixed bin(35,0) dcl 51 set ref 409* 423* 426* 428 491* 574* 1159 1168* 1173* 1177* 1246* 1567* 1597* 1647* 1786* 1804* 1834* 1840* error_table_$dirseg 000020 external static fixed bin(35,0) dcl 51 ref 508 error_table_$end_of_info 000014 external static fixed bin(35,0) dcl 51 ref 1063 error_table_$entlong 000022 external static fixed bin(35,0) dcl 51 ref 1768 error_table_$long_record 000016 external static fixed bin(35,0) dcl 51 ref 1065 error_table_$noentry 000024 external static fixed bin(35,0) dcl 51 ref 1023 1772 esw 000216 automatic fixed bin(17,0) dcl 51 set ref 223* 237* 570* 591 679 683 694* 741* 794* 909* 1001* 1197 1205 1248 1314 1342* 1368* 1584* 1609* 1745* expand_path_ 000026 constant entry external dcl 51 ref 1551 fail_act_f parameter bit(1) dcl 738 set ref 736 743* 1213* fail_flag 000456 automatic bit(1) dcl 1796 set ref 1810* 1811 1846* 1847 fcbp 6 based pointer level 2 dcl 4-13 set ref 295* 506* 516* 533* 534 545* 697 705 705* 706* 714 718* 720* 721* 760* 804* 812* 834* 856* 884 886* 894* 947* 949* 1020* 1035 1054* 1057* 1348 1672 1673* find_include_file_$initiate_count 000030 constant entry external dcl 51 ref 1708 fixedb 1 based fixed bin(17,0) level 2 dcl 8-4 set ref 239 1365 1824* 1837 fixnum_fmt based structure level 1 dcl 8-4 fixnum_mode 15(09) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 332* 370 716 747 885 1026 1052 1809 1845 fixnum_type constant bit(36) initial dcl 8-4 ref 1823 flags 15 based structure level 2 in structure "iochan" packed packed unaligned dcl 4-13 in procedure "lisp_io_control_" set ref 450* 581 781 1348 1808 1844 flags 11 based structure level 2 in structure "mode_value" dcl 12-16 in procedure "lisp_io_control_" set ref 956* 963* fn_clear_input constant fixed bin(17,0) initial dcl 6-9 ref 1679 fn_close constant fixed bin(17,0) initial dcl 6-9 ref 572 fn_deletef constant fixed bin(17,0) initial dcl 6-9 ref 1583 fn_force_output 007176 constant fixed bin(17,0) initial dcl 6-9 ref 1637 1640 1659 1668 fn_in constant fixed bin(17,0) initial dcl 6-9 ref 1800 fn_mergef 007177 constant fixed bin(17,0) initial dcl 6-9 ref 1369 1493 fn_open constant fixed bin(17,0) initial dcl 6-9 ref 236 fn_opena constant fixed bin(17,0) initial dcl 6-9 ref 219 fn_openi constant fixed bin(17,0) initial dcl 6-9 ref 207 745 fn_openo constant fixed bin(17,0) initial dcl 6-9 ref 213 744 fn_out constant fixed bin(17,0) initial dcl 6-9 ref 1830 fn_rename constant fixed bin(17,0) initial dcl 6-9 ref 1608 function 16 based fixed bin(71,0) level 2 dcl 4-13 set ref 275* 275 277* 277 836* 854* 1086 1096 1723* 1723 get_wdir_ 000032 constant entry external dcl 51 ref 929 hcs_$chname_file 000034 constant entry external dcl 51 ref 1626 hcs_$fs_get_path_name 000036 constant entry external dcl 51 ref 1714 hcs_$get_max_length_seg 000040 constant entry external dcl 51 ref 552 hcs_$status_minf 000042 constant entry external dcl 51 ref 316 i 000217 automatic fixed bin(17,0) dcl 51 set ref 930* 933 933 1733* 1735 1735 1736* image_mode 15(10) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 333* 371 index builtin function dcl 51 ref 1556 infile defined fixed bin(71,0) dcl 51 set ref 617 619 621 627 627 872 instack defined fixed bin(71,0) dcl 51 set ref 603 613 619 619 622 622 622 867 intended_dir parameter bit(1) dcl 738 ref 736 744 1209 1287 interactive 15(04) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 337* 375 830* 846* 1036 iochan based structure level 1 dcl 4-13 set ref 445 445 ioindex based fixed bin(24,0) level 2 dcl 4-13 set ref 320* 323* 449* 716* 716 718 769 809* 883 885* 885 886* 888* 973* 976* 1011* 1022* 1034* 1670* 1814 1820 1821* 1821 1850 1856 iolength 1 based fixed bin(24,0) level 2 dcl 4-13 set ref 291* 292* 293* 320 323 520* 522* 555* 557* 769 811* 833* 850* 973* 1022* 1026* 1028* 1034* 1054* 1055* 1055 1057* 1671* 1814 1850 ioptr 2 based pointer level 2 dcl 4-13 set ref 290* 516* 518 545* 547 552* 760* 763 777* 804* 808* 832* 849* 886* 1020* 1023 1054* 1057* 1820 1856 iox_$control 000052 constant entry external dcl 51 ref 1673 iox_$get_chars 000050 constant entry external dcl 51 ref 1054 iox_$get_line 000046 constant entry external dcl 51 ref 1057 iox_$look_iocb 000056 constant entry external dcl 51 ref 295 834 856 894 947 iox_$modes 000044 constant entry external dcl 51 ref 949 iox_$put_chars 000054 constant entry external dcl 51 ref 886 item parameter char dcl 392 ref 390 394 395 396 397 398 400 401 402 404 405 407 408 length builtin function dcl 51 ref 462 486 487 930 1556 1592 1592 1621 1626 1626 1626 1626 1703 1735 1735 linel 14 based fixed bin(17,0) level 2 dcl 4-13 set ref 273* 838* 853* 853 945* 945* 959* 959* 1722* linenum 33 based fixed bin(17,0) level 2 dcl 4-13 set ref 270* 839* 851* 942* 942* 1720* lisp_$apply 000060 constant entry external dcl 51 ref 1099 lisp_error_ 000230 constant entry external dcl 1153 ref 1161 lisp_error_table_$bad_arg_correctable 000170 external static fixed bin(17,0) dcl 179 ref 574 1647 1804 1834 1840 lisp_error_table_$bad_entry_name 000172 external static fixed bin(17,0) dcl 179 ref 491 lisp_error_table_$bad_item_in_modelist 000154 external static fixed bin(17,0) dcl 179 ref 409 426 lisp_error_table_$file_is_closed 000162 external static fixed bin(17,0) dcl 179 ref 1177 lisp_error_table_$file_sys_fun_err 000164 external static fixed bin(17,0) dcl 179 ref 1246 1597 lisp_error_table_$include_file_error 000174 external static fixed bin(17,0) dcl 179 ref 1786 lisp_error_table_$io_wrong_direction 000160 external static fixed bin(17,0) dcl 179 ref 1173 lisp_error_table_$reopen_inconsistent 000156 external static fixed bin(17,0) dcl 179 ref 1168 lisp_error_table_$stars_left_in_name 000166 external static fixed bin(17,0) dcl 179 ref 1567 lisp_get_atom_ 000062 constant entry external dcl 51 ref 933 1504 1557 1730 1731 1732 1735 1781 lisp_io_control_$close 000064 constant entry external dcl 51 ref 1128 lisp_io_control_$fix_not_ok_iochan 000226 constant entry external dcl 1655 ref 1654 lisp_io_fns_$inpush 000066 constant entry external dcl 51 ref 1761 lisp_io_fns_$internal_namelist 000070 constant entry external dcl 51 ref 1400 1428 lisp_list_utils_$nreverse 000072 constant entry external dcl 51 ref 1419 1488 lisp_print_$exploden 000076 constant entry external dcl 51 ref 1525 lisp_ptr based structure level 1 dcl 7-17 lisp_reader_$maknam 000074 constant entry external dcl 51 ref 1529 lisp_special_fns_$cons 000100 constant entry external dcl 51 ref 935 1097 1098 1194 1196 1268 1737 1782 1783 lisp_special_fns_$xcons 000102 constant entry external dcl 51 ref 1417 1444 1456 1464 1474 1485 lisp_static_man_$allocate 000140 constant entry external dcl 51 ref 290 445 777 832 849 lisp_static_vars_$STAR 000104 external static fixed bin(71,0) dcl 51 ref 934 934 1440 1440 1459 1459 1478 1478 1502 1502 lisp_static_vars_$binding_top 000204 external static pointer dcl 1-6 set ref 1516 1516 1519* 1519 1538* 1538 1538 1538 lisp_static_vars_$close 000106 external static fixed bin(71,0) dcl 51 ref 1321 lisp_static_vars_$ctrlQ 000220 external static fixed bin(71,0) dcl 5-8 ref 627 627 867 867 1211 1211 1224 1224 1290 1290 1293 1293 1765 1765 lisp_static_vars_$ctrlR 000222 external static fixed bin(71,0) dcl 5-11 ref 645 645 867 867 1209 1209 1225 1225 1287 1287 1296 1296 lisp_static_vars_$ctrlW 000224 external static fixed bin(71,0) dcl 5-14 ref 867 867 lisp_static_vars_$deletef 000110 external static fixed bin(71,0) dcl 51 ref 1327 lisp_static_vars_$infile 000112 external static fixed bin(71,0) dcl 51 ref 617 617 619 619 621 621 627 627 627 627 872 872 1187 lisp_static_vars_$instack 000114 external static fixed bin(71,0) dcl 51 ref 603 603 613 613 619 619 619 619 622 622 622 622 622 622 867 867 lisp_static_vars_$iochan_list 000214 external static pointer dcl 1-6 set ref 346 347* 659 659* 663 795 860* 861 910 1344 1750 1751* lisp_static_vars_$mergef 000116 external static fixed bin(71,0) dcl 51 ref 1324 lisp_static_vars_$nil 000206 external static fixed bin(71,0) dcl 1-6 ref 248 248 622 622 627 627 627 627 645 645 645 645 836 836 840 840 854 854 867 867 980 980 1086 1086 1092 1092 1103 1103 1119 1119 1190 1190 1264 1264 1287 1287 1290 1290 1293 1293 1296 1296 1408 1408 1411 1411 1435 1435 1451 1451 1478 1478 1545 1545 1571 1571 1640 1640 1729 1729 1779 1779 1816 1816 1852 1852 lisp_static_vars_$old_io_defaults 000120 external static pointer dcl 51 ref 980 lisp_static_vars_$open 000122 external static fixed bin(71,0) dcl 51 ref 1316 lisp_static_vars_$outfile 000124 external static fixed bin(71,0) dcl 51 ref 1189 lisp_static_vars_$outfiles 000126 external static fixed bin(71,0) dcl 51 ref 633 633 643 643 867 867 lisp_static_vars_$rdr_label 000130 external static label variable dcl 51 set ref 1048* 1048 lisp_static_vars_$rdr_state 000132 external static fixed bin(17,0) dcl 51 set ref 1049* 1049 1059* 1059 1071* 1071 lisp_static_vars_$rename 000134 external static fixed bin(71,0) dcl 51 ref 1330 lisp_static_vars_$stack_ptr 000176 external static pointer dcl 1-6 set ref 225 225 238 238 264* 264 355* 355 429 429 430* 430 434* 434 473 473 474* 474 488* 488 571 571 602* 602 680* 680 695 695 742 742 754* 754 931 931 932* 932 937* 937 1090 1090 1091* 1091 1105* 1105 1110* 1110 1121 1121 1124* 1124 1170* 1170 1181 1181 1185* 1185 1201* 1201 1212* 1212 1216* 1216 1226* 1226 1231* 1231 1251* 1251 1261* 1261 1364 1364 1395 1395 1398* 1398 1410* 1410 1415* 1415 1421* 1421 1426* 1426 1434* 1434 1439* 1439 1454* 1454 1462* 1462 1472* 1472 1483* 1483 1513* 1513 1540* 1540 1561* 1561 1569* 1569 1582 1582 1585* 1585 1607 1607 1610* 1610 1638 1638 1686 1686 1692 1692 1728* 1728 1760* 1760 1774* 1774 1802 1802 1832 1832 1838* 1838 lisp_static_vars_$stnopoint 000216 external static fixed bin(71,0) dcl 3-17 ref 1517 lisp_static_vars_$stream 000136 external static fixed bin(71,0) dcl 51 ref 287 287 1404 1404 1549 1549 lisp_static_vars_$t_atom 000200 external static fixed bin(71,0) dcl 1-6 ref 621 621 627 627 684 684 872 872 1084 1084 1104 1104 1209 1209 1211 1211 1224 1224 1225 1225 1520 1520 1640 1640 1765 1765 lisp_static_vars_$tty_input_chan 000210 external static pointer dcl 1-6 set ref 275 275 828* 828 861 941 941 942 942 943 943 944 944 945 945 959 959 967 967 973 973 973 973 1643 1643 1723 1723 lisp_static_vars_$tty_output_chan 000212 external static pointer dcl 1-6 set ref 241 241 265 265 277 277 844* 844 861 936 936 941 941 942 942 943 943 944 944 945 945 947 947 947 947 949 949 959 959 967 967 976 976 1041 1041 1586 1586 1611 1611 1640 1640 lisp_static_vars_$unmkd_ptr 000202 external static pointer dcl 1-6 set ref 1157 1157 1158* 1158 1511 1511 1512* 1512 1539* 1539 lisp_string based structure level 1 dcl 11-6 maxlen 000220 automatic fixed bin(19,0) dcl 51 set ref 552* 555 557 min builtin function dcl 51 ref 320 323 mode_string_$get_mode 000142 constant entry external dcl 51 ref 958 965 mode_value based structure level 1 dcl 12-16 mode_value_ptr 000454 automatic pointer dcl 12-6 set ref 954* 955 956 958* 959 959 963 965* 967 967 mode_value_version_3 constant fixed bin(17,0) initial dcl 12-30 ref 955 msf_manager_$adjust 000144 constant entry external dcl 51 ref 718 msf_manager_$close 000152 constant entry external dcl 51 ref 705 720 msf_manager_$get_ptr 000146 constant entry external dcl 51 ref 516 545 760 1020 msf_manager_$open 000150 constant entry external dcl 51 ref 506 533 must_reopen 15(05) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 749 773* 778* 798 814* 1654 myname 000221 automatic fixed bin(17,0) dcl 51 set ref 207* 213* 219* 236* 572* 694* 744* 745* 1160 1203* 1369* 1400* 1428* 1493 1583* 1608* 1637* 1640 1659 1668 1679* 1785* 1800* 1830* name 22 based char(32) level 2 packed packed unaligned dcl 4-13 set ref 288* 295* 316* 462* 506* 533* 831* 834* 848* 856* 894* 947* 1271* 1281* 1744* namelist 20 based fixed bin(71,0) level 2 dcl 4-13 set ref 241 265 267 278* 755 840* 936* 1586 1611 1739* nargs 000222 automatic fixed bin(17,0) dcl 51 set ref 239* 240 241 243 266* 1365* 1366 1367* 1367 1403 1407* 1407 1496* 1501* 1501 1556* 1556 1556* 1557 1557 1587* 1613* 1618* nil defined fixed bin(71,0) dcl 1-6 ref 248 622 627 627 645 645 836 840 854 867 980 1086 1092 1103 1119 1190 1264 1287 1290 1293 1296 1408 1411 1435 1451 1478 1545 1571 1640 1729 1779 1816 1852 nlsync 15(06) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 810* 883* 889* not_ok_to_read_fixnum constant bit(36) initial packed unaligned dcl 3-11 ref 1808 not_ok_to_write_fixnum constant bit(36) initial packed unaligned dcl 3-11 ref 1844 null builtin function dcl 51 ref 294 512 518 534 547 663 697 705 706 714 721 763 795 804 808 812 835 857 884 910 1023 1035 1344 1348 1551 1551 1672 1673 1673 1708 1708 1710 numeric_value 12 based fixed bin(35,0) level 2 dcl 12-16 ref 959 967 numeric_valuep 11(01) based bit(1) level 3 packed packed unaligned dcl 12-16 set ref 959 967 object 000504 automatic fixed bin(71,0) initial dcl 418 set ref 418* 424 424 425 425 431 433* object_type based bit(36) dcl 418 ref 424 425 openx_sim_arg 000452 automatic char(8) dcl 175 set ref 208* 214* 220* 227* other_ename 000223 automatic char(32) packed unaligned dcl 51 set ref 1621* 1626* 1704* 1708 1714* 1744 outfiles defined fixed bin(71,0) dcl 51 set ref 633 643 867 p 000234 automatic pointer dcl 51 in procedure "lisp_io_control_" set ref 258* 267 270 270 270 272 273 275 277 278 279 281 288 290 291 292 293 294 295 295 316 318 320 320 323 323 332 333 335 337 346 347 353 354 445* 449 449 450 459 462 506 506 512 516 516 516 518 520 522 533 533 534 545 545 545 547 552 555 557 580* 581 582 582 587 652 652 659 659 667 668 696* 697 697 705 705 706 714 716 716 716 718 718 718 720 721 746* 747 749 749 755 757 760 760 760 763 769 769 773 777 778 781 795* 795* 798 798 798 798 802 804 804 804 808 809 810 811 811 812 814* 815 828 829 830 831 832 833 834 834 835 835 836 837 838 839 839 839 840 842 844 845 846 847 848 849 850 851 851 851 852 853 854 856 856 857 858 859 860 883 883 884 885 885 885 886 886 886 888 889 894 894 910* 910* 913 913* 915 1003* 1004 1004 1009 1009 1011 1014 1019 1019 1020 1020 1020 1022 1022 1023 1026 1026 1028 1034 1034 1035 1036 1040 1041* 1043 1044* 1052 1054 1054 1054 1055 1055 1057 1057 1057 1086 1094 1095 1096 1125 1127 1187 1192 1193 1224 1225 1271 1271* 1281 1281* 1293 1296 1344* 1344* 1348 1348 1348 1348* 1354 1640* 1643* 1644* 1653 1654 1654* 1659 1662 1670 1671 1672 1673 1720 1720 1720 1721 1722 1723 1724 1739 1743 1744 1750 1751 1755 1756 1807* 1808 1809 1810* 1814 1814 1816* 1820 1820 1821 1821 1843* 1844 1845 1846* 1850 1850 1852* 1856 1856 p 000466 automatic pointer dcl 365 in procedure "set_mode_defaults" set ref 368* 369 370 371 373 375 p_ based structure level 1 dcl 156 p_fb based fixed bin(71,0) dcl 51 ref 354 1095 1127 1193 1756 pagel 32 based fixed bin(17,0) level 2 dcl 4-13 set ref 272* 837* 852* 852 944* 944* 967* 967* 1721* pagenum 34 based fixed bin(17,0) level 2 dcl 4-13 set ref 270* 839* 851* 943* 943* 1720* pdl_ptr_types36 based structure array level 1 dcl 2-7 pname 5 based char level 2 dcl 10-5 set ref 288 424* 477 484 1549 1551 1551 1697 pnamel 4 based fixed bin(17,0) level 2 dcl 10-5 set ref 288 424 424 477 484 1549 1551 1551 1551* 1697 ptr builtin function dcl 51 ref 1538 push_down_list_ptr_types based structure array level 1 dcl 2-7 q 000236 automatic pointer dcl 51 set ref 663* 663* 667 668* 671 842* 852 853 858 1040* 1044 1708* 1710 1714* rdr_label defined label variable dcl 51 set ref 1048* rdr_state defined fixed bin(17,0) dcl 51 set ref 1049* 1059* 1071* read 15(01) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 281* 369 582 652* 757 798 802 811 845* 1224 1293 1348 1662 rel builtin function dcl 51 ref 1514 1515 1516 reverse builtin function dcl 51 ref 930 1733 rnstack 000240 automatic pointer dcl 51 set ref 1199 1200 1607* 1616 1623 seg 15 based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 459* 582 697 749 798 913 1004 1014 1348 1653 1743* size builtin function dcl 51 ref 445 445 sp 000620 automatic pointer dcl 1389 set ref 1394* 1406* 1406 1408 1412 1412 1416 1418 1425 1427 1429 1436 1442 1446 1446 1453 1455 1457 1457 1478 1478 1478 1478 1484 stack 000242 automatic pointer dcl 51 set ref 225* 238* 239 240* 240 241 244 245 246 246 248 248 251 258 264 265 267 267 278 287 288 354 355 367 368 475 571* 573 580 602 603 603 604 605 605 605 605 605 605 608 608 610 610 611 611 613 617 633 633 634 635 635 635 635 635 635 638 638 640 640 641 641 643 645 680 684 695* 742* 754 755 931* 932 933 934 936 937 1090* 1091 1092 1093 1095 1096 1103 1104 1105 1109 1110 1121* 1124 1127 1170 1181* 1185 1187 1189 1190 1193 1199 1200* 1201 1212 1216 1226 1231 1251 1261 1264 1265 1265 1266 1266 1316 1321 1324 1327 1330 1364* 1365 1366* 1366 1394 1396 1399 1401 1404 1409 1412 1420 1436 1440 1440 1445 1445 1451 1451 1459 1459 1463 1471 1473 1475 1475 1489 1497 1549 1549 1551 1551 1551 1557 1561 1569 1571 1572 1572 1582* 1585 1586 1607* 1610 1611 1612 1612 1614* 1614 1616 1617* 1617 1623* 1629 1629 1638* 1640 1640 1644 1644 1686* 1687 1687 1692* 1694 1694 1697 1697 1728 1729 1730 1731 1732 1735 1739 1756 1760 1774 1779 1780 1780 1781 1802* 1803 1807 1823 1824 1832* 1833 1837 1838 1839 1843 stack_ptr defined pointer dcl 1-6 set ref 225 238 264* 355* 429 430* 434* 473 474* 488* 571 602* 680* 695 742 754* 931 932* 937* 1090 1091* 1105* 1110* 1121 1124* 1170* 1181 1185* 1201* 1212* 1216* 1226* 1231* 1251* 1261* 1364 1395 1398* 1410* 1415* 1421* 1426* 1434* 1439* 1454* 1462* 1472* 1483* 1513* 1540* 1561* 1569* 1582 1585* 1607 1610* 1638 1686 1692 1728* 1760* 1774* 1802 1832 1838* star defined fixed bin(71,0) dcl 51 ref 934 1440 1459 1478 1502 status 000244 automatic fixed bin(35,0) dcl 51 set ref 894* 895 896 947* 948 949* 950 958* 959 965* 967 1673* stream defined fixed bin(71,0) dcl 51 ref 287 1404 1549 string 1 based char level 2 in structure "lisp_string" dcl 11-6 in procedure "lisp_io_control_" set ref 425* 1504* 1694 string builtin function dcl 51 in procedure "lisp_io_control_" set ref 450* 581 781 1348 1808 1844 string_length based fixed bin(17,0) level 2 dcl 11-6 ref 425 425 1504 1504 1694 substr builtin function dcl 51 ref 462 933 933 1549 1557 1557 1592 1592 1621 1626 1626 1626 1626 1735 1735 t_atom defined fixed bin(71,0) dcl 1-6 ref 621 627 684 872 1084 1104 1209 1211 1224 1225 1520 1640 1765 temp based fixed bin(71,0) array dcl 2-7 set ref 241* 246* 248 248* 264 265* 267* 278 354* 355 430 431* 433 474 475* 475 480* 602 603* 603* 605 605 605 605* 610* 610 611* 613 617 633* 633* 635 635 635 635* 640* 640 641* 643 645 684* 754 755* 932 933* 934* 936 1091 1092* 1093* 1095* 1096* 1103 1104 1109 1124 1127* 1185 1187* 1189* 1190* 1193* 1199* 1199 1231 1251 1261 1264* 1265* 1265 1266* 1266 1316* 1321* 1324* 1327* 1330* 1399* 1399 1401* 1401 1408 1411* 1412* 1412* 1416* 1420* 1420 1427* 1427 1429* 1429 1435* 1440* 1442* 1445* 1446* 1451 1455* 1457* 1459 1459 1463* 1463 1473* 1475* 1478 1478 1478 1484* 1484 1489* 1489 1497* 1497* 1513 1514 1515 1517* 1518* 1524* 1533 1537 1540* 1545 1569 1571* 1572* 1572 1585 1586* 1610 1611* 1612* 1612 1614 1616* 1616 1629* 1629 1640 1640 1687* 1728 1729* 1730* 1731* 1732* 1735* 1739 1756* 1760 1774 1779* 1780* 1780 1781* 1837 1838 temp_ptr based pointer array dcl 2-7 ref 245 246 258 287 288 368 477 480 484 485 580 605 605 608 608 611 635 635 638 638 641 1404 1409 1412 1416 1418 1440 1440 1442 1445 1446 1455 1457 1459 1473 1475 1478 1502 1503 1504 1504 1507 1518 1520 1524 1533 1537 1543 1544 1549 1549 1551 1551 1551 1557 1644 1687 1694 1697 1807 1843 temp_type 0(21) based bit(9) array level 2 packed packed unaligned dcl 2-7 ref 244 480 604 634 1396 1425 1436 1436 1453 1471 1478 1497 temp_type36 based bit(36) array level 2 dcl 2-7 ref 251 267 367 573 1451 1644 1694 1697 1803 1833 1839 thread 4 based pointer level 2 dcl 4-13 set ref 346* 659 667 668* 668 671 815 835* 858* 859 915 1354 1750* top_block based bit(18) level 2 packed packed unaligned dcl 2-7 set ref 1515* tp 000624 automatic pointer dcl 1389 set ref 1395* 1398 1399 1401 1410 1411 1415 1416 1420 1421 1426 1427 1429 1434 1435 1439 1440 1442 1454 1455 1459 1462 1463 1472 1473 1478 1483 1484 1489 1497 1497 1502 1503 1504 1504 1507 1513 1514 1515 1517 1518 1518 1520 1524 1524 1533 1533 1537 1537 1540 1543 1544 1545 tsp 000506 automatic pointer dcl 418 in procedure "modelist_object" set ref 429* 430 431 433 434 tsp 000532 automatic pointer dcl 471 in procedure "get_path_name_0" set ref 473* 474 475 477 480 480 480 484 485 488 tty_input_chan defined pointer dcl 1-6 set ref 275 828* 941 942 943 944 945 959 967 973 973 1643 1723 tty_output_chan defined pointer dcl 1-6 set ref 241 265 277 844* 936 941 942 943 944 945 947 947 949 959 967 976 1041 1586 1611 1640 type 000245 automatic fixed bin(17,0) dcl 51 in procedure "lisp_io_control_" set ref 316* 318 type 0(21) based bit(9) level 2 in structure "lisp_ptr" packed packed unaligned dcl 7-17 in procedure "lisp_io_control_" set ref 619 859* 861* 861* 861* type 0(21) based bit(9) level 2 in structure "p_" packed packed unaligned dcl 156 in procedure "lisp_io_control_" set ref 353* 1094* 1125* 1192* 1755* type_info based bit(36) level 2 dcl 8-4 set ref 1823* unm 000622 automatic pointer dcl 1389 in procedure "umergef" set ref 1511* 1512 1514 1515 1516 1519 1538 1539 unm 000602 automatic pointer dcl 1153 in procedure "error" set ref 1157* 1158 1159 1160 unmkd_ptr defined pointer dcl 1-6 set ref 1157 1158* 1511 1512* 1539* user_io_modes 000246 automatic char(512) packed unaligned dcl 51 set ref 949* 958* 965* value based fixed bin(71,0) level 2 in structure "atom" dcl 10-5 in procedure "lisp_io_control_" set ref 603 613* 617 619* 621* 622 622* 627 627 627* 633 643* 645* 867* 867* 867* 867* 867* 872* 980* 1209* 1211* 1224* 1225* 1287* 1290* 1293* 1296* 1518 1520* 1537* 1765* value based pointer level 2 in structure "atom_ptrs" dcl 10-5 in procedure "lisp_io_control_" ref 619 622 verify builtin function dcl 51 ref 930 1733 version based fixed bin(17,0) level 2 dcl 12-16 set ref 955* word 000457 automatic fixed bin(35,0) dcl 1796 set ref 1820* 1824 1837* 1856 words based fixed bin(35,0) array dcl 1796 set ref 1820 1856* write 15(02) based bit(1) level 3 packed packed unaligned dcl 4-13 set ref 279* 587 652* 798 829* 913 1004 1187 1225 1296 1659 1724* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Array internal static bit(9) initial packed unaligned dcl 7-17 Array36 internal static bit(36) initial dcl 7-17 Atomic internal static bit(9) initial packed unaligned dcl 7-17 Atomic36 internal static bit(36) initial dcl 7-17 Bigfix internal static bit(9) initial packed unaligned dcl 7-17 Bigfix36 internal static bit(36) initial dcl 7-17 Bignum internal static bit(9) initial packed unaligned dcl 7-17 Bignum36 internal static bit(36) initial dcl 7-17 Cons36 internal static bit(36) initial dcl 7-17 Fixed internal static bit(9) initial packed unaligned dcl 7-17 Float internal static bit(9) initial packed unaligned dcl 7-17 Float36 internal static bit(36) initial dcl 7-17 NotConsOrAtsym36 internal static bit(36) initial dcl 7-17 Numeric internal static bit(9) initial packed unaligned dcl 7-17 String internal static bit(9) initial packed unaligned dcl 7-17 Subr internal static bit(9) initial packed unaligned dcl 7-17 Subr36 internal static bit(36) initial dcl 7-17 SubrNumeric36 internal static bit(36) initial dcl 7-17 System_Subr internal static bit(9) initial packed unaligned dcl 7-17 System_Subr36 internal static bit(36) initial dcl 7-17 Uncollectable internal static bit(9) initial packed unaligned dcl 7-17 Undefined internal static bit(72) initial packed unaligned dcl 7-17 array_atom defined fixed bin(71,0) dcl 1-6 atom_double_words based structure level 1 dcl 10-5 base defined fixed bin(71,0) dcl 3-17 binary builtin function dcl 51 bindings based structure array level 1 dcl 2-7 catch_frame defined pointer dcl 1-6 consptr automatic pointer dcl 9-5 ctrlD defined fixed bin(71,0) dcl 5-5 err_frame defined pointer dcl 1-6 err_recp defined pointer dcl 1-6 error_table_$no_space external static fixed bin(35,0) dcl 51 eval_frame defined pointer dcl 1-6 flag_reset_mask internal static bit(36) initial dcl 4-13 flonum_fmt based structure level 1 dcl 8-4 flonum_type internal static bit(36) initial dcl 8-4 fn_CtoI internal static fixed bin(17,0) initial dcl 6-9 fn_ItoC internal static fixed bin(17,0) initial dcl 6-9 fn_abs internal static fixed bin(17,0) initial dcl 6-9 fn_add1 internal static fixed bin(17,0) initial dcl 6-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 6-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 6-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 6-9 fn_allfiles internal static fixed bin(17,0) initial dcl 6-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 6-9 fn_apply internal static fixed bin(17,0) initial dcl 6-9 fn_arg internal static fixed bin(17,0) initial dcl 6-9 fn_args internal static fixed bin(17,0) initial dcl 6-9 fn_array internal static fixed bin(17,0) initial dcl 6-9 fn_arraydims internal static fixed bin(17,0) initial dcl 6-9 fn_ascii internal static fixed bin(17,0) initial dcl 6-9 fn_atan internal static fixed bin(17,0) initial dcl 6-9 fn_baktrace internal static fixed bin(17,0) initial dcl 6-9 fn_bltarray internal static fixed bin(17,0) initial dcl 6-9 fn_boole internal static fixed bin(17,0) initial dcl 6-9 fn_boundp internal static fixed bin(17,0) initial dcl 6-9 fn_catch internal static fixed bin(17,0) initial dcl 6-9 fn_catenate internal static fixed bin(17,0) initial dcl 6-9 fn_charpos internal static fixed bin(17,0) initial dcl 6-9 fn_chrct internal static fixed bin(17,0) initial dcl 6-9 fn_cline internal static fixed bin(17,0) initial dcl 6-9 fn_cos internal static fixed bin(17,0) initial dcl 6-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 6-9 fn_defaultf internal static fixed bin(17,0) initial dcl 6-9 fn_definedp internal static fixed bin(17,0) initial dcl 6-9 fn_defsubr internal static fixed bin(17,0) initial dcl 6-9 fn_defun internal static fixed bin(17,0) initial dcl 6-9 fn_delete internal static fixed bin(17,0) initial dcl 6-9 fn_delq internal static fixed bin(17,0) initial dcl 6-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 6-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 6-9 fn_difference internal static fixed bin(17,0) initial dcl 6-9 fn_displace internal static fixed bin(17,0) initial dcl 6-9 fn_do internal static fixed bin(17,0) initial dcl 6-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 6-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 6-9 fn_eoffn internal static fixed bin(17,0) initial dcl 6-9 fn_eql internal static fixed bin(17,0) initial dcl 6-9 fn_errframe internal static fixed bin(17,0) initial dcl 6-9 fn_errprint internal static fixed bin(17,0) initial dcl 6-9 fn_errset internal static fixed bin(17,0) initial dcl 6-9 fn_eval internal static fixed bin(17,0) initial dcl 6-9 fn_eval_when internal static fixed bin(17,0) initial dcl 6-9 fn_evalframe internal static fixed bin(17,0) initial dcl 6-9 fn_exp internal static fixed bin(17,0) initial dcl 6-9 fn_expt internal static fixed bin(17,0) initial dcl 6-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 6-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 6-9 fn_filepos internal static fixed bin(17,0) initial dcl 6-9 fn_fillarray internal static fixed bin(17,0) initial dcl 6-9 fn_fix internal static fixed bin(17,0) initial dcl 6-9 fn_float internal static fixed bin(17,0) initial dcl 6-9 fn_freturn internal static fixed bin(17,0) initial dcl 6-9 fn_fsc internal static fixed bin(17,0) initial dcl 6-9 fn_gcd internal static fixed bin(17,0) initial dcl 6-9 fn_gensym internal static fixed bin(17,0) initial dcl 6-9 fn_get internal static fixed bin(17,0) initial dcl 6-9 fn_get_pname internal static fixed bin(17,0) initial dcl 6-9 fn_getchar internal static fixed bin(17,0) initial dcl 6-9 fn_getl internal static fixed bin(17,0) initial dcl 6-9 fn_greaterp internal static fixed bin(17,0) initial dcl 6-9 fn_gt internal static fixed bin(17,0) initial dcl 6-9 fn_haipart internal static fixed bin(17,0) initial dcl 6-9 fn_haulong internal static fixed bin(17,0) initial dcl 6-9 fn_ifix internal static fixed bin(17,0) initial dcl 6-9 fn_includef internal static fixed bin(17,0) initial dcl 6-9 fn_index internal static fixed bin(17,0) initial dcl 6-9 fn_inpush internal static fixed bin(17,0) initial dcl 6-9 fn_isqrt internal static fixed bin(17,0) initial dcl 6-9 fn_lessp internal static fixed bin(17,0) initial dcl 6-9 fn_linel internal static fixed bin(17,0) initial dcl 6-9 fn_linenum internal static fixed bin(17,0) initial dcl 6-9 fn_listarray internal static fixed bin(17,0) initial dcl 6-9 fn_listify internal static fixed bin(17,0) initial dcl 6-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 6-9 fn_log internal static fixed bin(17,0) initial dcl 6-9 fn_ls internal static fixed bin(17,0) initial dcl 6-9 fn_lsh internal static fixed bin(17,0) initial dcl 6-9 fn_make_atom internal static fixed bin(17,0) initial dcl 6-9 fn_makunbound internal static fixed bin(17,0) initial dcl 6-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 6-9 fn_max internal static fixed bin(17,0) initial dcl 6-9 fn_min internal static fixed bin(17,0) initial dcl 6-9 fn_minus internal static fixed bin(17,0) initial dcl 6-9 fn_minusp internal static fixed bin(17,0) initial dcl 6-9 fn_namelist internal static fixed bin(17,0) initial dcl 6-9 fn_names internal static fixed bin(17,0) initial dcl 6-9 fn_namestring internal static fixed bin(17,0) initial dcl 6-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 6-9 fn_nth internal static fixed bin(17,0) initial dcl 6-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 6-9 fn_oddp internal static fixed bin(17,0) initial dcl 6-9 fn_pagel internal static fixed bin(17,0) initial dcl 6-9 fn_pagenum internal static fixed bin(17,0) initial dcl 6-9 fn_plus internal static fixed bin(17,0) initial dcl 6-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 6-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 6-9 fn_plusp internal static fixed bin(17,0) initial dcl 6-9 fn_prin1 internal static fixed bin(17,0) initial dcl 6-9 fn_princ internal static fixed bin(17,0) initial dcl 6-9 fn_print internal static fixed bin(17,0) initial dcl 6-9 fn_prog internal static fixed bin(17,0) initial dcl 6-9 fn_progv internal static fixed bin(17,0) initial dcl 6-9 fn_putprop internal static fixed bin(17,0) initial dcl 6-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 6-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 6-9 fn_quotient internal static fixed bin(17,0) initial dcl 6-9 fn_random internal static fixed bin(17,0) initial dcl 6-9 fn_read internal static fixed bin(17,0) initial dcl 6-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 6-9 fn_readch internal static fixed bin(17,0) initial dcl 6-9 fn_readstring internal static fixed bin(17,0) initial dcl 6-9 fn_remainder internal static fixed bin(17,0) initial dcl 6-9 fn_remprop internal static fixed bin(17,0) initial dcl 6-9 fn_rot internal static fixed bin(17,0) initial dcl 6-9 fn_rplaca internal static fixed bin(17,0) initial dcl 6-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 6-9 fn_save internal static fixed bin(17,0) initial dcl 6-9 fn_set internal static fixed bin(17,0) initial dcl 6-9 fn_setarg internal static fixed bin(17,0) initial dcl 6-9 fn_setq internal static fixed bin(17,0) initial dcl 6-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 6-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 6-9 fn_signp internal static fixed bin(17,0) initial dcl 6-9 fn_sin internal static fixed bin(17,0) initial dcl 6-9 fn_sleep internal static fixed bin(17,0) initial dcl 6-9 fn_sort internal static fixed bin(17,0) initial dcl 6-9 fn_sortcar internal static fixed bin(17,0) initial dcl 6-9 fn_sqrt internal static fixed bin(17,0) initial dcl 6-9 fn_sstatus internal static fixed bin(17,0) initial dcl 6-9 fn_star_array internal static fixed bin(17,0) initial dcl 6-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 6-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 6-9 fn_star_status internal static fixed bin(17,0) initial dcl 6-9 fn_status internal static fixed bin(17,0) initial dcl 6-9 fn_store internal static fixed bin(17,0) initial dcl 6-9 fn_stringlength internal static fixed bin(17,0) initial dcl 6-9 fn_sub1 internal static fixed bin(17,0) initial dcl 6-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 6-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 6-9 fn_substr internal static fixed bin(17,0) initial dcl 6-9 fn_sxhash internal static fixed bin(17,0) initial dcl 6-9 fn_sysp internal static fixed bin(17,0) initial dcl 6-9 fn_throw internal static fixed bin(17,0) initial dcl 6-9 fn_times internal static fixed bin(17,0) initial dcl 6-9 fn_times_fix internal static fixed bin(17,0) initial dcl 6-9 fn_times_flo internal static fixed bin(17,0) initial dcl 6-9 fn_truename internal static fixed bin(17,0) initial dcl 6-9 fn_tyi internal static fixed bin(17,0) initial dcl 6-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 6-9 fn_tyo internal static fixed bin(17,0) initial dcl 6-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 6-9 fn_zerop internal static fixed bin(17,0) initial dcl 6-9 ibase defined fixed bin(71,0) dcl 3-17 j automatic fixed bin(17,0) dcl 51 lisp_ptr_type based bit(36) dcl 7-17 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$base external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$catch_frame external static pointer dcl 1-6 lisp_static_vars_$ctrlD external static fixed bin(71,0) dcl 5-5 lisp_static_vars_$err_frame external static pointer dcl 1-6 lisp_static_vars_$err_recp external static pointer dcl 1-6 lisp_static_vars_$eval_frame external static pointer dcl 1-6 lisp_static_vars_$ibase external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 1-6 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$plus_status external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$prog_frame external static pointer dcl 1-6 lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$rdr_ptr external static pointer dcl 51 lisp_static_vars_$read_print_nl_sync external static bit(36) packed unaligned dcl 3-17 lisp_static_vars_$readtable external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 1-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$top_level external static label variable dcl 1-6 lisp_static_vars_$tty_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$unwp_frame external static pointer dcl 1-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 1-45 mode_string_info based structure level 1 dcl 12-9 mode_string_info_ptr automatic pointer dcl 12-14 mode_string_info_version_2 internal static fixed bin(17,0) initial dcl 12-30 nil_ptr based pointer dcl 1-6 not_ok_to_read internal static bit(36) initial packed unaligned dcl 3-9 not_ok_to_write internal static bit(36) initial packed unaligned dcl 3-9 number_of_modes automatic fixed bin(17,0) dcl 12-6 obarray defined fixed bin(71,0) dcl 1-6 p2 automatic pointer dcl 51 plus_status defined fixed bin(71,0) dcl 3-17 prog_frame defined pointer dcl 1-6 quote_atom defined fixed bin(71,0) dcl 3-17 rdr_ptr defined pointer dcl 51 read_print_nl_sync defined bit(36) packed unaligned dcl 3-17 readtable defined fixed bin(71,0) dcl 3-17 s_atom defined fixed bin(71,0) dcl 3-17 star_rset defined fixed bin(71,0) dcl 1-45 status_gctwa defined fixed bin(71,0) dcl 3-17 stnopoint defined fixed bin(71,0) dcl 3-17 t_atom_ptr based pointer dcl 1-6 tty_atom defined fixed bin(71,0) dcl 3-17 unwp_frame defined pointer dcl 1-6 user_intr_array defined fixed bin(71,0) array dcl 1-45 NAMES DECLARED BY EXPLICIT CONTEXT. E_O_F 002660 constant label dcl 1084 ref 1023 1063 bad_ename 005603 constant label dcl 491 ref 486 487 boot 001541 constant entry external dcl 825 cleanup 003361 constant entry external dcl 1340 cleanup_err_ret 003422 constant label dcl 1354 ref 1303 clear_input 004121 constant entry external dcl 1677 close 000713 constant entry external dcl 568 close_msf 006036 constant entry internal dcl 703 ref 508 582 770 802 1348 close_output_file 006057 constant entry internal dcl 710 ref 585 803 1353 deletef 003475 constant entry external dcl 1580 dump_buffer 006135 constant entry internal dcl 881 ref 587 913 1013 1042 1668 empty_all_buffers 002007 constant entry external dcl 907 empty_all_err_ret 002036 constant label dcl 915 ref 1219 1299 end_of_block 002421 constant entry external dcl 991 ref 1816 1852 eof_imm_ret 002777 constant label dcl 1133 ref 1084 1111 1119 eof_nil 002754 constant label dcl 1121 eof_nil_1 002761 constant label dcl 1125 ref 1103 error 006235 constant entry internal dcl 1151 ref 432 494 575 1204 1649 1787 1805 1835 1841 errproc 000014 constant label array(-6:7) dcl 1251 ref 1248 errproc_6_join 003461 constant label dcl 1569 ref 1598 errproc_aa 003040 constant label dcl 1190 ref 1258 errproc_cc 003052 constant label dcl 1194 ref 1269 1574 errtn 000000 constant label array(-4:7) dcl 659 ref 1205 exit 000705 constant label dcl 355 ref 685 1373 1595 1630 exit_t 001210 constant label dcl 679 ref 669 exitloop 006663 constant label dcl 1493 ref 1404 file_sys_fun_err_ 003166 constant label dcl 1246 ref 296 510 719 763 887 897 1025 1065 1628 fix_not_ok_iochan 001263 constant entry external dcl 736 ref 1810 1846 fo_ci_barf 004003 constant label dcl 1647 ref 1659 1662 fo_ci_join 003746 constant label dcl 1638 ref 1680 fo_ci_retry 003753 constant label dcl 1640 ref 1650 force_output 003737 constant entry external dcl 1632 fs_loss_close_it 005645 constant label dcl 508 ref 518 547 553 fs_loss_close_maybe 005641 constant label dcl 508 ref 534 gc_close 000746 constant label dcl 581 ref 259 700 gc_close_1 001146 constant label dcl 652 ref 591 1285 gc_flush 001227 constant entry external dcl 692 get_fname 006256 constant entry internal dcl 1312 ref 1257 1267 1573 get_iocb 006205 constant entry internal dcl 892 ref 884 1035 1672 get_output_seg_ptr 005753 constant entry internal dcl 541 ref 308 319 1010 get_path_name 005462 constant entry internal dcl 457 ref 301 756 get_path_name_0 005476 constant entry internal dcl 469 ref 460 1590 1620 1624 gfn 000032 constant label array(7) dcl 1316 ref 1314 in 004653 constant entry external dcl 1794 in_loss 004711 constant label dcl 1810 ref 1808 in_out_ret 004757 constant label dcl 1821 ref 1857 include_common 004162 constant label dcl 1694 ref 1688 include_file_name_truncated 004575 constant label dcl 1768 ref 1703 include_file_not_found 004600 constant label dcl 1772 ref 1697 include_file_not_found_but_have_code 004602 constant label dcl 1774 ref 1710 1715 1770 includef 004150 constant entry external dcl 1690 init 002044 constant entry external dcl 924 init_an_iochan 005454 constant entry internal dcl 447 ref 260 inouterr 003017 constant label dcl 1181 ref 1175 1179 1297 inouterr1 003023 constant label dcl 1185 ref 1171 1291 input_wait_ab_exit 002651 constant label dcl 1071 ref 1048 io_wrong_direction_ 003010 constant label dcl 1173 ref 785 iochan_has_been_closed_ 003014 constant label dcl 1177 ref 782 lisp_io_control_ 000174 constant entry external dcl 6 make_an_iochan 005437 constant entry internal dcl 443 ref 263 827 843 1719 mergef 003430 constant entry external dcl 1362 modelist_object 005344 constant entry internal dcl 416 ref 245 248 modelist_process 005201 constant entry internal dcl 390 ref 227 424 425 no_modes_available 002402 constant label dcl 973 set ref 948 950 open 000257 constant entry external dcl 234 open_close_ret 000352 constant label dcl 260 ref 683 open_input_file 005610 constant entry internal dcl 504 ref 303 757 1746 open_output_file 005716 constant entry internal dcl 531 ref 307 312 759 open_stuff 000343 constant label dcl 251 ref 228 opena 000231 constant entry external dcl 217 opena_new 000542 constant label dcl 308 ref 317 openi 000203 constant entry external dcl 205 openo 000216 constant entry external dcl 211 openx 000242 constant label dcl 223 set ref 209 215 out 004767 constant entry external dcl 1828 out_loss 005043 constant label dcl 1846 ref 1844 percent_include 004132 constant entry external dcl 1684 reget_in 004662 constant label dcl 1802 ref 1811 reget_out 004776 constant label dcl 1832 ref 1847 rename 003601 constant entry external dcl 1605 reopen_inconsistent_ 003002 constant label dcl 1168 ref 771 retry 005350 constant label dcl 423 ref 435 set_for_save 001441 constant entry external dcl 792 set_for_save_err_ret 001505 constant label dcl 804 ref 1278 set_mode_defaults 005112 constant entry internal dcl 363 ref 226 stars_left 003456 constant label dcl 1567 ref 1502 1543 1545 try_again 005507 constant label dcl 477 ref 495 umergef 006305 constant entry internal dcl 1387 ref 269 1371 1588 1615 1619 x01 006653 constant label dcl 1488 ref 1466 1486 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 10364 10616 7204 10374 Length 11552 7204 232 720 1160 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_io_control_ 586 external procedure is an external procedure. set_mode_defaults internal procedure shares stack frame of external procedure lisp_io_control_. modelist_process internal procedure shares stack frame of external procedure lisp_io_control_. modelist_object internal procedure shares stack frame of external procedure lisp_io_control_. make_an_iochan internal procedure shares stack frame of external procedure lisp_io_control_. get_path_name internal procedure shares stack frame of external procedure lisp_io_control_. get_path_name_0 internal procedure shares stack frame of external procedure lisp_io_control_. open_input_file internal procedure shares stack frame of external procedure lisp_io_control_. close_msf internal procedure shares stack frame of external procedure lisp_io_control_. close_output_file internal procedure shares stack frame of external procedure lisp_io_control_. dump_buffer internal procedure shares stack frame of external procedure lisp_io_control_. get_iocb internal procedure shares stack frame of external procedure lisp_io_control_. error internal procedure shares stack frame of external procedure lisp_io_control_. get_fname internal procedure shares stack frame of external procedure lisp_io_control_. umergef internal procedure shares stack frame of external procedure lisp_io_control_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_io_control_ 000100 amv lisp_io_control_ 000126 bc lisp_io_control_ 000127 code lisp_io_control_ 000130 codde lisp_io_control_ 000131 dname lisp_io_control_ 000203 ename lisp_io_control_ 000215 err lisp_io_control_ 000216 esw lisp_io_control_ 000217 i lisp_io_control_ 000220 maxlen lisp_io_control_ 000221 myname lisp_io_control_ 000222 nargs lisp_io_control_ 000223 other_ename lisp_io_control_ 000234 p lisp_io_control_ 000236 q lisp_io_control_ 000240 rnstack lisp_io_control_ 000242 stack lisp_io_control_ 000244 status lisp_io_control_ 000245 type lisp_io_control_ 000246 user_io_modes lisp_io_control_ 000446 direction lisp_io_control_ 000447 data_mode lisp_io_control_ 000450 buffer_mode lisp_io_control_ 000451 device_type lisp_io_control_ 000452 openx_sim_arg lisp_io_control_ 000454 mode_value_ptr lisp_io_control_ 000456 fail_flag lisp_io_control_ 000457 word lisp_io_control_ 000466 p set_mode_defaults 000504 object modelist_object 000506 tsp modelist_object 000532 tsp get_path_name_0 000602 unm error 000620 sp umergef 000622 unm umergef 000624 tp umergef THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_in call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ delete_$path expand_path_ find_include_file_$initiate_count get_wdir_ hcs_$chname_file hcs_$fs_get_path_name hcs_$get_max_length_seg hcs_$status_minf iox_$control iox_$get_chars iox_$get_line iox_$look_iocb iox_$modes iox_$put_chars lisp_$apply lisp_error_ lisp_get_atom_ lisp_io_control_$close lisp_io_control_$fix_not_ok_iochan lisp_io_fns_$inpush lisp_io_fns_$internal_namelist lisp_list_utils_$nreverse lisp_print_$exploden lisp_reader_$maknam lisp_special_fns_$cons lisp_special_fns_$xcons lisp_static_man_$allocate mode_string_$get_mode msf_manager_$adjust msf_manager_$close msf_manager_$get_ptr msf_manager_$open THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$dirseg error_table_$end_of_info error_table_$entlong error_table_$long_record error_table_$noentry lisp_error_table_$bad_arg_correctable lisp_error_table_$bad_entry_name lisp_error_table_$bad_item_in_modelist lisp_error_table_$file_is_closed lisp_error_table_$file_sys_fun_err lisp_error_table_$include_file_error lisp_error_table_$io_wrong_direction lisp_error_table_$reopen_inconsistent lisp_error_table_$stars_left_in_name lisp_static_vars_$STAR lisp_static_vars_$binding_top lisp_static_vars_$close lisp_static_vars_$ctrlQ lisp_static_vars_$ctrlR lisp_static_vars_$ctrlW lisp_static_vars_$deletef lisp_static_vars_$infile lisp_static_vars_$instack lisp_static_vars_$iochan_list lisp_static_vars_$mergef lisp_static_vars_$nil lisp_static_vars_$old_io_defaults lisp_static_vars_$open lisp_static_vars_$outfile lisp_static_vars_$outfiles lisp_static_vars_$rdr_label lisp_static_vars_$rdr_state lisp_static_vars_$rename 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 000173 205 000201 207 000210 208 000212 209 000214 211 000215 213 000223 214 000225 215 000227 217 000230 219 000236 220 000240 223 000242 225 000244 226 000251 227 000252 228 000255 234 000256 236 000264 237 000266 238 000270 239 000275 240 000277 241 000301 243 000307 244 000311 245 000316 246 000324 247 000330 248 000331 251 000343 258 000346 259 000351 260 000352 262 000353 263 000354 264 000355 265 000361 266 000366 267 000370 269 000376 270 000377 272 000403 273 000405 275 000407 277 000417 278 000424 279 000426 281 000433 287 000435 288 000441 290 000450 291 000463 292 000470 293 000500 294 000503 295 000505 296 000527 297 000531 301 000532 303 000533 306 000537 307 000541 308 000542 309 000543 312 000544 316 000545 317 000604 318 000606 319 000615 320 000616 323 000631 332 000640 333 000647 335 000654 337 000662 346 000670 347 000675 353 000677 354 000703 355 000705 357 000711 568 000712 570 000720 571 000722 572 000727 573 000731 574 000736 575 000741 576 000742 580 000743 581 000746 582 000753 585 000763 587 000765 591 000771 602 000773 603 000777 604 001004 605 001010 608 001022 610 001026 611 001030 612 001033 613 001034 617 001040 619 001044 621 001054 622 001056 627 001066 633 001077 634 001104 635 001110 638 001122 640 001126 641 001130 642 001133 643 001134 645 001140 652 001146 659 001153 663 001164 667 001174 668 001201 669 001204 671 001205 679 001210 680 001212 681 001215 683 001216 684 001220 685 001223 692 001224 694 001234 694 001236 695 001237 696 001243 697 001247 700 001256 736 001257 741 001270 742 001272 743 001276 744 001300 745 001307 746 001311 747 001314 747 001322 749 001324 754 001332 755 001334 756 001337 757 001340 759 001346 760 001347 763 001374 769 001401 770 001405 771 001406 773 001407 774 001411 777 001412 778 001425 779 001430 781 001431 782 001435 785 001436 792 001437 794 001446 795 001447 798 001460 802 001500 803 001504 804 001505 806 001514 808 001515 809 001517 810 001520 811 001523 812 001527 814 001531 815 001534 816 001537 825 001540 827 001546 828 001547 829 001552 830 001555 831 001557 832 001562 833 001575 834 001577 835 001620 836 001625 837 001631 838 001632 839 001634 840 001637 842 001641 843 001642 844 001643 845 001646 846 001651 847 001653 848 001655 849 001660 850 001673 851 001676 852 001701 853 001704 854 001706 856 001711 857 001731 858 001734 859 001737 860 001744 861 001746 867 001767 872 002002 874 002005 907 002006 909 002014 910 002016 913 002026 915 002036 917 002042 924 002043 929 002051 930 002060 931 002075 932 002101 933 002103 934 002125 935 002132 936 002136 937 002143 941 002145 942 002153 943 002155 944 002157 945 002161 947 002164 948 002204 949 002206 950 002235 954 002237 955 002241 956 002243 958 002255 959 002304 963 002322 965 002335 967 002364 973 002402 976 002407 980 002411 982 002414 991 002415 1001 002426 1002 002430 1003 002432 1004 002435 1009 002443 1010 002444 1011 002445 1012 002446 1013 002447 1014 002451 1019 002454 1020 002455 1022 002500 1023 002503 1025 002513 1026 002514 1028 002523 1029 002526 1034 002527 1035 002531 1036 002536 1040 002542 1041 002543 1042 002547 1043 002550 1044 002552 1048 002554 1049 002561 1052 002563 1054 002567 1055 002610 1056 002615 1057 002616 1059 002637 1063 002641 1065 002645 1067 002650 1071 002651 1073 002653 1074 002656 1077 002657 1084 002660 1086 002664 1090 002670 1091 002673 1092 002675 1093 002677 1094 002701 1095 002705 1096 002707 1097 002712 1098 002716 1099 002723 1103 002730 1104 002734 1105 002736 1106 002740 1107 002743 1109 002744 1110 002746 1111 002750 1119 002751 1121 002754 1124 002757 1125 002761 1127 002765 1128 002767 1129 002773 1130 002776 1133 002777 1136 003001 1168 003002 1170 003005 1171 003007 1173 003010 1175 003013 1177 003014 1179 003016 1181 003017 1185 003023 1187 003027 1189 003036 1190 003040 1192 003044 1193 003050 1194 003052 1196 003057 1197 003064 1199 003067 1200 003071 1201 003073 1203 003077 1204 003101 1205 003102 1209 003104 1211 003116 1212 003122 1213 003124 1214 003126 1216 003127 1219 003132 1221 003133 1224 003136 1225 003146 1226 003155 1227 003160 1231 003161 1234 003165 1246 003166 1248 003171 1251 003173 1257 003176 1258 003177 1261 003200 1264 003203 1265 003206 1266 003210 1267 003212 1268 003213 1269 003220 1271 003221 1278 003261 1281 003262 1285 003322 1287 003323 1290 003334 1291 003337 1293 003340 1296 003347 1297 003355 1299 003356 1303 003357 1340 003360 1342 003366 1344 003370 1348 003400 1353 003421 1354 003422 1355 003426 1362 003427 1364 003435 1365 003442 1366 003444 1367 003446 1368 003450 1369 003452 1371 003454 1373 003455 1567 003456 1569 003461 1571 003465 1572 003470 1573 003472 1574 003473 1580 003474 1582 003502 1583 003507 1584 003511 1585 003513 1586 003515 1587 003521 1588 003523 1590 003524 1592 003525 1595 003571 1597 003574 1598 003577 1605 003600 1607 003606 1608 003615 1609 003617 1610 003621 1611 003623 1612 003627 1613 003631 1614 003633 1615 003635 1616 003636 1617 003640 1618 003643 1619 003645 1620 003646 1621 003647 1623 003654 1624 003656 1626 003657 1628 003727 1629 003732 1630 003735 1632 003736 1637 003744 1638 003746 1640 003753 1643 003770 1644 003774 1647 004003 1649 004006 1650 004007 1653 004010 1654 004013 1659 004034 1661 004043 1662 004044 1668 004050 1670 004054 1671 004055 1672 004056 1673 004063 1675 004117 1677 004120 1679 004126 1680 004130 1684 004131 1686 004137 1687 004144 1688 004146 1690 004147 1692 004155 1694 004162 1697 004177 1703 004212 1704 004215 1708 004232 1710 004276 1714 004302 1715 004334 1719 004336 1720 004337 1721 004343 1722 004345 1723 004347 1724 004354 1728 004356 1729 004361 1730 004364 1731 004402 1732 004422 1733 004450 1735 004463 1736 004513 1737 004521 1738 004526 1739 004530 1743 004534 1744 004536 1745 004541 1746 004543 1750 004544 1751 004551 1755 004553 1756 004557 1760 004561 1761 004564 1765 004570 1766 004574 1768 004575 1770 004577 1772 004600 1774 004602 1779 004606 1780 004611 1781 004613 1782 004631 1783 004636 1785 004643 1786 004645 1787 004650 1788 004651 1794 004652 1800 004660 1802 004662 1803 004667 1804 004673 1805 004676 1806 004677 1807 004700 1808 004703 1809 004706 1810 004711 1811 004725 1814 004730 1816 004734 1817 004751 1820 004753 1821 004757 1823 004760 1824 004762 1825 004765 1828 004766 1830 004774 1832 004776 1833 005003 1834 005010 1835 005013 1836 005014 1837 005015 1838 005017 1839 005022 1840 005025 1841 005030 1842 005031 1843 005032 1844 005035 1845 005040 1846 005043 1847 005057 1850 005062 1852 005066 1853 005103 1856 005105 1857 005111 363 005112 367 005113 368 005116 369 005121 369 005127 370 005131 371 005137 372 005145 373 005147 374 005155 375 005157 376 005165 377 005167 379 005170 380 005172 381 005174 382 005176 384 005200 390 005201 394 005212 395 005223 396 005232 397 005241 398 005250 400 005257 401 005266 402 005275 404 005304 405 005313 407 005322 408 005331 409 005340 410 005343 416 005344 418 005346 423 005350 424 005351 425 005373 426 005412 428 005415 429 005420 430 005424 431 005426 432 005430 433 005431 434 005433 435 005436 443 005437 445 005440 447 005453 449 005455 450 005460 451 005461 457 005462 459 005463 460 005466 462 005467 463 005475 469 005476 473 005477 474 005503 475 005505 477 005507 479 005516 480 005517 484 005527 485 005566 486 005573 487 005575 488 005577 489 005602 491 005603 494 005606 495 005607 504 005610 506 005611 507 005637 508 005641 510 005646 512 005647 516 005652 518 005676 520 005703 522 005712 523 005715 531 005716 533 005717 534 005745 535 005752 541 005753 545 005754 547 006000 552 006005 553 006020 555 006022 557 006031 558 006035 703 006036 705 006037 706 006053 708 006056 710 006057 714 006060 716 006065 718 006073 719 006117 720 006121 721 006131 723 006134 881 006135 883 006136 883 006140 883 006143 884 006144 885 006152 886 006161 887 006176 888 006200 889 006201 890 006204 892 006205 894 006206 895 006230 896 006232 897 006233 899 006234 1151 006235 1157 006236 1158 006242 1159 006245 1160 006247 1161 006251 1162 006255 1312 006256 1314 006257 1316 006261 1319 006264 1321 006265 1322 006270 1324 006271 1325 006274 1327 006275 1328 006300 1330 006301 1331 006304 1387 006305 1394 006306 1395 006310 1396 006314 1398 006317 1399 006322 1400 006324 1401 006332 1403 006334 1404 006337 1406 006344 1407 006347 1408 006351 1409 006354 1410 006360 1411 006363 1412 006365 1415 006375 1416 006401 1417 006405 1418 006411 1419 006416 1420 006423 1421 006425 1423 006430 1425 006431 1426 006434 1427 006437 1428 006441 1429 006447 1434 006451 1435 006455 1436 006457 1439 006466 1440 006472 1442 006501 1444 006505 1445 006511 1446 006515 1447 006521 1451 006522 1453 006531 1454 006535 1455 006541 1456 006545 1457 006551 1458 006555 1459 006556 1462 006565 1463 006570 1464 006572 1466 006576 1471 006577 1472 006603 1473 006607 1474 006613 1475 006617 1476 006623 1478 006624 1483 006641 1484 006644 1485 006646 1486 006652 1488 006653 1489 006660 1491 006662 1493 006663 1496 006666 1497 006667 1501 006677 1502 006700 1503 006705 1504 006710 1506 006731 1507 006732 1511 006734 1512 006737 1513 006742 1514 006745 1515 006752 1516 006756 1517 006763 1518 006766 1519 006770 1520 006772 1524 006775 1525 006777 1529 007005 1533 007012 1537 007015 1538 007017 1539 007027 1540 007030 1541 007032 1543 007033 1544 007043 1545 007050 1549 007054 1551 007066 1556 007112 1556 007122 1557 007125 1559 007154 1561 007155 1562 007161 ----------------------------------------------------------- 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