COMPILATION LISTING OF SEGMENT lisp_save_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0850.5 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_save_: proc(arg); 7 /*** NOTE WELL: DUE TO A BUG IN THE PL1 COMPILER, THIS PROGRAM MUST ALWAYS BE COMPILED WITH -OPTIMIZE ***/ 8 9 10 /* 11* * changes made 3/20/73 by DAM: 12* * changed the variable size to Size to allow use of the size BIF 13* * added pointer overlays curptrp, newptrp, fakeptrp 14* * added code to save file objects (iochans) 15* * Modified 73.12.17 by DAM for a new format of saved environment header 16* * Modified 74.06.03 by DAM for new-arrays and to save the gensym data 17* * Modified 78.06.04 by BSG to put on Subr bit in snapped array links 18* * Modified 82.10.14 by Richard Lamson to remove warning about up-to-date-ness 19* */ 20 21 22 /* D E C L A R A T I O N S */ 23 24 25 /* P A R A M E T E R */ 26 27 dcl arg char(*) parameter; /* name of env. to save */ 28 29 30 /* A U T O M A T I C */ 31 32 dcl current_save_seg bit(18) init(""b), /* baseno of last temp seg created, used for threading */ 33 temp_ptr ptr, /* used to circomvent PL/I v2 bug */ 34 temp_ptr_1 ptr, 35 temp_ptr_0 ptr, 36 first_save_seg bit(18) init(""b), /* baseno of first temp seg created, has thread to rest */ 37 free_allocptr ptr init(null), /* -> next cell of lists space in temp seg to allocate */ 38 stat_allocptr ptr init(null), /* -> next part of static temp seg to allocate */ 39 dir char(168), /* directory pathname */ 40 ent char(32), /* entryname of savefile */ 41 ename char(32), 42 segnumber fixed bin init(0), /* msf component number */ 43 curptr fixed bin(71) aligned, /* current object */ 44 curptrp ptr aligned based(addr(curptr)), /* and same as a pointer */ 45 newptr fixed bin(71) aligned, /* copy */ 46 newptrp ptr aligned based(addr(newptr)), /* and same as a pointer */ 47 newsegptr ptr, 48 fakeptr fixed bin(71) aligned, /* object stored in saved env - has fake segment number */ 49 fakeptr2 fixed bin(71) aligned, 50 newptr2 ptr, 51 fake_lists_seg bit(18), /* segment index of current lists seg for making fakeptr */ 52 fake_array_seg bit(18), /* segment index of current array seg for making fakeptr */ 53 segptr ptr, 54 acinfo ptr, /* make tssi_ happy */ 55 number_of_array_links fixed bin, 56 system_tv_segno bit(18) init(baseno(addr(lisp_subr_tv_$tv_begin))), /* segment number of lisp_subr_tv_ */ 57 system_tv_offset fixed bin(17) init(binary(rel(addr(lisp_subr_tv_$tv_begin)))), 58 segment_size fixed bin(19), 59 this_seg_is_static bit(1), 60 retad label local, /* return address from pseudo subroutine copy */ 61 code fixed bin(35), /* Multics status code */ 62 bucketx fixed bin, /* index into gc'ed stuff in lisp_static_vars_ */ 63 bucketno fixed bin, /* which garbage-collected slot in lisp_static_vars_ */ 64 /* is being saved/restored; or else how many of these */ 65 Size fixed bin, /* size in words of data to copy */ 66 switch fixed bin, /* type of subr object being saved */ 67 to_be_copied fixed bin, /* total number words to move, may split across segments */ 68 words_left fixed bin, /* number words left in segment currently moving into */ 69 stack ptr init(null), /* -> our private stack used for recursion */ 70 bit_length fixed bin(24), /* dummy argument for hcs_ calls */ 71 defptr ptr, 72 string_ptr ptr, 73 list_of_iochans ptr, /* list of all iochans that have been saved */ 74 list_of_subr_blocks ptr, /* list of all new-type subr blocks that have been saved */ 75 file_control_ptr ptr; 76 77 dcl new_format bit(1), /* 1 => saved_env structure, 0 => save_header structure */ 78 atomic_constants_addr ptr, 79 atomic_constants_count fixed bin(18), 80 rest_of_gc_area_addr ptr, 81 rest_of_gc_area_count fixed bin(18), 82 first_seg_ptr ptr; 83 84 dcl amount_of_gensym_data fixed bin, 85 amount_of_maknum_data fixed bin, 86 (array_data_size, dope_vector_size) fixed bin(18), 87 must_convert_arrays bit(1), 88 i fixed bin; 89 90 91 92 93 /* B A S E D O V E R L A Y S */ 94 95 dcl 1 curptr_ovly based(addr(curptr)) aligned, 96 2 filler bit(21)unaligned, 97 2 curptr_type bit(9) unaligned, /* */ 98 2 pad bit(23) unaligned, 99 2 curptr_odd bit(1) unaligned, /* */ 100 2 rest_of_curptr bit(18) unaligned, 101 1 fakeptr_ovly based(addr(fakeptr))aligned, 102 2 filler bit(21) unaligned, 103 2 fakeptr_type bit(9) unaligned, /* */ 104 2 pad bit(42) unaligned, 105 Array_Data fixed bin(71) aligned based, /* just data */ 106 temp (1000) fixed bin(71) aligned based, /* (like lisp_stack_fmt.incl.pl1) */ 107 bit18unal bit(18) unaligned based, 108 copy_mask (Size) based aligned bit(36), /* (mask?) used to copy_words */ 109 transfer_location ptr based; /* used to save local label retad on stack */ 110 111 112 /* O L D S A V E F I L E H E A D E R */ 113 114 dcl 1 save_header based aligned, /* goes at word 0 of component 0 of msf */ 115 2 num_gc_ptrs fixed bin(17) unaligned, /* amount of cruft before first seg - from lisp_static_vars_ */ 116 2 seg_count fixed bin(17) unaligned, /* number of segments represented. /= number msf components */ 117 2 seg_size fixed bin, /* Size of saved segments */ 118 2 iochan_list ptr, /* list of saved iochans, here because not in 119* the gc'able part of lisp_static_vars_ that is saved */ 120 2 next_dbl_word fixed bin(71); /* first free location after this structure */ 121 122 123 /* N E W S A V E F I L E H E A D E R */ 124 125 dcl 1 saved_env aligned based, 126 2 flag fixed bin(17) unaligned, /* -1 => this format */ 127 2 seg_count fixed bin(17) unaligned, /* number of segments represented. /= number of msf components */ 128 2 seg_size fixed bin, /* Size of saved segments */ 129 2 version_number fixed bin, /* 3 for this declaration */ 130 2 iochan_list ptr, /* pseudo ptr for list of all iochans */ 131 2 subr_block_list ptr, /* pseudo ptr for list of all new type subr blocks */ 132 2 offset_to_first_seg fixed bin(18), /* offset in first msf component of start of first saved segment */ 133 2 atomic_constants, /* saved lisp_static_vars_ atoms */ 134 3 offset fixed bin(18), /* offset in first msf component */ 135 3 length fixed bin(18), /* number of saved items */ 136 2 rest_of_gc_area, /* similar stuff for other part of lisp_static_vars_ that is saved */ 137 3 offset fixed bin(18), 138 3 length fixed bin(18), 139 2 gensym_data (amount_of_gensym_data) bit(36) aligned, /* either 0 words (v=1) or 2 words (v>_2) */ 140 2 maknum_data (amount_of_maknum_data) bit(36) aligned, /* either 0 words (v<_2) or 5 words (v > 2) */ 141 2 seg_type (0 refer (saved_env.seg_count)) bit(1) unaligned; /* table of segment types, 1 = static, 0 = lists */ 142 143 144 /* S E G M E N T H E A D E R */ 145 146 dcl 1 segment based aligned, /* appears before each segment represented in save msf */ 147 2 chain bit(18) unaligned, /* root of its-pair chain requiring fixing up */ 148 2 seg_type bit(18) unaligned, /* ""b = lists, "1"b = array = static */ 149 2 seg_chain bit(18) unaligned, /* segno of next seg in list of such */ 150 2 seg_size bit(18) unaligned; /* number of words (always even) that were saved in the msf */ 151 152 153 /* S T A T I C S E G K L U D G E */ 154 155 dcl 1 static_seg_kludge aligned based, /* header of saved static seg */ 156 2 link_block_chain_ptr ptr, /* overlaid by segment header */ 157 158 2 def_sect_ptr ptr, 159 2 saved_list_of_subr_blocks ptr, /* hidey-hole for list of comp subr blocks (Kludgey!!) */ 160 2 virgin_link_ptr ptr, 161 2 zeroes bit(72); 162 163 /* S T A T I C S E G T E M P L A T E */ 164 165 dcl 1 static_seg_template aligned static, /* initialization for static seg header */ 166 2 chain_pointer ptr init(null), 167 2 def_pointer ptr init(null), 168 2 thread_pointer ptr init(null), 169 2 virgin_link_pointer ptr init(null), 170 2 zeroes bit(72) init(""b); 171 172 dcl 1 static_seg_header aligned based like static_seg_template; 173 174 175 /* F O R M A T O F E N T R Y P O I N T I N S U B R B L O C K */ 176 177 dcl 1 subr based aligned, 178 2 nargs fixed bin(17) unaligned, 179 2 infop fixed bin(17) unaligned, 180 2 entry_inst(3) bit(36) aligned, 181 2 stat_size fixed bin(17) unal, /* for type 3 subrs, static block Size */ 182 2 rest_of_word bit(18) unal, 183 2 gcmark bit(18) aligned; /* marker used by garbage collector for type 3 subrs */ 184 185 186 /* F O R M A T O F A R R A Y S */ 187 1 1 /***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 1 2 1 3 /* This include file defines the format of the "new" LISP arrays. 1 4* Written 74.05.13 by DAM */ 1 5 1 6 /* Info block in static space. pointed at by array ptr */ 1 7 1 8 dcl 1 array_info aligned based structure, /* 8 words long */ 1 9 2 ndims fixed bin(17) unaligned, /* number of dimensions */ 1 10 2 gc_mark bit(18) unaligned, /* alternating bits for garbage coll. */ 1 11 2 call_array_operator bit(36), /* tspbp instruction to array opr */ 1 12 2 array_data_ptr pointer, /* -> array_data structure */ 1 13 2 array_load_sequence(3) bit(36), /* lda, ldq, tra bp|0 */ 1 14 2 type fixed bin(17) unaligned, /* type of array, see dcl below */ 1 15 2 minus_2_times_ndims fixed bin(17) unaligned; /* for convenience of array opr */ 1 16 1 17 /* Codes for the different types of arrays: 1 18* Name Value arg to *array to create one */ 1 19 1 20 dcl (S_expr_array init(0), /* t */ 1 21 Un_gc_array init(1), /* nil */ 1 22 Fixnum_array init(2), /* fixnum */ 1 23 Flonum_array init(3), /* flonum */ 1 24 Readtable_array init(4), /* readtable */ 1 25 Obarray_array init(5), /* obarray */ 1 26 Dead_array init(6) /* (*rearray a) */ 1 27 ) fixed bin(17) static; 1 28 1 29 /* Block of array data and dimensions, in garbage-collected Lists space */ 1 30 1 31 dcl 1 array_data aligned based structure, 1 32 2 dope_vector(ZERO), /* address by dope_vector(i-ndims). no way to dcl in PL/I */ 1 33 3 bounds fixed bin(35), /* 0 <_ subscript < bounds */ 1 34 3 multiplier fixed bin(35), /* multiplier in polynomial-type subscript calc. */ 1 35 2 data(0:1000) fixed bin(71); /* single or double words depending on type of array */ 1 36 1 37 dcl ZERO fixed bin static init(0); /* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */ 1 38 1 39 /***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 188 189 190 191 /* F O R M A T O F L I N K S */ 192 193 dcl 1 acc based aligned, 194 2 len fixed bin(8) unaligned, /* "acc string" */ 195 2 string char(262144) unaligned, 196 1 link_info based aligned, 197 2 header_ptr fixed bin(17) unaligned, /* standard ft2 pair */ 198 2 ft2 fixed bin(17) unaligned, 199 2 def_offset bit(18) unaligned, 200 2 rest fixed bin(17) unaligned, 201 2 type_pair_ptr bit(18) unal, 202 2 exp_val bit(18) unal, 203 2 class bit(18) unal, 204 2 trap_off bit(18) unal, 205 2 seg_nam_ptr bit(18) unaligned, 206 2 ent_nam_ptr bit(18) unaligned; 207 208 209 /* F O R M A T O F O U R R E C U R S I O N S T A C K */ 210 211 dcl 1 stack_entry based(stack) aligned, 212 2 object fixed bin(71) aligned, 213 2 return ptr, /* saved copy of retad */ 214 1 array_save based(stack) aligned, 215 2 address ptr, 216 2 Size fixed bin, 217 2 pad fixed bin, 218 2 return_addr ptr; 219 dcl 1 array_link_save based(stack) aligned, 220 2 save_temp_ptr pointer unaligned, 221 2 save_temp_ptr_1 pointer unaligned, 222 2 save_fakeptr fixed bin(71), 223 2 save_newptr fixed bin(71), 224 2 save_return unaligned pointer, 225 2 number_of_links_left fixed bin; 226 227 228 /* E X T E R N A L S T A T I C */ 229 230 dcl lisp_standard_environment_$ ext fixed bin, /* the default environment for unsave */ 231 lisp_static_vars_$saved_environment_dir ext char(168), 232 lisp_static_vars_$no_snapped_links bit(1) external aligned, 233 lisp_static_vars_$maknum_data (5) bit(36) aligned ext, 234 lisp_subr_tv_$tv_begin ext bit(36) aligned, 235 lisp_static_vars_$number_gc_ptrs ext fixed bin(17) aligned, /* number of cells to save in lisp_static_vars_ */ 236 lisp_static_vars_$number_of_atomic_constants ext fixed bin(17) aligned, 237 lisp_static_vars_$garbage_collected_ptrs ext fixed bin(71) aligned, /* first cell to be saved */ 238 lisp_static_vars_$garbage_collect_inhibit ext bit(36) aligned, 239 lisp_static_vars_$subr_block_list external pointer, 240 lisp_static_vars_$ignore_faults bit(1) aligned external; 241 242 243 /* M A N I F E S T C O N S T A N T S */ 244 245 dcl already_copied fixed bin(71) static init(-1) aligned, 246 subr_size (-2:3) fixed bin static init(4,0,2,6,4,6), /* Size of blocks in subrs */ 247 unsnapped_array_link_instruction bit(36) static init("001000000001010110010111010001010000"b); 248 249 250 /* E X T E R N A L E N T R I E S C A L L E D */ 251 252 dcl lisp_alloc_$init_alloc entry(ptr,fixed bin,ptr,fixed bin), 253 cu_$cl entry, 254 lisp_save_alm_ entry(pointer, pointer), /* fast chain chaser written in alm */ 255 lisp_get_atom_ entry(char(*), fixed bin(71)), 256 (lisp_io_control_$set_for_save, lisp_io_control_$empty_all_buffers) entry, 257 lisp_garbage_collector_ entry, 258 lisp_alloc_$rehash_maknum entry, 259 lisp_garbage_collector_$set_gc_params entry, 260 lisp_segment_manager_$get_lists entry(ptr), 261 lisp_segment_manager_$free_lists entry(ptr), 262 lisp_segment_manager_$get_array entry(ptr), 263 lisp_segment_manager_$free_array entry(ptr), 264 expand_pathname_$add_suffix entry (char(*), char(*), char(*), char(*), fixed bin(35)), 265 pathname_ entry (char(*), char(*)) returns(char(168)), 266 com_err_ entry options(variable), 267 msf_manager_$open entry (char (*), char(*), ptr, fixed bin(35)), 268 hcs_$get_link_target entry (char(*), char(*), char(*), char(*), fixed bin(35)), 269 msf_manager_$get_ptr entry (ptr, fixed bin, bit(1), ptr, fixed bin(24), fixed bin(35)), 270 msf_manager_$close entry (ptr), 271 hcs_$get_max_length_seg entry(pointer, fixed bin(19), fixed bin(35)), 272 tssi_$get_file entry (char (*), char (*), ptr, ptr, ptr, fixed bin(35)), 273 tssi_$finish_file entry (ptr, fixed bin, fixed bin(24), bit(36) aligned, ptr, fixed bin(35)); 274 275 276 /* B U I L T I N */ 277 278 dcl (addr,addrel,baseno,baseptr,binary,bit,divide,fixed,min,mod,null,size,ptr,rel,unspec,substr,string) builtin; 279 2 1 /* lisp stack header format */ 2 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 2 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 2 4 2 5 declare 2 6 2 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 2 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 2 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 2 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 2 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 2 12 2 array_pointer ptr, /* obsolete */ 2 13 2 nil fixed bin(71), /* object for nil */ 2 14 2 true fixed bin(71), /* object for t */ 2 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 2 16 2 padding0 bit(36), /* double word boundary preservation */ 2 17 2 bind_op ptr, /* pointers to operators for run-time support */ 2 18 2 unbind_op ptr, 2 19 2 errset1_op ptr, 2 20 2 errset2_op ptr, 2 21 2 unerrset_op ptr, 2 22 2 call_op ptr, 2 23 2 catch1_op ptr, 2 24 2 catch2_op ptr, 2 25 2 uncatch_op ptr, 2 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 2 27 2 system_lp ptr, /* pointer to the system's linkage section */ 2 28 2 iogbind_op ptr, 2 29 2 unseen_go_tag_op ptr, 2 30 2 throw1_op ptr, 2 31 2 throw2_op ptr, 2 32 2 signp_op ptr, 2 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 2 34 2 return_op ptr, 2 35 2 err_op ptr, 2 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 2 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 2 38 2 cons_opr ptr, /* cons operator */ 2 39 2 ncons_opr ptr, /* ncons operator */ 2 40 2 xcons_opr ptr, /* xcons operator */ 2 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 2 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 2 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 2 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 2 45 2 link_op ptr, 2 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 2 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 2 48 2 store_operator pointer, /* operator to do compiled store */ 2 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 2 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 2 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 2 52 2 padding bit(36), 2 53 2 array_link_snap_opr pointer, 2 54 2 create_string_desc_op ptr, 2 55 2 create_array_desc_op ptr, 2 56 2 pl1_call_op ptr, 2 57 2 cons_string_op ptr, 2 58 2 create_varying_string_op ptr, 2 59 2 unwp1_op ptr, 2 60 2 unwp2_op ptr, 2 61 2 ununwp_op ptr, 2 62 2 irest_return_op ptr, 2 63 2 pl1_call_nopop_op ptr, 2 64 2 rcv_char_star_op ptr, 2 65 2 spare2 (7) ptr, 2 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 2 67 2 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 2 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 2 70 2 71 /* end stack segment format */ 280 3 1 /* Include file lisp_bignum_fmt.incl.pl1 */ 3 2 3 3 dcl 1 lisp_bignum based aligned, /* structure describing lisp big number */ 3 4 2 sign bit(18) unaligned, /* either all ones, or all zeros */ 3 5 2 prec fixed bin(17) unaligned, /* number of words in this number's precision */ 3 6 2 words(0 refer(lisp_bignum.prec)) fixed bin(35); /* 35 significant bits per word. */ 3 7 3 8 /* End include file lisp_bognum_fmt.incl.pl1 */ 281 4 1 /* Include file describing the data related to the free storage allocation package */ 4 2 4 3 dcl lisp_alloc_$alloc_fault_word ext bit(36) aligned, 4 4 alloc_fault_word bit(36) defined ( lisp_alloc_$alloc_fault_word), 4 5 lisp_alloc_$alloc_info bit(288) aligned ext, /* info to save for recursiveness of lisp */ 4 6 4 7 /* FAULT BIT MASKS FOR FAULT BITS IN ALLOC_FAULT_WORD 4 8* THE FAULT CODES ARE: 4 9* 6 ft3 - car or cdr of number 4 10* 5 mme4 - array oob 4 11* 4 quit 4 12* 2 alrm 4 13* 1 cput 4 14* */ 4 15 4 16 4 17 quit_fault bit(36) static init ("000000000000000000000000000000000100"b), 4 18 alrm_fault bit(36) static init ("000000000000000000000000000000000010"b), 4 19 cput_fault bit(36) static init ("000000000000000000000000000000000001"b), 4 20 4 21 fault_mask bit(36) static init ("000000000000000000000000000000000111"b), 4 22 lisp_alloc_$gc_blk_cntr ext fixed bin, /* number of 16k blocks before next gc. */ 4 23 lisp_alloc_$seg_blk_cntr ext fixed bin, /* number of 16k blocks to end of segment */ 4 24 lisp_alloc_$consptr ext ptr aligned, /* pointer to ad tally word */ 4 25 1 consptr_ovly based (addr(lisp_alloc_$consptr)) aligned, /* overlay to set further modification field of pointer */ 4 26 2 padding bit(66) unal, 4 27 2 mod bit(6) unal, 4 28 lisp_alloc_$cur_seg ext ptr aligned, /* pointer to current allocation segment */ 4 29 4 30 1 alloc_segment based aligned, /* structure of a free storage segment */ 4 31 2 next_seg ptr, /* chain to next older segment */ 4 32 2 tally_word, /* ad tally word */ 4 33 3 seg_offset bit(18) unal, /* next address in this seg to be allocated */ 4 34 3 tally bit(12) unal, /* decremented once for every 4 words, 16k runout */ 4 35 3 delta fixed bin(5) unal, /* should be set to 4, the size of a cons */ 4 36 2 pad bit(36), 4 37 2 first_allocatable_word bit(72); 4 38 4 39 /* end include file describing free storage structure */ 282 5 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 5 2 5 3 /* This include file describes the format of the 'iochan' block, 5 4* which is used to implement lisp file-objects. The iochan 5 5* is the central data base of the i/o system. When open 5 6* is used, an iochan is created in lisp static storage. 5 7* When the lisp environment is booted, 2 iochans for input and 5 8* output on the tty are created. Iochans are saved and restored 5 9* by the save mechanism */ 5 10 5 11 /* open i/o channel information */ 5 12 5 13 dcl 1 iochan based aligned, /* format of a file object */ 5 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 5 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 5 16 2 ioptr pointer, /* -> block */ 5 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 5 18 2 fcbp pointer, /* for tssi_ */ 5 19 2 aclinfop pointer, /* .. */ 5 20 2 component fixed bin, /* .. */ 5 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 5 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 5 23 2 flags unaligned, 5 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 5 25 3 read bit(1), /* 0 => openi, 1 => not */ 5 26 3 write bit(1), /* 0 => openo, 1 => not */ 5 27 3 gc_mark bit(1), /* for use by the garbage collector */ 5 28 3 interactive bit(1), /* 1 => input => this is the tty 5 29* output => flush buff after each op */ 5 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 5 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 5 32 3 charmode bit(1), /* enables instant ios_$write */ 5 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 5 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 5 35 3 image_mode bit(1), /* just suppresses auto-cr */ 5 36 3 not_yet_used bit(25), 5 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 5 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 5 39 2 name char(32) unaligned, /* stream name or entry name */ 5 40 2 pagel fixed bin, /* number of lines per page */ 5 41 2 linenum fixed bin, /* current line number, starting from 0 */ 5 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 5 43 5 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 5 45 "111011110111111111"b); 5 46 5 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 283 6 1 /******************** lisp_subr_fmt.incl.pl1 ****************************/ 6 2 6 3 6 4 /* Include file describing the format 6 5* of a lisp subroutine link. This format is designed 6 6* to appear just like a standard ft2 link, so the linker 6 7* can do link snapping for us */ 6 8 6 9 6 10 dcl 1 lisp_subr_ based aligned, 6 11 2 subr_nargs fixed bin(17) unaligned, 6 12 2 flags fixed bin(17) unaligned, 6 13 2 link_ptr, /* the its pointer will be created here */ 6 14 3 header_ptr fixed bin(17) unaligned, /* self relative pointer to definitions 6 15* pointer */ 6 16 3 pad bit(12) unaligned, /* = 0 */ 6 17 3 ft2 bit(6) unaligned, /* = o46 */ 6 18 3 exp_ptr bit(18) unaligned, /* pointer to exp word relative to definitions */ 6 19 3 rest_of_link_ptr bit(18) unaligned, /* = 0 */ 6 20 2 exp_word, 6 21 3 type_pair_ptr bit(18) unaligned, /* offset of type_pair below, from def_ptr */ 6 22 3 expr_word bit(18) unaligned, /* value of offset from symbol, will be ""b */ 6 23 2 type_pair, 6 24 3 type_no bit(18) unaligned, /* type of link - set to 4 for lisp */ 6 25 3 trap_ptr bit(18) unaligned, /* for trapbforlink, set to 0 for lisp */ 6 26 3 segname_ptr bit(18) unaligned, /* relative offset of segname in definitions */ 6 27 3 entname_ptr bit(18) unaligned,/* relative offset of entname in definitions */ 6 28 2 acc_seg_name, 6 29 3 segnamel bit(9) unaligned, /* length of acc string */ 6 30 3 segname char(0 refer(segnamel)) unaligned, 6 31 1 acc_ent_name based aligned, /* entry name overlay */ 6 32 2 entnamel bit(9) unaligned, /* length of acc string */ 6 33 2 entname char(0 refer(entnamel)) unaligned, /* entry name */ 6 34 1 lisp_subr_for_call based aligned, /* used to call through this link */ 6 35 2 subr_entry ptr; /* this is the faulting link noted above */ 6 36 6 37 6 38 /********************** end lisp_subr_fmt.incl.pl1 **********************/ 284 7 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 7 2* describes format of storage for lisp 7 3* character strings. 7 4* D. Reed 4/1/71 */ 7 5 7 6 dcl 1 lisp_string based aligned, 7 7 2 string_length fixed bin, 7 8 2 string char(1 refer(string_length)); 7 9 7 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 285 8 1 /* Include file lisp_cons_fmt.incl.pl1; 8 2* defines the format for a cons within the lisp system 8 3* D.Reed 4/1/71 */ 8 4 8 5 dcl consptr ptr, 8 6 1 cons aligned based (consptr), /* structure defining format for cons */ 8 7 2 car fixed bin(71), 8 8 2 cdr fixed bin(71), 8 9 8 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 8 11 2 car ptr, 8 12 2 cdr ptr, 8 13 8 14 8 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 8 16 2 padding bit(21) unaligned, 8 17 2 car bit(9) unaligned, 8 18 2 padding2 bit(63) unaligned, 8 19 2 cdr bit(9) unaligned, 8 20 2 padend bit(42) unaligned; 8 21 8 22 dcl 1 cons_types36 aligned based, 8 23 2 car bit(36), 8 24 2 pada bit(36), 8 25 2 cdr bit(36), 8 26 2 padd bit(36); 8 27 8 28 8 29 /* end include file lisp_cons_fmt.incl.pl1 */ 286 9 1 /* Include file lisp_ptr_fmt.incl.pl1; 9 2* describes the format of lisp pointers as 9 3* a bit string overlay on the double word ITS pair 9 4* which allows lisp to access some unused bits in 9 5* the standard ITS pointer format. It should be noted that 9 6* this is somewhat of a kludge, since 9 7* it is quite machine dependent. However, to store type 9 8* fields in the pointer, saves 2 words in each cons, 9 9* plus some efficiency problems. 9 10* 9 11* D.Reed 4/1/71 */ 9 12 /* modified to move type field to other half of ptr */ 9 13 /* D.Reed 5/31/72 */ 9 14 9 15 9 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 9 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 9 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 9 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 9 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 9 21 2 type bit(9) unaligned, /* type field */ 9 22 2 itsmod bit(6) unaligned, 9 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 9 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 9 25 9 26 /* manifest constant strings for testing above type field */ 9 27 9 28 ( 9 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 9 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 9 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 9 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 9 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 9 34 Bignum init("000001000"b), /* a multiple-precision number */ 9 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 9 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 9 37* means a special internal uncollectable weird object */ 9 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 9 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 9 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 9 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 9 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 9 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 9 44 ) bit(9) static, 9 45 9 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 9 47 9 48 9 49 ( 9 50 Cons36 init("000000000000000000000000000000"b), 9 51 Fixed36 init("000000000000000000000100000000"b), 9 52 Float36 init("000000000000000000000010000000"b), 9 53 Atsym36 init("000000000000000000000001000000"b), 9 54 Atomic36 init("000000000000000000000111111100"b), 9 55 Bignum36 init("000000000000000000000000001000"b), 9 56 System_Subr36 9 57 init("000000000000000000000000000100"b), 9 58 Bigfix36 init("000000000000000000000000001000"b), 9 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 9 60 NotConsOrAtsym36 9 61 init("000000000000000000000110111111"b), 9 62 SubrNumeric36 9 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 9 64 String36 init("000000000000000000000000100000"b), 9 65 Subr36 init("000000000000000000000000010000"b), 9 66 File36 init("000000000000000000000000000001"b), 9 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 9 68 9 69 /* undefined pointer value is double word of zeros */ 9 70 9 71 Undefined bit(72) static init(""b); 9 72 9 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 287 10 1 /* MACLISP Compiled SUBR Block */ 10 2 10 3 dcl 1 subr_block_head based aligned, /* this is the first part of the subr block */ 10 4 2 next_compiled_block ptr, /* for xctblt */ 10 5 2 instructions(4) bit(36), /* the common entry code */ 10 6 2 subr_code_link_offset bin(17) unal, /* points to subr code link */ 10 7 2 rest_of_tsplp bit(18) unal, /* tsplp ,ic* */ 10 8 2 gcmark bit(18) unal, /* for garbage collector to remember seeing this block */ 10 9 2 gc_length fixed bin(17) unal, /* number garbage collectable objects */ 10 10 2 constants(1000) fixed bin(71); /* the compiled constants */ 10 11 10 12 /* alternate declaration of above */ 10 13 10 14 dcl 1 subr_block_head_overlay based aligned, 10 15 2 first_word bit(36), 10 16 2 second_word aligned, 10 17 3 padding bit(28) unaligned, 10 18 3 no_links_are_snapped bit(1) unaligned, /* "1"b if no itp links in this block have been snapped */ 10 19 3 more_padding bit(7) unaligned; 10 20 10 21 10 22 10 23 dcl 1 lisp_subr_links(1000) based aligned, /* the subr links follow the constants, and are the last gc'ed items */ 10 24 2 itp_base bit(3) unal, 10 25 2 itp_info bit(27) unal, /* produced by compiler */ 10 26 2 itp_mod bit(6) unal, 10 27 2 link_opr_tv_offset bit(18) unal, 10 28 2 mbz bit(12) unal, 10 29 2 further_mod bit(6) unal; /* when itp; this is indirect */ 10 30 10 31 10 32 dcl 1 subr_entries(1000) based aligned, /* these are next in block, not gc'able */ 10 33 2 nargs bit(18) unal, 10 34 2 code_offset bit(18) unal, /* offset of entrypoint in object segment */ 10 35 2 head_offset bin(17) unal, /* offset to common entry sequence in subr_block_head */ 10 36 2 rest_of_tsx0 bit(18) unal; /* tsx0 ,ic */ 10 37 10 38 10 39 dcl 1 link_to_subr_code based aligned, /* used by lisp_linker_ to find object segment */ 10 40 2 itp_to_linker ptr, /* points to linker, reset by linker to point to base of object seg */ 10 41 2 compilation_time fixed bin(71), /* used to verify linking to correct segment */ 10 42 2 name_length fixed bin(24), /* length of subroutines name...both segname and ename */ 10 43 2 name char(0 refer(link_to_subr_code.name_length)) unal; 10 44 10 45 dcl instructions_for_subr (4) bit(36) static init("000000000000000100110010111000001111"b, 10 46 "001111111111111100110101000001001111"b, 10 47 "001111111111111110010101010001001111"b, 10 48 "111111111111111110111010000000001000"b), 10 49 tsplp_ic_ind bit(18) static init("110111000000010100"b), 10 50 tsx0_ic bit(18) static init("111000000000000100"b); 10 51 10 52 dcl 1 array_links (1000) aligned based, /* come after entries, before link_to_subr_code */ 10 53 2 instruction bit(36) aligned, /* tspbp to array_link_snap operator 10 54* or eppbb *+2,* when snapped */ 10 55 2 control_word unaligned, /* controls what to snap to */ 10 56 3 type fixed bin(8), /* 0=S-expr, 2=fixnum, 3=flonum */ 10 57 3 ndims fixed bin(8), 10 58 3 atomic_symbol fixed bin(17), /* offset in constants to symbol which names array */ 10 59 2 pointer pointer; /* -> array_info block when snapped */ 10 60 10 61 dcl 1 array_link_count aligned based, /* comes after array_links, before link_to_subr_code */ 10 62 2 unused bit(36), 10 63 2 number_of_array_links fixed bin(17) unaligned, 10 64 2 must_be_zero bit(18) unaligned; /* 0 to distinguish from tsx0 in subr block with no array links */ 10 65 10 66 /* End of description of Compiled SUBR Block */ 288 11 1 /* Include file lisp_atom_fmt.incl.pl1; 11 2* describes internal format of atoms in the lisp system 11 3* D.Reed 4/1/71 */ 11 4 11 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 11 6 2 value fixed bin(71), /* atom's value */ 11 7 2 plist fixed bin(71), /* property list */ 11 8 2 pnamel fixed bin, /* length of print name */ 11 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 11 10 11 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 11 12 2 value ptr, 11 13 2 plist ptr, 11 14 11 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 11 16 2 value bit(72), 11 17 2 plist bit(72); 11 18 11 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 289 290 12 1 /* Include file lisp_common_vars.incl.pl1; 12 2* describes the external static variables which may be referenced 12 3* by lisp routines. 12 4* D. Reed 4/1/71 */ 12 5 12 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 12 7 2 cclist_ptr ptr, /* pointer to list of constants kept 12 8* by compiled programs */ 12 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 12 10 12 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 12 12 err_recp ptr defined (lisp_static_vars_$err_recp), 12 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 12 14 lisp_static_vars_$eval_frame ptr ext static, 12 15 lisp_static_vars_$prog_frame ptr ext aligned, 12 16 lisp_static_vars_$err_frame ptr ext aligned, 12 17 lisp_static_vars_$catch_frame ptr ext aligned, 12 18 lisp_static_vars_$unwp_frame ptr ext aligned, 12 19 lisp_static_vars_$stack_ptr ptr ext aligned, 12 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 12 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 12 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 12 23 lisp_static_vars_$binding_top ptr ext aligned, 12 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 12 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 12 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 12 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 12 28 binding_top ptr defined (lisp_static_vars_$binding_top), 12 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 12 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 12 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 12 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 12 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 12 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 12 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 12 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 12 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 12 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 12 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 12 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 12 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 12 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 12 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 12 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 12 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 12 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 12 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 12 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 12 49 12 50 12 51 /* end include file lisp_common_vars.incl.pl1 */ 291 13 1 /* lisp_maknum_table.incl.pl1 */ 13 2 13 3 dcl 1 maknum_table(0:divide(lisp_static_vars_$maknum_mask,8,24,0)) based(lisp_static_vars_$maknum_table_ptr) aligned, 13 4 2 first, 13 5 3 uid bit(27) unal, 13 6 3 type bit(9) unal, 13 7 2 second, 13 8 3 segno fixed bin(17) unal, 13 9 3 offset bit(18) unal, 13 10 13 11 1 maknum_table_ptrs(0:divide(lisp_static_vars_$maknum_mask,8,24,0)) based(lisp_static_vars_$maknum_table_ptr) aligned, 13 12 2 first, 13 13 3 uid bit(27) unal, 13 14 3 type bit(9) unal, 13 15 2 second ptr unal, 13 16 lisp_static_vars_$maknum_table_ptr ptr ext, 13 17 lisp_static_vars_$maknum_mask fixed bin(24) ext, /* 8*dim(maknum_table)-1 */ 13 18 lisp_static_vars_$maknum_left fixed bin(17) ext; 13 19 /* when calling rehash_maknum, contains number of entries in maknum_table */ 13 20 13 21 /* end maknum_table.incl.pl1 */ 292 293 294 /* 295* 296*/* entry to save the current lisp environment at path specified by arg */ 297 298 call expand_pathname_$add_suffix (arg, "sv.lisp", dir, ent, code); 299 if code ^= 0 then go to crump; 300 call tssi_$get_file(dir,ent,segptr,acinfo,file_control_ptr,code); /* get segment for result */ 301 if code ^= 0 then go to crump; 302 call hcs_$get_max_length_seg(segptr, segment_size, code); 303 if code ^= 0 then go to crump; 304 305 lisp_static_vars_$ignore_faults = "1"b; /* can't user interrupt, since 306* we're going to destroy the env. */ 307 call lisp_io_control_$empty_all_buffers; /* set up the I/O system for saving */ 308 call lisp_io_control_$set_for_save; 309 list_of_iochans = null; 310 list_of_subr_blocks = null; 311 stack = ptr(stack_ptr,0); 312 bucketno = lisp_static_vars_$number_gc_ptrs; /* numbeer of things saved */ 313 314 /* generate header for save file */ 315 316 segptr -> saved_env.flag = -1; /* flag that this is new format */ 317 segptr -> saved_env.version_number = 3; 318 amount_of_maknum_data = 5; 319 amount_of_gensym_data = 2; 320 segptr -> saved_env.gensym_data(*) = ptr(unmkd_ptr, ""b) -> stack_seg.gensym_data(*); 321 segptr -> saved_env.atomic_constants.length = lisp_static_vars_$number_of_atomic_constants + 1; /* allow for obarray */ 322 segptr -> saved_env.atomic_constants.offset = fixed(rel(addr(segptr -> saved_env.seg_type(300))), 18); /* ?? */ 323 if mod(segptr -> saved_env.atomic_constants.offset, 2) ^= 0 324 then segptr -> saved_env.atomic_constants.offset = segptr -> saved_env.atomic_constants.offset + 1; 325 segptr -> saved_env.rest_of_gc_area.offset = segptr -> saved_env.atomic_constants.offset + 326 2 * segptr -> saved_env.atomic_constants.length; 327 segptr -> saved_env.rest_of_gc_area.length = lisp_static_vars_$number_gc_ptrs - segptr -> saved_env.atomic_constants.length; 328 segptr -> saved_env.offset_to_first_seg = segptr -> saved_env.rest_of_gc_area.offset + 329 2 * segptr -> saved_env.rest_of_gc_area.length; 330 331 temp_ptr_0 = addr(lisp_static_vars_$garbage_collected_ptrs); 332 333 newsegptr = addrel(segptr, segptr -> saved_env.atomic_constants.offset); 334 words_left = segment_size - segptr -> saved_env.atomic_constants.offset; 335 do while(bucketno > 0); 336 bucketno = bucketno - 1; 337 curptr = temp_ptr_0 -> Array_Data; /* next ptr */ 338 retad = main_loop; 339 go to copy; 340 main_loop: newsegptr->Array_Data = curptr; 341 newsegptr = addrel(newsegptr,2); 342 words_left = words_left - 2; 343 temp_ptr_0 = addrel(temp_ptr_0,2); 344 end; 345 346 if lisp_static_vars_$maknum_mask = -1 then go to stash_maknum_data; 347 348 lisp_static_vars_$maknum_left = 0; 349 do bucketno = lbound(maknum_table,1) to hbound(maknum_table,1); 350 if string(maknum_table(bucketno).first) 351 then if maknum_table(bucketno).first.type & Numeric 352 then lisp_static_vars_$maknum_left = lisp_static_vars_$maknum_left+1; 353 else do; 354 curptrp = maknum_table_ptrs(bucketno).second; 355 curptr_type = maknum_table(bucketno).first.type; 356 retad = mak_loop; 357 go to copy; 358 mak_loop: maknum_table_ptrs(bucketno).second = curptrp; 359 lisp_static_vars_$maknum_left = lisp_static_vars_$maknum_left+1; 360 end; 361 end; 362 363 Size = size(maknum_table); 364 call allocate; 365 newptrp -> maknum_table(*) = maknum_table(*); 366 lisp_static_vars_$maknum_table_ptr = addr(fakeptr) ->curptrp; /* fake up table ptr */ 367 368 stash_maknum_data: 369 segptr -> saved_env.maknum_data(*) = lisp_static_vars_$maknum_data(*); 370 go to done; 371 372 /* 373* 374*/* pseudo subroutine to do copying of lisp objects. It is recursive, so that 375* arbitrary structures may be copied. recursion is implemented by using the 376* push down stack segment. Note that a destructive copy is made, so lisp 377* must be re-entered to get the resulting environment back */ 378 379 380 copy: if curptr = 0 then go to retad; 381 if curptr_type & Numeric then go to retad; /* if simple object (resides in pointer) then just return */ 382 if curptr_type & String then go to copy_string; /* if string the go to string copy routine */ 383 if curptr_odd /* if odd address, fix to even address...snapped link */ 384 then do; 385 curptr_odd = "0"b; /* make address even */ 386 stack -> return = addr(retad) -> transfer_location; 387 stack -> object = 0; /* just fill it in (?) */ 388 stack = addrel(stack,4); 389 retad = odd_address; 390 end; 391 392 if curptrp -> cons.car = already_copied then do; /* if atomic symbol or cons has been copied, then just return new address, stored in cdr */ 393 curptr = curptrp -> cons.cdr; 394 go to retad; 395 end; 396 if curptr_type & Bigfix then go to copy_bigfix; 397 if curptr_type & File then go to copy_file; 398 if curptr_type & Array then go to copy_array; 399 if curptr_type & Subr then go to copy_subr; /* if subr then go to subr copy routine */ 400 if curptr_type & Atsym then go to copy_atsym; /* if atomic symbol then go to routine to copy it */ 401 402 /* do cons pointers */ 403 404 Size = 4; 405 call allocate; 406 407 newptrp -> cons = curptrp -> cons; /* copy contents */ 408 curptrp -> cons.car = already_copied; 409 curptrp -> cons.cdr = fakeptr; 410 411 copy_file_like_cons: 412 stack -> return = addr(retad) -> transfer_location; 413 stack -> object = newptr; 414 415 common_collector: 416 curptr = newptrp -> cons.car; 417 newptrp -> cons.car = fakeptr; 418 stack = addrel(stack,4); 419 retad = cdr_next; 420 go to copy; 421 cdr_next: stack = addrel(stack,-4); 422 newptr = stack -> object; 423 fakeptr = newptrp -> cons.car; 424 newptrp -> cons.car = curptr; 425 if curptr_type & Numeric then go to do_cdr; 426 addr(newptrp ->cons.car)-> lisp_ptr.chain = ptr(newptrp,0)-> segment.chain; 427 ptr(newptrp,0)-> segment.chain = rel(addr(newptrp ->cons.car)); 428 do_cdr: curptr = newptrp -> cons.cdr; 429 newptrp -> cons.cdr = fakeptr; 430 stack = addrel(stack,4); 431 retad = cons_almost_done; 432 goto copy; 433 cons_almost_done: 434 stack = addrel(stack,-4); 435 newptr = stack -> object; 436 fakeptr = newptrp-> cons.cdr; 437 newptrp-> cons.cdr = curptr; 438 if curptr_type & Numeric then go to cons_done; 439 addr(newptrp->cons.cdr)-> lisp_ptr.chain = ptr(newptrp,0) -> segment.chain; 440 ptr(newptrp,0) -> segment.chain = rel(addr(newptrp->cons.cdr)); 441 cons_done: curptr = fakeptr; 442 addr(retad) -> transfer_location = stack -> return; 443 go to retad; 444 445 446 /* routine to copy atomic symbol, and recursively copy its values */ 447 448 copy_atsym: Size = divide(curptrp -> pnamel + 23,4,17,0); 449 call allocate; 450 newptrp-> copy_mask = curptrp -> copy_mask; 451 fakeptr_type = Atsym; 452 curptrp -> atom.value = already_copied; 453 curptrp -> atom.plist = fakeptr; 454 455 stack -> return = addr(retad) -> transfer_location; 456 stack -> object = newptr; 457 458 if newptrp -> atom_double_words.value = Undefined then go to do_cdr; 459 go to common_collector; 460 copy_string: /* copy a lisp format string */ 461 Size = curptrp -> string_length; 462 if Size < 0 463 then do; 464 curptrp = curptrp -> copied_string.new_fake_address; 465 curptr_type = String; 466 go to retad; 467 end; 468 Size = divide(Size + 7,4,17,0); 469 call allocate; 470 newptrp-> copy_mask = curptrp -> copy_mask; 471 curptrp -> string_length = -5050; /* mark as copied */ 472 curptrp -> copied_string.new_fake_address = addr(fakeptr) -> based_ptr; 473 dcl 1 copied_string based aligned, 474 2 paddup fixed bin, 475 2 new_fake_address ptr unaligned; 476 477 curptr = fakeptr; 478 curptr_type = String; 479 goto retad; 480 481 copy_bigfix: 482 Size = divide(curptrp->lisp_bignum.prec+2,2,18,0)*2; 483 call allocate; 484 newptrp->copy_mask = curptrp->copy_mask; 485 fakeptr_type = curptr_type; 486 curptrp->cons.car = already_copied; 487 curptrp->cons.cdr = fakeptr; 488 curptr = fakeptr; 489 go to retad; 490 491 492 /* copy a subr value into static */ 493 494 copy_subr: 495 if curptr_type & System_Subr 496 then do; 497 addr(curptr)->lisp_ptr.segno = ""b; /* segno of 0 is relative to tv */ 498 addr(curptr)->lisp_ptr.ringnum = ""b; /* unsave needs 0 ring fields */ 499 addr(curptr)->lisp_ptr.offset = addr(curptr)->lisp_ptr.offset - system_tv_offset; 500 go to retad; 501 end; 502 if curptrp -> subr_entries(1).rest_of_tsx0 = tsx0_ic 503 then go to copy_comp_subr; 504 switch = subr_size(curptrp->subr.infop); 505 if curptrp->subr.infop = 3 then switch = switch + 506 curptrp->subr.stat_size-2; 507 defptr = addrel(curptrp,switch); /* get linker info address */ 508 string_ptr = ptr(defptr,defptr->link_info.seg_nam_ptr); 509 Size = divide(string_ptr->acc.len,4,17,0); 510 string_ptr = ptr(defptr,defptr->link_info.ent_nam_ptr); 511 Size = Size + divide(string_ptr->acc.len,4,17,0)+switch+7; /* get totoal Size fo subr block */ 512 call allocate_static; 513 514 newptrp->copy_mask = curptrp->copy_mask; 515 fakeptr_type = curptr_type; /* get type info into symbolic pointer */ 516 curptrp->cons.car = already_copied; 517 curptrp->cons.cdr = fakeptr; /* save new location */ 518 defptr = addrel(newptrp,switch); 519 curptr = fakeptr; 520 defptr->link_info.header_ptr = 2-binary(rel(defptr),18,0); 521 defptr->link_info.ft2 = 100110b; 522 defptr->link_info.def_offset = rel(addr(defptr->link_info.type_pair_ptr)); 523 defptr->link_info.rest = 0; 524 defptr -> link_info.type_pair_ptr = rel(addr(defptr->link_info.class)); 525 defptr -> link_info.seg_nam_ptr = rel(addrel(defptr,5)); 526 defptr -> link_info.ent_nam_ptr = rel(addrel(defptr,6+divide(addrel(defptr,5)->acc.len,4,17,0))); 527 if newptrp->subr.infop ^= 3 then go to retad; /* return if no data to continue with */ 528 newptrp -> subr.gcmark = "0"b; /* zero out word used by garbage collector */ 529 stack -> array_save.Size = newptrp->subr.stat_size-2; 530 stack -> array_save.return_addr = addr(retad)->transfer_location; 531 stack -> array_save.address, defptr = addrel(newptrp,6); 532 retad = array_loop; 533 go to subr_join; 534 535 copy_comp_subr: 536 if curptrp -> subr_entries(1).head_offset = -1 /* means already copied */ 537 then do; 538 newptrp = ptr(baseptr(curptrp -> subr_entries(1).nargs), curptrp -> subr_entries(1).code_offset); 539 addr(newptr) -> lisp_ptr_type = addr(newptr) -> lisp_ptr_type | Subr36; 540 addr(newptr) -> lisp_ptr.ringnum = "000"b; 541 curptr = newptr; 542 go to retad; 543 end; 544 545 defptr = addrel(curptrp, curptrp -> subr_entries(1).head_offset-1); 546 newptrp = addrel(defptr, defptr -> subr_block_head.subr_code_link_offset+6); 547 newptrp -> lisp_subr_links(1).itp_base = "001"b; 548 newptrp -> lisp_subr_links(1).itp_mod = "100001"b; 549 newptrp -> lisp_subr_links(1).link_opr_tv_offset = "000000000001001000"b; 550 newptrp -> lisp_subr_links(1).mbz = "0"b; 551 newptrp -> lisp_subr_links(1).further_mod = "010000"b; 552 newptrp -> lisp_subr_links(1).itp_info = "0"b; 553 Size = defptr -> subr_block_head.subr_code_link_offset + divide(51+newptrp -> link_to_subr_code.name_length,4,35,0); 554 newptrp = addrel(newptrp, -2); /* check for array links */ 555 if newptrp -> array_link_count.must_be_zero = ""b 556 then number_of_array_links = newptrp -> array_link_count.number_of_array_links; 557 else number_of_array_links = -1; 558 call allocate_static; 559 newptrp -> copy_mask = defptr -> copy_mask; 560 561 /* copy the "secret" bit used by (sstatus uuolinks) */ 562 563 newptrp -> subr_block_head_overlay.no_links_are_snapped = 564 defptr -> subr_block_head_overlay.no_links_are_snapped; 565 566 /* thread into list of all the comp subr blocks in the world */ 567 568 unspec (newptrp -> subr_block_head.next_compiled_block)= unspec (list_of_subr_blocks); 569 if list_of_subr_blocks ^= null then do; 570 addr(newptrp -> subr_block_head.next_compiled_block) -> lisp_ptr.chain = ptr(newptrp, 0) -> segment.chain; 571 ptr(newptrp, 0) -> segment.chain = rel(addr(newptrp -> subr_block_head.next_compiled_block)); 572 end; 573 unspec(list_of_subr_blocks) = unspec(fakeptr); 574 575 newptrp -> subr_block_head.gcmark = "0"b; 576 577 addr(fakeptr) -> based_ptr = addr(addr(fakeptr)->based_ptr-> subr_block_head.constants(defptr->subr_block_head.gc_length+1)); 578 temp_ptr = addr(defptr->subr_block_head.constants(defptr->subr_block_head.gc_length+1)); 579 580 Size = divide(newptrp -> subr_block_head.subr_code_link_offset,2,35,0) - newptrp -> subr_block_head.gc_length -1; 581 if number_of_array_links >= 0 then Size = Size - (2*number_of_array_links+1); 582 do switch = 1 to Size; 583 temp_ptr -> subr_entries(switch).nargs = substr(unspec(fakeptr),1,18); 584 temp_ptr -> subr_entries(switch).code_offset = substr(unspec(fakeptr),37,18); 585 temp_ptr -> subr_entries(switch).head_offset = -1; 586 addr(fakeptr) -> based_ptr = addrel(addr(fakeptr) -> based_ptr, 2); 587 end; 588 589 unspec(fakeptr) = curptrp -> subr_entries(1).nargs || "000"b || Subr || "100011"b || curptrp -> subr_entries(1).code_offset; 590 591 /* copy pointers in snapped array links */ 592 593 if number_of_array_links >= 0 then do; 594 temp_ptr = addrel(defptr, defptr -> subr_block_head.subr_code_link_offset+6-2-4*number_of_array_links); 595 temp_ptr_1 = addrel(newptrp, defptr -> subr_block_head.subr_code_link_offset+6-2-4*number_of_array_links); 596 stack -> array_link_save.save_newptr = newptr; 597 stack -> array_link_save.save_fakeptr = fakeptr; 598 stack -> array_link_save.save_return = addr(retad)->transfer_location; 599 stack -> array_link_save.number_of_links_left = number_of_array_links; 600 retad = array_link_loop; 601 array_link_loop_0: 602 stack -> array_link_save.number_of_links_left = stack -> array_link_save.number_of_links_left - 1; 603 if stack -> array_link_save.number_of_links_left < 0 then go to array_link_loop_end; 604 if temp_ptr -> array_links(1).instruction = unsnapped_array_link_instruction 605 then do; 606 temp_ptr = addrel(temp_ptr, 4); /* don't copy pointer since not set */ 607 go to copy_unsnapped_array_link; 608 end; 609 curptrp = temp_ptr -> array_links(1).pointer; 610 unspec(curptrp) = unspec(curptrp) | Array36 | Subr36; 611 temp_ptr = addrel(temp_ptr, 4); 612 stack -> array_link_save.save_temp_ptr = temp_ptr; 613 stack -> array_link_save.save_temp_ptr_1 = temp_ptr_1; 614 stack = addrel(stack, size(array_link_save)); 615 go to copy; 616 array_link_loop: 617 stack = addrel(stack, -size(array_link_save)); 618 temp_ptr = stack -> array_link_save.save_temp_ptr; 619 temp_ptr_1 = stack -> array_link_save.save_temp_ptr_1; 620 addr(fakeptr) -> lisp_ptr.chain = ptr(temp_ptr_1, 0) -> segment.chain; 621 ptr(temp_ptr_1, 0) -> segment.chain = rel(addr(temp_ptr_1 -> array_links(1).pointer)); 622 unspec(temp_ptr_1 -> array_links(1).pointer) = unspec(fakeptr); 623 copy_unsnapped_array_link: 624 temp_ptr_1 = addrel(temp_ptr_1, 4); 625 go to array_link_loop_0; 626 array_link_loop_end: 627 newptr = stack -> array_link_save.save_newptr; 628 fakeptr = stack -> array_link_save.save_fakeptr; 629 addr(retad)->transfer_location = stack -> array_link_save.save_return; 630 end; 631 632 633 stack -> array_save.Size = 2* newptrp -> subr_block_head.gc_length; 634 stack -> array_save.return_addr = addr(retad) -> transfer_location; 635 stack -> array_save.address, defptr = addr(newptrp -> subr_block_head.constants(1)); 636 retad = array_loop; 637 go to subr_join; 638 copy_file: /* copy an iochan. Has to recurse for the two garbage-collectable 639* components function and namelist, and for the thread of all iochans */ 640 641 642 if curptrp -> iochan.gc_mark then do; /* already been copied, ioptr -> the copy */ 643 curptrp = curptrp -> iochan.ioptr; 644 curptr_type = File; 645 go to retad; 646 end; 647 Size = size(iochan); 648 call allocate_static; /* make a copy of this iochan in save seg */ 649 newptrp -> copy_mask = curptrp -> copy_mask; 650 fakeptr_type = File; 651 curptrp -> iochan.gc_mark = "1"b; 652 unspec(curptrp -> iochan.ioptr) = unspec(fakeptr); 653 654 /* maintain a new threaded list of iochans - in list_of_iochans 655* this will replace lisp_static_vars_$iochan_list */ 656 657 unspec (newptrp -> iochan.thread) = unspec (list_of_iochans); 658 if list_of_iochans ^= null then do; 659 addr(newptrp -> iochan.thread)->lisp_ptr.chain = ptr(newptrp, 0) -> segment.chain; 660 ptr(newptrp, 0) -> segment.chain = rel(addr(newptrp -> iochan.thread)); 661 end; 662 unspec(list_of_iochans) = unspec(fakeptr); /* keep ring number in this pointer zero for unsave */ 663 664 /* now collect the function and namelist as if they were a cons */ 665 666 newptrp = addr(newptrp -> iochan.function); 667 go to copy_file_like_cons; 668 669 copy_array: /* copy a lisp array */ 670 671 /* compute number of words in array */ 672 673 if curptrp -> array_info.type < Fixnum_array then Size = 2; 674 else if curptrp -> array_info.type < Obarray_array then Size = 1; 675 else if curptrp -> array_info.type = Obarray_array then Size = 2; 676 else go to copy_dead_array; 677 if curptrp -> array_info.minus_2_times_ndims = 0 /* external array */ 678 then do; 679 curptrp -> array_info.array_data_ptr = null; /* won't work in new process probably */ 680 go to copy_dead_array; 681 end; 682 defptr = curptrp -> array_info.array_data_ptr; 683 do i = -(curptrp -> array_info.ndims) repeat (i+1) while (i < 0); 684 Size = Size * defptr -> array_data.dope_vector(i+1).bounds; 685 end; 686 687 /* compute amount of garbage-collectable stuff */ 688 689 if curptrp -> array_info.type < Fixnum_array then array_data_size = Size; 690 else if curptrp -> array_info.type = Obarray_array then array_data_size = Size; 691 else if curptrp -> array_info.type = Readtable_array then array_data_size = 18; 692 else array_data_size = 0; /* numeric array */ 693 694 dope_vector_size = 2*(curptrp -> array_info.ndims); 695 Size = Size + dope_vector_size; /* allow for dope vector */ 696 call allocate; 697 newptrp->copy_mask = addrel(defptr, -dope_vector_size)->copy_mask; 698 fakeptr2 = fakeptr + 262144*dope_vector_size; /* addrel fakeptr, -> array_data.data */ 699 newptr2 = addrel(newptrp, dope_vector_size); 700 Size = 8; /* create array_info */ 701 call allocate_static; 702 newptrp -> copy_mask = curptrp -> copy_mask; 703 fakeptr_type = curptr_type; 704 unspec(newptrp -> array_info.array_data_ptr) = unspec(fakeptr2); 705 string_ptr = ptr(newptrp, 0); /* put on list of fakeptr's */ 706 addr(newptrp -> array_info.array_data_ptr)-> lisp_ptr.chain = string_ptr -> segment.chain; 707 string_ptr -> segment.chain = rel(addr(newptrp -> array_info.array_data_ptr)); 708 newptrp -> array_info.gc_mark = (18)"0"b; /* zero out gc mark */ 709 710 curptrp -> cons.car = already_copied; /* mark old object */ 711 curptrp -> cons.cdr = fakeptr; /* and remember new loc */ 712 713 stack -> array_save.Size = array_data_size; 714 stack -> array_save.return_addr = addr(retad)->transfer_location; 715 stack -> array_save.address, defptr = newptr2; /* data to be collected */ 716 retad = array_loop; 717 718 subr_join: 719 do while(stack->array_save.Size > 0); 720 curptr = defptr -> Array_Data; /* get next pointer */ 721 if curptr = 0 then; 722 else if curptr_type & Numeric then; 723 else if addr(curptr)->lisp_ptr.itsmod ^= "100011"b then; 724 else do; 725 defptr -> Array_Data = fakeptr; /* save fakeptr */ 726 stack = addrel(stack,6); 727 go to copy; 728 array_loop: stack = addrel(stack,-6); 729 defptr = stack -> array_save.address; 730 string_ptr = ptr(defptr,0); /* segment base ptr */ 731 fakeptr = defptr -> Array_Data; /* restore fakeptr */ 732 defptr -> Array_Data = curptr; /* store copied data */ 733 addr(defptr -> Array_Data)->lisp_ptr.chain = string_ptr->segment.chain; 734 string_ptr->segment.chain = rel(defptr); 735 end; 736 stack -> array_save.Size = stack ->array_save.Size - 2; 737 stack -> array_save.address, defptr = addrel(defptr,2); 738 end; 739 740 addr(retad) -> transfer_location = stack -> array_save.return_addr; 741 curptr = fakeptr; 742 go to retad; 743 744 copy_dead_array: 745 Size = 8; 746 call allocate_static; 747 newptrp -> copy_mask = curptrp -> copy_mask; 748 newptrp -> array_info.gc_mark = ""b; 749 curptrp -> cons.car = already_copied; 750 curptrp -> cons.cdr = fakeptr; 751 curptr = fakeptr; 752 go to retad; 753 754 odd_address: /* fix up odd address pointer here --- array or subr link */ 755 curptr_odd = "1"b; /* make it odd */ 756 stack = addrel(stack,-4); /* pop stack */ 757 addr(retad) -> transfer_location = stack -> return; 758 go to retad; 759 760 /* 761* 762*/* now to finish up, copy temporary segments into segments desired, compacting as you go, 763* and clean up */ 764 765 done: segptr -> saved_env.seg_count = segnumber; 766 segptr -> saved_env.seg_size = segment_size; 767 768 /* save the lists of iochans and new type (comp) subr blocks */ 769 770 unspec (segptr -> saved_env.iochan_list) = unspec (list_of_iochans); 771 unspec (segptr -> saved_env.subr_block_list) = unspec (list_of_subr_blocks); 772 773 segnumber = 0; 774 newsegptr = addrel(segptr, segptr -> saved_env.offset_to_first_seg); /* actually, should be pointing here right now anyway */ 775 do while(first_save_seg ^= ""b); 776 curptrp = baseptr(first_save_seg); 777 first_save_seg = curptrp -> segment.seg_chain; 778 curptrp -> segment.seg_chain = ""b; 779 this_seg_is_static = curptrp -> segment.seg_type; 780 to_be_copied = binary(curptrp -> segment.seg_size,18,0); 781 copy_more: Size = min(to_be_copied,words_left); 782 newsegptr-> copy_mask = curptrp -> copy_mask; 783 words_left = words_left - Size; 784 newsegptr = addrel(newsegptr,Size); 785 to_be_copied = to_be_copied - Size; 786 if to_be_copied > 0 | words_left = 0 then do; 787 curptrp = addrel(curptrp,Size); 788 segnumber = segnumber + 1; 789 pm1: call msf_manager_$get_ptr (file_control_ptr, segnumber, "1"b, segptr, bit_length, code); 790 if segptr = null then do; 791 call com_err_(code, "lisp_save_", "Correct and type start."); 792 call cu_$cl; 793 go to pm1; 794 end; 795 words_left = segment_size; 796 newsegptr = segptr; 797 if to_be_copied > 0 then goto copy_more; 798 end; 799 if this_seg_is_static then call lisp_segment_manager_$free_array(curptrp); 800 else call lisp_segment_manager_$free_lists(curptrp); 801 end; 802 call tssi_$finish_file(file_control_ptr, segnumber,binary(rel(newsegptr),18,0)*36,"1000"b,acinfo,code); 803 return; 804 crump: call com_err_(code,"lisp_save_","Can't save environment at ^a", 805 pathname_ (dir, ent)); 806 return; 807 /* 808* 809*/* internal subroutine to allocate storage in temporary segments, and return "symbolc addresses" 810* in fakeptr, as well as real addresses */ 811 812 allocate: proc; 813 814 /* allocate Size words, set newptr -> actual place allocated, fakeptr to fake 815* pointer to that place which can be put in the saved environment */ 816 817 dcl 818 1 allocation based aligned, 819 2 words(Size) bit(36), 820 2 dbl_word fixed bin(71); 821 822 823 if free_allocptr = null then do; 824 make_seg: segnumber = segnumber + 1; 825 segptr -> saved_env.seg_type(segnumber) = "0"b; 826 call lisp_segment_manager_$get_lists(free_allocptr); 827 fake_lists_seg = bit(fixed(segnumber, 18), 18); 828 if current_save_seg then do; 829 temp_ptr = baseptr(current_save_seg); 830 temp_ptr -> segment.seg_chain = baseno(free_allocptr); 831 end; 832 else first_save_seg = baseno(free_allocptr); 833 current_save_seg = baseno(free_allocptr); 834 free_allocptr -> segment.seg_chain = ""b; 835 free_allocptr -> segment.seg_type = ""b; 836 free_allocptr -> segment.chain = ""b; 837 free_allocptr = addrel(free_allocptr,4); 838 end; 839 840 if binary(rel(free_allocptr),18,0) + Size > segment_size then go to make_seg; 841 842 newptrp = free_allocptr; 843 unspec(fakeptr) = fake_lists_seg || "000000000000100011"b || /* seg idx, its -- ring must be 0 for unsave */ 844 rel(free_allocptr); 845 free_allocptr = addr(free_allocptr -> allocation.dbl_word); 846 ptr(free_allocptr,0) -> segment.seg_size = rel(free_allocptr); 847 return; 848 end; 849 850 /* 851* 852*/* internal routine like "allocate", except that a temporary segment used for static is used 853* for the allocation */ 854 855 allocate_static: proc; 856 857 dcl 1 allocation based aligned, 858 2 words(Size) bit(36), 859 2 dbl_word fixed bin(71); 860 861 if stat_allocptr = null then do; 862 make_seg: segnumber = segnumber + 1; 863 segptr -> saved_env.seg_type(segnumber) = "1"b; 864 call lisp_segment_manager_$get_array(stat_allocptr); 865 fake_array_seg = bit(fixed(segnumber, 18), 18); 866 if current_save_seg then do; 867 temp_ptr = baseptr(current_save_seg); 868 temp_ptr -> segment.seg_chain = baseno(stat_allocptr); 869 end; 870 else first_save_seg = baseno(stat_allocptr); 871 current_save_seg = baseno(stat_allocptr); 872 stat_allocptr -> static_seg_header = static_seg_template; 873 stat_allocptr -> segment.seg_chain = ""b; 874 stat_allocptr -> segment.seg_type = "1"b; 875 stat_allocptr -> segment.chain = ""b; 876 stat_allocptr = addrel(stat_allocptr, size(static_seg_header)+2); 877 end; 878 879 if binary(rel(stat_allocptr),18,0) + Size > segment_size then go to make_seg; 880 newptrp = stat_allocptr; 881 unspec(fakeptr) = fake_array_seg || "000000000000100011"b || /* seg idx, its, ring zero for unsave */ 882 rel(stat_allocptr); 883 stat_allocptr = addr(stat_allocptr -> allocation.dbl_word); 884 ptr(stat_allocptr,0) -> segment.seg_size = rel(stat_allocptr); 885 return; 886 end; 887 888 /* 889* 890*/* routine to unsave a lisp environment which has been saved by the above */ 891 892 unsave: entry(arg,last_stat_seg,last_stat_off,error_code); 893 894 dcl last_stat_seg ptr parameter, /* (output) used to tell make_lisp_subr_block_ about static segs */ 895 last_stat_off fixed bin(18) parameter, /* (output) .. */ 896 error_code fixed bin(35) parameter, /* (output) return code. non zero means couldn't unsave env. */ 897 cur_ring bit(3) aligned, 898 free_size fixed bin; 899 900 error_code = 0; 901 902 /* kludge to fill in validation level in pointer to current validation level */ 903 904 segptr = addr(cur_ring); 905 cur_ring = addr(segptr)->lisp_ptr.ringnum; 906 907 bucketx = 0; /* assume no environment conversion will be necessary */ 908 909 if arg = "" then do; 910 segptr = addr(lisp_standard_environment_$); 911 file_control_ptr = null(); /* remember we got this from special place */ 912 ent = "lisp_standard_environment_"; 913 end; 914 else do; 915 call expand_pathname_$add_suffix (arg, "sv.lisp", dir, ent, code); 916 if code ^= 0 then go to crump_2; 917 call msf_manager_$open (dir, ent, file_control_ptr, code); 918 if code ^= 0 then go to crump_2; 919 call msf_manager_$get_ptr (file_control_ptr, 0, "0"b, segptr, bit_length, code); 920 if segptr = null then go to crump_2; 921 call hcs_$get_link_target (dir, ent, lisp_static_vars_$saved_environment_dir, (32)" ", code); 922 if code ^= 0 then go to crump_2; 923 end; 924 segnumber = segptr -> save_header.seg_count; /* works whether old or new format because first part of structure is the same */ 925 segment_size = binary(segptr -> save_header.seg_size,18,0); 926 bucketno = segptr -> save_header.num_gc_ptrs; /* lisp_static_vars_$number_gc_ptrs at time saved */ 927 if bucketno >= 0 then do; /* old format */ 928 new_format = "0"b; 929 if bucketno ^= lisp_static_vars_$number_gc_ptrs then do; /* Barf! */ 930 call com_err_(0, "lisp_save_", "^a is an old format saved environment. An attempt at conversion will be made.", 931 ent); 932 if bucketno = 0 then do; 933 call com_err_(0, "lisp_save_", "^a is too inconsistent to be converted. Resave it.", 934 ent); 935 error_code = 1; /* Kludge */ 936 return; 937 end; 938 if bucketno > lisp_static_vars_$number_gc_ptrs 939 then do; 940 call com_err_(0, "lisp_save_", "^a cannot be converted.", ent); 941 error_code = 1; /* kludge */ 942 return; 943 end; 944 if bucketno < lisp_static_vars_$number_gc_ptrs 945 then bucketx = bucketno+1; /* excess cruft will have to be filled */ 946 end; 947 948 atomic_constants_addr = addr(segptr -> save_header.next_dbl_word); 949 atomic_constants_count = 104; 950 rest_of_gc_area_addr = addrel(atomic_constants_addr, 208); 951 rest_of_gc_area_count = bucketno - 104; 952 first_seg_ptr = addrel(addr(segptr -> save_header.next_dbl_word), 2 * bucketno); 953 lisp_static_vars_$maknum_mask = -1; 954 end; /* end of old format stuff */ 955 956 else do; /* new format save header */ 957 958 new_format = "1"b; 959 bucketx = 0; /* see about 10 lines before crump_2: */ 960 if segptr -> saved_env.version_number = 1 then do; /* old-arrays version */ 961 amount_of_gensym_data, amount_of_maknum_data = 0; 962 must_convert_arrays = "1"b; 963 lisp_static_vars_$maknum_mask = -1; 964 end; 965 else if segptr -> saved_env.version_number <= 3 then do; /* new-arrays version */ 966 amount_of_gensym_data = 2; 967 if segptr -> saved_env.version_number = 2 968 then do; 969 lisp_static_vars_$maknum_mask = -1; 970 amount_of_maknum_data = 0; 971 end; 972 else do; 973 amount_of_maknum_data = 5; 974 lisp_static_vars_$maknum_data(*) = segptr -> saved_env.maknum_data(*); 975 end; 976 must_convert_arrays = "0"b; 977 ptr(unmkd_ptr, ""b) -> stack_seg.gensym_data(*) = segptr -> saved_env.gensym_data(*); 978 end; 979 else do; /* unreckognized version */ 980 call com_err_(0, "lisp_save_", "^a is in unknown format #^d; resave it.", 981 ent, segptr -> saved_env.version_number); 982 error_code = 1; 983 return; 984 end; 985 986 atomic_constants_addr = addrel(segptr, segptr -> saved_env.atomic_constants.offset); 987 atomic_constants_count = segptr -> saved_env.atomic_constants.length; 988 rest_of_gc_area_addr = addrel(segptr, segptr -> saved_env.rest_of_gc_area.offset); 989 rest_of_gc_area_count = segptr -> saved_env.rest_of_gc_area.length; 990 first_seg_ptr = addrel(segptr, segptr -> saved_env.offset_to_first_seg); 991 end; 992 993 /* check for minor differences between saved lisp_static_vars_ and current lisp_static_vars_ */ 994 995 if (atomic_constants_count > lisp_static_vars_$number_of_atomic_constants + 1) | 996 (rest_of_gc_area_count + atomic_constants_count > lisp_static_vars_$number_gc_ptrs) 997 then call com_err_(0, "lisp_save_", "^a was saved with a newer lisp than you are using.^/If you encounter mysterious errors, try re-saving it.", 998 pathname_ (dir, ent)); 999 1000 1001 1002 /* begin block to allocate space for segment number translation table */ 1003 1004 table_alloc: begin; 1005 dcl segno_table(segnumber) ptr; 1006 dcl new_chain bit(18), 1007 (cur_stat,cur_free) ptr init(null), 1008 no_segs fixed bin init(0), 1009 seg_offset bit(18), 1010 i fixed bin, 1011 j fixed bin, 1012 next_offset fixed bin(18), 1013 newptr ptr, 1014 curptr ptr, 1015 counter fixed bin(18), 1016 switch fixed bin; 1017 1018 1019 /* get all needed segments */ 1020 1021 j = 0; /* msf component number taking from */ 1022 newptr = first_seg_ptr; 1023 if new_format = "0"b then do i = 1 to segnumber; 1024 1025 if newptr -> segment.seg_type 1026 then call lisp_segment_manager_$get_array(segno_table(i)); /* get right type of segment */ 1027 else call lisp_segment_manager_$get_lists(segno_table(i)); 1028 1029 /* now make newptr point at the next segment */ 1030 1031 next_offset = fixed(rel(newptr), 18) + fixed(newptr -> segment.seg_size, 18); 1032 if next_offset + 2 > segment_size then do; /* advance segs */ 1033 next_offset = next_offset - segment_size; /* Note: all segs must be multiple of */ 1034 j = j + 1; /* two words in length or this loses */ 1035 call msf_manager_$get_ptr(file_control_ptr, j, "0"b, newptr, bit_length, code); 1036 if newptr = null() then go to crump_2; 1037 end; 1038 newptr = ptr(newptr, next_offset); 1039 end; 1040 1041 else do i = 1 to segnumber; 1042 if segptr -> saved_env.seg_type(i) 1043 then call lisp_segment_manager_$get_array(segno_table(i)); 1044 else call lisp_segment_manager_$get_lists(segno_table(i)); 1045 end; 1046 1047 /* set lisp_static_vars_$iochan_list from save_header */ 1048 1049 if new_format = "0"b then 1050 if segptr -> save_header.iochan_list = null () 1051 then lisp_static_vars_$iochan_list = null (); 1052 else lisp_static_vars_$iochan_list = ptr(segno_table( 1053 fixed(baseno(segptr -> save_header.iochan_list), 18)), 1054 rel(segptr -> save_header.iochan_list)); 1055 else do; 1056 if segptr -> saved_env.iochan_list = null () 1057 then lisp_static_vars_$iochan_list = null (); 1058 else lisp_static_vars_$iochan_list = ptr(segno_table(fixed(baseno(segptr -> saved_env.iochan_list), 18)), 1059 rel(segptr -> saved_env.iochan_list)); 1060 if segptr -> saved_env.subr_block_list = null () 1061 then lisp_static_vars_$subr_block_list = null (); 1062 else lisp_static_vars_$subr_block_list = ptr(segno_table(fixed(baseno(segptr -> saved_env.subr_block_list), 18)), 1063 rel(segptr -> saved_env.subr_block_list)); 1064 end; 1065 1066 /* unsave atomic_constants portion of lisp_static_vars_ */ 1067 1068 temp_ptr_1 = addr(lisp_static_vars_$garbage_collected_ptrs); 1069 newptr = atomic_constants_addr; 1070 1071 do counter = min(lisp_static_vars_$number_of_atomic_constants+1, atomic_constants_count) 1072 by -1 1073 while (counter > 0); 1074 call copy_1_datum; 1075 end; 1076 1077 1078 copy_1_datum: proc; /* moves one double-word and hacks the segment number */ 1079 1080 temp_ptr_1 -> Array_Data = newptr -> Array_Data; 1081 newptr = addrel(newptr,2); 1082 if temp_ptr_1->lisp_ptr.type & Numeric then; 1083 else do; 1084 if temp_ptr_1->lisp_ptr.segno 1085 then temp_ptr_1->lisp_ptr.segno = 1086 baseno(segno_table(binary(temp_ptr_1->lisp_ptr.segno,18,0))); 1087 else do; 1088 temp_ptr_1->lisp_ptr.segno = system_tv_segno; 1089 temp_ptr_1->lisp_ptr.offset = temp_ptr_1->lisp_ptr.offset + system_tv_offset; 1090 end; 1091 temp_ptr_1 -> lisp_ptr.ringnum = cur_ring; /* for 6180 validation info */ 1092 end; 1093 temp_ptr_1 = addrel(temp_ptr_1,2); 1094 end copy_1_datum; 1095 1096 1097 /* fill in any excess atomic constants that were added to lisp_static_vars_ since this environment 1098* was saved. This has to be done here so temp_ptr_1 will maintain correct values */ 1099 1100 do counter = atomic_constants_count by 1 1101 while (counter <= lisp_static_vars_$number_of_atomic_constants); /* Note - there are two +_ bugs which cancel */ 1102 temp_ptr_1 -> Array_Data = lisp_static_vars_$t_atom; /* almost but not quite right. 1103* However a warning has been typed out */ 1104 temp_ptr_1 = addrel(temp_ptr_1, 2); 1105 end; 1106 1107 1108 /* unsave the other S-expression data in lisp_static_vars_ */ 1109 1110 newptr = rest_of_gc_area_addr; 1111 do counter = min(lisp_static_vars_$number_gc_ptrs - lisp_static_vars_$number_of_atomic_constants - 1, 1112 rest_of_gc_area_count) by -1 while (counter > 0); 1113 call copy_1_datum; 1114 end; 1115 1116 1117 /* fill in any excess stuff in rest_of_gc_area that was added after this environment was saved */ 1118 1119 do counter = rest_of_gc_area_count by 1 1120 while(counter < lisp_static_vars_$number_gc_ptrs - lisp_static_vars_$number_of_atomic_constants - 1); 1121 temp_ptr_1 -> Array_Data = nil; /* see comment on previous reference to t_atom */ 1122 temp_ptr_1 = addrel(temp_ptr_1, 2); 1123 end; 1124 1125 /* unsave the storage segments */ 1126 1127 newptr = first_seg_ptr; 1128 do i = 1 to segnumber; 1129 1130 curptr = segno_table(i); 1131 seg_offset = newptr -> segment.seg_size; 1132 to_be_copied = binary(seg_offset,18,0); 1133 1134 copy_unsave: Size = min(to_be_copied,segment_size-binary(rel(newptr),18,0)); 1135 curptr -> copy_mask = newptr -> copy_mask; 1136 newptr = addrel(newptr,Size); 1137 to_be_copied = to_be_copied - Size; 1138 if to_be_copied > 0 then do; 1139 curptr = addrel(curptr,Size); 1140 no_segs = no_segs + 1; 1141 call msf_manager_$get_ptr(file_control_ptr, no_segs, "0"b, segptr, bit_length, code); 1142 if segptr = null() then go to crump_2; 1143 newptr = segptr; 1144 go to copy_unsave; 1145 end; 1146 1147 /* get chain, and chase down it, fixing up the ITS pointers in the chain */ 1148 1149 curptr = segno_table(i); 1150 new_chain = curptr -> segment.chain; 1151 if curptr -> segment.seg_type = ""b then do; 1152 curptr -> alloc_segment.next_seg = cur_free; 1153 cur_free = curptr; 1154 free_size = binary(seg_offset,18,0); 1155 end; 1156 else do; 1157 if cur_stat = null then curptr -> static_seg_header.chain_pointer = null; 1158 else curptr -> static_seg_header.chain_pointer = ptr(cur_stat,0); 1159 curptr -> static_seg_header.def_pointer = curptr; /* set definitions pointer for links */ 1160 cur_stat = ptr(curptr,seg_offset); 1161 end; 1162 1163 /***** Following 13 lines commented out and replaced by call to alm routine 1164*/* do while(new_chain); 1165*/* curptr = ptr(curptr,new_chain); 1166*/* new_chain = curptr -> lisp_ptr.chain; 1167*/* if curptr -> lisp_ptr.segno /* check for offset in tv */ 1168 /* then curptr -> lisp_ptr.segno = baseno(segno_table(binary(curptr->lisp_ptr.segno,18,0))); 1169*/* else do; 1170*/* curptr -> lisp_ptr.segno = system_tv_segno; 1171*/* curptr -> lisp_ptr.offset = curptr -> lisp_ptr.offset + system_tv_offset; 1172*/* end; 1173*/* curptr -> lisp_ptr.ringnum = cur_ring; /* make sure validation of indirection 1174*/* is for current ring! */ 1175 /* curptr -> lisp_ptr.chain = "0"b; 1176*/* end; 1177*/***** End of commented out section *****/ 1178 1179 call lisp_save_alm_(ptr(curptr, new_chain), addr(segno_table)); /* fix all its pairs in this seg */ 1180 1181 end; 1182 1183 /* inform allocation routines of new environment */ 1184 1185 free_size = 4*divide(free_size+3,4,17,0); 1186 lisp_alloc_$cur_seg = cur_free; 1187 lisp_alloc_$consptr = addr(cur_free -> alloc_segment.tally_word); 1188 consptr_ovly.mod = "101011"b; 1189 cur_free -> alloc_segment.tally_word.seg_offset = bit(binary(free_size,18,0),18); 1190 cur_free -> alloc_segment.tally_word.tally = bit(binary(divide(mod(-1020-free_size,16384),4,18,0),12,0),12); 1191 cur_free -> alloc_segment.tally_word.delta = 4; 1192 lisp_alloc_$seg_blk_cntr = divide(free_size+1024,16384,17,0) - 16; 1193 call lisp_garbage_collector_$set_gc_params; 1194 last_stat_seg = ptr(cur_stat,0); 1195 last_stat_off = binary(rel(cur_stat),18,0); 1196 1197 if new_format = "0"b then do; 1198 1199 /* pick up list of all subr blocks out of header of last static seg */ 1200 1201 lisp_static_vars_$subr_block_list = last_stat_seg -> static_seg_kludge.saved_list_of_subr_blocks; 1202 last_stat_seg -> static_seg_kludge.saved_list_of_subr_blocks = null; 1203 end; 1204 1205 /* put maknum stuff in */ 1206 1207 1208 if lisp_static_vars_$maknum_mask ^= -1 1209 then do; 1210 lisp_static_vars_$maknum_table_ptr = ptr(segno_table( 1211 fixed(baseno(lisp_static_vars_$maknum_table_ptr),18)), 1212 rel(lisp_static_vars_$maknum_table_ptr)); 1213 do counter = lbound(maknum_table,1) to hbound(maknum_table,1); 1214 if string(maknum_table(counter).first) 1215 then if maknum_table(counter).first.type &Numeric 1216 then; 1217 else maknum_table(counter).second.segno = fixed(baseno(segno_table( 1218 maknum_table(counter).second.segno)),18); 1219 end; 1220 lisp_static_vars_$garbage_collect_inhibit = "1"b; 1221 call lisp_alloc_$rehash_maknum; 1222 lisp_static_vars_$garbage_collect_inhibit = "0"b; 1223 end; 1224 1225 1226 1227 if file_control_ptr ^= null() /* check to see if we used not standard environment */ 1228 then call msf_manager_$close(file_control_ptr); 1229 end table_alloc; 1230 1231 1232 /* clear no snapped links flag since we're not sure if we 1233* just unsaved some snapped links */ 1234 1235 lisp_static_vars_$no_snapped_links = "0"b; 1236 1237 /* code to fill in slots in lisp_static_vars_ that weren't unsaved into - only when converting 1238* old environment */ 1239 1240 if bucketx ^= 0 then do; /* need to fill in end of lisp_static_vars_ */ 1241 1242 call lisp_get_atom_("++inserted-due-to-conversion-from-old-format++", curptr); /* KLUDGE, */ 1243 curptrp -> atom.value = nil; /* but seems best way to avoid lossage */ 1244 do while (bucketx ^= lisp_static_vars_$number_gc_ptrs); 1245 addr(lisp_static_vars_$garbage_collected_ptrs) -> temp(bucketx) = curptr; 1246 end; 1247 end; 1248 1249 /* if necessary, do a garbage collection to convert from old arrays to new arrays */ 1250 1251 if must_convert_arrays then do; 1252 call com_err_(0, "lisp_save_", "Converting from old arrays to new arrays."); 1253 call lisp_garbage_collector_; 1254 end; 1255 return; 1256 crump_2: call com_err_(code,"lisp_save_","Can't reload environment from ^a",ent); 1257 error_code = code; 1258 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.5 lisp_save_.pl1 >special_ldd>on>06/27/83>lisp_save_.pl1 188 1 03/27/82 0437.1 lisp_array_fmt.incl.pl1 >ldd>include>lisp_array_fmt.incl.pl1 280 2 06/29/83 1425.3 lisp_stack_seg.incl.pl1 >ldd>include>lisp_stack_seg.incl.pl1 281 3 03/27/82 0437.0 lisp_bignum_fmt.incl.pl1 >ldd>include>lisp_bignum_fmt.incl.pl1 282 4 03/27/82 0437.0 lisp_free_storage.incl.pl1 >ldd>include>lisp_free_storage.incl.pl1 283 5 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 284 6 03/27/82 0436.9 lisp_subr_fmt.incl.pl1 >ldd>include>lisp_subr_fmt.incl.pl1 285 7 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 286 8 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 287 9 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 288 10 03/27/82 0437.0 lisp_comp_subr_block.incl.pl1 >ldd>include>lisp_comp_subr_block.incl.pl1 289 11 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 291 12 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 292 13 03/27/82 0437.0 lisp_maknum_table.incl.pl1 >ldd>include>lisp_maknum_table.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) Array constant bit(9) initial unaligned dcl 9-17 ref 398 Array36 constant bit(36) initial dcl 9-17 ref 610 Array_Data based fixed bin(71,0) dcl 95 set ref 337 340* 720 725* 731 732* 733 1080* 1080 1102* 1121* Atomic internal static bit(9) initial unaligned dcl 9-17 Atomic36 internal static bit(36) initial dcl 9-17 Atsym constant bit(9) initial unaligned dcl 9-17 ref 400 451 Atsym36 internal static bit(36) initial dcl 9-17 Bigfix constant bit(9) initial unaligned dcl 9-17 ref 396 Bigfix36 internal static bit(36) initial dcl 9-17 Bignum internal static bit(9) initial unaligned dcl 9-17 Bignum36 internal static bit(36) initial dcl 9-17 Cons internal static bit(9) initial unaligned dcl 9-17 Cons36 internal static bit(36) initial dcl 9-17 Dead_array internal static fixed bin(17,0) initial dcl 1-20 File constant bit(9) initial unaligned dcl 9-17 ref 397 644 650 File36 internal static bit(36) initial dcl 9-17 Fixed internal static bit(9) initial unaligned dcl 9-17 Fixed36 internal static bit(36) initial dcl 9-17 Fixnum_array constant fixed bin(17,0) initial dcl 1-20 ref 669 689 Float internal static bit(9) initial unaligned dcl 9-17 Float36 internal static bit(36) initial dcl 9-17 Flonum_array internal static fixed bin(17,0) initial dcl 1-20 NotConsOrAtsym36 internal static bit(36) initial dcl 9-17 Numeric constant bit(9) initial unaligned dcl 9-17 ref 350 381 425 438 722 1082 1214 Numeric36 internal static bit(36) initial dcl 9-17 Obarray_array constant fixed bin(17,0) initial dcl 1-20 ref 674 675 690 Readtable_array constant fixed bin(17,0) initial dcl 1-20 ref 691 S_expr_array internal static fixed bin(17,0) initial dcl 1-20 Size 000241 automatic fixed bin(17,0) dcl 32 in procedure "lisp_save_" set ref 363* 404* 448* 450 460* 462 468* 468 470 481* 484 509* 511* 511 514 553* 559 580* 581* 581 582 647* 649 669* 674* 675* 684* 684 689 690 695* 695 697 700* 702 744* 747 781* 782 783 784 785 787 840 845 879 883 1134* 1135 1136 1137 1139 Size 2 based fixed bin(17,0) level 2 in structure "array_save" dcl 211 in procedure "lisp_save_" set ref 529* 633* 713* 718 736* 736 String constant bit(9) initial unaligned dcl 9-17 ref 382 465 478 String36 internal static bit(36) initial dcl 9-17 Subr constant bit(9) initial unaligned dcl 9-17 ref 399 589 Subr36 constant bit(36) initial dcl 9-17 ref 539 610 SubrNumeric36 internal static bit(36) initial dcl 9-17 System_Subr constant bit(9) initial unaligned dcl 9-17 ref 494 System_Subr36 internal static bit(36) initial dcl 9-17 Un_gc_array internal static fixed bin(17,0) initial dcl 1-20 Uncollectable internal static bit(9) initial unaligned dcl 9-17 Undefined 000012 constant bit(72) initial unaligned dcl 9-17 ref 458 ZERO internal static fixed bin(17,0) initial dcl 1-37 acc based structure level 1 dcl 193 acc_ent_name based structure level 1 dcl 6-10 acinfo 000222 automatic pointer dcl 32 set ref 300* 802* addr builtin function dcl 278 ref 32 32 322 331 354 355 358 365 366 381 382 383 385 386 392 393 396 397 398 399 400 407 407 408 409 411 415 417 423 424 425 426 426 426 427 427 427 428 429 436 437 438 439 439 439 440 440 440 442 448 450 450 451 452 453 455 458 460 464 464 465 470 470 471 472 472 478 481 484 484 485 485 486 487 494 497 498 499 499 502 504 505 505 507 514 514 515 515 516 517 518 522 524 527 528 529 530 531 535 538 538 538 539 539 540 545 545 546 547 548 549 550 551 552 553 554 554 555 555 559 563 568 570 570 570 571 571 571 575 577 577 577 578 580 580 586 586 589 589 595 598 609 610 610 620 621 629 633 634 635 635 638 643 643 644 649 649 650 651 652 657 659 659 659 660 660 660 666 666 666 669 674 675 677 679 682 683 689 690 691 694 697 699 702 702 703 703 704 705 706 706 707 707 708 710 711 714 722 723 733 740 747 747 748 749 750 754 757 776 777 778 779 780 782 787 787 799 800 842 845 880 883 904 905 910 948 952 1068 1179 1179 1187 1188 1243 1245 addrel builtin function dcl 278 ref 333 341 343 388 418 421 430 433 507 518 525 526 526 531 545 546 554 586 594 595 606 611 614 616 623 697 699 726 728 737 756 774 784 787 837 876 950 952 986 988 990 1081 1093 1104 1122 1136 1139 address based pointer level 2 dcl 211 set ref 531* 635* 715* 729 737* alloc_fault_word defined bit(36) unaligned dcl 4-3 alloc_segment based structure level 1 dcl 4-3 allocate 005444 constant entry internal dcl 812 ref 364 405 449 469 483 696 allocate_static 005560 constant entry internal dcl 855 ref 512 558 648 701 746 allocation based structure level 1 dcl 857 in procedure "allocate_static" allocation based structure level 1 dcl 817 in procedure "allocate" already_copied 000024 constant fixed bin(71,0) initial dcl 245 ref 392 408 452 486 516 710 749 alrm_fault internal static bit(36) initial unaligned dcl 4-3 amount_of_gensym_data 000300 automatic fixed bin(17,0) dcl 84 set ref 319* 320 322 368 825 863 961* 966* 974 977 1042 amount_of_maknum_data 000301 automatic fixed bin(17,0) dcl 84 set ref 318* 322 368 825 863 961* 970* 973* 974 1042 arg parameter char unaligned dcl 27 set ref 6 298* 892 909 915* array_atom defined fixed bin(71,0) dcl 12-6 array_data based structure level 1 dcl 1-31 array_data_ptr 2 based pointer level 2 dcl 1-8 set ref 679* 682 704* 706 707 array_data_size 000302 automatic fixed bin(18,0) dcl 84 set ref 689* 690* 691* 692* 713 array_info based structure level 1 dcl 1-8 array_link_count based structure level 1 dcl 10-61 array_link_loop 002222 constant label dcl 616 ref 600 array_link_loop_0 002165 constant label dcl 601 ref 625 array_link_loop_end 002252 constant label dcl 626 ref 603 array_link_save based structure level 1 dcl 219 set ref 614 616 array_links based structure array level 1 dcl 10-52 array_loop 002645 constant label dcl 728 ref 532 636 716 array_save based structure level 1 dcl 211 atom based structure level 1 dcl 11-5 atom_double_words based structure level 1 dcl 11-5 atom_ptrs based structure level 1 dcl 11-5 atomic_constants 11 based structure level 2 dcl 125 atomic_constants_addr 000266 automatic pointer dcl 77 set ref 948* 950 986* 1069 atomic_constants_count 000270 automatic fixed bin(18,0) dcl 77 set ref 949* 987* 995 995 1071 1100 based_ptr based pointer dcl 9-16 set ref 472 577* 577 586* 586 baseno builtin function dcl 278 ref 32 830 832 833 868 870 871 1052 1058 1062 1084 1210 1217 baseptr builtin function dcl 278 ref 538 776 829 867 binary builtin function dcl 278 ref 32 520 780 802 840 879 925 1084 1132 1134 1154 1189 1190 1195 binding_top defined pointer dcl 12-6 bit builtin function dcl 278 ref 827 865 1189 1190 bit18unal based bit(18) unaligned dcl 95 bit_length 000250 automatic fixed bin(24,0) dcl 32 set ref 789* 919* 1035* 1141* bounds based fixed bin(35,0) array level 3 dcl 1-31 ref 684 bucketno 000240 automatic fixed bin(17,0) dcl 32 set ref 312* 335 336* 336 349* 350 350 354 355 358* 926* 927 929 932 938 944 944 951 952 bucketx 000237 automatic fixed bin(17,0) dcl 32 set ref 907* 944* 959* 1240 1244 1245 call_array_operator internal static bit(36) initial unaligned dcl 2-68 call_dead_array_operator internal static bit(36) initial unaligned dcl 2-68 car based fixed bin(71,0) level 2 dcl 8-5 set ref 392 408* 415 417* 423 424* 426 427 486* 516* 710* 749* catch_frame defined pointer dcl 12-6 cdr 2 based fixed bin(71,0) level 2 dcl 8-5 set ref 393 409* 428 429* 436 437* 439 440 487* 517* 711* 750* cdr_next 001125 constant label dcl 421 set ref 419 chain 1(18) based bit(18) level 2 in structure "lisp_ptr" packed unaligned dcl 9-17 in procedure "lisp_save_" set ref 426* 439* 570* 620* 659* 706* 733* chain based bit(18) level 2 in structure "segment" packed unaligned dcl 146 in procedure "lisp_save_" set ref 426 427* 439 440* 570 571* 620 621* 659 660* 706 707* 733 734* 836* 875* 1150 chain_pointer based pointer initial level 2 dcl 172 set ref 1157* 1158* class 3 based bit(18) level 2 packed unaligned dcl 193 set ref 524 code 000236 automatic fixed bin(35,0) dcl 32 set ref 298* 299 300* 301 302* 303 789* 791* 802* 804* 915* 916 917* 918 919* 921* 922 1035* 1141* 1256* 1257 code_offset 0(18) based bit(18) array level 2 packed unaligned dcl 10-32 set ref 538 584* 589 com_err_ 000072 constant entry external dcl 252 ref 791 804 930 933 940 980 995 1252 1256 common_collector 001112 constant label dcl 415 ref 459 cons based structure level 1 dcl 8-5 set ref 407* 407 cons_almost_done 001173 constant label dcl 433 ref 431 cons_done 001226 constant label dcl 441 ref 438 cons_ptrs based structure level 1 dcl 8-5 cons_types based structure level 1 dcl 8-5 cons_types36 based structure level 1 dcl 8-22 consptr automatic pointer dcl 8-5 consptr_ovly based structure level 1 dcl 4-3 constants 10 based fixed bin(71,0) array level 2 dcl 10-3 set ref 577 578 635 copied_string based structure level 1 dcl 473 copy 000764 constant label dcl 380 ref 339 357 420 432 615 727 copy_1_datum 005231 constant entry internal dcl 1078 ref 1074 1113 copy_array 002374 constant label dcl 669 ref 398 copy_atsym 001234 constant label dcl 448 ref 400 copy_bigfix 001340 constant label dcl 481 ref 396 copy_comp_subr 001614 constant label dcl 535 ref 502 copy_dead_array 002703 constant label dcl 744 ref 676 680 copy_file 002302 constant label dcl 638 ref 397 copy_file_like_cons 001105 constant label dcl 411 ref 667 copy_mask based bit(36) array dcl 95 set ref 450* 450 470* 470 484* 484 514* 514 559* 559 649* 649 697* 697 702* 702 747* 747 782* 782 1135* 1135 copy_more 003006 constant label dcl 781 ref 797 copy_string 001276 constant label dcl 460 ref 382 copy_subr 001373 constant label dcl 494 ref 399 copy_unsave 004652 constant label dcl 1134 ref 1144 copy_unsnapped_array_link 002245 constant label dcl 623 ref 607 counter 000120 automatic fixed bin(18,0) dcl 1006 set ref 1071* 1071* 1100* 1100* 1111* 1111* 1119* 1119* 1213* 1214 1214 1217 1217* cput_fault internal static bit(36) initial unaligned dcl 4-3 crump 003212 constant label dcl 804 ref 299 301 303 crump_2 005404 constant label dcl 1256 ref 916 918 920 922 1036 1142 cu_$cl 000036 constant entry external dcl 252 ref 792 cur_free 000104 automatic pointer initial dcl 1006 set ref 1006* 1152 1153* 1186 1187 1189 1190 1191 cur_ring 000306 automatic bit(3) dcl 894 set ref 904 905* 1091 cur_stat 000102 automatic pointer initial dcl 1006 set ref 1006* 1157 1158 1160* 1194 1195 curptr 000116 automatic pointer dcl 1006 in begin block on line 1004 set ref 1130* 1135 1139* 1139 1149* 1150 1151 1152 1153 1157 1158 1159 1159 1160 1179 1179 curptr 000202 automatic fixed bin(71,0) dcl 32 in procedure "lisp_save_" set ref 337* 340 354 355 358 380 381 382 383 385 392 393* 393 396 397 398 399 400 407 408 409 415* 424 425 428* 437 438 441* 448 450 452 453 460 464 464 465 470 471 472 477* 478 481 484 485 486 487 488* 494 497 498 499 499 502 504 505 505 507 514 515 516 517 519* 535 538 538 541* 545 545 589 589 609 610 610 638 643 643 644 649 651 652 669 674 675 677 679 682 683 689 690 691 694 702 703 710 711 720* 721 722 723 732 741* 747 749 750 751* 754 776 777 778 779 780 782 787 787 799 800 1242* 1243 1245 curptr_odd 1(17) based bit(1) level 2 packed unaligned dcl 95 set ref 383 385* 754* curptr_ovly based structure level 1 dcl 95 curptr_type 0(21) based bit(9) level 2 packed unaligned dcl 95 set ref 355* 381 382 396 397 398 399 400 425 438 465* 478* 485 494 515 644* 703 722 curptrp based pointer dcl 32 set ref 354* 358 366 392 393 407 408 409 448 450 452 453 460 464* 464 470 471 472 481 484 486 487 502 504 505 505 507 514 516 517 535 538 538 545 545 589 589 609* 610* 610 638 643* 643 649 651 652 669 674 675 677 679 682 683 689 690 691 694 702 710 711 747 749 750 776* 777 778 779 780 782 787* 787 799* 800* 1243 current_save_seg 000100 automatic bit(18) initial unaligned dcl 32 set ref 32* 828 829 833* 866 867 871* dbl_word based fixed bin(71,0) level 2 in structure "allocation" dcl 857 in procedure "allocate_static" set ref 883 dbl_word based fixed bin(71,0) level 2 in structure "allocation" dcl 817 in procedure "allocate" set ref 845 def_offset 1 based bit(18) level 2 packed unaligned dcl 193 set ref 522* def_pointer 2 based pointer initial level 2 dcl 172 set ref 1159* defptr 000252 automatic pointer dcl 32 set ref 507* 508 508 510 510 518* 520 520 521 522 522 523 524 524 525 525 526 526 526 531* 545* 546 546 553 559 563 577 578 578 594 594 595 635* 682* 684 697 715* 720 725 729* 730 731 732 733 734 737 737* delta 2(30) based fixed bin(5,0) level 3 packed unaligned dcl 4-3 set ref 1191* dir 000116 automatic char(168) unaligned dcl 32 set ref 298* 300* 804* 804* 915* 917* 921* 995* 995* divide builtin function dcl 278 ref 349 363 365 448 468 481 509 511 526 553 580 1185 1190 1192 1213 do_cdr 001155 constant label dcl 428 ref 425 458 done 002737 constant label dcl 765 ref 370 dope_vector based structure array level 2 dcl 1-31 dope_vector_size 000303 automatic fixed bin(18,0) dcl 84 set ref 694* 695 697 698 699 ename automatic char(32) unaligned dcl 32 ent 000170 automatic char(32) unaligned dcl 32 set ref 298* 300* 804* 804* 912* 915* 917* 921* 930* 933* 940* 980* 995* 995* 1256* ent_nam_ptr 4(18) based bit(18) level 2 packed unaligned dcl 193 set ref 510 526* err_frame defined pointer dcl 12-6 err_recp defined pointer dcl 12-6 error_code parameter fixed bin(35,0) dcl 894 set ref 892 900* 935* 941* 982* 1257* eval_frame defined pointer dcl 12-6 expand_pathname_$add_suffix 000066 constant entry external dcl 252 ref 298 915 fake_array_seg 000217 automatic bit(18) unaligned dcl 32 set ref 865* 881 fake_lists_seg 000216 automatic bit(18) unaligned dcl 32 set ref 827* 843 fakeptr 000210 automatic fixed bin(71,0) dcl 32 set ref 366 409 417 423* 429 436* 441 451 453 472 477 485 487 488 515 517 519 573 577 577 583 584 586 586 589* 597 620 622 628* 650 652 662 698 703 711 725 731* 741 750 751 843* 881* fakeptr2 000212 automatic fixed bin(71,0) dcl 32 set ref 698* 704 fakeptr_ovly based structure level 1 dcl 95 fakeptr_type 0(21) based bit(9) level 2 packed unaligned dcl 95 set ref 451* 485* 515* 650* 703* fault_mask internal static bit(36) initial unaligned dcl 4-3 file_control_ptr 000262 automatic pointer dcl 32 set ref 300* 789* 802* 911* 917* 919* 1035* 1141* 1227 1227* first based structure array level 2 dcl 13-3 set ref 350 1214 first_save_seg 000110 automatic bit(18) initial unaligned dcl 32 set ref 32* 775 776 777* 832* 870* first_seg_ptr 000276 automatic pointer dcl 77 set ref 952* 990* 1022 1127 fixed builtin function dcl 278 ref 322 827 865 1031 1031 1052 1058 1062 1210 1217 flag based fixed bin(17,0) level 2 packed unaligned dcl 125 set ref 316* flag_reset_mask internal static bit(36) initial dcl 5-13 flags 15 based structure level 2 packed unaligned dcl 5-13 free_allocptr 000112 automatic pointer initial dcl 32 set ref 32* 823 826* 830 832 833 834 835 836 837* 837 840 842 843 845* 845 846 846 free_size 000307 automatic fixed bin(17,0) dcl 894 set ref 1154* 1185* 1185 1189 1190 1192 ft2 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 193 set ref 521* function 16 based fixed bin(71,0) level 2 dcl 5-13 set ref 666 further_mod 1(30) based bit(6) array level 2 packed unaligned dcl 10-23 set ref 551* gc_length 7(18) based fixed bin(17,0) level 2 packed unaligned dcl 10-3 ref 577 578 580 633 gc_mark 15(03) based bit(1) level 3 in structure "iochan" packed unaligned dcl 5-13 in procedure "lisp_save_" set ref 638 651* gc_mark 0(18) based bit(18) level 2 in structure "array_info" packed unaligned dcl 1-8 in procedure "lisp_save_" set ref 708* 748* gcmark 7 based bit(18) level 2 in structure "subr_block_head" packed unaligned dcl 10-3 in procedure "lisp_save_" set ref 575* gcmark 5 based bit(18) level 2 in structure "subr" dcl 177 in procedure "lisp_save_" set ref 528* gensym_data 42 based bit(36) array level 2 in structure "stack_seg" dcl 2-5 in procedure "lisp_save_" set ref 320 977* gensym_data 15 based bit(36) array level 2 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 320* 977 hbound builtin function ref 349 1213 hcs_$get_link_target 000076 constant entry external dcl 252 ref 921 hcs_$get_max_length_seg 000104 constant entry external dcl 252 ref 302 head_offset 1 based fixed bin(17,0) array level 2 packed unaligned dcl 10-32 set ref 535 545 585* header_ptr based fixed bin(17,0) level 2 packed unaligned dcl 193 set ref 520* i 000110 automatic fixed bin(17,0) dcl 1006 in begin block on line 1004 set ref 1023* 1025 1027* 1041* 1042 1042 1044* 1128* 1130 1149* i 000305 automatic fixed bin(17,0) dcl 84 in procedure "lisp_save_" set ref 683* 683* 684* 685 infop 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 177 ref 504 505 527 instruction based bit(36) array level 2 dcl 10-52 ref 604 instructions_for_subr internal static bit(36) initial array unaligned dcl 10-45 iochan based structure level 1 dcl 5-13 set ref 647 iochan_list 4 based pointer level 2 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 770* 1056 1058 1058 iochan_list 2 based pointer level 2 in structure "save_header" dcl 114 in procedure "lisp_save_" ref 1049 1052 1052 ioptr 2 based pointer level 2 dcl 5-13 set ref 643 652* itp_base based bit(3) array level 2 packed unaligned dcl 10-23 set ref 547* itp_info 0(03) based bit(27) array level 2 packed unaligned dcl 10-23 set ref 552* itp_mod 0(30) based bit(6) array level 2 packed unaligned dcl 10-23 set ref 548* itsmod 0(30) based bit(6) level 2 packed unaligned dcl 9-17 ref 723 j 000111 automatic fixed bin(17,0) dcl 1006 set ref 1021* 1034* 1034 1035* last_stat_off parameter fixed bin(18,0) dcl 894 set ref 892 1195* last_stat_seg parameter pointer dcl 894 set ref 892 1194* 1201 1202 lbound builtin function ref 349 1213 len based fixed bin(8,0) level 2 packed unaligned dcl 193 ref 509 511 526 length 12 based fixed bin(18,0) level 3 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 321* 325 327 987 length 14 based fixed bin(18,0) level 3 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 327* 328 989 link_info based structure level 1 dcl 193 link_opr_tv_offset 1 based bit(18) array level 2 packed unaligned dcl 10-23 set ref 549* link_to_subr_code based structure level 1 dcl 10-39 lisp_alloc_$alloc_fault_word external static bit(36) dcl 4-3 lisp_alloc_$alloc_info external static bit(288) dcl 4-3 lisp_alloc_$consptr 000114 external static pointer dcl 4-3 set ref 1187* 1188 lisp_alloc_$cur_seg 000116 external static pointer dcl 4-3 set ref 1186* lisp_alloc_$gc_blk_cntr external static fixed bin(17,0) dcl 4-3 lisp_alloc_$init_alloc 000000 constant entry external dcl 252 lisp_alloc_$rehash_maknum 000052 constant entry external dcl 252 ref 1221 lisp_alloc_$seg_blk_cntr 000112 external static fixed bin(17,0) dcl 4-3 set ref 1192* lisp_bignum based structure level 1 dcl 3-3 lisp_garbage_collector_ 000050 constant entry external dcl 252 ref 1253 lisp_garbage_collector_$set_gc_params 000054 constant entry external dcl 252 ref 1193 lisp_get_atom_ 000042 constant entry external dcl 252 ref 1242 lisp_io_control_$empty_all_buffers 000046 constant entry external dcl 252 ref 307 lisp_io_control_$set_for_save 000044 constant entry external dcl 252 ref 308 lisp_ptr based structure level 1 dcl 9-17 lisp_ptr_type based bit(36) dcl 9-17 set ref 539* 539 lisp_save_ 000315 constant entry external dcl 6 lisp_save_alm_ 000040 constant entry external dcl 252 ref 1179 lisp_segment_manager_$free_array 000064 constant entry external dcl 252 ref 799 lisp_segment_manager_$free_lists 000060 constant entry external dcl 252 ref 800 lisp_segment_manager_$get_array 000062 constant entry external dcl 252 ref 864 1025 1042 lisp_segment_manager_$get_lists 000056 constant entry external dcl 252 ref 826 1027 1044 lisp_standard_environment_$ 000010 external static fixed bin(17,0) dcl 230 set ref 910 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 12-6 lisp_static_vars_$binding_top external static pointer dcl 12-6 lisp_static_vars_$catch_frame external static pointer dcl 12-6 lisp_static_vars_$err_frame external static pointer dcl 12-6 lisp_static_vars_$err_recp external static pointer dcl 12-6 lisp_static_vars_$eval_frame external static pointer dcl 12-6 lisp_static_vars_$garbage_collect_inhibit 000030 external static bit(36) dcl 230 set ref 1220* 1222* lisp_static_vars_$garbage_collected_ptrs 000026 external static fixed bin(71,0) dcl 230 set ref 331 1068 1245 lisp_static_vars_$ignore_faults 000034 external static bit(1) dcl 230 set ref 305* lisp_static_vars_$iochan_list 000130 external static pointer dcl 12-6 set ref 1049* 1052* 1056* 1058* lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 12-6 lisp_static_vars_$maknum_data 000016 external static bit(36) array dcl 230 set ref 368 974* lisp_static_vars_$maknum_left 000136 external static fixed bin(17,0) dcl 13-3 set ref 348* 350* 350 359* 359 lisp_static_vars_$maknum_mask 000134 external static fixed bin(24,0) dcl 13-3 set ref 346 349 363 365 953* 963* 969* 1208 1213 lisp_static_vars_$maknum_table_ptr 000132 external static pointer dcl 13-3 set ref 349 349 350 350 354 355 358 363 365 366* 1210* 1210 1210 1213 1213 1214 1214 1217 1217 lisp_static_vars_$nil 000126 external static fixed bin(71,0) dcl 12-6 ref 1121 1121 1243 1243 lisp_static_vars_$no_snapped_links 000014 external static bit(1) dcl 230 set ref 1235* lisp_static_vars_$number_gc_ptrs 000022 external static fixed bin(17,0) dcl 230 ref 312 327 929 938 944 995 1111 1119 1244 lisp_static_vars_$number_of_atomic_constants 000024 external static fixed bin(17,0) dcl 230 ref 321 995 1071 1100 1111 1119 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 12-6 lisp_static_vars_$prog_frame external static pointer dcl 12-6 lisp_static_vars_$saved_environment_dir 000012 external static char(168) unaligned dcl 230 set ref 921* lisp_static_vars_$stack_ptr 000120 external static pointer dcl 12-6 ref 311 311 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 12-45 lisp_static_vars_$subr_block_list 000032 external static pointer dcl 230 set ref 1060* 1062* 1201* lisp_static_vars_$t_atom 000122 external static fixed bin(71,0) dcl 12-6 ref 1102 lisp_static_vars_$top_level external static label variable dcl 12-6 lisp_static_vars_$tty_input_chan external static pointer dcl 12-6 lisp_static_vars_$tty_output_chan external static pointer dcl 12-6 lisp_static_vars_$unmkd_ptr 000124 external static pointer dcl 12-6 ref 320 320 977 977 lisp_static_vars_$unwp_frame external static pointer dcl 12-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 12-45 lisp_string based structure level 1 dcl 7-6 lisp_subr_ based structure level 1 dcl 6-10 lisp_subr_for_call based structure level 1 dcl 6-10 lisp_subr_links based structure array level 1 dcl 10-23 lisp_subr_tv_$tv_begin 000020 external static bit(36) dcl 230 set ref 32 32 list_of_iochans 000256 automatic pointer dcl 32 set ref 309* 657 658 662* 770 list_of_subr_blocks 000260 automatic pointer dcl 32 set ref 310* 568 569 573* 771 main_loop 000611 constant label dcl 340 ref 338 mak_loop 000676 constant label dcl 358 ref 356 make_seg 005451 constant label dcl 824 in procedure "allocate" ref 840 make_seg 005565 constant label dcl 862 in procedure "allocate_static" ref 879 maknum_data based bit(36) array level 2 dcl 125 set ref 368* 974 maknum_table based structure array level 1 dcl 13-3 set ref 349 349 363 365* 365 1213 1213 maknum_table_ptrs based structure array level 1 dcl 13-3 mbz 1(18) based bit(12) array level 2 packed unaligned dcl 10-23 set ref 550* min builtin function dcl 278 ref 781 1071 1111 1134 minus_2_times_ndims 7(18) based fixed bin(17,0) level 2 packed unaligned dcl 1-8 ref 677 mod builtin function dcl 278 in procedure "lisp_save_" ref 323 1190 mod 1(30) based bit(6) level 2 in structure "consptr_ovly" packed unaligned dcl 4-3 in procedure "lisp_save_" set ref 1188* msf_manager_$close 000102 constant entry external dcl 252 ref 1227 msf_manager_$get_ptr 000100 constant entry external dcl 252 ref 789 919 1035 1141 msf_manager_$open 000074 constant entry external dcl 252 ref 917 must_be_zero 1(18) based bit(18) level 2 packed unaligned dcl 10-61 ref 555 must_convert_arrays 000304 automatic bit(1) unaligned dcl 84 set ref 962* 976* 1251 name_length 4 based fixed bin(24,0) level 2 dcl 10-39 ref 553 nargs based bit(18) array level 2 packed unaligned dcl 10-32 set ref 538 583* 589 ndims based fixed bin(17,0) level 2 packed unaligned dcl 1-8 ref 683 694 new_chain 000100 automatic bit(18) unaligned dcl 1006 set ref 1150* 1179 1179 new_fake_address 1 based pointer level 2 packed unaligned dcl 473 set ref 464 472* new_format 000264 automatic bit(1) unaligned dcl 77 set ref 928* 958* 1023 1049 1197 newptr 000204 automatic fixed bin(71,0) dcl 32 in procedure "lisp_save_" set ref 365 407 413 415 417 422* 423 424 426 426 427 427 428 429 435* 436 437 439 439 440 440 450 456 458 470 484 514 518 527 528 529 531 538 539 539 540 541 546 547 548 549 550 551 552 553 554 554 555 555 559 563 568 570 570 571 571 575 580 580 595 596 626* 633 635 649 657 659 659 660 660 666 666 697 699 702 704 705 706 707 708 747 748 842 880 newptr 000114 automatic pointer dcl 1006 in begin block on line 1004 set ref 1022* 1025 1031 1031 1035* 1036 1038* 1038 1069* 1080 1081* 1081 1110* 1127* 1131 1134 1135 1136* 1136 1143* newptr2 000214 automatic pointer dcl 32 set ref 699* 715 newptrp based pointer dcl 32 set ref 365 407 415 417 423 424 426 426 427 427 428 429 436 437 439 439 440 440 450 458 470 484 514 518 527 528 529 531 538* 546* 547 548 549 550 551 552 553 554* 554 555 555 559 563 568 570 570 571 571 575 580 580 595 633 635 649 657 659 659 660 660 666* 666 697 699 702 704 705 706 707 708 747 748 842* 880* newsegptr 000206 automatic pointer dcl 32 set ref 333* 340 341* 341 774* 782 784* 784 796* 802 next_compiled_block based pointer level 2 dcl 10-3 set ref 568* 570 571 next_dbl_word 4 based fixed bin(71,0) level 2 dcl 114 set ref 948 952 next_offset 000112 automatic fixed bin(18,0) dcl 1006 set ref 1031* 1032 1033* 1033 1038 next_seg based pointer level 2 dcl 4-3 set ref 1152* nil defined fixed bin(71,0) dcl 12-6 ref 1121 1243 nil_ptr based pointer dcl 12-6 no_links_are_snapped 1(28) based bit(1) level 3 packed unaligned dcl 10-14 set ref 563* 563 no_segs 000106 automatic fixed bin(17,0) initial dcl 1006 set ref 1006* 1140* 1140 1141* null builtin function dcl 278 ref 32 32 32 309 310 569 658 679 790 823 861 911 920 1006 1006 1036 1049 1049 1056 1056 1060 1060 1142 1157 1157 1202 1227 num_gc_ptrs based fixed bin(17,0) level 2 packed unaligned dcl 114 ref 926 number_of_array_links 000224 automatic fixed bin(17,0) dcl 32 in procedure "lisp_save_" set ref 555* 557* 581 581 593 594 595 599 number_of_array_links 1 based fixed bin(17,0) level 2 in structure "array_link_count" packed unaligned dcl 10-61 in procedure "lisp_save_" ref 555 number_of_links_left 7 based fixed bin(17,0) level 2 dcl 219 set ref 599* 601* 601 603 obarray defined fixed bin(71,0) dcl 12-6 object based fixed bin(71,0) level 2 dcl 211 set ref 387* 413* 422 435 456* odd_address 002727 constant label dcl 754 ref 389 offset 1 based fixed bin(17,0) level 2 in structure "lisp_ptr" packed unaligned dcl 9-17 in procedure "lisp_save_" set ref 499* 499 1089* 1089 offset 11 based fixed bin(18,0) level 3 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 322* 323 323* 323 325 333 334 986 offset 13 based fixed bin(18,0) level 3 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 325* 328 988 offset_to_first_seg 10 based fixed bin(18,0) level 2 dcl 125 set ref 328* 774 990 pathname_ 000070 constant entry external dcl 252 ref 804 804 995 995 plist 2 based fixed bin(71,0) level 2 dcl 11-5 set ref 453* pm1 003044 constant label dcl 789 ref 793 pnamel 4 based fixed bin(17,0) level 2 dcl 11-5 ref 448 pointer 2 based pointer array level 2 dcl 10-52 set ref 609 621 622* prec 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 3-3 ref 481 prog_frame defined pointer dcl 12-6 ptr builtin function dcl 278 ref 311 320 426 427 439 440 508 510 538 570 571 620 621 659 660 705 730 846 884 977 1038 1052 1058 1062 1158 1160 1179 1179 1194 1210 quit_fault internal static bit(36) initial unaligned dcl 4-3 rel builtin function dcl 278 ref 32 322 427 440 520 522 524 525 526 571 621 660 707 734 802 840 843 846 879 881 884 1031 1052 1058 1062 1134 1195 1210 rest 1(18) based fixed bin(17,0) level 2 packed unaligned dcl 193 set ref 523* rest_of_gc_area 13 based structure level 2 dcl 125 rest_of_gc_area_addr 000272 automatic pointer dcl 77 set ref 950* 988* 1110 rest_of_gc_area_count 000274 automatic fixed bin(18,0) dcl 77 set ref 951* 989* 995 1111 1119 rest_of_tsx0 1(18) based bit(18) array level 2 packed unaligned dcl 10-32 ref 502 retad 000232 automatic label variable local dcl 32 set ref 338* 356* 380 381 386 389* 394 411 419* 431* 442 443 455 466 479 489 500 527 530 532* 542 598 600* 629 634 636* 645 714 716* 740 742 752 757 758 return 2 based pointer level 2 dcl 211 set ref 386* 411* 442 455* 757 return_addr 4 based pointer level 2 dcl 211 set ref 530* 634* 714* 740 ringnum 0(18) based bit(3) level 2 packed unaligned dcl 9-17 set ref 498* 540* 905 1091* save_fakeptr 2 based fixed bin(71,0) level 2 dcl 219 set ref 597* 628 save_header based structure level 1 dcl 114 save_newptr 4 based fixed bin(71,0) level 2 dcl 219 set ref 596* 626 save_return 6 based pointer level 2 packed unaligned dcl 219 set ref 598* 629 save_temp_ptr based pointer level 2 packed unaligned dcl 219 set ref 612* 618 save_temp_ptr_1 1 based pointer level 2 packed unaligned dcl 219 set ref 613* 619 saved_env based structure level 1 dcl 125 saved_list_of_subr_blocks 4 based pointer level 2 dcl 155 set ref 1201 1202* second 1 based pointer array level 2 in structure "maknum_table_ptrs" packed unaligned dcl 13-3 in procedure "lisp_save_" set ref 354 358* second 1 based structure array level 2 in structure "maknum_table" dcl 13-3 in procedure "lisp_save_" second_word 1 based structure level 2 dcl 10-14 seg_chain 1 based bit(18) level 2 packed unaligned dcl 146 set ref 777 778* 830* 834* 868* 873* seg_count 0(18) based fixed bin(17,0) level 2 in structure "save_header" packed unaligned dcl 114 in procedure "lisp_save_" ref 924 seg_count 0(18) based fixed bin(17,0) level 2 in structure "saved_env" packed unaligned dcl 125 in procedure "lisp_save_" set ref 765* seg_nam_ptr 4 based bit(18) level 2 packed unaligned dcl 193 set ref 508 525* seg_offset 2 based bit(18) level 3 in structure "alloc_segment" packed unaligned dcl 4-3 in procedure "lisp_save_" set ref 1189* seg_offset 000107 automatic bit(18) unaligned dcl 1006 in begin block on line 1004 set ref 1131* 1132 1154 1160 seg_size 1 based fixed bin(17,0) level 2 in structure "save_header" dcl 114 in procedure "lisp_save_" ref 925 seg_size 1(18) based bit(18) level 2 in structure "segment" packed unaligned dcl 146 in procedure "lisp_save_" set ref 780 846* 884* 1031 1131 seg_size 1 based fixed bin(17,0) level 2 in structure "saved_env" dcl 125 in procedure "lisp_save_" set ref 766* seg_type 0(18) based bit(18) level 2 in structure "segment" packed unaligned dcl 146 in procedure "lisp_save_" set ref 779 835* 874* 1025 1151 seg_type based bit(1) array level 2 in structure "saved_env" packed unaligned dcl 125 in procedure "lisp_save_" set ref 322 825* 863* 1042 segment based structure level 1 dcl 146 segment_size 000227 automatic fixed bin(19,0) dcl 32 set ref 302* 334 766 795 840 879 925* 1032 1033 1134 segno based bit(18) level 2 in structure "lisp_ptr" packed unaligned dcl 9-17 in procedure "lisp_save_" set ref 497* 1084 1084* 1084 1088* segno 1 based fixed bin(17,0) array level 3 in structure "maknum_table" packed unaligned dcl 13-3 in procedure "lisp_save_" set ref 1217* 1217 segno_table 000100 automatic pointer array dcl 1005 set ref 1025* 1027* 1042* 1044* 1052 1058 1062 1084 1130 1149 1179 1179 1210 1217 segnumber 000200 automatic fixed bin(17,0) initial dcl 32 set ref 32* 765 773* 788* 788 789* 802* 824* 824 825 827 862* 862 863 865 924* 1005 1023 1041 1128 segptr 000220 automatic pointer dcl 32 set ref 300* 302* 316 317 320 321 322 322 323 323 323 325 325 325 327 327 328 328 328 333 333 334 368 765 766 770 771 774 774 789* 790 796 825 863 904* 905 910* 919* 920 924 925 926 948 952 960 965 967 974 977 980 986 986 987 988 988 989 990 990 1042 1049 1052 1052 1056 1058 1058 1060 1062 1062 1141* 1142 1143 size builtin function dcl 278 ref 363 614 616 647 876 stack 000246 automatic pointer initial dcl 32 set ref 32* 311* 386 387 388* 388 411 413 418* 418 421* 421 422 430* 430 433* 433 435 442 455 456 529 530 531 596 597 598 599 601 601 603 612 613 614* 614 614 616* 616 616 618 619 626 628 629 633 634 635 713 714 715 718 726* 726 728* 728 729 736 736 737 740 756* 756 757 stack_entry based structure level 1 dcl 211 stack_ptr defined pointer dcl 12-6 ref 311 stack_seg based structure level 1 dcl 2-5 star_rset defined fixed bin(71,0) dcl 12-45 stash_maknum_data 000734 constant label dcl 368 ref 346 stat_allocptr 000114 automatic pointer initial dcl 32 set ref 32* 861 864* 868 870 871 872 873 874 875 876* 876 879 880 881 883* 883 884 884 stat_size 4 based fixed bin(17,0) level 2 packed unaligned dcl 177 ref 505 529 static_seg_header based structure level 1 dcl 172 set ref 872* 876 static_seg_kludge based structure level 1 dcl 155 static_seg_template 000000 constant structure level 1 dcl 165 ref 872 string builtin function dcl 278 ref 350 1214 string_length based fixed bin(17,0) level 2 dcl 7-6 set ref 460 471* string_ptr 000254 automatic pointer dcl 32 set ref 508* 509 510* 511 705* 706 707 730* 733 734 subr based structure level 1 dcl 177 subr_block_head based structure level 1 dcl 10-3 subr_block_head_overlay based structure level 1 dcl 10-14 subr_block_list 6 based pointer level 2 dcl 125 set ref 771* 1060 1062 1062 subr_code_link_offset 6 based fixed bin(17,0) level 2 packed unaligned dcl 10-3 ref 546 553 580 594 595 subr_entries based structure array level 1 dcl 10-32 subr_join 002615 constant label dcl 718 ref 533 637 subr_size 000015 constant fixed bin(17,0) initial array dcl 245 ref 504 substr builtin function dcl 278 ref 583 584 switch 000242 automatic fixed bin(17,0) dcl 32 in procedure "lisp_save_" set ref 504* 505* 505 507 511 518 582* 583 584 585* switch automatic fixed bin(17,0) dcl 1006 in begin block on line 1004 system_tv_offset 000226 automatic fixed bin(17,0) initial dcl 32 set ref 32* 499 1089 system_tv_segno 000225 automatic bit(18) initial unaligned dcl 32 set ref 32* 1088 t_atom defined fixed bin(71,0) dcl 12-6 t_atom_ptr based pointer dcl 12-6 table_alloc 004212 constant label dcl 1004 tally 2(18) based bit(12) level 3 packed unaligned dcl 4-3 set ref 1190* tally_word 2 based structure level 2 dcl 4-3 set ref 1187 temp based fixed bin(71,0) array dcl 95 set ref 1245* temp_ptr 000102 automatic pointer dcl 32 set ref 578* 583 584 585 594* 604 606* 606 609 611* 611 612 618* 829* 830 867* 868 temp_ptr_0 000106 automatic pointer dcl 32 set ref 331* 337 343* 343 temp_ptr_1 000104 automatic pointer dcl 32 set ref 595* 613 619* 620 621 621 622 623* 623 1068* 1080 1082 1084 1084 1084 1088 1089 1089 1091 1093* 1093 1102 1104* 1104 1121 1122* 1122 this_seg_is_static 000230 automatic bit(1) unaligned dcl 32 set ref 779* 799 thread 4 based pointer level 2 dcl 5-13 set ref 657* 659 660 to_be_copied 000243 automatic fixed bin(17,0) dcl 32 set ref 780* 781 785* 785 786 797 1132* 1134 1137* 1137 1138 transfer_location based pointer dcl 95 set ref 386 411 442* 455 530 598 629* 634 714 740* 757* tsplp_ic_ind internal static bit(18) initial unaligned dcl 10-45 tssi_$finish_file 000110 constant entry external dcl 252 ref 802 tssi_$get_file 000106 constant entry external dcl 252 ref 300 tsx0_ic constant bit(18) initial unaligned dcl 10-45 ref 502 tty_input_chan defined pointer dcl 12-6 tty_output_chan defined pointer dcl 12-6 type 0(21) based bit(9) level 2 in structure "lisp_ptr" packed unaligned dcl 9-17 in procedure "lisp_save_" ref 1082 type 7 based fixed bin(17,0) level 2 in structure "array_info" packed unaligned dcl 1-8 in procedure "lisp_save_" ref 669 674 675 689 690 691 type 0(27) based bit(9) array level 3 in structure "maknum_table" packed unaligned dcl 13-3 in procedure "lisp_save_" set ref 350 355 1214 type_pair_ptr 2 based bit(18) level 2 packed unaligned dcl 193 set ref 522 524* unmkd_ptr defined pointer dcl 12-6 ref 320 977 unsave 003274 constant entry external dcl 892 unsnapped_array_link_instruction 000014 constant bit(36) initial unaligned dcl 245 ref 604 unspec builtin function dcl 278 set ref 568* 568 573* 573 583 584 589* 610* 610 622* 622 652* 652 657* 657 662* 662 704* 704 770* 770 771* 771 843* 881* unwp_frame defined pointer dcl 12-6 user_intr_array defined fixed bin(71,0) array dcl 12-45 value based fixed bin(71,0) level 2 in structure "atom" dcl 11-5 in procedure "lisp_save_" set ref 452* 1243* value based bit(72) level 2 in structure "atom_double_words" dcl 11-5 in procedure "lisp_save_" ref 458 version_number 2 based fixed bin(17,0) level 2 dcl 125 set ref 317* 960 965 967 980* words_left 000244 automatic fixed bin(17,0) dcl 32 set ref 334* 342* 342 781 783* 783 786 795* STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6452 6612 5710 6462 Length 7400 5710 140 552 542 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_save_ 402 external procedure is an external procedure. allocate internal procedure shares stack frame of external procedure lisp_save_. allocate_static internal procedure shares stack frame of external procedure lisp_save_. begin block on line 1004 120 begin block uses auto adjustable storage. copy_1_datum internal procedure shares stack frame of begin block on line 1004. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 1004 000100 segno_table begin block on line 1004 000100 new_chain begin block on line 1004 000102 cur_stat begin block on line 1004 000104 cur_free begin block on line 1004 000106 no_segs begin block on line 1004 000107 seg_offset begin block on line 1004 000110 i begin block on line 1004 000111 j begin block on line 1004 000112 next_offset begin block on line 1004 000114 newptr begin block on line 1004 000116 curptr begin block on line 1004 000120 counter begin block on line 1004 lisp_save_ 000100 current_save_seg lisp_save_ 000102 temp_ptr lisp_save_ 000104 temp_ptr_1 lisp_save_ 000106 temp_ptr_0 lisp_save_ 000110 first_save_seg lisp_save_ 000112 free_allocptr lisp_save_ 000114 stat_allocptr lisp_save_ 000116 dir lisp_save_ 000170 ent lisp_save_ 000200 segnumber lisp_save_ 000202 curptr lisp_save_ 000204 newptr lisp_save_ 000206 newsegptr lisp_save_ 000210 fakeptr lisp_save_ 000212 fakeptr2 lisp_save_ 000214 newptr2 lisp_save_ 000216 fake_lists_seg lisp_save_ 000217 fake_array_seg lisp_save_ 000220 segptr lisp_save_ 000222 acinfo lisp_save_ 000224 number_of_array_links lisp_save_ 000225 system_tv_segno lisp_save_ 000226 system_tv_offset lisp_save_ 000227 segment_size lisp_save_ 000230 this_seg_is_static lisp_save_ 000232 retad lisp_save_ 000236 code lisp_save_ 000237 bucketx lisp_save_ 000240 bucketno lisp_save_ 000241 Size lisp_save_ 000242 switch lisp_save_ 000243 to_be_copied lisp_save_ 000244 words_left lisp_save_ 000246 stack lisp_save_ 000250 bit_length lisp_save_ 000252 defptr lisp_save_ 000254 string_ptr lisp_save_ 000256 list_of_iochans lisp_save_ 000260 list_of_subr_blocks lisp_save_ 000262 file_control_ptr lisp_save_ 000264 new_format lisp_save_ 000266 atomic_constants_addr lisp_save_ 000270 atomic_constants_count lisp_save_ 000272 rest_of_gc_area_addr lisp_save_ 000274 rest_of_gc_area_count lisp_save_ 000276 first_seg_ptr lisp_save_ 000300 amount_of_gensym_data lisp_save_ 000301 amount_of_maknum_data lisp_save_ 000302 array_data_size lisp_save_ 000303 dope_vector_size lisp_save_ 000304 must_convert_arrays lisp_save_ 000305 i lisp_save_ 000306 cur_ring lisp_save_ 000307 free_size lisp_save_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a r_e_as enter_begin leave_begin call_ext_out_desc call_ext_out return tra_ext alloc_auto_adj bound_check_signal mod_fx1 ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$cl expand_pathname_$add_suffix hcs_$get_link_target hcs_$get_max_length_seg lisp_alloc_$rehash_maknum lisp_garbage_collector_ lisp_garbage_collector_$set_gc_params lisp_get_atom_ lisp_io_control_$empty_all_buffers lisp_io_control_$set_for_save lisp_save_alm_ lisp_segment_manager_$free_array lisp_segment_manager_$free_lists lisp_segment_manager_$get_array lisp_segment_manager_$get_lists msf_manager_$close msf_manager_$get_ptr msf_manager_$open pathname_ tssi_$finish_file tssi_$get_file THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_alloc_$consptr lisp_alloc_$cur_seg lisp_alloc_$seg_blk_cntr lisp_standard_environment_$ lisp_static_vars_$garbage_collect_inhibit lisp_static_vars_$garbage_collected_ptrs lisp_static_vars_$ignore_faults lisp_static_vars_$iochan_list lisp_static_vars_$maknum_data lisp_static_vars_$maknum_left lisp_static_vars_$maknum_mask lisp_static_vars_$maknum_table_ptr lisp_static_vars_$nil lisp_static_vars_$no_snapped_links lisp_static_vars_$number_gc_ptrs lisp_static_vars_$number_of_atomic_constants lisp_static_vars_$saved_environment_dir lisp_static_vars_$stack_ptr lisp_static_vars_$subr_block_list lisp_static_vars_$t_atom lisp_static_vars_$unmkd_ptr lisp_subr_tv_$tv_begin LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 32 000265 6 000312 298 000331 299 000366 300 000371 301 000424 302 000427 303 000442 305 000445 307 000450 308 000454 309 000461 310 000463 311 000464 312 000470 316 000472 317 000475 318 000500 319 000502 320 000504 321 000531 322 000534 323 000545 325 000552 327 000556 328 000561 331 000565 333 000567 334 000573 335 000576 336 000601 337 000603 338 000605 339 000610 340 000611 341 000613 342 000616 343 000620 344 000623 346 000624 348 000631 349 000632 350 000641 354 000656 355 000663 356 000672 357 000675 358 000676 359 000705 361 000706 363 000710 364 000716 365 000717 366 000732 368 000734 370 000763 380 000764 381 000767 382 000775 383 001003 385 001006 386 001010 387 001013 388 001015 389 001017 392 001022 393 001025 394 001030 396 001031 397 001037 398 001045 399 001053 400 001061 404 001067 405 001071 407 001072 408 001100 409 001102 411 001105 413 001110 415 001112 417 001114 418 001116 419 001121 420 001124 421 001125 422 001130 423 001132 424 001134 425 001136 426 001144 427 001151 428 001155 429 001161 430 001164 431 001167 432 001172 433 001173 435 001176 436 001200 437 001203 438 001206 439 001214 440 001221 441 001226 442 001231 443 001233 448 001234 449 001241 450 001242 451 001251 452 001255 453 001257 455 001262 456 001265 458 001267 459 001275 460 001276 462 001300 464 001301 465 001304 466 001310 468 001311 469 001314 470 001315 471 001324 472 001326 477 001331 478 001333 479 001337 481 001340 483 001347 484 001350 485 001357 486 001363 487 001365 488 001370 489 001372 494 001373 497 001400 498 001402 499 001404 500 001411 502 001412 504 001420 505 001425 507 001440 508 001444 509 001451 510 001455 511 001462 512 001471 514 001472 515 001501 516 001505 517 001507 518 001512 519 001516 520 001520 521 001527 522 001531 523 001534 524 001536 525 001541 526 001545 527 001560 528 001566 529 001571 530 001577 531 001603 532 001610 533 001613 535 001614 538 001621 539 001632 540 001634 541 001636 542 001640 543 001641 545 001642 546 001651 547 001657 548 001663 549 001666 550 001671 551 001674 552 001677 553 001701 554 001714 555 001717 557 001730 558 001732 559 001733 563 001742 568 001747 569 001753 570 001757 571 001764 572 001770 573 001771 575 001773 577 001776 578 002005 580 002013 581 002036 582 002045 583 002055 584 002062 585 002070 586 002075 587 002100 589 002102 593 002123 594 002125 595 002137 596 002151 597 002154 598 002156 599 002160 600 002162 601 002165 603 002170 604 002173 606 002176 607 002201 609 002202 610 002205 611 002211 612 002214 613 002215 614 002217 615 002221 616 002222 618 002226 619 002230 620 002232 621 002236 622 002242 623 002245 625 002251 626 002252 628 002254 629 002256 633 002260 634 002267 635 002271 636 002276 637 002301 638 002302 643 002306 644 002311 645 002315 647 002316 648 002320 649 002321 650 002330 651 002334 652 002337 657 002343 658 002347 659 002353 660 002360 661 002365 662 002366 666 002370 667 002373 669 002374 674 002404 675 002414 676 002424 677 002425 679 002432 680 002435 682 002436 683 002441 684 002450 685 002455 689 002457 690 002467 691 002477 692 002507 694 002510 695 002514 696 002515 697 002516 698 002527 699 002533 700 002537 701 002541 702 002542 703 002551 704 002555 705 002561 706 002563 707 002567 708 002573 710 002575 711 002577 713 002602 714 002605 715 002607 716 002612 718 002615 720 002621 721 002623 722 002625 723 002633 725 002640 726 002642 727 002644 728 002645 729 002650 730 002652 731 002654 732 002656 733 002660 734 002663 736 002665 737 002670 738 002675 740 002676 741 002700 742 002702 744 002703 746 002705 747 002706 748 002715 749 002717 750 002721 751 002724 752 002726 754 002727 756 002731 757 002734 758 002736 765 002737 766 002742 770 002745 771 002750 773 002754 774 002755 775 002762 776 002764 777 002767 778 002773 779 002776 780 003002 781 003006 782 003013 783 003021 784 003023 785 003026 786 003030 787 003037 788 003043 789 003044 790 003067 791 003073 792 003123 793 003130 795 003131 796 003133 797 003135 799 003140 800 003152 801 003161 802 003162 803 003211 804 003212 806 003266 892 003267 900 003310 904 003312 905 003314 907 003320 909 003321 910 003327 911 003332 912 003334 913 003337 915 003340 916 003374 917 003377 918 003424 919 003427 920 003453 921 003460 922 003513 924 003516 925 003522 926 003525 927 003530 928 003531 929 003532 930 003535 932 003571 933 003573 935 003630 936 003633 938 003634 940 003637 941 003673 942 003676 944 003677 948 003702 949 003705 950 003707 951 003712 952 003715 953 003722 954 003724 958 003725 959 003727 960 003730 961 003733 962 003735 963 003736 964 003741 965 003742 966 003745 967 003747 969 003752 970 003755 971 003756 973 003757 974 003761 976 004007 977 004010 978 004035 980 004036 982 004077 983 004102 986 004103 987 004107 988 004111 989 004115 990 004117 995 004123 1004 004212 1005 004215 1006 004225 1021 004231 1022 004232 1023 004234 1025 004245 1027 004262 1031 004273 1032 004303 1033 004307 1034 004311 1035 004312 1036 004335 1038 004344 1039 004350 1041 004353 1042 004363 1044 004411 1045 004423 1049 004425 1052 004441 1056 004454 1058 004465 1060 004477 1062 004507 1068 004520 1069 004522 1071 004524 1074 004534 1075 004535 1100 004540 1102 004550 1104 004553 1105 004556 1110 004560 1111 004563 1113 004576 1114 004577 1119 004602 1121 004614 1122 004617 1123 004622 1127 004624 1128 004627 1130 004637 1131 004643 1132 004647 1134 004652 1135 004664 1136 004672 1137 004675 1138 004677 1139 004701 1140 004704 1141 004705 1142 004730 1143 004740 1144 004742 1149 004743 1150 004750 1151 004753 1152 004756 1153 004760 1154 004761 1155 004764 1157 004765 1158 004774 1159 004776 1160 004777 1179 005003 1181 005022 1185 005024 1186 005032 1187 005035 1188 005037 1189 005042 1190 005047 1191 005062 1192 005064 1193 005071 1194 005075 1195 005101 1197 005104 1201 005106 1202 005113 1208 005117 1210 005123 1213 005136 1214 005145 1217 005161 1219 005201 1220 005203 1221 005206 1222 005212 1227 005214 1229 005227 1078 005231 1080 005232 1081 005235 1082 005240 1084 005246 1088 005262 1089 005265 1091 005273 1093 005300 1094 005303 1235 005304 1240 005306 1242 005310 1243 005327 1244 005332 1245 005336 1246 005343 1251 005344 1252 005346 1253 005376 1255 005403 1256 005404 1257 005440 1258 005443 812 005444 823 005445 824 005451 825 005452 826 005463 827 005472 828 005477 829 005501 830 005504 831 005507 832 005510 833 005513 834 005516 835 005521 836 005523 837 005525 840 005527 842 005535 843 005537 845 005546 846 005553 847 005557 855 005560 861 005561 862 005565 863 005566 864 005577 865 005606 866 005613 867 005615 868 005620 869 005623 870 005624 871 005627 872 005632 873 005636 874 005641 875 005643 876 005645 879 005650 880 005656 881 005660 883 005667 884 005674 885 005700 ----------------------------------------------------------- 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