THIS FILE IS DAMAGED COMPILATION LISTING OF SEGMENT reset_external_variables Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/20/86 1201.1 mst Thu Options: optimize list 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7420), audit(86-11-12,Zwick), 15* install(86-11-20,MR12.0-1222): 16* change the parameters of list init 17* END HISTORY COMMENTS */ 18 19 20 reset_external_variables: 21 rev: 22 proc; 23 24 /* This command resets or deletes selected external 25* variables (*system link targets). */ 26 /* coded October 1976 by M. Weaver */ 27 /* modified October 1977 by Melanie Weaver to handle links snapped directly */ 28 /* Modified November 12 1982 by T Oke to cleanup and handle Very Large Arrays */ 29 /* Modified April 22 1983 by M. Weaver to remove references to init_info_ptr */ 30 /* Modified October 26 1984 by M. Mabey to explicitly zero a variable that is 31* initialized with list templates. This has to be done in 32* reponse to a change in list_init_ which no longer zeros 33* skipped over data. */ 34 35 dcl (i, j, n, whox, alng, nnames, nprocessed, high_seg, hcscnt, nchars) 36 fixed bin; 37 dcl vsize fixed bin (35); 38 dcl code fixed bin (35); 39 dcl (fatal, deleted) bit (1) aligned; 40 dcl (tp, np, aptr, vptr, lotptr, tnp, old_np, alp) 41 ptr; 42 dcl arg char (alng) based (aptr); 43 dcl vname char (65); 44 dcl me (2) char (25) static options (constant) 45 init ("reset_external_variables", "delete_external_variables"); 46 dcl variable (vsize) bit (36) based; 47 dcl do_it entry () variable; 48 dcl ( 49 error_table_$badopt, 50 error_table_$too_many_args, 51 error_table_$bigarg 52 ) ext fixed bin (35); 53 dcl error_table_$noarg ext fixed bin (35); 54 dcl (addr, addrel, baseno, bin, bit, fixed, hbound, 55 lbound, null, ptr, rel, substr, stackbaseptr, 56 unspec, empty) 57 builtin; 58 dcl (com_err_, ioa_) entry options (variable); 59 dcl cu_$arg_count entry () returns (fixed bin); 60 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 61 dcl cu_$arg_list_ptr entry () returns (ptr); 62 dcl hcs_$high_low_seg_count 63 entry (fixed bin, fixed bin); 64 dcl delete_$ptr entry (ptr, bit (6), char (*), fixed bin (35)); 65 66 dcl fortran_storage_manager_$free 67 entry (ptr); 68 dcl list_init_ entry (ptr, ptr, fixed bin (35), 69 ptr, ptr, fixed bin (35)); 70 dcl list_init_$variable_already_zero 71 entry (ptr, ptr, fixed bin (35), 72 ptr, ptr, fixed bin (35)); 73 dcl sys_info$max_seg_size fixed bin (35) external; 74 75 76 whox = 1; 77 do_it = reset_it; 78 79 /* find out if there are any external variables */ 80 81 join: 82 code = 0; 83 sb = ptr (addr (nnames), 0); 84 tp = sb -> stack_header.sys_link_info_ptr; 85 if tp = null 86 then do; 87 no_variables: 88 call com_err_ (0, me (whox), "There are no external variables."); 89 return; 90 end; 91 if tp -> variable_table_header.cur_num_of_variables < 1 92 then goto no_variables; 93 lotptr = sb -> stack_header.lot_ptr; 94 95 fatal = "0"b; 96 nnames = 0; 97 nprocessed = 0; 98 alp = cu_$arg_list_ptr (); 99 n = cu_$arg_count (); 100 101 begin; 102 dcl 1 list (n) aligned, 103 2 name char (65), 104 2 nsize fixed bin (17) unal, 105 2 found bit (1) unal, 106 2 pad bit (17) unal; 107 108 109 /* process all the arguments */ 110 111 do i = 1 to n; 112 call cu_$arg_ptr_rel (i, aptr, alng, code, alp); 113 if code ^= 0 114 then do; 115 call com_err_ (code, me (whox), arg); 116 fatal = "1"b; 117 end; 118 else if substr (arg, 1, 1) = "-" 119 then do; 120 if arg = "-unlabelled_common" | arg = "-uc" 121 then do; 122 nnames = nnames + 1; 123 list (nnames).name = "blnk*com"; 124 list (nnames).nsize = 8; 125 list (nnames).found = "0"b; 126 end; 127 else do; 128 call com_err_ (error_table_$badopt, me (whox), arg); 129 fatal = "1"b; 130 end; 131 end; 132 else do; 133 nnames = nnames + 1; 134 if nnames > hbound (list, 1) 135 then do; 136 call com_err_ (error_table_$too_many_args, me (whox), "^d names maximum", 137 hbound (list, 1)); 138 return; 139 end; 140 if alng > 65 141 then do; 142 call com_err_ (error_table_$bigarg, me (whox), arg); 143 fatal = "1"b; 144 end; 145 list (nnames).name = arg; 146 list (nnames).nsize = alng; 147 list (nnames).found = "0"b; 148 end; 149 end; 150 151 if fatal 152 then return; 153 if nnames = 0 154 then do; 155 call com_err_ (error_table_$noarg, me (whox)); 156 return; 157 end; 158 159 /* loop through system name list, printing info for desired variables */ 160 161 162 do i = lbound (tp -> variable_table_header.hash_table, 1) 163 to hbound (tp -> variable_table_header.hash_table, 1); 164 old_np = addr (tp -> variable_table_header.hash_table (i)); 165 tnp = tp -> variable_table_header.hash_table (i); 166 do while (tnp ^= null); 167 deleted = "0"b; 168 np = tnp; 169 tnp = np -> variable_node.forward_thread; 170 /* update now in case node gets deleted */ 171 do j = 1 to nnames; /* see if this name matches any on list */ 172 if ^list (j).found 173 then do; 174 if list (j).nsize = np -> variable_node.name_size 175 then if list (j).name = np -> variable_node.name 176 then do; 177 call do_it; 178 list (j).found = "1"b; 179 nprocessed = nprocessed + 1; 180 if nprocessed = nnames 181 then return; 182 go to next_name; 183 end; 184 end; 185 end; 186 next_name: 187 if ^deleted 188 then old_np = np; /* current node didn't get deleted */ 189 end; 190 end; 191 192 call ioa_ ("^/The following variables were not found:"); 193 do i = 1 to nnames; 194 if ^list (i).found @Apuzzo 8l\XR6~ Apuzzo fa Develcon !D LU9LLnoneVIP7400_DTR L%\"d, 1 65 /* number of times to repeat datum */ 1 66 2 datum bit (init_n_bits_in_datum refer (list_template_entry.n_bits)); 1 67 1 68 /* list_template_entry_ptr is defined such that it can be used as an 1 69* automatic definition overlay with a fixed size datum. it has a declared 1 70* size of 72 to allow for the its pointer sixe of 72 bits. 1 71**/ 1 72 1 73 dcl 1 list_template_entry_ptr aligned based, 1 74 2 n_bits fixed bin (35) aligned, 1 75 2 mbz bit(3) unaligned, 1 76 2 init_type fixed bin (3) unsigned unaligned, 1 77 2 repeat fixed bin (30) unsigned unaligned, 1 78 2 datum bit(72); 1 79 1 80 /* the pointer_init_template represents the initialization information 1 81* for ITS and packed pointers. Both pointer types require the entire 1 82* 72 bit structure. 1 83**/ 1 84 1 85 dcl 1 pointer_init_template based, 1 86 2 ptr_type fixed bin (18) unsigned unaligned, /* 0 text section, 1 linkage section, 2 static section */ 1 87 2 section_offset fixed bin (18) unsigned unaligned, /* offset to item in specified section */ 1 88 2 word_offset fixed bin (18) unsigned unaligned, /* word offset from section item to target */ 1 89 2 mbz bit (12) unaligned, 1 90 2 bit_offset fixed bin (6) unsigned unaligned; /* bit offset from section item|word offset to target */ 1 91 1 92 1 93 dcl init_n_bits_in_datum fixed bin (35); 1 94 1 95 dcl NO_INIT fixed bin static options (constant) init (0); 1 96 dcl TEMPLATE_INIT fixed bin static options (constant) init (3); 1 97 dcl EMPTY_AREA_INIT fixed bin static options (constant) init (4); 1 98 dcl LIST_TEMPLATE_INIT fixed bin static options (constant) init (5); 1 99 dcl INIT_DEFERRED fixed bin static options (constant) init (6); 1 100 dcl ITS_PTR_INIT fixed bin (3) unsigned static options (constant) init(1); 1 101 dcl PACKED_PTR_INIT fixed bin (3) unsigned static options (constant) init(2); 1 102 dcl PTR_INIT_TEXT fixed bin (17) static options (constant) init(0); 1 103 dcl PTR_INIT_LOT fixed bin (17) static options (constant) init(1); 1 104 dcl PTR_INIT_ISOT fixed bin (17) static options (constant) init(2); 1 105 1 106 1 107 /* End include file ... system_link_init_info.incl.pl1 */ 224 225 226 dcl based_vbl_area area (vsize) based; 227 228 code = 0; 229 230 if (np -> variable_node.init_type = TEMPLATE_INIT) & (np -> variable_node.init_ptr = null) 231 then do; /* this will not happen with blank common */ 232 call com_err_ (0, me (whox), "External variable ^a could not be reset.", np -> variable_node.name); 233 return; 234 end; 235 236 vsize = np -> variable_node.vbl_size; 237 238 if np -> variable_node.init_type = NO_INIT 239 then call list_init_ (np -> variable_node.vbl_ptr, null (), 240 vsize,stackbaseptr(),null(), code); 241 242 else if np -> variable_node.init_type = EMPTY_AREA_INIT 243 then np -> variable_node.vbl_ptr -> based_vbl_area = empty; 244 245 else if np -> variable_node.init_type = LIST_TEMPLATE_INIT 246 then do; /* First the variable is zeroed. */ 247 call list_init_ (np -> variable_node.vbl_ptr, 248 null (), vsize, stackbaseptr(),null(), code); 249 /* Then it is initialized. */ 250 call list_init_$variable_already_zero ( 251 np -> variable_node.vbl_ptr, 252 addr (np -> variable_node.init_ptr -> list_init_info.template), 253 vsize, stackbaseptr(), np ->variable_node.seg_ptr, 254 code); 255 end; 256 257 else unspec (np -> variable_node.vbl_ptr -> variable) = 258 unspec (np -> variable_node.init_ptr -> init_info.init_template); 259 if code ^= 0 then 260 call com_err_ (code,me," while referencing ^a", 261 np->variable_node.name); 262 263 return; 264 end; /* of reset_it */ 265 266 /* */ 267 delete_it: 268 proc; 269 270 dcl based_ptr ptr based; 271 dcl based_area area based; 272 dcl based_double bit (72) aligned based; 273 dcl block_end bit (18) aligned; 274 dcl code fixed bin (35); 275 dcl (headptr, defstartptr, linkstartptr, itsptr, vlp, lptr) 276 ptr; 277 dcl segno fixed bin; 278 2 1 /* BEGIN INCLUDE FILE its.incl.pl1 2 2* modified 27 July 79 by JRDavis to add its_unsigned 2 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 2 4 2 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 2 6 2 pad1 bit (3) unaligned, 2 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 2 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 2 9 2 pad2 bit (9) unaligned, 2 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 2 11 2 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 2 13 2 pad3 bit (3) unaligned, 2 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 2 15 2 pad4 bit (3) unaligned, 2 16 2 mod bit (6) unaligned; /* further modification */ 2 17 2 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 2 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 2 20 2 pad1 bit (27) unaligned, 2 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 2 22 2 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 2 24 2 pad2 bit (3) unaligned, 2 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 2 26 2 pad3 bit (3) unaligned, 2 27 2 mod bit (6) unaligned; /* further modification */ 2 28 2 29 2 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 2 31 2 pad1 bit (3) unaligned, 2 32 2 segno fixed bin (15) unsigned unaligned, 2 33 2 ringno fixed bin (3) unsigned unaligned, 2 34 2 pad2 bit (9) unaligned, 2 35 2 its_mod bit (6) unaligned, 2 36 2 37 2 offset fixed bin (18) unsigned unaligned, 2 38 2 pad3 bit (3) unaligned, 2 39 2 bit_offset fixed bin (6) unsigned unaligned, 2 40 2 pad4 bit (3) unaligned, 2 41 2 mod bit (6) unaligned; 2 42 2 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 2 44 2 pr_no fixed bin (3) unsigned unaligned, 2 45 2 pad1 bit (27) unaligned, 2 46 2 itp_mod bit (6) unaligned, 2 47 2 48 2 offset fixed bin (18) unsigned unaligned, 2 49 2 pad2 bit (3) unaligned, 2 50 2 bit_offset fixed bin (6) unsigned unaligned, 2 51 2 pad3 bit (3) unaligned, 2 52 2 mod bit (6) unaligned; 2 53 2 54 2 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 2 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 2 57 2 58 /* END INCLUDE FILE its.incl.pl1 */ 279 280 281 3 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 3 2 /* modified by M. Weaver 3/77 */ 3 3 3 4 dcl lotp ptr; 3 5 3 6 dcl 1 lot based (lotp) aligned, 3 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 3 8 3 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 3 10 /* lot fault has fault code = 0 and offset = 0 */ 3 11 3 12 dcl isotp ptr; 3 13 dcl 1 isot based (isotp) aligned, 3 14 2 isp (0:9999) ptr unaligned; 3 15 3 16 dcl 1 isot1 (0 :9999) aligned based, 3 17 2 flags unaligned, 3 18 3 fault bit (2) unaligned, 3 19 3 system bit (1) unaligned, 3 20 3 mbz bit (6) unaligned, 3 21 2 fault_code fixed bin (8) unaligned, 3 22 2 static_offset bit (18) unaligned; 3 23 3 24 3 25 /* END INCLUDE FILE lot.incl.pl1 */ 282 283 284 285 286 code = 0; 287 vptr = np -> variable_node.vbl_ptr; /* get value links would have */ 288 289 do segno = hcscnt + 1 to hcscnt + high_seg; 290 if rel (lotptr -> lot.lp (segno)) ^= "0"b 291 then do; 292 headptr = lotptr -> lot.lp (segno); 293 defstartptr = headptr -> header.def_ptr; 294 /* pointer to beginning of def section */ 295 linkstartptr = addrel (headptr, headptr -> header.stats.begin_links); 296 /* pointer to beginning of links */ 297 298 /* check for defs in linkage section and compute end of links */ 299 300 if (baseno (linkstartptr) = baseno (defstartptr)) 301 & (fixed (rel (defstartptr), 18) > fixed (rel (linkstartptr), 18)) 302 then block_end = rel (defstartptr);/* end of links before end of block if defs follow links */ 303 else block_end = rel (addrel (headptr, headptr -> header.stats.block_length)); 304 /* end of links and end of block are the same */ 305 306 307 do itsptr = linkstartptr repeat (addrel (itsptr, 2)) /* loop through all links */ 308 while (bin (rel (itsptr), 18) < bin (block_end, 18)); 309 if itsptr -> its.its_mod = "100011"b 310 then do; /* see if link is snapped */ 311 lptr = itsptr -> based_ptr; 312 /* do ptr copy to pick up any indirection */ 313 if lptr = vptr 314 then do; 315 vlp = headptr -> header.original_linkage_ptr; 316 itsptr -> based_double = 317 addrel (vlp, 318 bit (bin (bin (rel (itsptr), 18) - bin (rel (headptr), 18), 18))) 319 -> based_double; 320 end; 321 end; 322 end; 323 end; 324 end; 325 326 vsize = np -> variable_node.vbl_size; 327 328 if vsize > sys_info$max_seg_size 329 then call fortran_storage_manager_$free (np); 330 331 else if rel (np -> variable_node.vbl_ptr) = "0"b /* separate seg */ 332 then call delete_$ptr (np -> variable_node.vbl_ptr, "010100"b, me (whox), code); 333 else free np -> variable_node.vbl_ptr -> variable in (sb -> stack_header.user_free_ptr -> based_area); 334 tp -> variable_table_header.total_allocated_size = tp -> variable_table_header.total_allocated_size - vsize; 335 336 nchars = np -> variable_node.name_size; /* set so that free will work correctly */ 337 old_np -> variable_node.forward_thread = tnp; /* thread around node to be deleted */ 338 free np -> variable_node in (sb -> stack_header.system_free_ptr -> based_area); 339 tp -> variable_table_header.cur_num_of_variables = tp -> variable_table_header.cur_num_of_variables - 1; 340 341 deleted = "1"b; 342 return; 343 end; /* of delete_it */ 344 345 346 /* Include Files */ 4 1 /* BEGIN INCLUDE FILE ... system_link_names.incl.pl1 */ 4 2 4 3 4 4 /****^ HISTORY COMMENTS: 4 5* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), audit(86-11-12,Zwick), 4 6* install(86-11-20,MR12.0-1222): 4 7* added the declaration of the heap_header. 4 8* 2) change(86-10-20,DGHowe), approve(86-10-20,MCR7420), audit(86-11-12,Zwick), 4 9* install(86-11-20,MR12.0-1222): 4 10* add the seg ptr to the variable node structure. 4 11* END HISTORY COMMENTS */ 4 12 4 13 4 14 /* created by M. Weaver 7/28/76 */ 4 15 /* Modified: 82-11-19 by T. Oke to add LIST_TEMPLATE_INIT. */ 4 16 /* Modified 02/11/83 by M. Weaver to add have_vla_variables flag */ 4 17 4 18 4 19 dcl 1 variable_table_header aligned based, /* header for name table */ 4 20 2 hash_table (0:63) ptr unaligned, /* hash table for variable nodes */ 4 21 2 total_search_time fixed bin (71), /* total time to search for variables */ 4 22 2 total_allocation_time fixed bin (71), /* total time spent allocating and initializing nodes and variables */ 4 23 2 number_of_searches fixed bin, /* number of times names were looked up */ 4 24 2 number_of_variables fixed bin (35), /* number of variables allocated by the linker, incl deletions */ 4 25 2 flags unaligned, 4 26 3 have_vla_variables bit (1) unaligned, /* on if some variables are > sys_info$max_seg_size */ 4 27 3 pad bit (11) unaligned, 4 28 2 cur_num_of_variables fixed bin (24) unal, /* current number of variables allocated */ 4 29 2 number_of_steps fixed bin, /* total number of nodes looked at */ 4 30 2 total_allocated_size fixed bin (35); /* current amount of storage in user area */ 4 31 4 32 4 33 dcl 1 variable_node aligned based, /* individual variable information */ 4 34 2 forward_thread ptr unaligned, /* thread to next node off same hash bucket */ 4 35 2 vbl_size fixed bin (24) unsigned unaligned, /* length in words of variable */ 4 36 2 init_type fixed bin (11) unaligned, /* 0=not init; 3=init template; 4=area 5=list_template*/ 4 37 2 time_allocated fixed bin (71), /* time when variable was allocated */ 4 38 2 vbl_ptr ptr, /* pointer to variable's storage */ 4 39 2 init_ptr ptr, /* pointer to original init info in object seg */ 4 40 2 name_size fixed bin(21) aligned, /* length of name in characters */ 4 41 2 name char (nchars refer (variable_node.name_size)), /* name of variable */ 4 42 2 seg_ptr pointer; 4 43 4 44 /* variable_node.seg_ptr 4 45* Is a pointer to the segment containing the initialization information 4 46* for this variable. It is used as a segment base pointer for external 4 47* pointer initialization via list_init_. 4 48* 4 49* The init_ptr can not be used as a reference to the defining segment 4 50* due to the possibility of set_fortran_common being used to initialize 4 51* the external variables. sfc will generate an initialization information 4 52* structure if multiple intialization sizes are found in the specified 4 53* segments. sfc stores the address of this structure in the init_ptr field. 4 54* This is one reason why sfc does not perform external pointer 4 55* initialization. 4 56* 4 57* The seg_ptr is set to point at the segment used to define the 4 58* initialization information. term_ sets this field to null on termination 4 59* due to the possiblity of executing a different segment which defines 4 60* initialization information. In this way the seg_ptr field will either 4 61* be valid or null. 4 62**/ 4 63 4 64 dcl 1 heap_header based, 4 65 2 version char(8), /* specifies the verison of the header */ 4 66 2 heap_name_list_ptr pointer, /* points to the variable_table_header for this heap */ 4 67 2 previous_heap_ptr pointer, /* points to the previous heap or is null */ 4 68 2 area_ptr pointer, /* points to the heap area */ 4 69 2 execution_level fixed bin (17); /* specifies the execution level this header deals with */ 4 70 4 71 dcl heap_header_version_1 char(8) static options (constant) 4 72 init ("Heap_v01"); 4 73 4 74 4 75 /* END INCLUDE FILE ... system_link_names.incl.pl1 */ 347 348 5 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 5 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 5 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 5 4 /* Modified April 1983 by C. Hornig for tasking */ 5 5 5 6 /****^ HISTORY COMMENTS: 5 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 5 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 5 9* added the heap_header_ptr definition. 5 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 5 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 5 12* Modified to support control point management. These changes were actually 5 13* made in February 1985 by G. Palter. 5 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 5 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 5 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 5 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 5 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 5 19* (ITS pair). 5 20* END HISTORY COMMENTS */ 5 21 5 22 /* format: style2 */ 5 23 5 24 dcl sb ptr; /* the main pointer to the stack header */ 5 25 5 26 dcl 1 stack_header based (sb) aligned, 5 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 5 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 5 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 5 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 5 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 5 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 5 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 5 34 2 pad4 bit (2) unal, 5 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 5 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 5 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 5 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 5 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 5 40 2 null_ptr ptr, /* (16) */ 5 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 5 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 5 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 5 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 5 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 5 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 5 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 5 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 5 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 5 50 2 return_no_pop_op_ptr 5 51 ptr, /* (36) pointer to standard return / no pop operator */ 5 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 5 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 5 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 5 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 5 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 5 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 5 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 5 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 5 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 5 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 5 62 2 trace, 5 63 3 frames, 5 64 4 count fixed bin, /* (58) number of trace frames */ 5 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 5 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 5 67 2 pad2 bit (36), /* (61) */ 5 68 2 pad5 pointer; /* (62) pointer to future stuff */ 5 69 5 70 /* The following offset refers to a table within the pl1 operator table. */ 5 71 5 72 dcl tv_offset fixed bin init (361) internal static; 5 73 /* (551) octal */ 5 74 5 75 5 76 /* The following constants are offsets within this transfer vector table. */ 5 77 5 78 dcl ( 5 79 call_offset fixed bin init (271), 5 80 push_offset fixed bin init (272), 5 81 return_offset fixed bin init (273), 5 82 return_no_pop_offset fixed bin init (274), 5 83 entry_offset fixed bin init (275) 5 84 ) internal static; 5 85 5 86 5 87 5 88 5 89 5 90 /* The following declaration is an overlay of the whole stack header. Procedures which 5 91* move the whole stack header should use this overlay. 5 92**/ 5 93 5 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 5 95 5 96 5 97 5 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 349 350 6 1 /* BEGIN INCLUDE FILE linkdcl.incl.pl1 --- last modified 15 Nov 1971 by C Garman */ 6 2 6 3 /* Last Modified (Date and Reason): 6 4* 6/75 by M.Weaver to add virgin_linkage_header declaration 6 5* 6/75 by S.Webber to comment existing structures better 6 6* 9/77 by M. Weaver to add run_depth to link 6 7* 2/83 by M. Weaver to add linkage header flags and change run_depth precision 6 8**/ 6 9 6 10 /* format: style3 */ 6 11 dcl 1 link based aligned, /* link pair in linkage section */ 6 12 2 head_ptr bit (18) unal, /* rel pointer to beginning of linkage section */ 6 13 2 ringno bit (3) unal, 6 14 2 mbz bit (6) unal, 6 15 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 6 16 2 ft2 bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 6 17 2 exp_ptr bit (18) unal, /* pointer (rel to defs) of expression word */ 6 18 2 mbz2 bit (12) unal, 6 19 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 6 20 6 21 dcl 1 exp_word based aligned, /* expression word in link definition */ 6 22 2 type_ptr bit (18) unal, /* pointer (rel to defs) of type pair structure */ 6 23 2 exp bit (18) unal; /* constant expression to be added in when snapping link */ 6 24 6 25 dcl 1 type_pair based aligned, /* type pair in link definition */ 6 26 2 type bit (18) unal, /* type of link. may be 1,2,3,4,5, or 6 */ 6 27 2 trap_ptr bit (18) unal, /* pointer (rel to defs) to the trap word */ 6 28 2 seg_ptr bit (18) unal, /* pointer to ACC reference name for segment referenced */ 6 29 2 ext_ptr bit (18) unal; /* pointer (rel to defs) of ACC segdef name */ 6 30 6 31 dcl 1 header based aligned, /* linkage block header */ 6 32 2 def_ptr ptr, /* pointer to definition section */ 6 33 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 6 34 2 original_linkage_ptr 6 35 ptr unal, /* pointer to linkage section in object segment */ 6 36 2 unused bit (72), 6 37 2 stats, 6 38 3 begin_links bit (18) unal, /* offset (rel to this section) of first link */ 6 39 3 block_length bit (18) unal, /* number of words in this linkage section */ 6 40 3 segment_number 6 41 bit (18) unal, /* text segment number associated with this section */ 6 42 3 static_length bit (18) unal; /* number of words of static for this segment */ 6 43 6 44 dcl 1 linkage_header_flags 6 45 aligned based, /* overlay of def_ptr for flags */ 6 46 2 pad1 bit (28) unaligned, /* flags are in first word */ 6 47 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 6 48 2 perprocess_static 6 49 bit (1) unaligned, /* 1 copy of static section is used by all tasks/run units */ 6 50 2 pad2 bit (6) unaligned; 6 51 6 52 dcl 1 virgin_linkage_header 6 53 aligned based, /* template for linkage header in object segment */ 6 54 2 pad bit (30) unaligned, /* is filled in by linker */ 6 55 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 6 56 2 def_offset bit (18) unaligned, /* offset of definition section */ 6 57 2 first_ref_relp bit (18) unaligned, /* offset of trap-at-first-reference offset array */ 6 58 2 filled_in_later bit (144), 6 59 2 link_begin bit (18) unaligned, /* offset of first link */ 6 60 2 linkage_section_lng 6 61 bit (18) unaligned, /* length of linkage section */ 6 62 2 segno_pad bit (18) unaligned, /* will be segment number of copied linkage */ 6 63 2 static_length bit (18) unaligned; /* length of static section */ 6 64 6 65 6 66 dcl 1 trap_word based aligned, /* trap word in link definition */ 6 67 2 call_ptr bit (18) unal, /* pointer (rel to link) of link to trap procedure */ 6 68 2 arg_ptr bit (18) unal; /* pointer (rel to link) of link to arg info for trap proc */ 6 69 6 70 dcl 1 name based aligned, /* storage of ASCII names in definitions */ 6 71 2 nchars bit (9) unaligned, /* number of characters in name */ 6 72 2 char_string char (31) unaligned; /* 31-character name */ 6 73 6 74 /* END INCLUDE FILE linkdcl.incl.pl1 */ 351 352 353 354 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/20/86 1142.4 reset_external_variables.pl1 >special_ldd>install>MR12.0-1222>reset_external_variables.pl1 224 1 11/20/86 1035.4 system_link_init_info.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_init_info.incl.pl1 279 2 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.incl.pl1 282 3 08/05/77 1022.4 lot.incl.pl1 >ldd>include>lot.incl.pl1 347 4 11/20/86 1035.4 system_link_names.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_names.incl.pl1 349 5 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 351 6 07/27/83 0910.0 linkdcl.incl.pl1 >ldd>include>linkdcl.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. EMPTY_AREA_INIT constant fixed bin(17,0) initial dcl 1-97 ref 242 LIST_TEMPLATE_INIT constant fixed bin(17,0) initial dcl 1-98 ref 245 NO_INIT constant fixed bin(17,0) initial dcl 1-95 ref 238 TEMPLATE_INIT constant fixed bin(17,0) initial dcl 1-96 ref 230 addr builtin function dcl 54 ref 83 164 250 250 addrel builtin function dcl 54 ref 295 303 316 322 alng 000104 automatic fixed bin(17,0) dcl 35 set ref 112* 115 115 118 120 120 128 128 140 142 142 145 146 alp 000134 automatic pointer dcl 40 set ref 98* 112* aptr 000122 automatic pointer dcl 40 set ref 112* 115 118 120 120 128 142 145 arg based char unaligned dcl 42 set ref 115* 118 120 120 128* 142* 145 based_area based area(1024) dcl 271 ref 333 338 based_double based bit(72) dcl 272 set ref 316* 316 based_ptr based pointer dcl 270 ref 311 based_vbl_area based area dcl 226 set ref 242* baseno builtin function dcl 54 ref 300 300 begin_links 6 based bit(18) level 3 packed unaligned dcl 6-31 ref 295 bin builtin function dcl 54 ref 307 307 316 316 316 bit builtin function dcl 54 ref 316 block_end 000100 automatic bit(18) dcl 273 set ref 300* 303* 307 block_length 6(18) based bit(18) level 3 packed unaligned dcl 6-31 ref 303 code 000101 automatic fixed bin(35,0) dcl 274 in procedure "delete_it" set ref 286* 331* code 000113 automatic fixed bin(35,0) dcl 38 in procedure "rev" set ref 81* 112* 113 115* code 000100 automatic fixed bin(35,0) dcl 222 in procedure "reset_it" set ref 228* 238* 247* 250* 259 259* com_err_ 000020 constant entry external dcl 58 ref 87 115 128 136 142 155 232 259 cu_$arg_count 000024 constant entry external dcl 59 ref 99 cu_$arg_list_ptr 000030 constant entry external dcl 61 ref 98 cu_$arg_ptr_rel 000026 constant entry external dcl 60 ref 112 cur_num_of_variables 106(12) based fixed bin(24,0) level 2 packed unaligned dcl 4-19 set ref 91 339* 339 def_ptr based pointer level 2 dcl 6-31 ref 293 defstartptr 000104 automatic pointer dcl 275 set ref 293* 300 300 300 delete_$ptr 000034 constant entry external dcl 64 ref 331 deleted 000115 automatic bit(1) dcl 39 set ref 167* 186 341* do_it 000160 automatic entry variable dcl 47 set ref 77* 177 214* empty builtin function dcl 54 ref 242 error_table_$badopt 000010 external static fixed bin(35,0) dcl 48 set ref 128* error_table_$bigarg 000014 external static fixed bin(35,0) dcl 48 set ref 142* error_table_$noarg 000016 external static fixed bin(35,0) dcl 53 set ref 155* error_table_$too_many_args 000012 external static fixed bin(35,0) dcl 48 set ref 136* fatal 000114 automatic bit(1) dcl 39 set ref 95* 116* 129* 143* 151 fixed builtin function dcl 54 ref 300 300 fortran_storage_manager_$free 000036 constant entry external dcl 66 ref 328 forward_thread based pointer level 2 packed unaligned dcl 4-33 set ref 169 337* found 21(18) 000100 automatic bit(1) array level 2 packed unaligned dcl 102 set ref 125* 147* 172 178* 194 hash_table based pointer array level 2 packed unaligned dcl 4-19 set ref 162 162 164 165 hbound builtin function dcl 54 ref 134 136 136 162 hcs_$high_low_seg_count 000032 constant entry external dcl 62 ref 215 hcscnt 000110 automatic fixed bin(17,0) dcl 35 set ref 215* 289 289 header based structure level 1 dcl 6-31 headptr 000102 automatic pointer dcl 275 set ref 292* 293 295 295 303 303 315 316 high_seg 000107 automatic fixed bin(17,0) dcl 35 set ref 215* 289 i 000100 automatic fixed bin(17,0) dcl 35 set ref 111* 112* 162* 164 165* 193* 194 196 198* init_info based structure level 1 dcl 1-30 init_ptr 6 based pointer level 2 dcl 4-33 ref 230 250 250 257 init_template 2 based fixed bin(35,0) array level 2 dcl 1-30 ref 257 init_type 1(24) based fixed bin(11,0) level 2 packed unaligned dcl 4-33 ref 230 238 242 245 ioa_ 000022 constant entry external dcl 58 ref 192 199 its based structure level 1 dcl 2-5 its_mod 0(30) based bit(6) level 2 packed unaligned dcl 2-5 ref 309 itsptr 000110 automatic pointer dcl 275 set ref 307* 307* 309 311 316 316* 322 j 000101 automatic fixed bin(17,0) dcl 35 set ref 171* 172 174 174 178* lbound builtin function dcl 54 ref 162 linkstartptr 000106 automatic pointer dcl 275 set ref 295* 300 300 307 list 000100 automatic structure array level 1 dcl 102 set ref 134 136 136 list_init_ 000040 constant entry external dcl 68 ref 238 247 list_init_$variable_already_zero 000042 constant entry external dcl 70 ref 250 list_init_info based structure level 1 dcl 1-41 lot based structure level 1 dcl 3-6 lot_ptr 26 based pointer level 2 dcl 5-26 ref 93 lotptr 000126 automatic pointer dcl 40 set ref 93* 290 292 lp based pointer array level 2 packed unaligned dcl 3-6 ref 290 292 lptr 000114 automatic pointer dcl 275 set ref 311* 313 me 000000 constant char(25) initial array unaligned dcl 44 set ref 87* 115* 128* 136* 142* 155* 232* 259* 331* n 000102 automatic fixed bin(17,0) dcl 35 set ref 99* 102 111 name 000100 automatic char(65) array level 2 in structure "list" dcl 102 in begin block on line 101 set ref 123* 145* 174 196 198 name 11 based char level 2 in structure "variable_node" dcl 4-33 in procedure "rev" set ref 174 232* 259* name_size 10 based fixed bin(21,0) level 2 dcl 4-33 ref 174 174 232 232 250 259 259 336 338 nchars 000111 automatic fixed bin(17,0) dcl 35 set ref 336* nnames 000105 automatic fixed bin(17,0) dcl 35 set ref 83 96* 122* 122 123 124 125 133* 133 134 145 146 147 153 171 180 193 np 000120 automatic pointer dcl 40 set ref 168* 169 174 174 186 230 230 232 236 238 238 242 242 245 247 250 250 250 250 257 257 259 287 326 328* 331 331 333 336 338 nprocessed 000106 automatic fixed bin(17,0) dcl 35 set ref 97* 179* 179 180 nsize 21 000100 automatic fixed bin(17,0) array level 2 packed unaligned dcl 102 set ref 124* 146* 174 null builtin function dcl 54 ref 85 166 230 238 238 238 238 247 247 247 247 old_np 000132 automatic pointer dcl 40 set ref 164* 186* 337 original_linkage_ptr 3 based pointer level 2 packed unaligned dcl 6-31 ref 315 ptr builtin function dcl 54 ref 83 rel builtin function dcl 54 ref 290 300 300 300 303 307 316 316 331 sb 000164 automatic pointer dcl 5-24 set ref 83* 84 93 333 338 seg_ptr based pointer level 2 dcl 4-33 set ref 250* segno 000116 automatic fixed bin(17,0) dcl 277 set ref 289* 290 292* size based fixed bin(35,0) level 2 dcl 1-30 ref 257 stack_header based structure level 1 dcl 5-26 stackbaseptr builtin function dcl 54 ref 238 238 247 247 250 250 stats 6 based structure level 2 dcl 6-31 substr AWTaylor $8 AWTaylor awt Multics |R; TIET%mnoneVIP7400_DTR NݞMZAllen ކ ކ Allen NMLPROD QvQvQnoneWY50_80C QjEBHas  Smith as Develcon KY L&iFKiwnoneVIP7400_DTR automatic pointer dcl 1-27 init_info_single_word based structure level 1 dcl 1-35 init_n_bits_in_datum automatic fixed bin(35,0) dcl 1-93 init_size automatic fixed bin(35,0) dcl 1-28 isot based structure level 1 dcl 3-13 isot1 based structure array level 1 dcl 3-16 isotp automatic pointer dcl 3-12 itp based structure level 1 dcl 2-18 itp_unsigned based structure level 1 dcl 2-43 its_unsigned based structure level 1 dcl 2-30 link based structure level 1 dcl 6-11 linkage_header_flags based structure level 1 dcl 6-44 list_template_entry based structure level 1 dcl 1-60 list_template_entry_ptr based structure level 1 dcl 1-73 lot_fault internal static bit(36) initial dcl 3-9 lotp automatic pointer dcl 3-4 name based structure level 1 dcl 6-70 pointer_init_template based structure level 1 packed unaligned dcl 1-85 push_offset internal static fixed bin(17,0) initial dcl 5-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 5-78 return_offset internal static fixed bin(17,0) initial dcl 5-78 stack_header_overlay based fixed bin(17,0) array dcl 5-94 trap_word based structure level 1 dcl 6-66 tv_offset internal static fixed bin(17,0) initial dcl 5-72 type_pair based structure level 1 dcl 6-25 virgin_linkage_header based structure level 1 dcl 6-52 NAMES DECLARED BY EXPLICIT CONTEXT. delete_external_variables 001032 constant entry external dcl 209 delete_it 001350 constant entry internal dcl 267 ref 214 dev 001023 constant entry external dcl 209 join 000151 constant label dcl 81 ref 216 next_name 000717 constant label dcl 186 ref 182 no_variables 000164 constant label dcl 87 ref 91 reset_external_variables 000137 constant entry external dcl 20 reset_it 001057 constant entry internal dcl 219 ref 77 rev 000130 constant entry external dcl 20 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2110 2156 1643 2120 Length 2524 1643 46 332 244 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME rev 144 external procedure is an external procedure. begin block on line 101 116 begin block uses auto adjustable storage. reset_it 102 internal procedure is assigned to an entry variable. delete_it 106 internal procedure is assigned to an entry variable. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 101 000100 list begin block on line 101 delete_it 000100 block_end delete_it 000101 code delete_it 000102 headptr delete_it 000104 defstartptr delete_it 000106 linkstartptr delete_it 000110 itsptr delete_it 000112 vlp delete_it 000114 lptr delete_it 000116 segno delete_it reset_it 000100 code reset_it rev 000100 i rev 000101 j rev 000102 n rev 000103 whox rev 000104 alng rev 000105 nnames rev 000106 nprocessed rev 000107 high_seg rev 000110 hcscnt rev 000111 nchars rev 000112 vsize rev 000113 code rev 000114 fatal rev 000115 deleted rev 000116 tp rev 000120 np rev 000122 aptr rev 000124 vptr rev 000126 lotptr rev 000130 tnp rev 000132 old_np rev 000134 alp rev 000136 vname rev 000160 do_it rev 000164 sb rev THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. enter_begin_block leave_begin_block call_ent_var call_ext_out_desc call_ext_out begin_return_mac return_mac alloc_auto_adj ext_entry int_entry op_freen_ op_empty_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr_rel delete_$ptr fortran_storage_manager_$free hcs_$high_low_seg_count ioa_ list_init_ list_init_$variable_already_zero THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$bigarg error_table_$noarg error_table_$too_many_args sys_info$max_seg_size CONSTANTS 001641 aa 777777377777 000000 aa 162 145 163 145 rese 000001 aa 164 137 145 170 t_ex 000002 aa 164 145 162 156 tern 000003 aa 141 154 137 166 al_v 000004 aa 141 162 151 141 aria 000005 aa 142 154 145 163 bles 000006 aa 040 144 145 154 del 000007 aa 145 164 145 137 ete_ 000010 aa 145 170 164 145 exte 000011 aa 162 156 141 154 rnal 000012 aa 137 166 141 162 _var 000013 aa 151 141 142 154 iabl 000014 aa 145 163 000 000 es 000015 aa 514000000006 000016 aa 524000000025 000017 aa 524000000000 000020 aa 524000000050 000021 aa 526000000101 000022 aa 524000000002 000023 aa 524000000051 000024 aa 404000000030 000025 aa 524000000020 000026 aa 055 165 143 000 -uc 001642 aa 055 000 000 000 - 000027 aa 526000000000 000030 aa 404000000043 000031 aa 524000000040 000032 aa 526000000031 000033 aa 404000000005 000034 aa 464000000000 000035 aa 404000000021 000036 aa 142 154 156 153 blnk 000037 aa 052 143 157 155 *com 000040 aa 077777000043 000041 aa 000001000000 000042 aa 526100000031 000043 aa 000000000001 000044 aa 000000000002 000045 aa 000000000341 000046 aa 136 144 040 156 ^d n 000047 aa 141 155 145 163 ames 000050 aa 040 155 141 170 max 000051 aa 151 155 165 155 imum 000052 aa 165 156 154 141 unla 000053 aa 142 145 154 154 bell 000054 aa 145 144 040 143 ed c 000055 aa 157 155 155 157 ommo 000056 aa 156 000 000 000 n 000057 aa 055 165 156 154 -unl 000060 aa 141 142 145 154 abel 000061 aa 154 145 144 137 led_ 000062 aa 143 157 155 155 comm 000063 aa 157 156 000 000 on 000064 aa 040 167 150 151 whi 000065 aa 154 145 040 162 le r 000066 aa 145 146 145 162 efer 000067 aa 145 156 143 151 enci 000070 aa 156 147 040 136 ng ^ 000071 aa 141 000 000 000 a 000072 aa 124 150 145 162 Ther 000073 aa 145 040 141 162 e ar 000074 aa 145 040 156 157 e no 000075 aa 040 145 170 164 ext 000076 aa 145 162 156 141 erna 000077 aa 154 040 166 141 l va 000100 aa 162 151 141 142 riab 000101 aa 154 145 163 056 les. 000102 aa 105 170 164 145 Exte 000103 aa 162 156 141 154 rnal 000104 aa 040 166 141 162 var 000105 aa 151 141 142 154 iabl 000106 aa 145 040 136 141 e ^a 000107 aa 040 143 157 165 cou 000110 aa 154 144 040 156 ld n 000111 aa 157 164 040 142 ot b 000112 aa 145 040 162 145 e re 000113 aa 163 145 164 056 set. 000114 aa 136 057 124 150 ^/Th 000115 aa 145 040 146 157 e fo 000116 aa 154 154 157 167 llow 000117 aa 151 156 147 040 ing 000120 aa 166 141 162 151 vari 000121 aa 141 142 154 145 able 000122 aa 163 040 167 145 s we 000123 aa 162 145 040 156 re n 000124 aa 157 164 040 146 ot f 000125 aa 157 165 156 144 ound 000126 aa 072 000 000 000 : BEGIN PROCEDURE rev ENTRY TO rev STATEMENT 1 ON LINE 20 reset_external_variables: rev: proc; 000127 da 000203200000 000130 aa 000220 6270 00 eax7 144 000131 aa 7 00034 3521 20 epp2 pr7|28,* 000132 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000133 aa 000000000000 000134 aa 000000000000 000135 aa 000007 7100 04 tra 7,ic 000144 ENTRY TO reset_external_variables STATEMENT 1 ON LINE 20 reset_external_variables: rev: proc; 000136 da 000206200000 000137 aa 000220 6270 00 eax7 144 000140 aa 7 00034 3521 20 epp2 pr7|28,* 000141 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000142 aa 000000000000 000143 aa 000000000000 STATEMENT 1 ON LINE 76 whox = 1; 000144 aa 000001 2360 07 ldq 1,dl 000145 aa 6 00103 7561 00 stq pr6|67 whox STATEMENT 1 ON LINE 77 do_it = reset_it; 000146 aa 000711 3520 04 epp2 457,ic 001057 = 000160627000 000147 aa 6 00160 2521 00 spri2 pr6|112 do_it 000150 aa 6 00162 6521 00 spri6 pr6|114 do_it STATEMENT 1 ON LINE 81 join: code = 0; 000151 aa 6 00113 4501 00 stz pr6|75 code STATEMENT 1 ON LINE 83 sb = ptr (addr (nnames), 0); 000152 aa 6 00105 3735 00 epp7 pr6|69 nnames 000153 aa 7 00000 3525 00 epbp2 pr7|0 000154 aa 6 00164 2521 00 spri2 pr6|116 sb STATEMENT 1 ON LINE 84 tp = sb -> stack_header.sys_link_info_ptr; 000155 aa 2 00060 3715 20 epp5 pr2|48,* stack_header.sys_link_info_ptr 000156 aa 6 00116 6515 00 spri5 pr6|78 tp STATEMENT 1 ON LINE 85 if tp = null then do; 000157 aa 6 00116 2371 00 ldaq pr6|78 tp 000160 aa 777660 6770 04 eraq -80,ic 000040 = 077777000043 000001000000 000161 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000162 aa 6 00166 6535 00 spri7 pr6|118 000163 aa 000033 6010 04 tnz 27,ic 000216 STATEMENT 1 ON LINE 87 no_variables: call com_err_ (0, me (whox), "There are no external variables."); 000164 aa 6 00170 4501 00 stz pr6|120 000165 aa 6 00103 2361 00 ldq pr6|67 whox 000166 aa 000031 4020 07 mpy 25,dl 000167 aa 000 100 100 404 mlr (ic),(pr),fill(000) 000170 aa 777703 00 0040 desc9a -61,32 000072 = 124150145162 000171 aa 6 00172 00 0040 desc9a pr6|122,32 000172 aa 6 00170 3521 00 epp2 pr6|120 000173 aa 6 00204 2521 00 spri2 pr6|132 000174 aa 000003 6270 06 eax7 3,ql 000175 ta 777771 3520 00 epp2 -7 000176 aa 2 00000 5005 17 a9bd pr2|0,7 000177 aa 6 00206 2521 00 spri2 pr6|134 000200 aa 6 00172 3521 00 epp2 pr6|122 000201 aa 6 00210 2521 00 spri2 pr6|136 000202 aa 777631 3520 04 epp2 -103,ic 000033 = 404000000005 000203 aa 6 00212 2521 00 spri2 pr6|138 000204 aa 777626 3520 04 epp2 -106,ic 000032 = 526000000031 000205 aa 6 00214 2521 00 spri2 pr6|140 000206 aa 777623 3520 04 epp2 -109,ic 000031 = 524000000040 000207 aa 6 00216 2521 00 spri2 pr6|142 000210 aa 6 00202 6211 00 eax1 pr6|130 000211 aa 014000 4310 07 fld 6144,dl 000212 aa 6 00044 3701 20 epp4 pr6|36,* 000213 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000214 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 89 return; 000215 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 90 end; STATEMENT 1 ON LINE 91 if tp -> variable_table_header.cur_num_of_variables < 1 then goto no_variables; 000216 aa 5 00106 2351 00 lda pr5|70 variable_table_header.cur_num_of_variables 000217 aa 5 00107 2361 00 ldq pr5|71 variable_table_header.cur_num_of_variables 000220 aa 000014 7370 00 lls 12 000221 aa 000057 7330 00 lrs 47 000222 aa 000001 1160 07 cmpq 1,dl 000223 aa 777741 6040 04 tmi -31,ic 000164 STATEMENT 1 ON LINE 93 lotptr = sb -> stack_header.lot_ptr; 000224 aa 2 00026 3535 20 epp3 pr2|22,* stack_header.lot_ptr 000225 aa 6 00126 2535 00 spri3 pr6|86 lotptr STATEMENT 1 ON LINE 95 fatal = "0"b; 000226 aa 6 00114 4501 00 stz pr6|76 fatal STATEMENT 1 ON LINE 96 nnames = 0; 000227 aa 6 00105 4501 00 stz pr6|69 nnames STATEMENT 1 ON LINE 97 nprocessed = 0; 000230 aa 6 00106 4501 00 stz pr6|70 nprocessed STATEMENT 1 ON LINE 98 alp = cu_$arg_list_ptr (); 000231 aa 6 00134 3521 00 epp2 pr6|92 alp 000232 aa 6 00174 2521 00 spri2 pr6|124 000233 aa 6 00172 6211 00 eax1 pr6|122 000234 aa 004000 4310 07 fld 2048,dl 000235 aa 6 00044 3701 20 epp4 pr6|36,* 000236 la 4 00030 3521 20 epp2 pr4|24,* cu_$arg_list_ptr 000237 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 99 n = cu_$arg_count (); 000240 aa 6 00102 3521 00 epp2 pr6|66 n 000241 aa 6 00174 2521 00 spri2 pr6|124 000242 aa 6 00172 6211 00 eax1 pr6|122 000243 aa 004000 4310 07 fld 2048,dl 000244 aa 6 00044 3701 20 epp4 pr6|36,* 000245 la 4 00024 3521 20 epp2 pr4|20,* cu_$arg_count 000246 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 101 begin; 000247 aa 000200 6270 00 eax7 128 000250 aa 0 00614 2721 00 tsp2 pr0|396 enter_begin_block 000251 aa 000000000000 BEGIN BLOCK 1 PROLOGUE SEQUENCE STATEMENT 1 ON LINE 102 000252 aa 6 00040 3735 20 epp7 pr6|32,* 000253 aa 7 00102 2361 00 ldq pr7|66 n 000254 aa 6 00102 7561 00 stq pr6|66 000255 aa 000022 4020 07 mpy 18,dl 000256 aa 0 00661 7001 00 tsx0 pr0|433 alloc_auto_adj 000257 aa 6 00100 2521 00 spri2 pr6|64 MAIN SEQUENCE STATEMENT 1 ON LINE 111 do i = 1 to n; 000260 aa 7 00102 2361 00 ldq pr7|66 n 000261 aa 6 00103 7561 00 stq pr6|67 000262 aa 000001 2360 07 ldq 1,dl 000263 aa 7 00100 7561 00 stq pr7|64 i 000264 aa 6 00040 3735 20 epp7 pr6|32,* 000265 aa 7 00100 2361 00 ldq pr7|64 i 000266 aa 6 00103 1161 00 cmpq pr6|67 000267 aa 000277 6054 04 tpnz 191,ic 000566 STATEMENT 1 ON LINE 112 call cu_$arg_ptr_rel (i, aptr, alng, code, alp); 000270 aa 7 00100 3521 00 epp2 pr7|64 i 000271 aa 6 00110 2521 00 spri2 pr6|72 000272 aa 7 00122 3521 00 epp2 pr7|82 aptr 000273 aa 6 00112 2521 00 spri2 pr6|74 000274 aa 7 00104 3521 00 epp2 pr7|68 alng 000275 aa 6 00114 2521 00 spri2 pr6|76 000276 aa 7 00113 3521 00 epp2 pr7|75 code 000277 aa 6 00116 2521 00 spri2 pr6|78 000300 aa 7 00134 3521 00 epp2 pr7|92 alp 000301 aa 6 00120 2521 00 spri2 pr6|80 000302 aa 6 00106 6211 00 eax1 pr6|70 000303 aa 024000 4310 07 fld 10240,dl 000304 aa 6 00044 3701 20 epp4 pr6|36,* 000305 la 4 00026 3521 20 epp2 pr4|22,* cu_$arg_ptr_rel 000306 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 113 if code ^= 0 then do; 000307 aa 6 00040 3735 20 epp7 pr6|32,* 000310 aa 7 00113 2361 00 ldq pr7|75 code 000311 aa 000035 6000 04 tze 29,ic 000346 STATEMENT 1 ON LINE 115 call com_err_ (code, me (whox), arg); 000312 aa 7 00104 2361 00 ldq pr7|68 alng 000313 aa 526000 2760 03 orq 175104,du 000314 aa 6 00122 7561 00 stq pr6|82 000315 aa 7 00103 2361 00 ldq pr7|67 whox 000316 aa 000031 4020 07 mpy 25,dl 000317 aa 7 00113 3521 00 epp2 pr7|75 code 000320 aa 6 00126 2521 00 spri2 pr6|86 000321 aa 000003 6270 06 eax7 3,ql 000322 ta 777771 3520 00 epp2 -7 000323 aa 2 00000 5005 17 a9bd pr2|0,7 000324 aa 6 00130 2521 00 spri2 pr6|88 000325 aa 7 00122 3521 20 epp2 pr7|82,* arg 000326 aa 6 00132 2521 00 spri2 pr6|90 000327 aa 777501 3520 04 epp2 -191,ic 000030 = 404000000043 000330 aa 6 00134 2521 00 spri2 pr6|92 000331 aa 777501 3520 04 epp2 -191,ic 000032 = 526000000031 000332 aa 6 00136 2521 00 spri2 pr6|94 000333 aa 6 00122 3521 00 epp2 pr6|82 000334 aa 6 00140 2521 00 spri2 pr6|96 000335 aa 6 00124 6211 00 eax1 pr6|84 000336 aa 014000 4310 07 fld 6144,dl 000337 aa 6 00044 3701 20 epp4 pr6|36,* 000340 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000341 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 116 fatal = "1"b; 000342 aa 400000 2350 03 lda 131072,du 000343 aa 6 00040 3735 20 epp7 pr6|32,* 000344 aa 7 00114 7551 00 sta pr7|76 fatal STATEMENT 1 ON LINE 117 end; 000345 aa 000217 7100 04 tra 143,ic 000564 STATEMENT 1 ON LINE 118 else if substr (arg, 1, 1) = "-" then do; 000346 aa 7 00122 3715 20 epp5 pr7|82,* aptr 000347 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 000350 aa 5 00000 00 0001 desc9a pr5|0,1 arg 000351 aa 001273 00 0001 desc9a 699,1 001642 = 055000000000 000352 aa 000065 6010 04 tnz 53,ic 000437 STATEMENT 1 ON LINE 120 if arg = "-unlabelled_common" | arg = "-uc" then do; 000353 aa 7 00104 7271 00 lxl7 pr7|68 alng 000354 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000355 aa 5 00000 00 0017 desc9a pr5|0,x7 arg 000356 aa 777503 00 0022 desc9a -189,18 000057 = 055165156154 000357 aa 000005 6000 04 tze 5,ic 000364 000360 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000361 aa 5 00000 00 0017 desc9a pr5|0,x7 arg 000362 aa 777446 00 0003 desc9a -218,3 000026 = 055165143000 000363 aa 000020 6010 04 tnz 16,ic 000403 STATEMENT 1 ON LINE 122 nnames = nnames + 1; 000364 aa 7 00105 0541 00 aos pr7|69 nnames STATEMENT 1 ON LINE 123 list (nnames).name = "blnk*com"; 000365 aa 7 00105 2361 00 ldq pr7|69 nnames 000366 aa 000022 4020 07 mpy 18,dl 000367 aa 6 00100 3535 20 epp3 pr6|64,* 000370 aa 3 77756 3535 06 epp3 pr3|-18,ql list.name 000371 aa 040 100 100 404 mlr (ic),(pr),fill(040) 000372 aa 777445 00 0010 desc9a -219,8 000036 = 142154156153 000373 aa 3 00000 00 0101 desc9a pr3|0,65 list.name STATEMENT 1 ON LINE 124 list (nnames).nsize = 8; 000374 aa 000010 2350 03 lda 8,du 000375 aa 6 00100 3515 20 epp1 pr6|64,* 000376 aa 1 77777 3535 06 epp3 pr1|-1,ql list.nsize 000377 aa 3 00000 5511 60 stba pr3|0,60 list.nsize STATEMENT 1 ON LINE 125 list (nnames).found = "0"b; 000400 aa 001241 2350 04 lda 673,ic 001641 = 777777377777 000401 aa 1 77777 3551 06 ansa pr1|-1,ql list.found STATEMENT 1 ON LINE 126 end; 000402 aa 000162 7100 04 tra 114,ic 000564 STATEMENT 1 ON LINE 127 else do; STATEMENT 1 ON LINE 128 call com_err_ (error_table_$badopt, me (whox), arg); 000403 aa 7 00104 2361 00 ldq pr7|68 alng 000404 aa 526000 2760 03 orq 175104,du 000405 aa 6 00122 7561 00 stq pr6|82 000406 aa 7 00103 2361 00 ldq pr7|67 whox 000407 aa 000031 4020 07 mpy 25,dl 000410 aa 6 00044 3701 20 epp4 pr6|36,* 000411 la 4 00010 3521 20 epp2 pr4|8,* error_table_$badopt 000412 aa 6 00126 2521 00 spri2 pr6|86 000413 aa 000003 6260 06 eax6 3,ql 000414 ta 777771 3520 00 epp2 -7 000415 aa 2 00000 5005 16 a9bd pr2|0,6 000416 aa 6 00130 2521 00 spri2 pr6|88 000417 aa 5 00000 3521 00 epp2 pr5|0 arg 000420 aa 6 00132 2521 00 spri2 pr6|90 000421 aa 777407 3520 04 epp2 -249,ic 000030 = 404000000043 000422 aa 6 00134 2521 00 spri2 pr6|92 000423 aa 777407 3520 04 epp2 -249,ic 000032 = 526000000031 000424 aa 6 00136 2521 00 spri2 pr6|94 000425 aa 6 00122 3521 00 epp2 pr6|82 000426 aa 6 00140 2521 00 spri2 pr6|96 000427 aa 6 00124 6211 00 eax1 pr6|84 000430 aa 014000 4310 07 fld 6144,dl 000431 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000432 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 129 fatal = "1"b; 000433 aa 400000 2350 03 lda 131072,du 000434 aa 6 00040 3735 20 epp7 pr6|32,* 000435 aa 7 00114 7551 00 sta pr7|76 fatal STATEMENT 1 ON LINE 130 end; STATEMENT 1 ON LINE 131 end; 000436 aa 000126 7100 04 tra 86,ic 000564 STATEMENT 1 ON LINE 132 else do; STATEMENT 1 ON LINE 133 nnames = nnames + 1; 000437 aa 7 00105 0541 00 aos pr7|69 nnames STATEMENT 1 ON LINE 134 if nnames > hbound (list, 1) then do; 000440 aa 6 00102 2361 00 ldq pr6|66 000441 aa 7 00105 1161 00 cmpq pr7|69 nnames 000442 aa 000044 6050 04 tpl 36,ic 000506 STATEMENT 1 ON LINE 136 call com_err_ (error_table_$too_many_args, me (whox), "^d names maximum", hbound (list, 1)); 000443 aa 7 00103 2361 00 ldq pr7|67 whox 000444 aa 000031 4020 07 mpy 25,dl 000445 aa 6 00122 7561 00 stq pr6|82 000446 aa 777400 2370 04 ldaq -256,ic 000046 = 136144040156 141155145163 000447 aa 6 00106 7571 00 staq pr6|70 000450 aa 777400 2370 04 ldaq -256,ic 000050 = 040155141170 151155165155 000451 aa 6 00110 7571 00 staq pr6|72 000452 aa 6 00102 2361 00 ldq pr6|66 000453 aa 6 00123 7561 00 stq pr6|83 000454 aa 6 00044 3701 20 epp4 pr6|36,* 000455 la 4 00012 3521 20 epp2 pr4|10,* error_table_$too_many_args 000456 aa 6 00144 2521 00 spri2 pr6|100 000457 aa 6 00122 7271 00 lxl7 pr6|82 000460 aa 000003 6270 17 eax7 3,7 000461 ta 777771 3520 00 epp2 -7 000462 aa 2 00000 5005 17 a9bd pr2|0,7 000463 aa 6 00146 2521 00 spri2 pr6|102 000464 aa 6 00106 3521 00 epp2 pr6|70 000465 aa 6 00150 2521 00 spri2 pr6|104 000466 aa 6 00123 3521 00 epp2 pr6|83 000467 aa 6 00152 2521 00 spri2 pr6|106 000470 aa 777340 3520 04 epp2 -288,ic 000030 = 404000000043 000471 aa 6 00154 2521 00 spri2 pr6|108 000472 aa 777340 3520 04 epp2 -288,ic 000032 = 526000000031 000473 aa 6 00156 2521 00 spri2 pr6|110 000474 aa 777331 3520 04 epp2 -295,ic 000025 = 524000000020 000475 aa 6 00160 2521 00 spri2 pr6|112 000476 aa 777326 3520 04 epp2 -298,ic 000024 = 404000000030 000477 aa 6 00162 2521 00 spri2 pr6|114 000500 aa 6 00142 6211 00 eax1 pr6|98 000501 aa 020000 4310 07 fld 8192,dl 000502 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000503 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 138 return; 000504 aa 000001 2360 07 ldq 1,dl 000505 aa 0 00630 7101 00 tra pr0|408 begin_return_mac STATEMENT 1 ON LINE 139 end; STATEMENT 1 ON LINE 140 if alng > 65 then do; 000506 aa 7 00104 2361 00 ldq pr7|68 alng 000507 aa 000101 1160 07 cmpq 65,dl 000510 aa 000033 6044 04 tmoz 27,ic 000543 STATEMENT 1 ON LINE 142 call com_err_ (error_table_$bigarg, me (whox), arg); 000511 aa 526000 2760 03 orq 175104,du 000512 aa 6 00123 7561 00 stq pr6|83 000513 aa 7 00103 2361 00 ldq pr7|67 whox 000514 aa 000031 4020 07 mpy 25,dl 000515 aa 6 00044 3701 20 epp4 pr6|36,* 000516 la 4 00014 3521 20 epp2 pr4|12,* error_table_$bigarg 000517 aa 6 00126 2521 00 spri2 pr6|86 000520 aa 000003 6270 06 eax7 3,ql 000521 ta 777771 3520 00 epp2 -7 000522 aa 2 00000 5005 17 a9bd pr2|0,7 000523 aa 6 00130 2521 00 spri2 pr6|88 000524 aa 5 00000 3521 00 epp2 pr5|0 arg 000525 aa 6 00132 2521 00 spri2 pr6|90 000526 aa 777302 3520 04 epp2 -318,ic 000030 = 404000000043 000527 aa 6 00134 2521 00 spri2 pr6|92 000530 aa 777302 3520 04 epp2 -318,ic 000032 = 526000000031 000531 aa 6 00136 2521 00 spri2 pr6|94 000532 aa 6 00123 3521 00 epp2 pr6|83 000533 aa 6 00140 2521 00 spri2 pr6|96 000534 aa 6 00124 6211 00 eax1 pr6|84 000535 aa 014000 4310 07 fld 6144,dl 000536 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000537 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 143 fatal = "1"b; 000540 aa 400000 2350 03 lda 131072,du 000541 aa 6 00040 3735 20 epp7 pr6|32,* 000542 aa 7 00114 7551 00 sta pr7|76 fatal STATEMENT 1 ON LINE 144 end; STATEMENT 1 ON LINE 145 list (nnames).name = arg; 000543 aa 7 00105 2361 00 ldq pr7|69 nnames 000544 aa 000022 4020 07 mpy 18,dl 000545 aa 6 00100 3715 20 epp5 pr6|64,* 000546 aa 5 77756 3715 06 epp5 pr5|-18,ql list.name 000547 aa 7 00122 3535 20 epp3 pr7|82,* aptr 000550 aa 7 00104 7271 00 lxl7 pr7|68 alng 000551 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 000552 aa 3 00000 00 0017 desc9a pr3|0,x7 arg 000553 aa 5 00000 00 0101 desc9a pr5|0,65 list.name STATEMENT 1 ON LINE 146 list (nnames).nsize = alng; 000554 aa 000000 6260 06 eax6 0,ql 000555 aa 7 00104 2361 00 ldq pr7|68 alng 000556 aa 000066 7370 00 lls 54 000557 aa 6 00100 3515 20 epp1 pr6|64,* 000560 aa 1 77777 3715 16 epp5 pr1|-1,6 list.nsize 000561 aa 5 00000 5511 60 stba pr5|0,60 list.nsize STATEMENT 1 ON LINE 147 list (nnames).found = "0"b; 000562 aa 001057 2350 04 lda 559,ic 001641 = 777777377777 000563 aa 1 77777 3551 16 ansa pr1|-1,6 list.found STATEMENT 1 ON LINE 148 end; STATEMENT 1 ON LINE 149 end; 000564 aa 7 00100 0541 00 aos pr7|64 i 000565 aa 777477 7100 04 tra -193,ic 000264 STATEMENT 1 ON LINE 151 if fatal then return; 000566 aa 7 00114 2351 00 lda pr7|76 fatal 000567 aa 000003 6000 04 tze 3,ic 000572 000570 aa 000001 2360 07 ldq 1,dl 000571 aa 0 00630 7101 00 tra pr0|408 begin_return_mac STATEMENT 1 ON LINE 153 if nnames = 0 then do; 000572 aa 7 00105 2361 00 ldq pr7|69 nnames 000573 aa 000024 6010 04 tnz 20,ic 000617 STATEMENT 1 ON LINE 155 call com_err_ (error_table_$noarg, me (whox)); 000574 aa 7 00103 2361 00 ldq pr7|67 whox 000575 aa 000031 4020 07 mpy 25,dl 000576 aa 6 00044 3701 20 epp4 pr6|36,* 000577 la 4 00016 3521 20 epp2 pr4|14,* error_table_$noarg 000600 aa 6 00110 2521 00 spri2 pr6|72 000601 aa 000003 6270 06 eax7 3,ql 000602 ta 777771 3520 00 epp2 -7 000603 aa 2 00000 5005 17 a9bd pr2|0,7 000604 aa 6 00112 2521 00 spri2 pr6|74 000605 aa 777223 3520 04 epp2 -365,ic 000030 = 404000000043 000606 aa 6 00114 2521 00 spri2 pr6|76 000607 aa 777223 3520 04 epp2 -365,ic 000032 = 526000000031 000610 aa 6 00116 2521 00 spri2 pr6|78 000611 aa 6 00106 6211 00 eax1 pr6|70 000612 aa 010000 4310 07 fld 4096,dl 000613 la 4 00020 3521 20 epp2 pr4|16,* com_err_ 000614 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 156 return; 000615 aa 000001 2360 07 ldq 1,dl 000616 aa 0 00630 7101 00 tra pr0|408 begin_return_mac STATEMENT 1 ON LINE 157 end; STATEMENT 1 ON LINE 162 do i = lbound (tp -> variable_table_header.hash_table, 1) to hbound (tp -> variable_table_header.hash_table, 1); 000617 aa 7 00100 4501 00 stz pr7|64 i 000620 aa 6 00040 3735 20 epp7 pr6|32,* 000621 aa 7 00100 2361 00 ldq pr7|64 i 000622 aa 000077 1160 07 cmpq 63,dl 000623 aa 000104 6054 04 tpnz 68,ic 000727 STATEMENT 1 ON LINE 164 old_np = addr (tp -> variable_table_header.hash_table (i)); 000624 aa 7 00116 3715 66 epp5 pr7|78,*ql variable_table_header.hash_table 000625 aa 7 00132 6515 00 spri5 pr7|90 old_np STATEMENT 1 ON LINE 165 tnp = tp -> variable_table_header.hash_table (i); 000626 aa 7 00116 7631 66 lprp3 pr7|78,*ql variable_table_header.hash_table 000627 aa 7 00130 2535 00 spri3 pr7|88 tnp STATEMENT 1 ON LINE 166 do while (tnp ^= null); 000630 aa 6 00040 3735 20 epp7 pr6|32,* 000631 aa 7 00130 2371 00 ldaq pr7|88 tnp 000632 aa 777206 6770 04 eraq -378,ic 000040 = 077777000043 000001000000 000633 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000634 aa 000071 6000 04 tze 57,ic 000725 STATEMENT 1 ON LINE 167 deleted = "0"b; 000635 aa 7 00115 4501 00 stz pr7|77 deleted STATEMENT 1 ON LINE 168 np = tnp; 000636 aa 7 00130 3715 20 epp5 pr7|88,* tnp 000637 aa 7 00120 6515 00 spri5 pr7|80 np STATEMENT 1 ON LINE 169 tnp = np -> variable_node.forward_thread; 000640 aa 7 00120 7631 20 lprp3 pr7|80,* variable_node.forward_thread 000641 aa 7 00130 2535 00 spri3 pr7|88 tnp STATEMENT 1 ON LINE 171 do j = 1 to nnames; 000642 aa 7 00105 2361 00 ldq pr7|69 nnames 000643 aa 6 00104 7561 00 stq pr6|68 000644 aa 000001 2360 07 ldq 1,dl 000645 aa 7 00101 7561 00 stq pr7|65 j 000646 aa 6 00040 3735 20 epp7 pr6|32,* 000647 aa 7 00101 2361 00 ldq pr7|65 j 000650 aa 6 00104 1161 00 cmpq pr6|68 000651 aa 000046 6054 04 tpnz 38,ic 000717 STATEMENT 1 ON LINE 172 if ^list (j).found then do; 000652 aa 000022 4020 07 mpy 18,dl 000653 aa 6 00100 3715 20 epp5 pr6|64,* 000654 aa 5 77777 2351 06 lda pr5|-1,ql list.found 000655 aa 400000 3150 07 cana 131072,dl 000656 aa 6 00123 7561 00 stq pr6|83 000657 aa 000036 6010 04 tnz 30,ic 000715 STATEMENT 1 ON LINE 174 if list (j).nsize = np -> variable_node.name_size then if list (j).name = np -> variable_node.name then do; 000660 aa 5 77777 2351 06 lda pr5|-1,ql list.nsize 000661 aa 000066 7330 00 lrs 54 000662 aa 7 00120 3535 20 epp3 pr7|80,* np 000663 aa 3 00010 1161 00 cmpq pr3|8 variable_node.name_size 000664 aa 000031 6010 04 tnz 25,ic 000715 000665 aa 6 00123 7271 00 lxl7 pr6|83 000666 aa 5 77756 3515 17 epp1 pr5|-18,7 list.name 000667 aa 3 00010 2351 00 lda pr3|8 variable_node.name_size 000670 aa 040 140 106 500 cmpc (pr),(pr,rl),fill(040) 000671 aa 1 00000 00 0101 desc9a pr1|0,65 list.name 000672 aa 3 00011 00 0005 desc9a pr3|9,al variable_node.name 000673 aa 000022 6010 04 tnz 18,ic 000715 STATEMENT 1 ON LINE 177 call do_it; 000674 aa 6 00056 6211 00 eax1 pr6|46 000675 aa 000000 4310 07 fld 0,dl 000676 aa 7 00160 3521 00 epp2 pr7|112 do_it 000677 aa 0 00617 7001 00 tsx0 pr0|399 call_ent_var STATEMENT 1 ON LINE 178 list (j).found = "1"b; 000700 aa 6 00040 3735 20 epp7 pr6|32,* 000701 aa 7 00101 2361 00 ldq pr7|65 j 000702 aa 000022 4020 07 mpy 18,dl 000703 aa 400000 2350 07 lda 131072,dl 000704 aa 6 00100 3715 20 epp5 pr6|64,* 000705 aa 5 77777 2551 06 orsa pr5|-1,ql list.found STATEMENT 1 ON LINE 179 nprocessed = nprocessed + 1; 000706 aa 7 00106 0541 00 aos pr7|70 nprocessed STATEMENT 1 ON LINE 180 if nprocessed = nnames then return; 000707 aa 7 00106 2361 00 ldq pr7|70 nprocessed 000710 aa 7 00105 1161 00 cmpq pr7|69 nnames 000711 aa 000006 6010 04 tnz 6,ic 000717 000712 aa 000001 2360 07 ldq 1,dl 000713 aa 0 00630 7101 00 tra pr0|408 begin_return_mac STATEMENT 1 ON LINE 182 go to next_name; 000714 aa 000003 7100 04 tra 3,ic 000717 STATEMENT 1 ON LINE 183 end; STATEMENT 1 ON LINE 184 end; STATEMENT 1 ON LINE 185 end; 000715 aa 7 00101 0541 00 aos pr7|65 j 000716 aa 777730 7100 04 tra -40,ic 000646 STATEMENT 1 ON LINE 186 next_name: if ^deleted then old_np = np; 000717 aa 6 00040 3735 20 epp7 pr6|32,* 000720 aa 7 00115 2351 00 lda pr7|77 deleted 000721 aa 777707 6010 04 tnz -57,ic 000630 000722 aa 7 00120 3715 20 epp5 pr7|80,* np 000723 aa 7 00132 6515 00 spri5 pr7|90 old_np STATEMENT 1 ON LINE 189 end; 000724 aa 777704 7100 04 tra -60,ic 000630 STATEMENT 1 ON LINE 190 end; 000725 aa 7 00100 0541 00 aos pr7|64 i 000726 aa 777672 7100 04 tra -70,ic 000620 STATEMENT 1 ON LINE 192 call ioa_ ("^/The following variables were not found:"); 000727 aa 000 100 100 404 mlr (ic),(pr),fill(000) 000730 aa 777165 00 0054 desc9a -395,44 000114 = 136057124150 000731 aa 6 00106 00 0054 desc9a pr6|70,44 000732 aa 6 00106 3521 00 epp2 pr6|70 000733 aa 6 00126 2521 00 spri2 pr6|86 000734 aa 777067 3520 04 epp2 -457,ic 000023 = 524000000051 000735 aa 6 00130 2521 00 spri2 pr6|88 000736 aa 6 00124 6211 00 eax1 pr6|84 000737 aa 004000 4310 07 fld 2048,dl 000740 aa 6 00044 3701 20 epp4 pr6|36,* 000741 la 4 00022 3521 20 epp2 pr4|18,* ioa_ 000742 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 193 do i = 1 to nnames; 000743 aa 6 00040 3735 20 epp7 pr6|32,* 000744 aa 7 00105 2361 00 ldq pr7|69 nnames 000745 aa 6 00105 7561 00 stq pr6|69 000746 aa 000001 2360 07 ldq 1,dl 000747 aa 7 00100 7561 00 stq pr7|64 i 000750 aa 6 00040 3735 20 epp7 pr6|32,* 000751 aa 7 00100 2361 00 ldq pr7|64 i 000752 aa 6 00105 1161 00 cmpq pr6|69 000753 aa 000045 6054 04 tpnz 37,ic 001020 STATEMENT 1 ON LINE 194 if ^list (i).found then do; 000754 aa 000022 4020 07 mpy 18,dl 000755 aa 6 00100 3715 20 epp5 pr6|64,* 000756 aa 5 77777 2351 06 lda pr5|-1,ql list.found 000757 aa 400000 3150 07 cana 131072,dl 000760 aa 000035 6010 04 tnz 29,ic 001015 STATEMENT 1 ON LINE 196 if list (i).name = "blnk*com" then vname = "unlabelled common"; 000761 aa 5 77756 3535 06 epp3 pr5|-18,ql list.name 000762 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 000763 aa 3 00000 00 0101 desc9a pr3|0,65 list.name 000764 aa 777054 00 0010 desc9a -468,8 000036 = 142154156153 000765 aa 6 00123 7561 00 stq pr6|83 000766 aa 000005 6010 04 tnz 5,ic 000773 000767 aa 040 100 100 404 mlr (ic),(pr),fill(040) 000770 aa 777063 00 0021 desc9a -461,17 000052 = 165156154141 000771 aa 7 00136 00 0101 desc9a pr7|94,65 vname 000772 aa 000004 7100 04 tra 4,ic 000776 STATEMENT 1 ON LINE 198 else vname = list (i).name; 000773 aa 040 100 100 500 mlr (pr),(pr),fill(040) 000774 aa 3 00000 00 0101 desc9a pr3|0,65 list.name 000775 aa 7 00136 00 0101 desc9a pr7|94,65 vname STATEMENT 1 ON LINE 199 call ioa_ ("^a", vname); 000776 aa 136141 2350 03 lda 48225,du 000777 aa 6 00123 7551 00 sta pr6|83 001000 aa 6 00123 3521 00 epp2 pr6|83 001001 aa 6 00110 2521 00 spri2 pr6|72 001002 aa 7 00136 3521 00 epp2 pr7|94 vname 001003 aa 6 00112 2521 00 spri2 pr6|74 001004 aa 777016 3520 04 epp2 -498,ic 000022 = 524000000002 001005 aa 6 00114 2521 00 spri2 pr6|76 001006 aa 777013 3520 04 epp2 -501,ic 000021 = 526000000101 001007 aa 6 00116 2521 00 spri2 pr6|78 001010 aa 6 00106 6211 00 eax1 pr6|70 001011 aa 010000 4310 07 fld 4096,dl 001012 aa 6 00044 3701 20 epp4 pr6|36,* 001013 la 4 00022 3521 20 epp2 pr4|18,* ioa_ 001014 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 200 end; STATEMENT 1 ON LINE 201 end; 001015 aa 6 00040 3735 20 epp7 pr6|32,* 001016 aa 7 00100 0541 00 aos pr7|64 i 001017 aa 777731 7100 04 tra -39,ic 000750 STATEMENT 1 ON LINE 203 end; 001020 aa 0 00615 7001 00 tsx0 pr0|397 leave_begin_block END BLOCK 1 STATEMENT 1 ON LINE 205 return; 001021 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO dev STATEMENT 1 ON LINE 209 delete_external_variables: dev: entry; 001022 da 000212200000 001023 aa 000220 6270 00 eax7 144 001024 aa 7 00034 3521 20 epp2 pr7|28,* 001025 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 001026 aa 000000000000 001027 aa 000000000000 001030 aa 000007 7100 04 tra 7,ic 001037 ENTRY TO delete_external_variables STATEMENT 1 ON LINE 209 delete_external_variables: dev: entry; 001031 da 000224200000 001032 aa 000220 6270 00 eax7 144 001033 aa 7 00034 3521 20 epp2 pr7|28,* 001034 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 001035 aa 000000000000 001036 aa 000000000000 STATEMENT 1 ON LINE 213 whox = 2; 001037 aa 000002 2360 07 ldq 2,dl 001040 aa 6 00103 7561 00 stq pr6|67 whox STATEMENT 1 ON LINE 214 do_it = delete_it; 001041 aa 000307 3520 04 epp2 199,ic 001350 = 000160627000 001042 aa 6 00160 2521 00 spri2 pr6|112 do_it 001043 aa 6 00162 6521 00 spri6 pr6|114 do_it STATEMENT 1 ON LINE 215 call hcs_$high_low_seg_count (high_seg, hcscnt); 001044 aa 6 00107 3521 00 epp2 pr6|71 high_seg 001045 aa 6 00174 2521 00 spri2 pr6|124 001046 aa 6 00110 3521 00 epp2 pr6|72 hcscnt 001047 aa 6 00176 2521 00 spri2 pr6|126 001050 aa 6 00172 6211 00 eax1 pr6|122 001051 aa 010000 4310 07 fld 4096,dl 001052 aa 6 00044 3701 20 epp4 pr6|36,* 001053 la 4 00032 3521 20 epp2 pr4|26,* hcs_$high_low_seg_count 001054 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 216 goto join; 001055 aa 777074 7100 04 tra -452,ic 000151 STATEMENT 1 ON LINE 354 end; BEGIN PROCEDURE reset_it ENTRY TO reset_it STATEMENT 1 ON LINE 219 reset_it: proc; 001056 da 000232200000 001057 aa 000160 6270 00 eax7 112 001060 aa 7 00034 3521 20 epp2 pr7|28,* 001061 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 001062 aa 000000000000 001063 aa 000000000000 STATEMENT 1 ON LINE 228 code = 0; 001064 aa 6 00100 4501 00 stz pr6|64 code STATEMENT 1 ON LINE 230 if (np -> variable_node.init_type = TEMPLATE_INIT) & (np -> variable_node.init_ptr = null) then do; 001065 aa 6 00040 3735 20 epp7 pr6|32,* 001066 aa 7 00120 3715 20 epp5 pr7|80,* np 001067 aa 5 00001 2351 00 lda pr5|1 variable_node.init_type 001070 aa 000030 7350 00 als 24 001071 aa 000074 7330 00 lrs 60 001072 aa 6 00101 7561 00 stq pr6|65 variable_node.init_type 001073 aa 000003 1160 07 cmpq 3,dl 001074 aa 000045 6010 04 tnz 37,ic 001141 001075 aa 5 00006 2371 00 ldaq pr5|6 variable_node.init_ptr 001076 aa 776742 6770 04 eraq -542,ic 000040 = 077777000043 000001000000 001077 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 001100 aa 000041 6010 04 tnz 33,ic 001141 STATEMENT 1 ON LINE 232 call com_err_ (0, me (whox), "External variable ^a could not be reset.", np -> variable_node.name); 001101 aa 5 00010 2361 00 ldq pr5|8 variable_node.name_size 001102 aa 524000 2760 03 orq 174080,du 001103 aa 6 00102 7561 00 stq pr6|66 001104 aa 6 00103 4501 00 stz pr6|67 001105 aa 7 00103 2361 00 ldq pr7|67 whox 001106 aa 000031 4020 07 mpy 25,dl 001107 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001110 aa 776773 00 0050 desc9a -517,40 000102 = 105170164145 001111 aa 6 00104 00 0050 desc9a pr6|68,40 001112 aa 6 00103 3521 00 epp2 pr6|67 001113 aa 6 00120 2521 00 spri2 pr6|80 001114 aa 000003 6270 06 eax7 3,ql 001115 ta 777771 3520 00 epp2 -7 001116 aa 2 00000 5005 17 a9bd pr2|0,7 00111Donaldson ZNt$ Donaldson Multics [QUTBVBSWnoneVIP7400_DTR Q}sh  Huen sh Multics L( variable_node.vbl_ptr; 001356 aa 6 00040 3735 20 epp7 pr6|32,* 001357 aa 7 00120 3715 20 epp5 pr7|80,* np 001360 aa 5 00004 3735 20 epp7 pr5|4,* variable_node.vbl_ptr 001361 aa 6 00040 3535 20 epp3 pr6|32,* 001362 aa 3 00124 6535 00 spri7 pr3|84 vptr STATEMENT 1 ON LINE 289 do segno = hcscnt + 1 to hcscnt + high_seg; 001363 aa 3 00110 2361 00 ldq pr3|72 hcscnt 001364 aa 3 00107 0761 00 adq pr3|71 high_seg 001365 aa 6 00117 7561 00 stq pr6|79 001366 aa 3 00110 2361 00 ldq pr3|72 hcscnt 001367 aa 000001 0760 07 adq 1,dl 001370 aa 6 00116 7561 00 stq pr6|78 segno 001371 aa 000000 0110 03 nop 0,du 001372 aa 6 00116 2361 00 ldq pr6|78 segno 001373 aa 6 00117 1161 00 cmpq pr6|79 001374 aa 000125 6054 04 tpnz 85,ic 001521 STATEMENT 1 ON LINE 290 if rel (lotptr -> lot.lp (segno)) ^= "0"b then do; 001375 aa 6 00040 3735 20 epp7 pr6|32,* 001376 aa 7 00126 2351 66 lda pr7|86,*ql lot.lp 001377 aa 000022 7350 00 als 18 001400 aa 000117 6000 04 tze 79,ic 001517 STATEMENT 1 ON LINE 292 headptr = lotptr -> lot.lp (segno); 001401 aa 7 00126 7651 66 lprp5 pr7|86,*ql lot.lp 001402 aa 6 00102 6515 00 spri5 pr6|66 headptr STATEMENT 1 ON LINE 293 defstartptr = headptr -> header.def_ptr; 001403 aa 5 00000 3535 20 epp3 pr5|0,* header.def_ptr 001404 aa 6 00104 2535 00 spri3 pr6|68 defstartptr STATEMENT 1 ON LINE 295 linkstartptr = addrel (headptr, headptr -> header.stats.begin_links); 001405 aa 5 00006 2351 00 lda pr5|6 header.begin_links 001406 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001407 aa 5 00000 3521 01 epp2 pr5|0,au 001410 aa 000000 0520 03 adwp2 0,du 001411 aa 6 00106 2521 00 spri2 pr6|70 linkstartptr STATEMENT 1 ON LINE 300 if (baseno (linkstartptr) = baseno (defstartptr)) & (fixed (rel (defstartptr), 18) > fixed (rel (linkstartptr), 18)) then block_end = rel (defstartptr); 001412 aa 3 00000 2131 00 epaq pr3|0 defstartptr 001413 aa 077777 3750 03 ana 32767,du 001414 aa 6 00120 7551 00 sta pr6|80 001415 aa 2 00000 2131 00 epaq pr2|0 linkstartptr 001416 aa 077777 3750 03 ana 32767,du 001417 aa 6 00120 1151 00 cmpa pr6|80 001420 aa 000013 6010 04 tnz 11,ic 001433 001421 aa 2 00000 6351 00 eaa pr2|0 linkstartptr 001422 aa 000066 7730 00 lrl 54 001423 aa 6 00120 7561 00 stq pr6|80 001424 aa 3 00000 6351 00 eaa pr3|0 defstartptr 001425 aa 000066 7730 00 lrl 54 001426 aa 6 00120 1161 00 cmpq pr6|80 001427 aa 000004 6044 04 tmoz 4,ic 001433 001430 aa 3 00000 6351 00 eaa pr3|0 defstartptr 001431 aa 6 00100 7551 00 sta pr6|64 block_end 001432 aa 000007 7100 04 tra 7,ic 001441 STATEMENT 1 ON LINE 303 else block_end = rel (addrel (headptr, headptr -> header.stats.block_length)); 001433 aa 5 00006 2351 00 lda pr5|6 header.block_length 001434 aa 000022 7350 00 als 18 001435 aa 5 00000 3515 01 epp1 pr5|0,au 001436 aa 000000 0510 03 adwp1 0,du 001437 aa 1 00000 6351 00 eaa pr1|0 001440 aa 6 00100 7551 00 sta pr6|64 block_end 001441 aa 6 00122 2515 00 spri1 pr6|82 STATEMENT 1 ON LINE 307 do itsptr = linkstartptr repeat (addrel (itsptr, 2)) /* loop through all links */ while (bin (rel (itsptr), 18) < bin (block_end, 18)); 001442 aa 6 00110 2521 00 spri2 pr6|72 itsptr 001443 aa 000000 0110 03 nop 0,du 001444 aa 6 00100 2351 00 lda pr6|64 block_end 001445 aa 000066 7730 00 lrl 54 001446 aa 6 00121 7561 00 stq pr6|81 001447 aa 6 00110 6351 20 eaa pr6|72,* itsptr 001450 aa 000066 7730 00 lrl 54 001451 aa 6 00121 1161 00 cmpq pr6|81 001452 aa 6 00120 7561 00 stq pr6|80 001453 aa 000044 6050 04 tpl 36,ic 001517 STATEMENT 1 ON LINE 309 if itsptr -> its.its_mod = "100011"b then do; 001454 aa 6 00110 2351 20 lda pr6|72,* its.its_mod 001455 aa 000036 7350 00 als 30 001456 aa 430000 1150 03 cmpa 143360,du 001457 aa 000034 6010 04 tnz 28,ic 001513 STATEMENT 1 ON LINE 311 lptr = itsptr -> based_ptr; 001460 aa 6 00110 3735 20 epp7 pr6|72,* based_ptr 001461 aa 7 00000 3735 20 epp7 pr7|0,* based_ptr 001462 aa 6 00114 6535 00 spri7 pr6|76 lptr STATEMENT 1 ON LINE 313 if lptr = vptr then do; 001463 aa 6 00114 2371 00 ldaq pr6|76 lptr 001464 aa 6 00040 3715 20 epp5 pr6|32,* 001465 aa 5 00124 6771 00 eraq pr5|84 vptr 001466 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 001467 aa 000024 6010 04 tnz 20,ic 001513 STATEMENT 1 ON LINE 315 vlp = headptr -> header.original_linkage_ptr; 001470 aa 6 00102 3535 20 epp3 pr6|66,* headptr 001471 aa 3 00003 7631 00 lprp3 pr3|3 header.original_linkage_ptr 001472 aa 6 00112 2535 00 spri3 pr6|74 vlp STATEMENT 1 ON LINE 316 itsptr -> based_double = addrel (vlp, bit (bin (bin (rel (itsptr), 18) - bin (rel (headptr), 18), 18))) -> based_double; 001473 aa 6 00102 6351 20 eaa pr6|66,* headptr 001474 aa 000066 7730 00 lrl 54 001475 aa 6 00121 7561 00 stq pr6|81 001476 aa 6 00120 2361 00 ldq pr6|80 001477 aa 6 00121 1761 00 sbq pr6|81 001500 aa 000003 6050 04 tpl 3,ic 001503 001501 aa 0 00110 6761 00 erq pr0|72 = 777777777777 001502 aa 000001 0760 07 adq 1,dl 001503 aa 000066 7370 00 lls 54 001504 aa 3 00000 3521 01 epp2 pr3|0,au 001505 aa 000000 0520 03 adwp2 0,du 001506 aa 2 00000 2351 00 lda pr2|0 based_double 001507 aa 2 00001 2361 00 ldq pr2|1 based_double 001510 aa 6 00110 3515 20 epp1 pr6|72,* itsptr 001511 aa 1 00000 7551 00 sta pr1|0 based_double 001512 aa 1 00001 7561 00 stq pr1|1 based_double STATEMENT 1 ON LINE 320 end; STATEMENT 1 ON LINE 321 end; STATEMENT 1 ON LINE 322 end; 001513 aa 6 00110 3521 20 epp2 pr6|72,* itsptr 001514 aa 000002 0520 03 adwp2 2,du 001515 aa 6 00110 2521 00 spri2 pr6|72 itsptr 001516 aa 777726 7100 04 tra -42,ic 001444 STATEMENT 1 ON LINE 323 end; STATEMENT 1 ON LINE 324 end; 001517 aa 6 00116 0541 00 aos pr6|78 segno 001520 aa 777652 7100 04 tra -86,ic 001372 STATEMENT 1 ON LINE 326 vsize = np -> variable_node.vbl_size; 001521 aa 6 00040 3735 20 epp7 pr6|32,* 001522 aa 7 00120 3715 20 epp5 pr7|80,* np 001523 aa 5 00001 2351 00 lda pr5|1 variable_node.vbl_size 001524 aa 000060 7730 00 lrl 48 001525 aa 7 00112 7561 00 stq pr7|74 vsize STATEMENT 1 ON LINE 328 if vsize > sys_info$max_seg_size then call fortran_storage_manager_$free (np); 001526 aa 6 00044 3701 20 epp4 pr6|36,* 001527 la 4 00044 1161 20 cmpq pr4|36,* sys_info$max_seg_size 001530 aa 000010 6044 04 tmoz 8,ic 001540 001531 aa 7 00120 3521 00 epp2 pr7|80 np 001532 aa 6 00126 2521 00 spri2 pr6|86 001533 aa 6 00124 6211 00 eax1 pr6|84 001534 aa 004000 4310 07 fld 2048,dl 001535 la 4 00036 3521 20 epp2 pr4|30,* fortran_storage_manager_$free 001536 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 001537 aa 000040 7100 04 tra 32,ic 001577 STATEMENT 1 ON LINE 331 else if rel (np -> variable_node.vbl_ptr) = "0"b /* separate seg */ then call delete_$ptr (np -> variable_node.vbl_ptr, "010100"b, me (whox), code); 001540 aa 5 00004 6351 20 eaa pr5|4,* variable_node.vbl_ptr 001541 aa 000034 6010 04 tnz 28,ic 001575 001542 aa 240000 2350 03 lda 81920,du 001543 aa 6 00121 7551 00 sta pr6|81 001544 aa 7 00103 2361 00 ldq pr7|67 whox 001545 aa 000031 4020 07 mpy 25,dl 001546 aa 5 00004 3521 00 epp2 pr5|4 variable_node.vbl_ptr 001547 aa 6 00132 2521 00 spri2 pr6|90 001550 aa 6 00121 3521 00 epp2 pr6|81 001551 aa 6 00134 2521 00 spri2 pr6|92 001552 aa 000003 6270 06 eax7 3,ql 001553 ta 777771 3520 00 epp2 -7 001554 aa 2 00000 5005 17 a9bd pr2|0,7 001555 aa 6 00136 2521 00 spri2 pr6|94 001556 aa 6 00101 3521 00 epp2 pr6|65 code 001557 aa 6 00140 2521 00 spri2 pr6|96 001560 aa 776254 3520 04 epp2 -852,ic 000034 = 464000000000 001561 aa 6 00142 2521 00 spri2 pr6|98 001562 aa 776233 3520 04 epp2 -869,ic 000015 = 514000000006 001563 aa 6 00144 2521 00 spri2 pr6|100 001564 aa 776246 3520 04 epp2 -858,ic 000032 = 526000000031 001565 aa 6 00146 2521 00 spri2 pr6|102 001566 aa 776242 3520 04 epp2 -862,ic 000030 = 404000000043 001567 aa 6 00150 2521 00 spri2 pr6|104 001570 aa 6 00130 6211 00 eax1 pr6|88 001571 aa 020000 4310 07 fld 8192,dl 001572 la 4 00034 3521 20 epp2 pr4|28,* delete_$ptr 001573 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001574 aa 000003 7100 04 tra 3,ic 001577 STATEMENT 1 ON LINE 333 else free np -> variable_node.vbl_ptr -> variable in (sb -> stack_header.user_free_ptr -> based_area); 001575 aa 5 00004 3715 00 epp5 pr5|4 variable_node.vbl_ptr 001576 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 334 tp -> variable_table_header.total_allocated_size = tp -> variable_table_header.total_allocated_size - vsize; 001577 aa 6 00040 3735 20 epp7 pr6|32,* 001600 aa 7 00116 3715 20 epp5 pr7|78,* tp 001601 aa 5 00111 3361 00 lcq pr5|73 variable_table_header.total_allocated_size 001602 aa 000044 7770 00 llr 36 001603 aa 000044 7330 00 lrs 36 001604 aa 7 00112 0331 00 adl pr7|74 vsize 001605 aa 000000 5330 00 negl 0 001606 aa 5 00111 7561 00 stq pr5|73 variable_table_header.total_allocated_size STATEMENT 1 ON LINE 336 nchars = np -> variable_node.name_size; 001607 aa 7 00120 3535 20 epp3 pr7|80,* np 001610 aa 3 00010 2361 00 ldq pr3|8 variable_node.name_size 001611 aa 7 00111 7561 00 stq pr7|73 nchars STATEMENT 1 ON LINE 337 old_np -> variable_node.forward_thread = tnp; 001612 aa 7 00130 3515 20 epp1 pr7|88,* tnp 001613 aa 7 00132 5411 20 sprp1 pr7|90,* variable_node.forward_thread STATEMENT 1 ON LINE 338 free np -> variable_node in (sb -> stack_header.system_free_ptr -> based_area); 001614 aa 000003 0760 07 adq 3,dl 001615 aa 000002 7320 00 qrs 2 001616 aa 000011 0760 07 adq 9,dl 001617 aa 000001 0760 07 adq 1,dl 001620 aa 777776 3760 07 anq 262142,dl 001621 aa 000002 0760 07 adq 2,dl 001622 aa 7 00120 3715 00 epp5 pr7|80 np 001623 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 339 tp -> variable_table_header.cur_num_of_variables = tp -> variable_table_header.cur_num_of_variables - 1; 001624 aa 6 00040 3735 20 epp7 pr6|32,* 001625 aa 7 00116 3715 20 epp5 pr7|78,* tp 001626 aa 5 00106 2351 00 lda pr5|70 variable_table_header.cur_num_of_variables 001627 aa 5 00107 2361 00 ldq pr5|71 variable_table_header.cur_num_of_variables 001630 aa 000014 7370 00 lls 12 001631 aa 000057 7330 00 lrs 47 001632 aa 000001 1760 07 sbq 1,dl 001633 aa 000043 7370 00 lls 35 001634 aa 5 00106 7511 17 stca pr5|70,17 variable_table_header.cur_num_of_variables 001635 aa 5 00107 7521 40 stcq pr5|71,40 variable_table_header.cur_num_of_variables STATEMENT 1 ON LINE 341 deleted = "1"b; 001636 aa 400000 2350 03 lda 131072,du 001637 aa 7 00115 7551 00 sta pr7|77 deleted STATEMENT 1 ON LINE 342 return; 001640 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 343 end; END PROCEDURE delete_it END PROCEDURE rev ----------------------------------------------------------- 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