COMPILATION LISTING OF SEGMENT lsm_fs_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 02/16/88 1412.6 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 lsm_fs_: proc; return; 19 20 /* coded by Edwin W. Meyer, Jr. on 041069 */ 21 /* modified on 3/29/71 by C. D. Tavares */ 22 /* modified on 6/25/73 by Lee J. Scheffler to clean up a little. 23* This program is about due for an overhaul. */ 24 /* Modified 08/79 by CDT as part of the general lsm_ overhaul that we've been 25* promising ourselves since 1973. Some of the specific changes were: getting 26* compaction to work; making the segment-to-segment structure moves compact 27* the contents of the structure; and fixing the previous hashing algorithm, 28* which sometimes used to depend on hashing garbage. */ 29 /* Modified 11/79 by CDT to make pull entry remember to bump 30* length of all version 6 symbol tables down by one when copying them. */ 31 /* Modified 01/80 by CDT to fix bug causing rejection (for node OOB) 32* of almost all operations on version 6 segments where there was a symbol in 33* symtab slot 0. This word coincided with what is now lsm.component_slots. */ 34 /* Last modified 07/21/80 by CDT to implement graphic search paths. */ 35 36 dcl (from_segptr, to_segptr, temp_segptr) pointer, 37 (from_segptr_arg, to_segptr_arg) pointer parameter, 38 (from_node_arg, to_node_arg) fixed bin (18) parameter, 39 err_code fixed bin (35); 40 41 dcl move_array (move_len) fixed bin (35) based, 42 move_len fixed bin (18); /* for moving large blocks of words */ 43 44 /* EXTERNAL STATIC */ 45 46 dcl (graphic_error_table_$bad_node, 47 graphic_error_table_$not_a_structure, 48 graphic_error_table_$lsm_node_ob, 49 graphic_error_table_$struc_duplication) fixed bin (35) external static; 50 51 dcl (error_table_$segknown, 52 error_table_$unimplemented_version, 53 error_table_$bad_arg) ext fixed bin (35) static; 54 55 dcl sys_info$max_seg_size fixed bin (35) external static; 56 57 /* ENTRIES */ 58 59 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 60 hcs_$fs_get_path_name ext entry (pointer, char (*), fixed bin, char (*), fixed bin (35)), 61 hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)), 62 hcs_$initiate entry (char (*), char (*), char (*), fixed bin (17), fixed bin (17), ptr, fixed bin (35)); 63 64 dcl (get_temp_segment_, release_temp_segment_) ext entry (char (*), pointer, fixed bin (35)), 65 search_paths_$find_dir ext entry (char (*), pointer, char (*), char (*), char (*), fixed bin (35)), 66 sub_err_ ext entry options (variable); 67 68 /* BUILTINS AND CONDITIONS */ 69 70 dcl (addr, addrel, codeptr, currentsize, divide, mod, 71 null, pointer, rel, size, unspec) builtin; 72 73 dcl cleanup condition; 74 75 /* CONSTANTS */ 76 77 dcl (On_dup_error initial (0), /* Various merge codes */ 78 On_dup_source initial (1), 79 On_dup_target_then_nulls initial (2), 80 On_dup_target_then_source initial (3)) fixed bin static options (constant); 81 1 1 /* --------------- BEGIN include file lsm_entry_dcls.incl.pl1 --------------- */ 1 2 1 3 dcl lsm_$get_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)), 1 4 lsm_$make_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)), 1 5 lsm_$mk_char entry (ptr, char (*), fixed bin (18)), 1 6 lsm_$replace_blk entry (ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 1 7 lsm_$replicate entry (ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 1 8 lsm_$set_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)); 1 9 1 10 dcl lsm_fs_$compact entry (ptr, fixed bin (18), fixed bin (35)), 1 11 lsm_fs_$free entry (ptr, fixed bin (35)), 1 12 lsm_fs_$init entry (ptr, fixed bin (35)), 1 13 lsm_fs_$init_seg entry (ptr, char (*), char (*), fixed bin, fixed bin (35)), 1 14 lsm_fs_$merge_symbol entry (ptr, ptr, fixed bin (18), bit (1), fixed bin, fixed bin (35)), 1 15 lsm_fs_$move_struc entry (ptr, ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 1 16 lsm_fs_$pull entry (ptr, char (*), char (*), fixed bin (35)), 1 17 lsm_fs_$push entry (ptr, char (*), char (*), fixed bin (35)); 1 18 1 19 dcl lsm_sym_$find_table entry (pointer, fixed bin (18), fixed bin (35)), 1 20 lsm_sym_$sym_list entry (ptr, (*) fixed bin (18), fixed bin, fixed bin (35)), 1 21 lsm_sym_$symk entry (ptr, fixed bin, char (*), fixed bin (18), fixed bin (18), fixed bin (35)), 1 22 lsm_sym_$symn entry (ptr, fixed bin, fixed bin (18), fixed bin (18), fixed bin (18), fixed bin (35)); 1 23 1 24 dcl (Find_symbol initial (0), /* op codes for lsm_sym_$symk and lsm_sym_$symn */ 1 25 Find_or_create_symbol initial (1), 1 26 Create_symbol initial (2), 1 27 Delete_symbol initial (3)) fixed bin static options (constant); 1 28 1 29 dcl (Find_seg initial (0), /* Opcodes for lsm_fs_$init_seg */ 1 30 Create_seg initial (1), 1 31 Clear_seg initial (2)) fixed bin static options (constant); 1 32 1 33 /* ---------------- END include file lsm_entry_dcls.incl.pl1 ---------------- */ 82 83 2 1 /* Begin include file . . . lsm_formats.incl.pl1 */ 2 2 2 3 /* CONSTANTS */ 2 4 2 5 dcl (LSM_version_7 initial (7), /* current version, root is always symtab */ 2 6 LSM_version_6 initial (6)) /* root wasn't automatically symtab */ 2 7 fixed bin static options (constant); 2 8 2 9 dcl 1 lsm_constants aligned static options (constant), 2 10 2 n_types fixed bin initial (9), 2 11 2 types, 2 12 3 indirect_type initial (1), 2 13 3 fixed_type initial (2), 2 14 3 float_type initial (3), 2 15 3 bit_type initial (4), 2 16 3 char_type initial (5), 2 17 3 symtab_type initial (6), 2 18 3 symbol_type initial (7), 2 19 3 list_type initial (8), 2 20 3 array_type initial (9), 2 21 2 data_length_factors (9) initial (1, 1, 1, 36, 4, 1, 1, 1, 1), 2 22 2 max_allocation fixed bin initial (4095), 2 23 2 initial_component_slots fixed bin initial (8); 2 24 2 25 dcl lsm_segptr pointer; 2 26 2 27 dcl 1 lsm aligned based (lsm_segptr), /* declaration of head of lsm_ segment */ 2 28 2 version fixed bin, /* number of lsm_ version that created this seg */ 2 29 2 free fixed bin (18), /* word number of first free word in seg */ 2 30 2 root_symtab fixed bin (18), /* node number of the root symbol table */ 2 31 2 lock bit (36) aligned, 2 32 2 component_slots fixed bin, 2 33 2 components fixed bin, 2 34 2 pad (26) fixed bin (18), 2 35 2 component_ptrs (lsm_constants.initial_component_slots refer (lsm.component_slots)) pointer unaligned; 2 36 2 37 2 38 /* Formats of different node types used by lsm_ */ 2 39 2 40 dcl node_ptr pointer; 2 41 2 42 dcl 1 header aligned based (node_ptr), /* Used in all formats below */ 2 43 2 type fixed bin (6) unsigned unaligned, /* type of node */ 2 44 2 allocated_len fixed bin (12) unsigned unaligned, /* allocated length of data space */ 2 45 2 data_len fixed bin (18) unsigned unaligned; /* current length of data in block */ 2 46 /* (in appropriate units) */ 2 47 2 48 dcl 1 any_node aligned based (node_ptr), /* general node description */ 2 49 2 header like header aligned, 2 50 2 data_space (0 refer (any_node.allocated_len)) bit (36) aligned; 2 51 2 52 dcl 1 indirect_node aligned based (node_ptr), /* internal to lsm_ */ 2 53 2 header like header, 2 54 2 new_node fixed bin (18); /* numberof reallocated node */ 2 55 2 56 dcl 1 fixed_node aligned based (node_ptr), /* array of fixed bin (35) */ 2 57 2 header like header, 2 58 2 element (0 refer (fixed_node.data_len)) fixed bin (35); /* array of values */ 2 59 2 60 dcl 1 float_node aligned based (node_ptr), /* array of float binary (27) */ 2 61 2 header like header, 2 62 2 element (0 refer (float_node.data_len)) float bin (27); 2 63 2 64 dcl 1 bit_node aligned based (node_ptr), /* string of bits */ 2 65 2 header like header, 2 66 2 string bit (0 refer (bit_node.data_len)); /* bit string of max length */ 2 67 2 68 dcl 1 char_node aligned based (node_ptr), /* string of characters */ 2 69 2 header like header, 2 70 2 string char (0 refer (char_node.data_len)) unaligned; /* character string of max length */ 2 71 2 72 dcl 1 symtab_node aligned based (node_ptr), /* symbol table node */ 2 73 2 header like header, 2 74 2 bucket_root (0 : 1 refer (symtab_node.data_len)) fixed bin (18); 2 75 /* actually, it is (0 : data_len - 1), but there's no way to do */ 2 76 /* this with a refer option, and it's invalid not to use refer */ 2 77 2 78 dcl 1 symbol_node aligned based (node_ptr), /* symbol node */ 2 79 2 header like header, 2 80 2 name_node fixed bin (18), /* number of character string node containing symbol name */ 2 81 2 value_node fixed bin (18), /* number of node that is the "value" of this symbol */ 2 82 2 next_node fixed bin (18); /* number of next symbol node in this bucket chain */ 2 83 /* =0 if this is last node o chain */ 2 84 2 85 dcl 1 list_node aligned based (node_ptr), /* non-terminal list node */ 2 86 2 header like header, 2 87 2 node (0 refer (list_node.data_len)) fixed bin (18); /* numbers of nodes comprising this list */ 2 88 2 89 dcl 1 array_node aligned based (node_ptr), /* non-terminal list with terminal properties */ 2 90 2 header like header, 2 91 2 node (0 refer (array_node.data_len)) fixed bin (18); /* numbers of nodes comprising this array */ 2 92 2 93 2 94 /* End include file . . . lsm_formats.incl.pl1 */ 84 85 3 1 /* BEGIN INCLUDE FILE . . . sl_info.incl.pl1 */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(87-11-16,Lippard), approve(87-12-21,MCR7822), 3 7* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 3 8* Modified to add INITIATED_SEGS type. 3 9* 2) change(87-11-19,Lippard), approve(87-12-21,MCR7822), 3 10* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 3 11* Added uid to sl_info structure. 3 12* END HISTORY COMMENTS */ 3 13 3 14 3 15 declare 1 sl_info aligned based (sl_info_p), 3 16 2 version fixed binary, /* Must be 1 */ 3 17 2 num_paths fixed binary, /* Number of search paths */ 3 18 2 change_index_p pointer, /* Pointer to search list's update count */ 3 19 2 change_index fixed binary (71), /* This search list's update count */ 3 20 2 pad1 (6) bit (36), /* Must be zero */ 3 21 2 paths (sl_info_num_paths refer (sl_info.num_paths)), 3 22 3 type fixed binary, /* Type of search path */ 3 23 3 code fixed binary (35), /* Standard status code of search path */ 3 24 3 uid bit (36), /* Unique ID */ 3 25 3 pathname char (168) unaligned; /* Search pathname */ 3 26 3 27 declare sl_info_num_paths fixed binary; 3 28 declare sl_info_p pointer; 3 29 declare sl_info_version_1 fixed binary internal static options (constant) initial (1); 3 30 3 31 /* Keyword Types */ 3 32 3 33 declare ABSOLUTE_PATH fixed binary internal static options (constant) initial (0); 3 34 declare UNEXPANDED_PATH fixed binary internal static options (constant) initial (1); 3 35 declare REFERENCING_DIR fixed binary internal static options (constant) initial (3); 3 36 declare WORKING_DIR fixed binary internal static options (constant) initial (4); 3 37 declare PROCESS_DIR fixed binary internal static options (constant) initial (5); 3 38 declare HOME_DIR fixed binary internal static options (constant) initial (6); 3 39 declare INITIATED_SEGS fixed binary internal static options (constant) initial (7); 3 40 3 41 /* END INCLUDE FILE . . . sl_info.incl.pl1 */ 86 87 88 init: entry (lsm_segptr, err_code); 89 90 /* the entry init creates a fresh lsm segment in the process directory 91* if the supplied pointer "pr" is null. If not, it assumes that "pr" is a 92* valid base pointer to an lsm segment and truncates and re-initializes it */ 93 94 call init (lsm_segptr, err_code); 95 return; 96 97 98 /* ------------------------- */ 99 100 init: proc (lsm_segptr, err_code); 101 102 dcl lsm_segptr pointer parameter, 103 err_code fixed bin (35) parameter; 104 105 if lsm_segptr = null then do; /* get a temp segment */ 106 call get_temp_segment_ ("graphic lsm_ temp", lsm_segptr, err_code); 107 if err_code ^= 0 then return; 108 end; 109 110 call init_lsm_header (lsm_segptr, err_code); 111 return; 112 end init; 113 114 /* ------------------------- */ 115 116 117 /* ------------------------- */ 118 119 init_lsm_header: proc (lsm_segptr, code); 120 121 dcl lsm_segptr pointer parameter, 122 code fixed bin (35) parameter; 123 124 if rel (lsm_segptr) ^= ""b then do; 125 err_code = error_table_$bad_arg; 126 call sub_err_ (code, "lsm_", "h", null, 0, 127 "Supplied segment pointer (^p) contains nonzero offset. 128 Please notify graphics system maintenance personnel.", 129 lsm_segptr); 130 return; 131 end; 132 133 lsm_segptr -> lsm.version = LSM_version_7; 134 lsm_segptr -> lsm.root_symtab = 0; 135 lsm_segptr -> lsm.lock = "0"b; 136 lsm_segptr -> lsm.component_slots = lsm_constants.initial_component_slots; 137 lsm_segptr -> lsm.components = 0; 138 lsm_segptr -> lsm.pad = -1; 139 lsm_segptr -> lsm.component_ptrs = null; 140 141 lsm_segptr -> lsm.free = currentsize (lsm_segptr -> lsm); 142 143 call hcs_$truncate_seg (lsm_segptr, lsm_segptr -> lsm.free, code); /* truncate the existing seg */ 144 if code ^= 0 then return; 145 146 return; 147 end init_lsm_header; 148 149 /* ------------------------- */ 150 151 init_seg: entry (lsm_segptr, dir_path, entry, icv_sw, err_code); 152 153 /* init_seg attempts to initiate the specified LSM segment. 154* If not found and 'icv_sw' = 1, an empty LSM segment is created. 155* If 'icv_sw' = 2 the segment is cleared (made empty) */ 156 157 dcl dir_path char (*), /* directory of LSM segment */ 158 entry char (*), /* entry name of LSM */ 159 icv_sw fixed bin (17); /* 0 - init, 1 - create, 2 - clear */ 160 161 call init_seg (lsm_segptr, dir_path, entry, icv_sw, err_code); 162 return; 163 164 165 /* ------------------------- */ 166 167 init_seg: proc (lsm_segptr, dir_path, entry, icv_sw, err_code); 168 169 dcl (lsm_segptr pointer, 170 (dir_path, entry) char (*), 171 icv_sw fixed bin, 172 err_code fixed bin (35)) parameter; 173 174 if dir_path = "" then 175 call find_via_search_paths (entry, lsm_segptr, err_code); 176 else call hcs_$initiate (dir_path, entry, "", 0, 1 /* no copy */, lsm_segptr, err_code); 177 178 if err_code = error_table_$segknown then err_code = 0; /* innocuous */ 179 180 if icv_sw = Find_seg then do; 181 if lsm_segptr ^= null then /* tiny gullibility checks */ 182 if lsm.version ^= LSM_version_7 then 183 if lsm.version ^= LSM_version_6 then 184 err_code = error_table_$unimplemented_version; 185 return; /* whether or not it worked */ 186 end; 187 188 if err_code ^= 0 then do; 189 call hcs_$make_seg (dir_path, entry, "", 1010b /* rw */, lsm_segptr, err_code); 190 if err_code ^= 0 then 191 if err_code = error_table_$segknown then err_code = 0; /* innocuous */ 192 else return; /* can't do it, give up */ 193 call init_lsm_header (lsm_segptr, err_code); 194 return; 195 end; 196 197 if icv_sw = Clear_seg then call init_lsm_header (lsm_segptr, err_code); 198 return; 199 200 end init_seg; 201 202 /* ------------------------- */ 203 204 free: entry (lsm_segptr, err_code); 205 206 /* free truncates to zero the supplied segment and returns it to 207* the free temporary segment list */ 208 209 call free_seg (lsm_segptr, err_code); 210 return; 211 212 213 /* ------------------------- */ 214 215 free_seg: proc (lsm_segptr, err_code); 216 217 dcl lsm_segptr pointer parameter, 218 err_code fixed bin (35) parameter; 219 220 call hcs_$truncate_seg (lsm_segptr, 0, err_code); 221 if err_code ^= 0 then return; /* something funny, don't fiddle further */ 222 223 call release_temp_segment_ ("graphic lsm_ temp", lsm_segptr, err_code); 224 if err_code ^= 0 then return; 225 226 lsm_segptr = null; 227 return; 228 229 end free_seg; 230 231 /* ------------------------- */ 232 233 pull: entry (to_segptr_arg, dir_path, entry, err_code); 234 235 /* pull "pulls" into the temp segment the list structure of the lsm segment in dir_path>entry. */ 236 237 dcl temp_table_node fixed bin (18); 238 239 to_segptr = to_segptr_arg; 240 241 call init_seg (from_segptr, dir_path, entry, Find_seg, err_code); 242 if from_segptr = null then return; /* can't get at it, return */ 243 244 call init_lsm_header (to_segptr, err_code); /* destroy previous contents of target seg */ 245 if err_code ^= 0 then return; 246 247 if from_segptr -> lsm.version = LSM_version_7 then do; 248 move_len = from_segptr -> lsm.free; 249 unspec (to_segptr -> move_array) = unspec (from_segptr -> move_array); /* Move bunch of data */ 250 err_code = 0; 251 return; 252 end; 253 254 else do; /* pulling an old version LSM segment */ 255 call lsm_sym_$find_table (from_segptr, temp_table_node, err_code); 256 if err_code ^= 0 then return; 257 258 call move_substruc (from_segptr, temp_table_node, to_segptr, to_segptr -> lsm.root_symtab, 259 On_dup_error, err_code); 260 return; 261 end; 262 263 push: entry (from_segptr_arg, dir_path, entry, err_code); 264 265 from_segptr = from_segptr_arg; 266 267 call init_seg (to_segptr, dir_path, entry, Clear_seg, err_code); 268 if err_code ^= 0 then return; 269 270 call move_substruc (from_segptr, from_segptr -> lsm.root_symtab, to_segptr, to_segptr -> lsm.root_symtab, 271 On_dup_error, err_code); 272 return; 273 274 compact: entry (lsm_segptr, count, err_code); 275 276 dcl count fixed bin (18); /* gc threshold */ 277 278 if count > lsm_segptr -> lsm.free then do; /* garbage collection threshold not yet reached */ 279 err_code = 0; 280 return; 281 end; 282 283 temp_segptr = null; 284 call init (temp_segptr, err_code); /* Initiate a temp seg for copying */ 285 if err_code ^= 0 then return; 286 call move_substruc (lsm_segptr, lsm_segptr -> lsm.root_symtab, temp_segptr, temp_segptr -> lsm.root_symtab, 287 On_dup_error, err_code); /* Move the structure into the temp seg */ 288 if err_code ^= 0 then return; 289 290 move_len = temp_segptr -> lsm.free; /* Compute length of compacted version */ 291 lsm_segptr -> move_array = temp_segptr -> move_array; /* Copy compacted version back */ 292 293 call hcs_$truncate_seg (lsm_segptr, move_len, err_code); /* Truncate the original */ 294 if err_code ^= 0 then return; 295 296 call free_seg (temp_segptr, err_code); /* Free up the temporary */ 297 return; 298 299 move_struc: entry (from_segptr_arg, to_segptr_arg, from_node_arg, to_node_arg, err_code); 300 301 /* Copies list structure subsidiary to from_node in "from" segment 302* into "to" segment and returns new value of root_node */ 303 304 call move_substruc (from_segptr_arg, from_node_arg, to_segptr_arg, to_node_arg, On_dup_error, err_code); 305 /* Get common code to do work */ 306 return; 307 308 merge_symbol: entry (from_segptr_arg, to_segptr_arg, from_node_arg, merge, merge_code, err_code); 309 310 /* Copy list structure subordinate to from_node_arg and replace subordinate symbols or overwrite them */ 311 312 dcl merge bit (1) aligned, /* ON iff merging symbol tables */ 313 merge_code fixed bin; 314 315 call move_substruc (from_segptr_arg, from_node_arg, to_segptr_arg, 0, merge_code, err_code); 316 return; 317 318 move_substruc: procedure (from_segptr, from_node, to_segptr, to_node, merge_code, err_code); 319 320 /* Internal procedure to move a node (and its substructure) 321* from segment "from_p" to segment "to_p" */ 322 323 /* Movement is done recursively on list and array type nodes, iteratively on others. 324* 325* If merge_code = On_dup_error then all subordinate named substructures are copied from the 326* original into the copy, and entered into the copy symbol table. 327* If a name already exists in the copy symbol table, copying is aborted, and 328* and error message is returned. 329* 330* If merge_code = On_dup_source then operation is identical to 0, but symbols already in the 331* copy symbol table are overwritten by identically named substructures 332* from the original. 333* 334* If merge_code = On_dup_target_then_nulls, subordinate named substructures in the original are 335* replaced with identically named substructures in the copy. 336* If a name does not yet exist in the copy symbol table, it is created with 337* a value node of 0. 338* 339* If merge_code = On_dup_target_then_source, operation is identical to 2, but when a name doesn't exist 340* in the copy symbol table, the named substrucuture from the original is copied. */ 341 342 dcl from_node fixed bin (18), /* node number in lsm_ segment pointed to by 343* "from_segptr" to be moved */ 344 to_node fixed bin (18), /* node number in lsm_ segment pointed to by 345* "to_segptr" where from_node has been moved */ 346 from_segptr pointer, /* pointer to lsm_segment contining structure to be moved */ 347 to_segptr pointer, /* pointer to lsm_ segment into which structure is to be moved */ 348 merge_code fixed bin, /* see above for description */ 349 err_code fixed bin (35); 350 /* if on, overwrite symbols in "to" segment */ 351 dcl 1 scratch_seg based (scratch_ptr) aligned, 352 2 lsm_header (size (null -> lsm)) bit (36) aligned, 353 2 old_new_table (0 : sys_info$max_seg_size - 1) fixed bin (18) unsigned unaligned, 354 2 sym_list_array (divide (sys_info$max_seg_size, 2, 18, 0) - currentsize (scratch_ptr -> lsm)) fixed bin (18) aligned; 355 356 dcl scratch_ptr pointer initial (null), 357 old_copy_ptr pointer initial (null); 358 359 dcl upgrading_version_6_seg bit (1) aligned; 360 361 dcl old_new_tab_p pointer, /* Points to table of old-new node correspondences */ 362 old_new_tab (0 : sys_info$max_seg_size - 1) fixed bin (18) unsigned unaligned based (old_new_tab_p); 363 /* Table of node correspondences between old and new copies */ 364 dcl sym_list_array_p pointer, 365 sym_list_array (divide (sys_info$max_seg_size, 2, 18, 0) - currentsize (scratch_ptr -> lsm)) fixed bin (18) based (sym_list_array_p); 366 367 dcl hcs_$fs_get_mode ext entry (pointer, fixed bin, fixed bin (35)), 368 error_table_$moderr ext fixed bin (35), 369 effmode fixed bin; 370 371 /* First, check to see that we can read from the from_seg and write to the to_seg. 372* This should save a lot of faults. */ 373 374 call hcs_$fs_get_mode (from_segptr, effmode, err_code); 375 if err_code ^= 0 then return; 376 377 if effmode ^> 111b /* no read permission */ then do; 378 bad_access_mode: err_code = error_table_$moderr; 379 return; 380 end; 381 382 call hcs_$fs_get_mode (to_segptr, effmode, err_code); 383 if err_code ^= 0 then return; 384 385 if mod (effmode, 4) ^= 10b /* no write permission */ then goto bad_access_mode; 386 387 if to_segptr -> lsm.version ^= LSM_version_7 then do; 388 err_code = error_table_$unimplemented_version; 389 return; 390 end; 391 392 on cleanup begin; 393 if scratch_ptr ^= null then call free_seg (scratch_ptr, 0); 394 if old_copy_ptr ^= null then call free_seg (old_copy_ptr, 0); 395 end; 396 397 call init (scratch_ptr, err_code); 398 if err_code ^= 0 then return; 399 400 old_new_tab_p = addr (scratch_seg.old_new_table); 401 sym_list_array_p = addr (scratch_seg.sym_list_array); 402 /* so as not to destroy header */ 403 404 call init (old_copy_ptr, err_code); /* we will store old contents in case of error */ 405 move_len = from_segptr -> lsm.free; 406 unspec (old_copy_ptr -> move_array) = unspec (to_segptr -> move_array); 407 408 if from_segptr -> lsm.version = LSM_version_7 then 409 upgrading_version_6_seg = ""b; 410 else if from_segptr -> lsm.version = LSM_version_6 then 411 upgrading_version_6_seg = "1"b; 412 else do; 413 err_code = error_table_$unimplemented_version; 414 return; 415 end; 416 417 call move_substruc_recurse (from_node, to_node, "1"b, err_code); /* Get friend to do work */ 418 419 if err_code ^= 0 then do; /* something wrong, clean up seg like we found it */ 420 unspec (to_segptr -> move_array) = unspec (old_copy_ptr -> move_array); 421 call hcs_$truncate_seg (to_segptr, to_segptr -> lsm.free, 0); 422 end; 423 424 call free_seg (scratch_ptr, 0); /* Free up temporary segs */ 425 call free_seg (old_copy_ptr, 0); 426 return; 427 428 move_substruc_recurse: procedure (from_node, to_node, top_level, err_code); 429 430 /* "from_p" and "to_p" are already assumed to point to proper lsm_ segments */ 431 432 dcl from_node fixed bin (18), /* node number in from seg to be moved */ 433 to_node fixed bin (18), /* node no. of copied node in to seg (output ) */ 434 top_level bit (1) aligned parameter, /* ON if this is top level structure */ 435 err_code fixed bin (35) parameter; 436 437 dcl actual_node fixed bin (18), /* Current node being moved */ 438 node_ptr pointer, /* pointer to node in lsm segment */ 439 cur_type fixed bin (4), /* lsm_ type of same */ 440 symtab_node_no fixed bin (18); 441 442 443 if from_node = 0 then do; /* the null node, be happy about it */ 444 err_code, to_node = 0; 445 return; 446 end; 447 448 call chase_indirect (from_node, actual_node, node_ptr, cur_type, err_code); 449 /* Find out all about the node */ 450 /* and chase any indirects */ 451 if err_code ^= 0 then return; 452 453 to_node = old_new_tab (actual_node); 454 /* See if it has already been copied */ 455 if to_node ^= 0 then return; /* already been copied, wonderful */ 456 457 /* If not, we have to copy it over now. */ 458 459 if (cur_type <= bit_type) | (cur_type = char_type) then /* vanilla nodes */ 460 call move_simple_node (node_ptr, actual_node, to_node); 461 462 else if (cur_type = list_type) | (cur_type = array_type) then 463 call move_list_node (node_ptr, actual_node, to_node, err_code); 464 465 else if cur_type = symbol_type then 466 call merge_symbol_node (node_ptr, actual_node, to_node, top_level, err_code); 467 /* then move it as specified by "merge_code" */ 468 else if cur_type = symtab_type then do; 469 call lsm_sym_$find_table (from_segptr, symtab_node_no, err_code); 470 if err_code ^= 0 then return; 471 472 if (^top_level | (from_node ^= symtab_node_no)) then do; 473 /* we should NEVER encounter a symtab at a lower level */ 474 err_code = graphic_error_table_$not_a_structure; 475 return; 476 end; 477 478 else call move_symtab_node (node_ptr, actual_node, to_node, err_code); 479 end; 480 481 else do; 482 err_code = graphic_error_table_$bad_node; 483 return; 484 end; 485 486 if actual_node ^= from_node then 487 old_new_tab (from_node) = to_node; 488 return; 489 490 move_simple_node: procedure (node_ptr, from_node, to_node); 491 492 /* This subroutine moves nodes that contain no node references */ 493 494 dcl (from_node, to_node) fixed bin (18), /* old and new node numbers */ 495 node_ptr ptr; /* pointer to current node being moved */ 496 497 dcl to_p pointer; 498 499 to_node = to_segptr -> lsm.free; /* Allocate new space for it */ 500 to_p = addrel (to_segptr, to_node); 501 unspec (to_p -> any_node.header) = unspec (node_ptr -> any_node.header); 502 if upgrading_version_6_seg then 503 to_p -> any_node.allocated_len = to_p -> any_node.allocated_len - 1; 504 unspec (to_p -> any_node.data_space) = unspec (node_ptr -> any_node.data_space); 505 to_segptr -> lsm.free = to_segptr -> lsm.free + currentsize (to_p -> any_node); 506 /* Up allocation count */ 507 old_new_tab (from_node) = to_node; /* Save number of new node for later references */ 508 509 return; 510 end; 511 512 move_list_node: procedure (node_ptr, from_node, to_node, err_code); 513 514 dcl from_node fixed bin (18), /* node being moved */ 515 err_code fixed bin (35), 516 to_node fixed bin (18), /* place it is moved to */ 517 node_ptr pointer, 518 to_node_p pointer, 519 elem_node fixed bin (18), 520 elem_to_node fixed bin (18); 521 522 dcl i fixed bin; /* iteration index */ 523 524 call move_simple_node (node_ptr, from_node, to_node); /* Get a friend to move list itself */ 525 old_new_tab (from_node) = to_node; 526 527 to_node_p = addrel (to_segptr, to_node); /* Get pointer to request */ 528 529 do i = 1 to node_ptr -> list_node.data_len; /* Iterate down list */ 530 531 elem_node = node_ptr -> list_node.node (i); 532 533 if old_new_tab (elem_node) = 0 then do; 534 call chase_indirect (elem_node, actual_node, null, 0, err_code); 535 if err_code ^= 0 then return; 536 537 if old_new_tab (actual_node) = 0 then do; 538 call move_substruc_recurse (elem_node, elem_to_node, ""b, err_code); 539 if err_code ^= 0 then return; 540 541 old_new_tab (actual_node) = elem_to_node; 542 end; 543 else old_new_tab (elem_node) = old_new_tab (actual_node); 544 end; 545 546 to_node_p -> list_node.node (i) = old_new_tab (elem_node); 547 end; 548 549 return; 550 end; 551 552 move_symtab_node: proc (node_ptr, from_node, to_symtab_node, err_code); 553 554 /* This procedure moves the contents of a (the) symbol table from one 555* LSM segment to another. This is incidentally how compaction gets done. */ 556 557 dcl (node_ptr pointer, 558 from_node fixed bin (18), 559 to_symtab_node fixed bin (18), 560 err_code fixed bin (35)) parameter; 561 562 dcl i fixed bin, 563 array_len fixed bin, 564 to_node fixed bin (18), 565 new_len fixed bin, 566 symbol_ptr pointer, 567 actual_node fixed bin (18); 568 569 dcl Not_top_level bit (1) aligned initial ("0"b) static options (constant); 570 571 new_len = node_ptr -> symtab_node.allocated_len; 572 if upgrading_version_6_seg then /* old lengths all 1 too high */ 573 new_len = new_len - 1; 574 575 call lsm_$make_blk (to_segptr, to_symtab_node, symtab_type, 576 new_len, null, err_code); 577 /* Make a symbol table in the new LSM segment */ 578 if err_code ^= 0 then return; 579 580 old_new_tab (to_symtab_node) = from_node; 581 582 call lsm_sym_$sym_list (from_segptr, sym_list_array, array_len, err_code); 583 if err_code ^= 0 then return; 584 585 do i = 1 to array_len; 586 if old_new_tab (sym_list_array (i)) = 0 then do; 587 call chase_indirect (sym_list_array (i), actual_node, symbol_ptr, 0, err_code); 588 if err_code ^= 0 then return; 589 590 if old_new_tab (actual_node) = 0 then do; 591 call merge_symbol_node (symbol_ptr, actual_node, to_node, Not_top_level, err_code); 592 if err_code ^= 0 then return; 593 594 if sym_list_array (i) ^= actual_node then 595 old_new_tab (sym_list_array (i)) = to_node; 596 end; 597 598 else old_new_tab (sym_list_array (i)) = old_new_tab (actual_node); 599 end; 600 end; 601 602 return; 603 604 end move_symtab_node; 605 606 merge_symbol_node: procedure (node_ptr, from_node, to_node, top_level, err_code); 607 608 dcl (node_ptr pointer, /* pointer to symbol node in "from" seg */ 609 from_node fixed bin (18), /* node number of same */ 610 to_node fixed bin (18), /* node no of copy in "to" seg */ 611 top_level bit (1) aligned, /* ON means moving top level structure */ 612 err_code fixed bin (35)) parameter; 613 614 dcl (to_val_n, from_val_n) fixed bin (18), /* value node nos in "to" and "from" segs */ 615 to_sym_n fixed bin (18), /* symbol node no in "to" seg */ 616 from_val_p pointer, 617 from_val_type fixed bin (4), 618 name_node_ptr pointer, 619 not_in_to bit (1) aligned; /* switch indicates that symbol is not found in "to" seg */ 620 621 if node_ptr -> any_node.type ^= symbol_type then do; 622 err_code = graphic_error_table_$bad_node; 623 return; 624 end; 625 626 627 name_node_ptr = pointer (node_ptr, node_ptr -> symbol_node.name_node); 628 629 call lsm_sym_$symk (to_segptr, Find_symbol, name_node_ptr -> char_node.string, 630 to_sym_n, to_val_n, 0); 631 not_in_to = (to_sym_n = 0); /* ON if symbol is not in symbol table of "to" seg */ 632 633 go to merge_symbol (merge_code); 634 635 merge_symbol (0): if not_in_to then 636 call copy_from_symbol; 637 else do; 638 err_code = graphic_error_table_$struc_duplication; 639 return; 640 end; 641 goto merge_end; 642 643 merge_symbol (1): call copy_from_symbol; 644 goto merge_end; 645 646 647 merge_symbol (2): if top_level then 648 call copy_from_symbol; /* this is direct user request, move it whether there or not */ 649 else if not_in_to then do; /* tagalong subsymbol, create it, make it empty */ 650 call lsm_sym_$symk (to_segptr, Create_symbol, name_node_ptr -> char_node.string, 651 to_sym_n, to_node, err_code); 652 to_node = to_sym_n; 653 end; 654 else to_node = to_sym_n; /* else already there, mirror */ 655 goto merge_end; 656 657 merge_symbol (3): if (top_level | not_in_to) 658 then call copy_from_symbol; 659 else to_node = to_sym_n; 660 661 merge_end: old_new_tab (from_node) = to_node; /* note that this node now known */ 662 return; 663 664 copy_from_symbol: procedure; 665 666 /* Utility routine to copy the value node of a symbol in the "from" segment 667* into to "to" segment, and insert the symbol name and value in to "to" symbol table */ 668 669 from_val_n = node_ptr -> symbol_node.value_node; /* Get "from" value node */ 670 call chase_indirect (from_val_n, from_val_n, from_val_p, from_val_type, err_code); 671 /* Get its type, leng, pointer to it */ 672 if err_code ^= 0 then return; 673 674 to_val_n = old_new_tab (from_val_n); /* See if already copied */ 675 676 if from_val_n ^= 0 then /* not the dummy null node */ 677 if to_val_n = 0 then do; /* never previously copied */ 678 call move_substruc_recurse (from_val_n, to_val_n, ""b, err_code); 679 if err_code ^= 0 then return; 680 end; 681 682 call lsm_sym_$symk (to_segptr, Create_symbol, name_node_ptr -> char_node.string, 683 to_node, to_val_n, err_code); 684 /* Make new or write old symbol in copy symtab */ 685 686 return; 687 end copy_from_symbol; 688 689 end merge_symbol_node; 690 691 chase_indirect: procedure (start_node, actual_node, node_ptr, cur_type, err_code); 692 693 694 /* This subroutine chases down LSM indirections and returns info about the real McCoy node. */ 695 dcl start_node fixed bin (18), /* Start here */ 696 actual_node fixed bin (18), /* Final number of node */ 697 /* SHOULD THIS BE HERE ? */ 698 node_ptr pointer, /* pointer to node specificstions */ 699 cur_type fixed bin (4), /* type of node found */ 700 err_code fixed bin (35); 701 702 if start_node = 0 then do; 703 actual_node = 0; 704 node_ptr = null; 705 cur_type = -1; 706 return; 707 end; 708 actual_node = start_node; 709 cur_type = indirect_type; 710 711 do while (cur_type = indirect_type); 712 call in_bounds_check (actual_node, err_code); 713 if err_code ^= 0 then return; 714 node_ptr = addrel (from_segptr, actual_node); 715 cur_type = node_ptr -> any_node.type; 716 if cur_type <= 0 | cur_type > lsm_constants.n_types 717 then do; 718 err_code = graphic_error_table_$bad_node; 719 return; 720 end; 721 if cur_type = indirect_type then actual_node = node_ptr -> indirect_node.new_node; 722 end; 723 724 return; 725 726 in_bounds_check: procedure (node_no, err_code); 727 728 dcl node_no fixed bin (18) parameter, 729 err_code fixed bin (35) parameter; 730 731 if node_no = 0 then err_code = 0; 732 else if (node_no < currentsize (from_segptr -> lsm)) then 733 if from_segptr -> lsm.version = LSM_version_6 then do; 734 /* check ameliorating circumstances */ 735 if node_no = 3 then 736 err_code = 0; /* symtab in version 6 segment */ 737 else if node_no ^< currentsize (from_segptr -> lsm) 738 - from_segptr -> lsm.component_slots then 739 err_code = 0; /* symbol in slot 0 of v6 lsm_ makes header look huge */ 740 else err_code = graphic_error_table_$lsm_node_ob; 741 end; 742 else err_code = graphic_error_table_$lsm_node_ob; 743 else if node_no > sys_info$max_seg_size - 1 then 744 err_code = graphic_error_table_$lsm_node_ob; 745 else err_code = 0; 746 747 return; 748 749 end in_bounds_check; 750 end chase_indirect; 751 end move_substruc_recurse; 752 end move_substruc; 753 754 find_via_search_paths: proc (ename, segptr, code); 755 756 dcl ename char (*) parameter, 757 segptr pointer parameter, 758 code fixed bin (35) parameter; 759 760 dcl dname char (168); 761 762 dcl my_own_dirname char (168) static initial (""); 763 764 if my_own_dirname = "" then do; 765 this_label: call hcs_$fs_get_path_name (codeptr (this_label), 766 my_own_dirname, 0, "", code); 767 if code ^= 0 then return; 768 end; 769 770 segptr = null; 771 772 call search_paths_$find_dir ("graphics", null, ename, my_own_dirname, dname, code); 773 if code ^= 0 then return; 774 775 call hcs_$initiate (dname, ename, "", 0, 1, segptr, code); 776 return; 777 778 end find_via_search_paths; 779 780 end lsm_fs_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/16/88 1411.9 lsm_fs_.pl1 >spec>install>MR12.2-1023>lsm_fs_.pl1 82 1 03/27/82 0439.3 lsm_entry_dcls.incl.pl1 >ldd>include>lsm_entry_dcls.incl.pl1 84 2 12/17/79 1708.9 lsm_formats.incl.pl1 >ldd>include>lsm_formats.incl.pl1 86 3 02/16/88 1407.4 sl_info.incl.pl1 >spec>install>MR12.2-1023>sl_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Clear_seg 000051 constant fixed bin(17,0) initial dcl 1-29 set ref 197 267* Create_symbol 000051 constant fixed bin(17,0) initial dcl 1-24 set ref 650* 682* Find_seg 000045 constant fixed bin(17,0) initial dcl 1-29 set ref 180 241* Find_symbol 000045 constant fixed bin(17,0) initial dcl 1-24 set ref 629* LSM_version_6 constant fixed bin(17,0) initial dcl 2-5 ref 181 410 732 LSM_version_7 constant fixed bin(17,0) initial dcl 2-5 ref 133 181 247 387 408 Not_top_level 000045 constant bit(1) initial dcl 569 set ref 591* On_dup_error 000045 constant fixed bin(17,0) initial dcl 77 set ref 258* 270* 286* 304* actual_node parameter fixed bin(18,0) dcl 695 in procedure "chase_indirect" set ref 691 703* 708* 712* 714 721* actual_node 000170 automatic fixed bin(18,0) dcl 562 in procedure "move_symtab_node" set ref 587* 590 591* 594 598 actual_node 000100 automatic fixed bin(18,0) dcl 437 in procedure "move_substruc_recurse" set ref 448* 453 459* 462* 465* 478* 486 534* 537 541 543 addr builtin function dcl 70 ref 400 401 addrel builtin function dcl 70 ref 500 527 714 allocated_len 0(06) based fixed bin(12,0) level 3 in structure "any_node" packed unsigned unaligned dcl 2-48 in procedure "lsm_fs_" set ref 502* 502 504 504 505 allocated_len 0(06) based fixed bin(12,0) level 3 in structure "symtab_node" packed unsigned unaligned dcl 2-72 in procedure "lsm_fs_" ref 571 any_node based structure level 1 dcl 2-48 set ref 505 array_len 000163 automatic fixed bin(17,0) dcl 562 set ref 582* 585 array_type 11 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 462 bit_type 4 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 459 char_node based structure level 1 dcl 2-68 char_type 5 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 459 cleanup 000000 stack reference condition dcl 73 ref 392 code parameter fixed bin(35,0) dcl 121 in procedure "init_lsm_header" set ref 119 126* 143* 144 code parameter fixed bin(35,0) dcl 756 in procedure "find_via_search_paths" set ref 754 765* 767 772* 773 775* codeptr builtin function dcl 70 ref 765 765 component_ptrs 40 based pointer array level 2 packed unaligned dcl 2-27 set ref 139* component_slots 4 based fixed bin(17,0) level 2 dcl 2-27 set ref 136* 139 141 400 401 582 732 737 737 components 5 based fixed bin(17,0) level 2 dcl 2-27 set ref 137* count parameter fixed bin(18,0) dcl 276 ref 274 278 cur_type parameter fixed bin(4,0) dcl 695 in procedure "chase_indirect" set ref 691 705* 709* 711 715* 716 716 721 cur_type 000104 automatic fixed bin(4,0) dcl 437 in procedure "move_substruc_recurse" set ref 448* 459 459 462 462 465 468 currentsize builtin function dcl 70 ref 141 505 582 732 737 data_len 0(18) based fixed bin(18,0) level 3 in structure "list_node" packed unsigned unaligned dcl 2-85 in procedure "lsm_fs_" ref 529 data_len 0(18) based fixed bin(18,0) level 3 in structure "char_node" packed unsigned unaligned dcl 2-68 in procedure "lsm_fs_" ref 629 629 650 650 682 682 data_space 1 based bit(36) array level 2 dcl 2-48 set ref 504* 504 dir_path parameter char unaligned dcl 169 in procedure "init_seg" set ref 167 174 176* 189* dir_path parameter char unaligned dcl 157 in procedure "lsm_fs_" set ref 151 161* 233 241* 263 267* divide builtin function dcl 70 ref 582 dname 000130 automatic char(168) unaligned dcl 760 set ref 772* 775* effmode 000112 automatic fixed bin(17,0) dcl 367 set ref 374* 377 382* 385 elem_node 000126 automatic fixed bin(18,0) dcl 514 set ref 531* 533 534* 538* 543 546 elem_to_node 000127 automatic fixed bin(18,0) dcl 514 set ref 538* 541 ename parameter char unaligned dcl 756 set ref 754 772* 775* entry parameter char unaligned dcl 169 in procedure "init_seg" set ref 167 174* 176* 189* entry parameter char unaligned dcl 157 in procedure "lsm_fs_" set ref 151 161* 233 241* 263 267* err_code parameter fixed bin(35,0) dcl 514 in procedure "move_list_node" set ref 512 534* 535 538* 539 err_code parameter fixed bin(35,0) dcl 432 in procedure "move_substruc_recurse" set ref 428 444* 448* 451 462* 465* 469* 470 474* 478* 482* err_code parameter fixed bin(35,0) dcl 728 in procedure "in_bounds_check" set ref 726 731* 735* 737* 740* 742* 743* 745* err_code parameter fixed bin(35,0) dcl 102 in procedure "init" set ref 100 106* 107 110* err_code parameter fixed bin(35,0) dcl 557 in procedure "move_symtab_node" set ref 552 575* 578 582* 583 587* 588 591* 592 err_code parameter fixed bin(35,0) dcl 169 in procedure "init_seg" set ref 167 174* 176* 178 178* 181* 188 189* 190 190 190* 193* 197* err_code parameter fixed bin(35,0) dcl 695 in procedure "chase_indirect" set ref 691 712* 713 718* err_code parameter fixed bin(35,0) dcl 36 in procedure "lsm_fs_" set ref 88 94* 125* 151 161* 204 209* 233 241* 244* 245 250* 255* 256 258* 263 267* 268 270* 274 279* 284* 285 286* 288 293* 294 296* 299 304* 308 315* err_code parameter fixed bin(35,0) dcl 217 in procedure "free_seg" set ref 215 220* 221 223* 224 err_code parameter fixed bin(35,0) dcl 342 in procedure "move_substruc" set ref 318 374* 375 378* 382* 383 388* 397* 398 404* 413* 417* 419 err_code parameter fixed bin(35,0) dcl 608 in procedure "merge_symbol_node" set ref 606 622* 638* 650* 670* 672 678* 679 682* error_table_$bad_arg 000076 external static fixed bin(35,0) dcl 51 ref 125 error_table_$moderr 000134 external static fixed bin(35,0) dcl 367 ref 378 error_table_$segknown 000072 external static fixed bin(35,0) dcl 51 ref 178 190 error_table_$unimplemented_version 000074 external static fixed bin(35,0) dcl 51 ref 181 388 413 free 1 based fixed bin(18,0) level 2 dcl 2-27 set ref 141* 143* 248 278 290 405 421* 499 505* 505 from_node parameter fixed bin(18,0) dcl 557 in procedure "move_symtab_node" ref 552 580 from_node parameter fixed bin(18,0) dcl 494 in procedure "move_simple_node" ref 490 507 from_node parameter fixed bin(18,0) dcl 514 in procedure "move_list_node" set ref 512 524* 525 from_node parameter fixed bin(18,0) dcl 432 in procedure "move_substruc_recurse" set ref 428 443 448* 472 486 486 from_node parameter fixed bin(18,0) dcl 608 in procedure "merge_symbol_node" ref 606 661 from_node parameter fixed bin(18,0) dcl 342 in procedure "move_substruc" set ref 318 417* from_node_arg parameter fixed bin(18,0) dcl 36 set ref 299 304* 308 315* from_segptr 000100 automatic pointer dcl 36 in procedure "lsm_fs_" set ref 241* 242 247 248 249 255* 258* 265* 270* 270 from_segptr parameter pointer dcl 342 in procedure "move_substruc" set ref 318 374* 405 408 410 469* 582* 714 732 732 737 737 from_segptr_arg parameter pointer dcl 36 set ref 263 265 299 304* 308 315* from_val_n 000201 automatic fixed bin(18,0) dcl 614 set ref 669* 670* 670* 674 676 678* from_val_p 000204 automatic pointer dcl 614 set ref 670* from_val_type 000206 automatic fixed bin(4,0) dcl 614 set ref 670* get_temp_segment_ 000112 constant entry external dcl 64 ref 106 graphic_error_table_$bad_node 000062 external static fixed bin(35,0) dcl 46 ref 482 622 718 graphic_error_table_$lsm_node_ob 000066 external static fixed bin(35,0) dcl 46 ref 740 742 743 graphic_error_table_$not_a_structure 000064 external static fixed bin(35,0) dcl 46 ref 474 graphic_error_table_$struc_duplication 000070 external static fixed bin(35,0) dcl 46 ref 638 hcs_$fs_get_mode 000132 constant entry external dcl 367 ref 374 382 hcs_$fs_get_path_name 000104 constant entry external dcl 59 ref 765 hcs_$initiate 000110 constant entry external dcl 59 ref 176 775 hcs_$make_seg 000102 constant entry external dcl 59 ref 189 hcs_$truncate_seg 000106 constant entry external dcl 59 ref 143 220 293 421 header based structure level 2 in structure "symtab_node" dcl 2-72 in procedure "lsm_fs_" header based structure level 2 in structure "char_node" dcl 2-68 in procedure "lsm_fs_" header based structure level 1 dcl 2-42 in procedure "lsm_fs_" header based structure level 2 in structure "any_node" dcl 2-48 in procedure "lsm_fs_" set ref 501* 501 header based structure level 2 in structure "list_node" dcl 2-85 in procedure "lsm_fs_" i 000130 automatic fixed bin(17,0) dcl 522 in procedure "move_list_node" set ref 529* 531 546* i 000162 automatic fixed bin(17,0) dcl 562 in procedure "move_symtab_node" set ref 585* 586 587 594 594 598* icv_sw parameter fixed bin(17,0) dcl 169 in procedure "init_seg" ref 167 180 197 icv_sw parameter fixed bin(17,0) dcl 157 in procedure "lsm_fs_" set ref 151 161* indirect_node based structure level 1 dcl 2-52 indirect_type 1 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 709 711 721 initial_component_slots 24 000000 constant fixed bin(17,0) initial level 2 dcl 2-9 ref 136 list_node based structure level 1 dcl 2-85 list_type 10 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 462 lock 3 based bit(36) level 2 dcl 2-27 set ref 135* lsm based structure level 1 dcl 2-27 set ref 141 400 401 582 732 737 lsm_$make_blk 000122 constant entry external dcl 1-3 ref 575 lsm_constants 000000 constant structure level 1 dcl 2-9 lsm_segptr parameter pointer dcl 169 in procedure "init_seg" set ref 167 174* 176* 181 189* 193* 197* lsm_segptr parameter pointer dcl 2-25 in procedure "lsm_fs_" set ref 88 94* 151 161* 181 181 204 209* 274 278 286* 286 291 293* lsm_segptr parameter pointer dcl 121 in procedure "init_lsm_header" set ref 119 124 126* 133 134 135 136 137 138 139 141 141 143* 143 lsm_segptr parameter pointer dcl 217 in procedure "free_seg" set ref 215 220* 223* 226* lsm_segptr parameter pointer dcl 102 in procedure "init" set ref 100 105 106* 110* lsm_sym_$find_table 000124 constant entry external dcl 1-19 ref 255 469 lsm_sym_$sym_list 000126 constant entry external dcl 1-19 ref 582 lsm_sym_$symk 000130 constant entry external dcl 1-19 ref 629 650 682 merge parameter bit(1) dcl 312 ref 308 merge_code parameter fixed bin(17,0) dcl 312 in procedure "lsm_fs_" set ref 308 315* merge_code parameter fixed bin(17,0) dcl 342 in procedure "move_substruc" ref 318 633 mod builtin function dcl 70 ref 385 move_array based fixed bin(35,0) array dcl 41 set ref 249* 249 291* 291 406* 406 420* 420 move_len 000106 automatic fixed bin(18,0) dcl 41 set ref 248* 249 249 290* 291 293* 405* 406 406 420 420 my_own_dirname 000010 internal static char(168) initial unaligned dcl 762 set ref 764 765* 772* n_types 000000 constant fixed bin(17,0) initial level 2 dcl 2-9 ref 716 name_node 1 based fixed bin(18,0) level 2 dcl 2-78 ref 627 name_node_ptr 000210 automatic pointer dcl 614 set ref 627* 629 650 682 new_len 000165 automatic fixed bin(17,0) dcl 562 set ref 571* 572* 572 575* new_node 1 based fixed bin(18,0) level 2 dcl 2-52 ref 721 node 1 based fixed bin(18,0) array level 2 dcl 2-85 set ref 531 546* node_no parameter fixed bin(18,0) dcl 728 ref 726 731 732 735 737 743 node_ptr parameter pointer dcl 494 in procedure "move_simple_node" ref 490 501 504 node_ptr parameter pointer dcl 557 in procedure "move_symtab_node" ref 552 571 node_ptr parameter pointer dcl 608 in procedure "merge_symbol_node" ref 606 621 627 627 669 node_ptr parameter pointer dcl 514 in procedure "move_list_node" set ref 512 524* 529 531 node_ptr parameter pointer dcl 695 in procedure "chase_indirect" set ref 691 704* 714* 715 721 node_ptr 000102 automatic pointer dcl 437 in procedure "move_substruc_recurse" set ref 448* 459* 462* 465* 478* not_in_to 000212 automatic bit(1) dcl 614 set ref 631* 635 649 657 null builtin function dcl 70 ref 105 126 126 139 181 226 242 283 356 356 393 394 400 401 534 534 575 575 704 770 772 772 old_copy_ptr 000102 automatic pointer initial dcl 356 set ref 356* 394 394* 404* 406 420 425* old_new_tab based fixed bin(18,0) array unsigned unaligned dcl 361 set ref 453 486* 507* 525* 533 537 541* 543* 543 546 580* 586 590 594* 598* 598 661* 674 old_new_tab_p 000106 automatic pointer dcl 361 set ref 400* 453 486 507 525 533 537 541 543 543 546 580 586 590 594 598 598 661 674 old_new_table based fixed bin(18,0) array level 2 packed unsigned unaligned dcl 351 set ref 400 pad 6 based fixed bin(18,0) array level 2 dcl 2-27 set ref 138* pointer builtin function dcl 70 ref 627 rel builtin function dcl 70 ref 124 release_temp_segment_ 000114 constant entry external dcl 64 ref 223 root_symtab 2 based fixed bin(18,0) level 2 dcl 2-27 set ref 134* 258* 270* 270* 286* 286* scratch_ptr 000100 automatic pointer initial dcl 356 set ref 356* 393 393* 397* 400 401 424* 582 scratch_seg based structure level 1 dcl 351 search_paths_$find_dir 000116 constant entry external dcl 64 ref 772 segptr parameter pointer dcl 756 set ref 754 770* 775* size builtin function dcl 70 ref 400 401 start_node parameter fixed bin(18,0) dcl 695 ref 691 702 708 string 1 based char level 2 packed unaligned dcl 2-68 set ref 629* 650* 682* sub_err_ 000120 constant entry external dcl 64 ref 126 sym_list_array based fixed bin(18,0) array level 2 in structure "scratch_seg" dcl 351 in procedure "move_substruc" set ref 401 sym_list_array based fixed bin(18,0) array dcl 364 in procedure "move_substruc" set ref 582* 586 587* 594 594 598 sym_list_array_p 000110 automatic pointer dcl 364 set ref 401* 582 586 587 594 594 598 symbol_node based structure level 1 dcl 2-78 symbol_ptr 000166 automatic pointer dcl 562 set ref 587* 591* symbol_type 7 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 ref 465 621 symtab_node based structure level 1 dcl 2-72 symtab_node_no 000105 automatic fixed bin(18,0) dcl 437 set ref 469* 472 symtab_type 6 000000 constant fixed bin(17,0) initial level 3 dcl 2-9 set ref 468 575* sys_info$max_seg_size 000100 external static fixed bin(35,0) dcl 55 ref 401 582 743 temp_segptr 000104 automatic pointer dcl 36 set ref 283* 284* 286* 286 290 291 296* temp_table_node 000107 automatic fixed bin(18,0) dcl 237 set ref 255* 258* to_node parameter fixed bin(18,0) dcl 514 in procedure "move_list_node" set ref 512 524* 525 527 to_node 000164 automatic fixed bin(18,0) dcl 562 in procedure "move_symtab_node" set ref 591* 594 to_node parameter fixed bin(18,0) dcl 342 in procedure "move_substruc" set ref 318 417* to_node parameter fixed bin(18,0) dcl 494 in procedure "move_simple_node" set ref 490 499* 500 507 to_node parameter fixed bin(18,0) dcl 432 in procedure "move_substruc_recurse" set ref 428 444* 453* 455 459* 462* 465* 478* 486 to_node parameter fixed bin(18,0) dcl 608 in procedure "merge_symbol_node" set ref 606 650* 652* 654* 659* 661 682* to_node_arg parameter fixed bin(18,0) dcl 36 set ref 299 304* to_node_p 000124 automatic pointer dcl 514 set ref 527* 546 to_p 000114 automatic pointer dcl 497 set ref 500* 501 502 502 504 505 to_segptr 000102 automatic pointer dcl 36 in procedure "lsm_fs_" set ref 239* 244* 249 258* 258 267* 270* 270 to_segptr parameter pointer dcl 342 in procedure "move_substruc" set ref 318 382* 387 406 420 421* 421 499 500 505 505 527 575* 629* 650* 682* to_segptr_arg parameter pointer dcl 36 set ref 233 239 299 304* 308 315* to_sym_n 000202 automatic fixed bin(18,0) dcl 614 set ref 629* 631 650* 652 654 659 to_symtab_node parameter fixed bin(18,0) dcl 557 set ref 552 575* 580 to_val_n 000200 automatic fixed bin(18,0) dcl 614 set ref 629* 674* 676 678* 682* top_level parameter bit(1) dcl 432 in procedure "move_substruc_recurse" set ref 428 465* 472 top_level parameter bit(1) dcl 608 in procedure "merge_symbol_node" ref 606 647 657 type based fixed bin(6,0) level 3 packed unsigned unaligned dcl 2-48 set ref 621 715 types 1 000000 constant structure level 2 dcl 2-9 unspec builtin function dcl 70 set ref 249* 249 406* 406 420* 420 501* 501 504* 504 upgrading_version_6_seg 000104 automatic bit(1) dcl 359 set ref 408* 410* 502 572 value_node 2 based fixed bin(18,0) level 2 dcl 2-78 ref 669 version based fixed bin(17,0) level 2 dcl 2-27 set ref 133* 181 181 247 387 408 410 732 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ABSOLUTE_PATH internal static fixed bin(17,0) initial dcl 3-33 Create_seg internal static fixed bin(17,0) initial dcl 1-29 Delete_symbol internal static fixed bin(17,0) initial dcl 1-24 Find_or_create_symbol internal static fixed bin(17,0) initial dcl 1-24 HOME_DIR internal static fixed bin(17,0) initial dcl 3-38 INITIATED_SEGS internal static fixed bin(17,0) initial dcl 3-39 On_dup_source internal static fixed bin(17,0) initial dcl 77 On_dup_target_then_nulls internal static fixed bin(17,0) initial dcl 77 On_dup_target_then_source internal static fixed bin(17,0) initial dcl 77 PROCESS_DIR internal static fixed bin(17,0) initial dcl 3-37 REFERENCING_DIR internal static fixed bin(17,0) initial dcl 3-35 UNEXPANDED_PATH internal static fixed bin(17,0) initial dcl 3-34 WORKING_DIR internal static fixed bin(17,0) initial dcl 3-36 array_node based structure level 1 dcl 2-89 bit_node based structure level 1 dcl 2-64 fixed_node based structure level 1 dcl 2-56 float_node based structure level 1 dcl 2-60 lsm_$get_blk 000000 constant entry external dcl 1-3 lsm_$mk_char 000000 constant entry external dcl 1-3 lsm_$replace_blk 000000 constant entry external dcl 1-3 lsm_$replicate 000000 constant entry external dcl 1-3 lsm_$set_blk 000000 constant entry external dcl 1-3 lsm_fs_$compact 000000 constant entry external dcl 1-10 lsm_fs_$free 000000 constant entry external dcl 1-10 lsm_fs_$init 000000 constant entry external dcl 1-10 lsm_fs_$init_seg 000000 constant entry external dcl 1-10 lsm_fs_$merge_symbol 000000 constant entry external dcl 1-10 lsm_fs_$move_struc 000000 constant entry external dcl 1-10 lsm_fs_$pull 000000 constant entry external dcl 1-10 lsm_fs_$push 000000 constant entry external dcl 1-10 lsm_sym_$symn 000000 constant entry external dcl 1-19 node_ptr automatic pointer dcl 2-40 sl_info based structure level 1 dcl 3-15 sl_info_num_paths automatic fixed bin(17,0) dcl 3-27 sl_info_p automatic pointer dcl 3-28 sl_info_version_1 internal static fixed bin(17,0) initial dcl 3-29 NAMES DECLARED BY EXPLICIT CONTEXT. bad_access_mode 001620 constant label dcl 378 ref 385 chase_indirect 003547 constant entry internal dcl 691 ref 448 534 587 670 compact 000564 constant entry external dcl 274 copy_from_symbol 003412 constant entry internal dcl 664 ref 635 643 647 657 find_via_search_paths 003720 constant entry internal dcl 754 ref 174 free 000246 constant entry external dcl 204 free_seg 001505 constant entry internal dcl 215 ref 209 296 393 394 424 425 in_bounds_check 003633 constant entry internal dcl 726 ref 712 init 000137 constant entry external dcl 88 init 001013 constant entry internal dcl 100 in procedure "lsm_fs_" ref 94 284 397 404 init_lsm_header 001071 constant entry internal dcl 119 ref 110 193 197 244 init_seg 000166 constant entry external dcl 151 init_seg 001244 constant entry internal dcl 167 in procedure "lsm_fs_" ref 161 241 267 lsm_fs_ 000125 constant entry external dcl 18 merge_end 003374 constant label dcl 661 ref 641 644 655 merge_symbol 000025 constant label array(0:3) dcl 635 in procedure "merge_symbol_node" ref 633 merge_symbol 000755 constant entry external dcl 308 merge_symbol_node 003175 constant entry internal dcl 606 ref 465 591 move_list_node 002460 constant entry internal dcl 512 ref 462 move_simple_node 002371 constant entry internal dcl 490 ref 459 524 move_struc 000713 constant entry external dcl 299 move_substruc 001567 constant entry internal dcl 318 ref 258 270 286 304 315 move_substruc_recurse 002143 constant entry internal dcl 428 ref 417 538 678 move_symtab_node 002677 constant entry internal dcl 552 ref 478 pull 000275 constant entry external dcl 233 push 000453 constant entry external dcl 263 this_label 003736 constant label dcl 765 ref 765 765 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4534 4672 4117 4544 Length 5212 4117 136 303 415 52 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lsm_fs_ 302 external procedure is an external procedure. init 84 internal procedure is called by several nonquick procedures. init_lsm_header 128 internal procedure is called by several nonquick procedures. init_seg internal procedure shares stack frame of external procedure lsm_fs_. free_seg 88 internal procedure is called by several nonquick procedures. move_substruc 106 internal procedure enables or reverts conditions. on unit on line 392 74 on unit move_substruc_recurse 322 internal procedure calls itself recursively. move_simple_node internal procedure shares stack frame of internal procedure move_substruc_recurse. move_list_node internal procedure shares stack frame of internal procedure move_substruc_recurse. move_symtab_node internal procedure shares stack frame of internal procedure move_substruc_recurse. merge_symbol_node internal procedure shares stack frame of internal procedure move_substruc_recurse. copy_from_symbol internal procedure shares stack frame of internal procedure move_substruc_recurse. chase_indirect internal procedure shares stack frame of internal procedure move_substruc_recurse. in_bounds_check internal procedure shares stack frame of internal procedure move_substruc_recurse. find_via_search_paths internal procedure shares stack frame of external procedure lsm_fs_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 my_own_dirname find_via_search_paths STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lsm_fs_ 000100 from_segptr lsm_fs_ 000102 to_segptr lsm_fs_ 000104 temp_segptr lsm_fs_ 000106 move_len lsm_fs_ 000107 temp_table_node lsm_fs_ 000130 dname find_via_search_paths move_substruc 000100 scratch_ptr move_substruc 000102 old_copy_ptr move_substruc 000104 upgrading_version_6_seg move_substruc 000106 old_new_tab_p move_substruc 000110 sym_list_array_p move_substruc 000112 effmode move_substruc move_substruc_recurse 000100 actual_node move_substruc_recurse 000102 node_ptr move_substruc_recurse 000104 cur_type move_substruc_recurse 000105 symtab_node_no move_substruc_recurse 000114 to_p move_simple_node 000124 to_node_p move_list_node 000126 elem_node move_list_node 000127 elem_to_node move_list_node 000130 i move_list_node 000162 i move_symtab_node 000163 array_len move_symtab_node 000164 to_node move_symtab_node 000165 new_len move_symtab_node 000166 symbol_ptr move_symtab_node 000170 actual_node move_symtab_node 000200 to_val_n merge_symbol_node 000201 from_val_n merge_symbol_node 000202 to_sym_n merge_symbol_node 000204 from_val_p merge_symbol_node 000206 from_val_type merge_symbol_node 000210 name_node_ptr merge_symbol_node 000212 not_in_to merge_symbol_node THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out call_int_this call_int_other return_mac mpfx2 mdfx1 enable_op ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_temp_segment_ hcs_$fs_get_mode hcs_$fs_get_path_name hcs_$initiate hcs_$make_seg hcs_$truncate_seg lsm_$make_blk lsm_sym_$find_table lsm_sym_$sym_list lsm_sym_$symk release_temp_segment_ search_paths_$find_dir sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$moderr error_table_$segknown error_table_$unimplemented_version graphic_error_table_$bad_node graphic_error_table_$lsm_node_ob graphic_error_table_$not_a_structure graphic_error_table_$struc_duplication sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000124 18 000132 88 000133 94 000147 95 000160 151 000161 161 000211 162 000243 204 000244 209 000256 210 000267 233 000270 239 000322 241 000325 242 000357 244 000363 245 000373 247 000375 248 000400 249 000403 250 000410 251 000411 255 000412 256 000425 258 000427 260 000450 263 000451 265 000476 267 000502 268 000533 270 000535 272 000557 274 000560 278 000574 279 000602 280 000603 283 000604 284 000606 285 000616 286 000620 288 000644 290 000646 291 000651 293 000660 294 000673 296 000675 297 000705 299 000706 304 000725 306 000746 308 000747 315 000767 316 001011 100 001012 105 001020 106 001025 107 001053 110 001056 111 001067 119 001070 124 001076 125 001103 126 001106 130 001157 133 001160 134 001162 135 001163 136 001164 137 001166 138 001167 139 001204 141 001222 143 001225 144 001240 146 001243 167 001244 174 001262 176 001313 178 001357 180 001365 181 001367 185 001404 188 001405 189 001407 190 001446 192 001456 193 001457 194 001467 197 001470 198 001503 215 001504 220 001512 221 001526 223 001531 224 001560 226 001563 227 001565 318 001566 356 001574 374 001577 375 001612 377 001615 378 001620 379 001624 382 001625 383 001640 385 001643 387 001650 388 001654 389 001657 392 001660 393 001674 394 001713 395 001732 397 001733 398 001745 400 001750 401 001754 404 002003 405 002014 406 002022 408 002031 410 002036 413 002043 414 002046 417 002047 419 002065 420 002070 421 002101 424 002115 425 002127 426 002141 428 002142 443 002150 444 002153 445 002155 448 002156 451 002174 453 002177 455 002211 459 002212 462 002232 465 002253 468 002274 469 002276 470 002312 472 002315 474 002323 475 002326 478 002327 479 002343 482 002344 483 002347 486 002350 488 002370 490 002371 499 002373 500 002401 501 002404 502 002407 504 002420 505 002440 507 002443 509 002457 512 002460 524 002462 525 002475 527 002512 529 002520 531 002531 533 002535 534 002546 535 002567 537 002573 538 002607 539 002626 541 002632 542 002646 543 002647 546 002661 547 002674 549 002676 552 002677 571 002701 572 002706 575 002713 578 002740 580 002744 582 002760 583 003024 585 003030 586 003037 587 003052 588 003073 590 003077 591 003113 592 003131 594 003135 596 003155 598 003156 600 003172 602 003174 606 003175 621 003177 622 003204 623 003207 627 003210 629 003214 631 003260 633 003263 635 003267 638 003273 639 003277 641 003300 643 003301 644 003302 647 003303 649 003311 650 003313 652 003355 653 003360 654 003361 655 003362 657 003363 659 003373 661 003374 662 003411 664 003412 669 003413 670 003420 672 003435 674 003441 676 003453 678 003457 679 003476 682 003502 686 003546 691 003547 702 003551 703 003553 704 003554 705 003556 706 003560 708 003561 709 003562 711 003564 712 003570 713 003600 714 003604 715 003613 716 003616 718 003621 719 003624 721 003625 722 003631 724 003632 726 003633 731 003635 732 003641 735 003655 737 003662 740 003670 741 003673 742 003674 743 003700 745 003716 747 003717 754 003720 764 003731 765 003736 767 003773 770 003777 772 004002 773 004043 775 004047 776 004113 ----------------------------------------------------------- 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