COMPILATION LISTING OF SEGMENT make_lisp_listing Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0842.8 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 /* protect old protection notice */ 7 /* (c) Copyright 1973, Massachusetts Institute of Technology. 8* All rights reserved. */ 9 10 make_lisp_listing: mll: 11 procedure; 12 13 /* modified 15 Nov 73 by DAM for new subr blocks */ 14 15 dcl cu_$arg_ptr entry(fixed bin, ptr, fixed bin, fixed bin(35)), 16 object_info_$brief entry ( ptr, fixed bin(24), ptr, fixed bin(35)), 17 dump_lisp_code_ entry(fixed bin(18), fixed bin(18), ptr, pointer), 18 make_lisp_xref_ entry(pointer, ptr), 19 iox_$attach_ioname entry(char(*), ptr, char(*), fixed bin(35)), 20 iox_$open entry(ptr, fixed bin, bit(1) unaligned, fixed bin(35)), 21 iox_$close entry(ptr, fixed bin(35)), 22 iox_$detach_iocb entry(ptr, fixed bin(35)), 23 iox_$put_chars entry(ptr, ptr, fixed bin(21), fixed bin(35)), 24 iox_$position entry(ptr, fixed bin, fixed bin(21), fixed bin(35)), 25 hcs_$initiate_count entry(char(*), char(*), char(*), fixed bin(24), fixed bin(2), ptr, fixed bin(35)), 26 unique_chars_ entry(bit(*)) returns(char(15)), 27 error_table_$segknown fixed bin(35) external, 28 hcs_$terminate_name entry(char(*), fixed bin(35)), 29 hcs_$terminate_noname entry(pointer, fixed bin(35)), 30 hcs_$make_ptr entry(pointer, char(*), char(*), pointer, fixed bin(35)), 31 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin(35)), 32 date_time_ entry(fixed bin(71), char(*)), 33 34 bitcount fixed bin (24), 35 segptr ptr, 36 dir char(168), 37 ent char(32), 38 unique_ref_name char(15), 39 40 sdir char(168), 41 sent char(32), 42 sptr pointer, 43 sbc fixed bin(24), 44 slen fixed bin(21), 45 snameptr pointer, 46 snamelen fixed bin, 47 soff fixed bin(21), 48 nelemt fixed bin(21), 49 50 s char(1), /* singular/plural hackery */ 51 52 time_string char(24), 53 based_string char(1000) based aligned, 54 nameptr ptr, 55 namelen fixed bin, 56 name char(namelen) based(nameptr) unal, 57 bword bit(36) aligned based, 58 code fixed bin(35), 59 1 status aligned, 60 2 error_code fixed bin(35), 61 2 statbits bit(36), 62 63 atom_name char(10000) varying based aligned, 64 listfile char(32), 65 66 (mll_internal_error, cleanup) condition, 67 68 size_of_text fixed bin(18), 69 actionsp pointer, 70 sblkp pointer, 71 symrtp pointer, 72 number_of_definitions fixed bin init(0), 73 actionx fixed bin, 74 atomsp pointer, 75 number_of_atoms fixed bin init(0), 76 constp pointer, 77 number_of_constants fixed bin init(0), 78 79 mll_list_stream ptr, 80 def_ptr ptr, 81 82 (addr, addrel, substr, null, bit, fixed, multiply, binary, lbound, hbound, length) builtin, 83 84 1 acc aligned based, 85 2 len fixed bin(8) unal, 86 2 str char(0 refer(acc.len)) unal, 87 88 com_err_ entry options(variable), 89 ioa_$ioa_switch entry options(variable); 90 91 dcl brief_opt bit(1) init("0"b), 92 object_opt bit(1) init("0"b), 93 source_opt bit(1) init("0"b), 94 one_fun_opt bit(1) init("0"b), /* 1 => only list one function */ 95 one_fun char(256), /* the one function to list's name. */ 96 not_a_lisp_seg bit(1) init("0"b), 97 argx fixed bin, 98 argptr pointer, 99 arglen fixed bin, 100 arg char(arglen) based(argptr) unaligned, 101 error_table_$badopt fixed bin(35) external; 102 103 dcl source_map_ptr pointer; 104 105 dcl source_x fixed bin; 106 107 dcl source_pathname char(fixed(source_map_ptr -> source_map.pathname(source_x).size, 18)) unaligned 108 based(addrel(sblkp, source_map_ptr -> source_map.pathname(source_x).offset)); 109 1 1 /* MACLISP symbol section for compiled SUBR */ 1 2 1 3 dcl 1 symbol_root based aligned, /* starts off the LISP symbol section */ 1 4 1 5 2 version fixed bin, /* 2 for this dcl (new-arrays version) */ 1 6 2 number_objects fixed bin, /* number of objects which are to be made at fasload time */ 1 7 2 objects unal, 1 8 3 fixnum_blockp bit(18) unal, /* pointers to blocks describing variaous type classes of objects */ 1 9 3 flonum_blockp bit(18) unal, 1 10 3 string_blockp bit(18) unal, 1 11 3 bignum_blockp bit(18) unal, 1 12 3 atsym_blockp bit(18) unal, 1 13 3 cons_blockp bit(18) unal, 1 14 2 subr_block_size fixed bin(18), /* number of double word items to be put in subr block */ 1 15 2 subr_block_items unal, /* pointers to blocks indicating which objects to place in subr block */ 1 16 3 entry_blockp bit(18) unal, 1 17 3 const_blockp bit(18) unal, 1 18 3 links_blockp bit(18) unal, 1 19 2 action_blockp bit(18) unal, /* points to array of operations to be done at fasload time, in order */ 1 20 2 array_links_blockp bit(18) unal; /* points at block of array links */ 1 21 1 22 1 23 dcl 1 fixnum_block based aligned, 1 24 2 count fixed bin(18), 1 25 2 fixnums(0 refer(fixnum_block.count)) fixed bin(35); 1 26 1 27 dcl 1 flonum_block based aligned, 1 28 2 count fixed bin(18), 1 29 2 flonums(0 refer(flonum_block.count)) float bin(27); 1 30 1 31 dcl 1 string_block based aligned, 1 32 2 count fixed bin(18), 1 33 2 string_offset(0 refer(string_block.count)) bit(18) unal; /* pointers to string representation */ 1 34 1 35 1 36 dcl 1 atsym_block based aligned, 1 37 2 count fixed bin(18), 1 38 2 atsym_offset(0 refer(atsym_block.count)) bit(18) unal; /* pointers to atom names */ 1 39 1 40 dcl 1 bignum_block based aligned, 1 41 2 count fixed bin(18), 1 42 2 bignum_offsets(0 refer(bignum_block.count)) bit(18) unal; 1 43 1 44 dcl 1 cons_block based aligned, 1 45 2 count fixed bin(18), 1 46 2 conses(0 refer(cons_block.count)) unal, 1 47 3 car bin(17), 1 48 3 cdr bin(17); 1 49 1 50 dcl 1 string_chars based aligned, 1 51 2 flags unal, 1 52 3 uninterned_atom bit(1), 1 53 3 padding bit(10), 1 54 2 length fixed bin(24)unal, 1 55 2 chars char(0 refer (string_chars.length)) unaligned; 1 56 1 57 dcl 1 entry_block based aligned, 1 58 2 count fixed bin(18), 1 59 2 entry_info(0 refer(entry_block.count)) unal, 1 60 3 nargs bit(18), 1 61 3 entrypoint bit(18); 1 62 1 63 dcl 1 const_block based aligned, 1 64 2 count fixed bin(18), 1 65 2 constants (0 refer(const_block.count)) fixed bin(17) unal; 1 66 1 67 dcl 1 links_block based aligned, 1 68 2 count fixed bin(18), 1 69 2 link_info(0 refer(links_block.count)) bit(27); 1 70 1 71 dcl 1 array_links_block based aligned, 1 72 2 count fixed bin(18), 1 73 2 array_link(0 refer(array_links_block.count)), 1 74 3 control_word bit(36); /* rest is filled in at load time. 1 75* this word has type, ndims, symbol offset. */ 1 76 1 77 dcl 1 action_block based aligned, 1 78 2 count fixed bin(18), 1 79 2 actions(0 refer(action_block.count)) unal, /* each action described as one of these objects */ 1 80 3 action_code fixed bin(17) unal, 1 81 3 operand fixed bin(17) unal; /* offset of constant which is used in operation */ 1 82 1 83 /* End of description of MACLISP Compiled symbol tree */ 110 2 1 /* BEGIN INCLUDE SEGMENT ... symbol_block.incl.pl1 2 2*coded February 8, 1972 by Michael J. Spier */ 2 3 2 4 /* last modified may 3, 1972 by M. Weaver */ 2 5 2 6 declare 1 sb aligned based(sblkp), /* structure describing a standard symbol block */ 2 7 2 decl_vers fixed bin, /* version number of current structure format */ 2 8 2 identifier char(8) aligned, /* symbolic code to define purpose of this symb block */ 2 9 2 gen_version_number fixed bin, /* positive integer designating version of object generator */ 2 10 2 gen_creation_time fixed bin(71), /* clock reading of date/time generator was created */ 2 11 2 obj_creation_time fixed bin(71), /* clock reading of date/time object was generated */ 2 12 2 generator char(8) aligned, /* name of processor which generated segment */ 2 13 2 gen_name_offset bit(18) unaligned, /* offset of generator name in words rel to base of symbol block */ 2 14 2 gen_name_length bit(18) unaligned, /* length of printable generator version name in characters */ 2 15 2 uid_offset bit(18) unaligned, /* offset of creator id in words rel to base of symbol block */ 2 16 2 uid_length bit(18) unaligned, /* length of standard Multics id of object creator in characters */ 2 17 2 comment_offset bit(18) unaligned, /* offset of comment in words relative to base of symbol block */ 2 18 2 comment_length bit(18) unaligned, /* length of printable generator comment in characters */ 2 19 2 tbound bit(18) unaligned, /* specifies mod of text section base boundary */ 2 20 2 stat_bound bit(18) unaligned, /* specifies mod of internal static base boundary */ 2 21 2 source_map bit(18) unaligned, /* offset relative to base of symbol block of source map structure */ 2 22 2 area_ptr bit(18) unaligned, /* offset of block info in words relative to base of symbol block */ 2 23 2 symb_base bit(18) unaligned, /* back pointer (rel to base of symb block) to base of symb section */ 2 24 2 block_size bit(18) unaligned, /* size in words of entire symbol block */ 2 25 2 next_block bit(18) unaligned, /* if ^= "0"b, is thread (rel to base of symb section) to next symb block */ 2 26 2 rel_text bit(18) unaligned, /* offset rel to base of symbol block of text sect relocation info */ 2 27 2 rel_def bit(18) unaligned, /* offset rel to base of symb block of def section relocation info */ 2 28 2 rel_link bit(18) unaligned, /* offset rel to base of symb block of link sect relocation info */ 2 29 2 rel_symb bit(18) unaligned, /* offset rel to base of symb block of symb sect relocation info */ 2 30 2 default_truncate bit(18) unaligned, /* offset RTBOSB for binder to automatically trunc. symb sect. */ 2 31 2 optional_truncate bit(18) unaligned; /* offset RTBOSB for binder to optionally truncate symb section */ 2 32 2 33 /* END INCLUDE SEGMENT ... symbol_block.incl.pl1 */ 111 3 1 /* BEGIN INCLUDE FILE ... source_map.incl.pl1 */ 3 2 3 3 dcl 1 source_map aligned based, 3 4 2 version fixed bin, 3 5 2 number fixed bin, 3 6 2 map(n refer(source_map.number)) aligned, 3 7 3 pathname unaligned, 3 8 4 offset bit(18), 3 9 4 size bit(18), 3 10 3 uid bit(36), 3 11 3 dtm fixed bin(71); 3 12 3 13 /* END INCLUDE FILE ... source_map.incl.pl1 */ 112 4 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 4 2*coded February 8, 1972 by Michael J. Spier */ 4 3 /* modified May 26, 1972 by M. Weaver */ 4 4 /* modified 15 April, 1975 by M. Weaver */ 4 5 4 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 4 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 4 8 2 textp pointer, /* pointer to beginning of text section */ 4 9 2 defp pointer, /* pointer to beginning of definition section */ 4 10 2 linkp pointer, /* pointer to beginning of linkage section */ 4 11 2 statp pointer, /* pointer to beginning of static section */ 4 12 2 symbp pointer, /* pointer to beginning of symbol section */ 4 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 4 14 2 tlng fixed bin, /* length in words of text section */ 4 15 2 dlng fixed bin, /* length in words of definition section */ 4 16 2 llng fixed bin, /* length in words of linkage section */ 4 17 2 ilng fixed bin, /* length in words of static section */ 4 18 2 slng fixed bin, /* length in words of symbol section */ 4 19 2 blng fixed bin, /* length in words of break map */ 4 20 2 format, /* word containing bit flags about object type */ 4 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 4 22 3 bound bit(1) unaligned, /* on if segment is bound */ 4 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 4 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 4 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 4 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 4 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 4 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 4 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 4 30 3 pad bit(27) unaligned, 4 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 4 32 2 textlinkp pointer, /* ptr to first link in text */ 4 33 4 34 /* LIMIT OF BRIEF STRUCTURE */ 4 35 4 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 4 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 4 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 4 39 2 cvers aligned, /* generator version name in printable char string form */ 4 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 4 41 3 length bit(18) unaligned, /* length of name in characters */ 4 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 4 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 4 44 3 length bit(18) unaligned, /* length of comment in characters */ 4 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 4 46 4 47 /* LIMIT OF DISPLAY STRUCTURE */ 4 48 4 49 2 rel_text pointer, /* pointer to text section relocation info */ 4 50 2 rel_def pointer, /* pointer to definition section relocation info */ 4 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 4 52 2 rel_static pointer, /* pointer to static section relocation info */ 4 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 4 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 4 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 4 56 /* currently not used by system */ 4 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 4 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 4 59 4 60 declare object_info_version_2 fixed bin int static init(2); 4 61 4 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 113 114 115 dcl 1 oi like object_info aligned automatic; 116 117 /* process arguments */ 118 119 do argx = 1 by 1; 120 call cu_$arg_ptr(argx, argptr, arglen, code); 121 if code ^= 0 then go to exitloop_get_args; 122 if arg = "" then; /* ignore null args for sake of compiler */ 123 else if substr(arg, 1, 1) = "-" 124 then if arg = "-brief" then brief_opt = "1"b; 125 else if arg = "-bf" then brief_opt = "1"b; 126 else if arg = "-function" | arg = "-fn" then do; 127 one_fun_opt = "1"b; 128 argx = argx + 1; 129 call cu_$arg_ptr(argx, argptr, arglen, code); 130 if code ^= 0 then do; 131 call com_err_(code, "make_lisp_listing", "Function name required after -function."); 132 return; 133 end; 134 one_fun = arg; 135 end; 136 else do; 137 call com_err_(error_table_$badopt, "make_lisp_listing", arg); 138 return; 139 end; 140 else if ^object_opt then do; /* first pathname is object seg */ 141 object_opt = "1"b; 142 nameptr = argptr; 143 namelen = arglen; 144 end; 145 else if ^source_opt then do; /* second pathname is source seg */ 146 source_opt = "1"b; 147 snameptr = argptr; 148 snamelen = arglen; 149 end; 150 else do; /* a third pathname is not allowed */ 151 call com_err_(0, "make_lisp_listing", "^a is an extraneous argument.", arg); 152 return; 153 end; 154 end; 155 exitloop_get_args: 156 157 if ^object_opt then do; 158 call com_err_(0, "make_lisp_listing", 159 "Usage is: make_lisp_listing object_seg^/ the -brief and -bf options are allowed."); 160 return; 161 end; 162 163 call expand_path_(nameptr, namelen, addr(dir), addr(ent), code); 164 if code ^= 0 165 then do; 166 call com_err_ (code, "make_lisp_listing", name); 167 return; 168 end; 169 170 171 unique_ref_name = unique_chars_(""b); 172 call hcs_$initiate_count(dir, ent, unique_ref_name, bitcount, 0, segptr, code); 173 if code ^= 0 then if code ^= error_table_$segknown 174 then do; 175 call com_err_(code, "make_lisp_listing", "Cannot initiate ^a>^a.", dir, ent); 176 return; 177 end; 178 179 /* compute size of text section from rel of def section - needed later */ 180 181 call object_info_$brief(segptr, bitcount, addr(oi), code); 182 if code ^= 0 then go to bad_code; 183 size_of_text = fixed(rel(oi.defp), 18); 184 185 186 /* find symbol section */ 187 188 call hcs_$make_ptr(null, unique_ref_name, "symbol_table", sblkp, code); 189 if sblkp = null 190 then do; 191 bad_code: call com_err_(code, "make_lisp_listing", "^a>^a.", dir, ent); 192 return; 193 end; 194 if sblkp -> sb.generator ^= "lisp" then do; 195 not_lisp: if brief_opt then do; /* allowed if not looking at code */ 196 not_a_lisp_seg = "1"b; 197 go to skip_lisp_stuff; 198 end; 199 call com_err_(0, "make_lisp_listing", "^a>^a is not an object segment produced by the LISP compiler.", dir, ent); 200 return; 201 end; 202 if sblkp -> sb.area_ptr = ""b then go to not_lisp; /* old format, with .defs file? */ 203 symrtp = addrel(sblkp, sblkp -> sb.area_ptr); 204 205 /* determine number of functions defined in this object segment by scanning actions */ 206 207 actionsp = addrel(symrtp, symrtp -> symbol_root.action_blockp); 208 number_of_definitions = 0; 209 do actionx = 1 to actionsp -> action_block.count; 210 if actionsp -> action_block.action_code(actionx) > 0 /* def fcn of one type or another */ 211 then number_of_definitions = number_of_definitions + 1; 212 end; 213 214 atomsp = addrel(symrtp, symrtp -> symbol_root.atsym_blockp); 215 number_of_atoms = atomsp -> atsym_block.count; 216 217 constp = addrel(symrtp, symrtp -> symbol_root.const_blockp); 218 number_of_constants = constp -> const_block.count; 219 220 skip_lisp_stuff: 221 /* enter begin block to allocate various tables */ 222 223 allocate_various_tables: begin; 224 225 dcl defx fixed bin, 226 entryp pointer, 227 linksp pointer, 228 atom_lbound fixed bin(18), 229 actionx fixed bin, 230 i fixed bin, 231 codelength fixed bin(18); 232 233 dcl 1 table aligned automatic structure, 234 2 stack_height fixed bin(17), /* added to ap offset gives real offset */ 235 2 atom_table_size fixed bin(17) init(number_of_atoms), 236 2 link_table_ptr unaligned pointer, /* points at array of itp link info */ 237 2 link_table_lbound fixed bin(18), /* first lp| offset of itp link */ 238 2 link_table_hbound fixed bin(18), /* last lp| offset of itp link */ 239 2 array_link_table_ptr unaligned pointer, /* -> array of array_link control words */ 240 2 array_link_table_lbound fixed bin(18), /* first lp| offset of array link */ 241 2 array_link_table_hbound fixed bin(18), /* last lp| offset of array link */ 242 2 definition_table_size fixed bin init(number_of_definitions), 243 2 constant_table_size fixed bin(17) init(number_of_constants), 244 2 constant_table_lbound fixed bin(18), /* first lp| offset of constant */ 245 2 constant_table_hbound fixed bin(18), /* last lp| offset of constant */ 246 2 bind_stack_ptr fixed bin, /* index of first unused entry in the bind_stack */ 247 2 arg_twiddle fixed bin(18), /* eax5 hacker */ 248 2 seg_ptr unaligned pointer, /* -> object seg text section */ 249 2 bind_stack (100) fixed bin, /* table of sizes of nested binding blocks */ 250 2 atom_table (number_of_atoms) structure, /* pointers to atomic symbols */ 251 3 ptr_to_name unaligned pointer, /* packed pointer to varying string which is name */ 252 2 definition_table (number_of_definitions) structure, 253 3 arg_pdl bit(18) unaligned, /* number of pdl cells occupied by args */ 254 3 entrypoint bit(18) unaligned, /* location of entry */ 255 3 ptr_to_name unaligned pointer, /* packed pointer to varying string */ 256 2 constant_table (number_of_constants) structure, 257 3 atom_table_index fixed bin; /* 0 if this constant not an atom */ 258 259 260 if not_a_lisp_seg then seg_ptr = segptr; 261 else do; /* only do lisp stuff if lisp seg */ 262 263 /* get pointer to text section */ 264 265 call hcs_$make_ptr(segptr, unique_ref_name, "*segtop", entryp, code); 266 seg_ptr = entryp; 267 268 /* set up handler for bind_stack overflow/underflow */ 269 270 on mll_internal_error begin; 271 dcl foo char(5); 272 if bind_stack_ptr <= 0 then foo = "under"; 273 else foo = "over"; 274 call com_err_(0, "make_lisp_listing", "Internal binding stack ^aflow while listing ^a.", foo, definition_table(defx).ptr_to_name -> atom_name); 275 call ioa_$ioa_switch(mll_list_stream, "^/BUST IT! BUST IT!"); /* ?? */ 276 go to flush_this; 277 end; 278 279 /* fill in the tables: 280* 281* a t o m t a b l e */ 282 283 do i = lbound(atom_table, 1) to hbound(atom_table, 1); 284 atom_table(i).ptr_to_name = addrel(symrtp, atomsp -> atsym_block.atsym_offset(i)); 285 end; 286 287 /* l i n k t a b l e */ 288 289 linksp = addrel(symrtp, symrtp -> symbol_root.links_blockp); 290 link_table_lbound = 1 + 2*number_of_constants; /* lp offset of first link */ 291 link_table_hbound = link_table_lbound + 2*linksp -> links_block.count - 2; /* lp offset of last link */ 292 link_table_ptr = addr(linksp -> links_block.link_info); 293 294 /* d e f i n i t i o n t a b l e */ 295 296 atom_lbound = 1 + addrel(symrtp, symrtp -> symbol_root.fixnum_blockp) -> fixnum_block.count 297 + addrel(symrtp, symrtp -> symbol_root.flonum_blockp) -> flonum_block.count 298 + addrel(symrtp, symrtp -> symbol_root.string_blockp) -> string_block.count 299 + addrel(symrtp, symrtp -> symbol_root.bignum_blockp) -> bignum_block.count; 300 defx = 0; 301 entryp = addrel(symrtp, symrtp -> symbol_root.entry_blockp); 302 do actionx = 1 to actionsp -> action_block.count; 303 if actionsp -> action_block.action_code(actionx) > 0 /* defining function */ 304 then do; 305 defx = defx + 1; 306 if actionsp -> action_block.action_code(actionx) = 1 /* subr */ 307 then definition_table(defx).arg_pdl = bit(multiply(2, fixed(entryp -> entry_info(defx).nargs, 18), 308 18, 0), 18); 309 else if actionsp -> action_block.action_code(actionx) = 2 /* lsubr */ 310 then definition_table(defx).arg_pdl = ""b; 311 else definition_table(defx).arg_pdl = bit(binary(2, 18), 18); /* fsubr */ 312 definition_table(defx).entrypoint = entryp -> entry_info(defx).entrypoint; 313 definition_table(defx).ptr_to_name = atom_table( 314 actionsp -> action_block.actions(actionx).operand - atom_lbound + 1).ptr_to_name; 315 end; 316 end; 317 318 /* c o n s t a n t t a b l e */ 319 320 constant_table_lbound = 1; /* lp offset of first constant */ 321 constant_table_hbound = 2*number_of_constants - 1; /* lp offset of last constant */ 322 do i = 1 to number_of_constants; 323 actionx = constp -> const_block.constants(i); 324 if actionx >= atom_lbound 325 then if actionx - atom_lbound + 1 <= atom_table_size 326 then actionx = actionx - atom_lbound + 1; /* constant is atom - this is index in atom table */ 327 else actionx = 0; 328 else actionx = 0; 329 330 constant_table(i).atom_table_index = actionx; 331 end; 332 333 334 /* a r r a y l i n k t a b l e */ 335 336 if symrtp -> symbol_root.version < 2 then array_link_table_ptr = null; 337 else do; 338 array_link_table_ptr = addrel(symrtp, symrtp -> symbol_root.array_links_blockp); 339 array_link_table_lbound = constant_table_hbound + 2 + 2*entryp -> entry_block.count; 340 array_link_table_hbound = array_link_table_lbound + 4*(array_link_table_ptr -> array_links_block.count-1); 341 array_link_table_ptr = addr(array_link_table_ptr -> array_links_block.array_link(1)); 342 end; 343 344 end; /* end of lisp only */ 345 /* NOW BEGIN GENERATING LISTING */ 346 347 listfile = substr(ent, 1, min(27, 1+length(ent)-verify(reverse(ent), " "))) || ".list"; 348 349 350 call iox_$attach_ioname("mll."||unique_chars_(""b), mll_list_stream, "vfile_ "||listfile, code); 351 if code ^= 0 then do; 352 353 call com_err_(code, "make_lisp_listing", "Trying to attach mll_list_stream to ^a.", 354 listfile); 355 return; 356 end; 357 358 call iox_$open(mll_list_stream, 2, "0"b, code); 359 if code ^= 0 then do; 360 call com_err_(code, "make_lisp_listing", "Trying to open iocb ^p.", mll_list_stream); 361 return; 362 end; 363 on cleanup begin; 364 call iox_$close(mll_list_stream, code); 365 call iox_$detach_iocb(mll_list_stream, code); 366 end; 367 call ioa_$ioa_switch(mll_list_stream, "LISTING FOR ^a>^a", dir, ent); 368 call ioa_$ioa_switch(mll_list_stream, "COMPILED BY ^a", substr(addrel(sblkp, sblkp -> sb.gen_name_offset) 369 ->based_string, 1, fixed(sblkp -> sb.gen_name_length, 18))); 370 call date_time_(sblkp -> sb.obj_creation_time, time_string); 371 call ioa_$ioa_switch(mll_list_stream, "ON ^a", time_string); 372 call ioa_$ioa_switch(mll_list_stream, "IN BEHALF OF ^a^3/", 373 substr(addrel(sblkp, sblkp -> sb.uid_offset) -> based_string, 1, 374 fixed(sblkp -> sb.uid_length, 18))); 375 376 /* Insert listing of source if we were given a second argument, 377* the source path name */ 378 379 if source_opt then call insert_source_seg; 380 381 else if one_fun_opt then; /* suppress source */ 382 383 else if sb.source_map ^= ""b then do; /* get source from source map */ 384 385 source_map_ptr = addrel(sblkp, sb.source_map); 386 do source_x = 1 to source_map_ptr -> source_map.number; 387 if source_x > 1 then call ioa_$ioa_switch(mll_list_stream, 388 "INCLUDE FILE ^a^/", source_pathname); 389 snameptr = addr(source_pathname); 390 snamelen = length(source_pathname); 391 call insert_source_seg; 392 end; 393 end; 394 395 396 if brief_opt then go to dont_list_the_code; 397 398 /* list the code: do loop done once for each entry in definition table */ 399 400 do defx = 1 to number_of_definitions; 401 if one_fun_opt 402 then if definition_table(defx).ptr_to_name -> atom_name ^= one_fun 403 then go to skip_this_definition; 404 if definition_table(defx).arg_pdl = "000000000000000010"b /* 2 */ 405 then s = ""; /* 1 - singular */ 406 else s = "s"; /* anything else - plural */ 407 408 call ioa_$ioa_switch(mll_list_stream, "FUNCTION ^a^2x(^d arg-temp^a)^2/", 409 definition_table(defx).ptr_to_name -> atom_name, 410 divide(fixed(definition_table(defx).arg_pdl, 18), 2, 17, 0), s); 411 if defx = number_of_definitions 412 then codelength = size_of_text - fixed(definition_table(defx).entrypoint, 18); 413 else codelength = fixed(definition_table(defx+1).entrypoint, 18) - fixed(definition_table(defx).entrypoint, 18); 414 415 stack_height = 2 + fixed(definition_table(defx).arg_pdl, 18); 416 bind_stack_ptr = 1; 417 418 call dump_lisp_code_(fixed(definition_table(defx).entrypoint, 18), 419 codelength, mll_list_stream, addr(table)); 420 flush_this: 421 call ioa_$ioa_switch(mll_list_stream, "^|"); 422 skip_this_definition: 423 end; 424 425 dont_list_the_code: 426 427 /* now list the functions referenced and defined */ 428 429 if ^ (not_a_lisp_seg | one_fun_opt) 430 then call make_lisp_xref_(addr(table), mll_list_stream); 431 432 call iox_$close(mll_list_stream, code); 433 call iox_$detach_iocb(mll_list_stream, code); 434 435 call hcs_$terminate_name(unique_ref_name, code); 436 437 return; 438 439 440 insert_source_seg: proc; 441 442 call expand_path_(snameptr, snamelen, addr(sdir), addr(sent), code); 443 if code = 0 then do; 444 call hcs_$initiate_count(sdir, sent, "", sbc, 0, sptr, code); 445 if sptr ^= null then do; 446 slen = divide(sbc, 9, 21, 0); 447 call iox_$put_chars(mll_list_stream, sptr, slen, code); 448 if code ^= 0 then do; 449 call com_err_(code, "make_lisp_listing", "Trying to write source segment ^a.", sent); 450 return; 451 end; 452 call hcs_$terminate_noname(sptr, code); 453 call ioa_$ioa_switch(mll_list_stream, "^|"); 454 end; 455 else; /* source not there, ignore */ 456 end; 457 else; /* crufty pathname, ignore */ 458 end insert_source_seg; 459 end; /* end begin block */ 460 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.1 make_lisp_listing.pl1 >special_ldd>on>06/27/83>make_lisp_listing.pl1 110 1 03/27/82 0436.9 lisp_symb_tree.incl.pl1 >ldd>include>lisp_symb_tree.incl.pl1 111 2 05/06/74 1752.6 symbol_block.incl.pl1 >ldd>include>symbol_block.incl.pl1 112 3 11/26/79 1320.6 source_map.incl.pl1 >ldd>include>source_map.incl.pl1 113 4 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) acc based structure level 1 dcl 15 action_block based structure level 1 dcl 1-77 action_blockp 7(18) based bit(18) level 2 packed unaligned dcl 1-3 ref 207 action_code 1 based fixed bin(17,0) array level 3 packed unaligned dcl 1-77 ref 210 303 306 309 actions 1 based structure array level 2 packed unaligned dcl 1-77 actionsp 000310 automatic pointer dcl 15 set ref 207* 209 210 302 303 306 309 313 actionx 000317 automatic fixed bin(17,0) dcl 15 in procedure "mll" set ref 209* 210* actionx 000107 automatic fixed bin(17,0) dcl 225 in begin block on line 220 set ref 302* 303 306 309 313* 323* 324 324 324* 324 327* 328* 330 addr builtin function dcl 15 ref 163 163 163 163 181 181 292 341 389 418 418 425 425 442 442 442 442 addrel builtin function dcl 15 ref 203 207 214 217 284 289 296 296 296 296 301 338 368 368 372 372 385 387 389 390 allocate_various_tables 001376 constant label dcl 220 area_ptr 16(18) based bit(18) level 2 packed unaligned dcl 2-6 ref 202 203 arg based char unaligned dcl 91 set ref 122 123 123 125 126 126 134 137* 151* arg_pdl 000112 automatic bit(18) array level 3 packed unaligned dcl 233 set ref 306* 309* 311* 404 408 408 415 arglen 000442 automatic fixed bin(17,0) dcl 91 set ref 120* 122 123 123 125 126 126 129* 134 137 137 143 148 151 151 argptr 000440 automatic pointer dcl 91 set ref 120* 122 123 123 125 126 126 129* 134 137 142 147 151 argx 000437 automatic fixed bin(17,0) dcl 91 set ref 119* 120* 128* 128 129* array_link 1 based structure array level 2 dcl 1-71 set ref 341 array_link_table_hbound 7 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 340* array_link_table_lbound 6 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 339* 340 array_link_table_ptr 5 000112 automatic pointer level 2 packed unaligned dcl 233 set ref 336* 338* 340 341* 341 array_links_block based structure level 1 dcl 1-71 array_links_blockp 10 based bit(18) level 2 packed unaligned dcl 1-3 ref 338 atom_lbound 000106 automatic fixed bin(18,0) dcl 225 set ref 296* 313 324 324 324 atom_name based varying char(10000) dcl 15 set ref 274* 401 408* atom_table 163 000112 automatic structure array level 2 dcl 233 set ref 283 283 atom_table_index 000112 automatic fixed bin(17,0) array level 3 dcl 233 set ref 330* atom_table_size 1 000112 automatic fixed bin(17,0) initial level 2 dcl 233 set ref 233* 324 atomsp 000320 automatic pointer dcl 15 set ref 214* 215 284 atsym_block based structure level 1 dcl 1-36 atsym_blockp 4 based bit(18) level 3 packed unaligned dcl 1-3 ref 214 atsym_offset 1 based bit(18) array level 2 packed unaligned dcl 1-36 ref 284 bad_code 001200 constant label dcl 191 ref 182 based_string based char(1000) dcl 15 ref 368 368 372 372 bignum_block based structure level 1 dcl 1-40 bignum_blockp 3(18) based bit(18) level 3 packed unaligned dcl 1-3 ref 296 binary builtin function dcl 15 ref 311 bind_stack_ptr 14 000112 automatic fixed bin(17,0) level 2 dcl 233 set ref 272 416* bit builtin function dcl 15 ref 306 311 bitcount 000100 automatic fixed bin(24,0) dcl 15 set ref 172* 181* brief_opt 000332 automatic bit(1) initial unaligned dcl 91 set ref 91* 123* 125* 195 396 bword based bit(36) dcl 15 cleanup 000000 stack reference condition dcl 15 ref 363 code 000275 automatic fixed bin(35,0) dcl 15 set ref 120* 121 129* 130 131* 163* 164 166* 172* 173 173 175* 181* 182 188* 191* 265* 350* 351 353* 358* 359 360* 364* 365* 432* 433* 435* 442* 443 444* 447* 448 449* 452* codelength 000111 automatic fixed bin(18,0) dcl 225 set ref 411* 413* 418* com_err_ 000052 constant entry external dcl 15 ref 131 137 151 158 166 175 191 199 274 353 360 449 cons_block based structure level 1 dcl 1-44 const_block based structure level 1 dcl 1-63 const_blockp 6(18) based bit(18) level 3 packed unaligned dcl 1-3 ref 217 constant_table 000112 automatic structure array level 2 dcl 233 constant_table_hbound 13 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 321* 339 constant_table_lbound 12 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 320* constant_table_size 11 000112 automatic fixed bin(17,0) initial level 2 dcl 233 set ref 233* constants 1 based fixed bin(17,0) array level 2 packed unaligned dcl 1-63 ref 323 constp 000324 automatic pointer dcl 15 set ref 217* 218 323 count based fixed bin(18,0) level 2 in structure "const_block" dcl 1-63 in procedure "mll" ref 218 count based fixed bin(18,0) level 2 in structure "fixnum_block" dcl 1-23 in procedure "mll" ref 296 count based fixed bin(18,0) level 2 in structure "bignum_block" dcl 1-40 in procedure "mll" ref 296 count based fixed bin(18,0) level 2 in structure "flonum_block" dcl 1-27 in procedure "mll" ref 296 count based fixed bin(18,0) level 2 in structure "string_block" dcl 1-31 in procedure "mll" ref 296 count based fixed bin(18,0) level 2 in structure "action_block" dcl 1-77 in procedure "mll" ref 209 302 count based fixed bin(18,0) level 2 in structure "entry_block" dcl 1-57 in procedure "mll" ref 339 count based fixed bin(18,0) level 2 in structure "array_links_block" dcl 1-71 in procedure "mll" ref 340 count based fixed bin(18,0) level 2 in structure "links_block" dcl 1-67 in procedure "mll" ref 291 count based fixed bin(18,0) level 2 in structure "atsym_block" dcl 1-36 in procedure "mll" ref 215 cu_$arg_ptr 000010 constant entry external dcl 15 ref 120 129 date_time_ 000050 constant entry external dcl 15 ref 370 def_ptr automatic pointer dcl 15 definition_table 000112 automatic structure array level 2 dcl 233 definition_table_size 10 000112 automatic fixed bin(17,0) initial level 2 dcl 233 set ref 233* defp 4 000450 automatic pointer level 2 dcl 115 set ref 183 defx 000100 automatic fixed bin(17,0) dcl 225 set ref 274 300* 305* 305 306 306 309 311 312 312 313 400* 401 404 408 408 408 411 411 413 413 415 418 418* dir 000104 automatic char(168) unaligned dcl 15 set ref 163 163 172* 175* 191* 199* 367* divide builtin function ref 408 408 446 dont_list_the_code 003367 constant label dcl 425 ref 396 dump_lisp_code_ 000014 constant entry external dcl 15 ref 418 ent 000156 automatic char(32) unaligned dcl 15 set ref 163 163 172* 175* 191* 199* 347 347 347 367* entry_block based structure level 1 dcl 1-57 entry_blockp 6 based bit(18) level 3 packed unaligned dcl 1-3 ref 301 entry_info 1 based structure array level 2 packed unaligned dcl 1-57 entryp 000102 automatic pointer dcl 225 set ref 265* 266 301* 306 312 339 entrypoint 000112 automatic bit(18) array level 3 in structure "table" packed unaligned dcl 233 in begin block on line 220 set ref 312* 411 413 413 418 418 entrypoint 1(18) based bit(18) array level 3 in structure "entry_block" packed unaligned dcl 1-57 in procedure "mll" ref 312 error_table_$badopt 000056 external static fixed bin(35,0) dcl 91 set ref 137* error_table_$segknown 000036 external static fixed bin(35,0) dcl 15 ref 173 exitloop_get_args 000642 constant label dcl 155 ref 121 expand_path_ 000046 constant entry external dcl 15 ref 163 442 fixed builtin function dcl 15 ref 183 306 368 368 372 372 387 387 389 390 408 408 411 413 413 415 418 418 fixnum_block based structure level 1 dcl 1-23 fixnum_blockp 2 based bit(18) level 3 packed unaligned dcl 1-3 ref 296 flonum_block based structure level 1 dcl 1-27 flonum_blockp 2(18) based bit(18) level 3 packed unaligned dcl 1-3 ref 296 flush_this 003345 constant label dcl 420 ref 276 foo 000100 automatic char(5) unaligned dcl 271 set ref 272* 273* 274* gen_name_length 12(18) based bit(18) level 2 packed unaligned dcl 2-6 ref 368 368 gen_name_offset 12 based bit(18) level 2 packed unaligned dcl 2-6 ref 368 368 generator 10 based char(8) level 2 dcl 2-6 ref 194 hbound builtin function dcl 15 ref 283 hcs_$initiate_count 000032 constant entry external dcl 15 ref 172 444 hcs_$make_ptr 000044 constant entry external dcl 15 ref 188 265 hcs_$terminate_name 000040 constant entry external dcl 15 ref 435 hcs_$terminate_noname 000042 constant entry external dcl 15 ref 452 i 000110 automatic fixed bin(17,0) dcl 225 set ref 283* 284 284* 322* 323 330* insert_source_seg 003453 constant entry internal dcl 440 ref 379 391 ioa_$ioa_switch 000054 constant entry external dcl 15 ref 275 367 368 371 372 387 408 420 453 iox_$attach_ioname 000020 constant entry external dcl 15 ref 350 iox_$close 000024 constant entry external dcl 15 ref 364 432 iox_$detach_iocb 000026 constant entry external dcl 15 ref 365 433 iox_$open 000022 constant entry external dcl 15 ref 358 iox_$position 000000 constant entry external dcl 15 iox_$put_chars 000030 constant entry external dcl 15 ref 447 lbound builtin function dcl 15 ref 283 length builtin function dcl 15 ref 347 390 link_info 1 based bit(27) array level 2 dcl 1-67 set ref 292 link_table_hbound 4 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 291* link_table_lbound 3 000112 automatic fixed bin(18,0) level 2 dcl 233 set ref 290* 291 link_table_ptr 2 000112 automatic pointer level 2 packed unaligned dcl 233 set ref 292* links_block based structure level 1 dcl 1-67 links_blockp 7 based bit(18) level 3 packed unaligned dcl 1-3 ref 289 linksp 000104 automatic pointer dcl 225 set ref 289* 291 292 listfile 000276 automatic char(32) unaligned dcl 15 set ref 347* 350 353* make_lisp_listing 000342 constant entry external dcl 10 make_lisp_xref_ 000016 constant entry external dcl 15 ref 425 map 2 based structure array level 2 dcl 3-3 min builtin function ref 347 mll 000332 constant entry external dcl 10 mll_internal_error 000000 stack reference condition dcl 15 ref 270 mll_list_stream 000330 automatic pointer dcl 15 set ref 275* 350* 358* 360* 364* 365* 367* 368* 371* 372* 387* 408* 418* 420* 425* 432* 433* 447* 453* multiply builtin function dcl 15 ref 306 name based char unaligned dcl 15 set ref 166* namelen 000274 automatic fixed bin(17,0) dcl 15 set ref 143* 163* 166 166 nameptr 000272 automatic pointer dcl 15 set ref 142* 163* 166 nargs 1 based bit(18) array level 3 packed unaligned dcl 1-57 ref 306 nelemt automatic fixed bin(21,0) dcl 15 not_a_lisp_seg 000436 automatic bit(1) initial unaligned dcl 91 set ref 91* 196* 260 425 not_lisp 001252 constant label dcl 195 ref 202 null builtin function dcl 15 ref 188 188 189 336 445 number 1 based fixed bin(17,0) level 2 dcl 3-3 ref 386 number_of_atoms 000322 automatic fixed bin(17,0) initial dcl 15 set ref 15* 215* 233 233 number_of_constants 000326 automatic fixed bin(17,0) initial dcl 15 set ref 15* 218* 233 233 290 321 322 number_of_definitions 000316 automatic fixed bin(17,0) initial dcl 15 set ref 15* 208* 210* 210 233 233 400 411 obj_creation_time 6 based fixed bin(71,0) level 2 dcl 2-6 set ref 370* object_info based structure level 1 dcl 4-6 object_info_$brief 000012 constant entry external dcl 15 ref 181 object_info_version_2 internal static fixed bin(17,0) initial dcl 4-60 object_opt 000333 automatic bit(1) initial unaligned dcl 91 set ref 91* 140 141* 155 objects 2 based structure level 2 packed unaligned dcl 1-3 offset 2 based bit(18) array level 4 packed unaligned dcl 3-3 ref 387 389 390 oi 000450 automatic structure level 1 dcl 115 set ref 181 181 one_fun 000336 automatic char(256) unaligned dcl 91 set ref 134* 401 one_fun_opt 000335 automatic bit(1) initial unaligned dcl 91 set ref 91* 127* 381 401 425 operand 1(18) based fixed bin(17,0) array level 3 packed unaligned dcl 1-77 ref 313 pathname 2 based structure array level 3 packed unaligned dcl 3-3 ptr_to_name 000112 automatic pointer array level 3 in structure "table" packed unaligned dcl 233 in begin block on line 220 set ref 274 313* 401 408 ptr_to_name 163 000112 automatic pointer array level 3 in structure "table" packed unaligned dcl 233 in begin block on line 220 set ref 284* 313 rel builtin function ref 183 reverse builtin function ref 347 s 000263 automatic char(1) unaligned dcl 15 set ref 404* 406* 408* sb based structure level 1 dcl 2-6 sbc 000256 automatic fixed bin(24,0) dcl 15 set ref 444* 446 sblkp 000312 automatic pointer dcl 15 set ref 188* 189 194 202 203 203 368 368 368 368 368 368 370 372 372 372 372 372 372 383 385 385 387 389 390 sdir 000172 automatic char(168) unaligned dcl 15 set ref 442 442 444* seg_ptr 16 000112 automatic pointer level 2 packed unaligned dcl 233 set ref 260* 266* segptr 000102 automatic pointer dcl 15 set ref 172* 181* 260 265* sent 000244 automatic char(32) unaligned dcl 15 set ref 442 442 444* 449* size 2(18) based bit(18) array level 4 packed unaligned dcl 3-3 ref 387 387 389 390 size_of_text 000306 automatic fixed bin(18,0) dcl 15 set ref 183* 411 skip_lisp_stuff 001376 constant label dcl 220 ref 197 skip_this_definition 003365 constant label dcl 422 ref 401 slen 000257 automatic fixed bin(21,0) dcl 15 set ref 446* 447* snamelen 000262 automatic fixed bin(17,0) dcl 15 set ref 148* 390* 442* snameptr 000260 automatic pointer dcl 15 set ref 147* 389* 442* soff automatic fixed bin(21,0) dcl 15 source_map 16 based bit(18) level 2 in structure "sb" packed unaligned dcl 2-6 in procedure "mll" ref 383 385 source_map based structure level 1 dcl 3-3 in procedure "mll" source_map_ptr 000444 automatic pointer dcl 103 set ref 385* 386 387 387 387 389 389 390 390 source_opt 000334 automatic bit(1) initial unaligned dcl 91 set ref 91* 145 146* 379 source_pathname based char unaligned dcl 107 set ref 387* 389 390 source_x 000446 automatic fixed bin(17,0) dcl 105 set ref 386* 387 387 387 387 389 389 390 390* sptr 000254 automatic pointer dcl 15 set ref 444* 445 447* 452* stack_height 000112 automatic fixed bin(17,0) level 2 dcl 233 set ref 415* status automatic structure level 1 dcl 15 string_block based structure level 1 dcl 1-31 string_blockp 3 based bit(18) level 3 packed unaligned dcl 1-3 ref 296 string_chars based structure level 1 dcl 1-50 subr_block_items 6 based structure level 2 packed unaligned dcl 1-3 substr builtin function dcl 15 ref 123 347 368 368 372 372 symbol_root based structure level 1 dcl 1-3 symrtp 000314 automatic pointer dcl 15 set ref 203* 207 207 214 214 217 217 284 289 289 296 296 296 296 296 296 296 296 301 301 336 338 338 table 000112 automatic structure level 1 dcl 233 set ref 418 418 425 425 time_string 000264 automatic char(24) unaligned dcl 15 set ref 370* 371* uid_length 13(18) based bit(18) level 2 packed unaligned dcl 2-6 ref 372 372 uid_offset 13 based bit(18) level 2 packed unaligned dcl 2-6 ref 372 372 unique_chars_ 000034 constant entry external dcl 15 ref 171 350 unique_ref_name 000166 automatic char(15) unaligned dcl 15 set ref 171* 172* 188* 265* 435* verify builtin function ref 347 version based fixed bin(17,0) level 2 dcl 1-3 ref 336 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4160 4240 3673 4170 Length 4560 3673 60 303 264 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mll 462 external procedure is an external procedure. begin block on line 220 224 begin block uses auto adjustable storage, and enables or reverts conditions. on unit on line 270 108 on unit on unit on line 363 70 on unit insert_source_seg internal procedure shares stack frame of begin block on line 220. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 220 000100 defx begin block on line 220 000102 entryp begin block on line 220 000104 linksp begin block on line 220 000106 atom_lbound begin block on line 220 000107 actionx begin block on line 220 000110 i begin block on line 220 000111 codelength begin block on line 220 000112 table begin block on line 220 mll 000100 bitcount mll 000102 segptr mll 000104 dir mll 000156 ent mll 000166 unique_ref_name mll 000172 sdir mll 000244 sent mll 000254 sptr mll 000256 sbc mll 000257 slen mll 000260 snameptr mll 000262 snamelen mll 000263 s mll 000264 time_string mll 000272 nameptr mll 000274 namelen mll 000275 code mll 000276 listfile mll 000306 size_of_text mll 000310 actionsp mll 000312 sblkp mll 000314 symrtp mll 000316 number_of_definitions mll 000317 actionx mll 000320 atomsp mll 000322 number_of_atoms mll 000324 constp mll 000326 number_of_constants mll 000330 mll_list_stream mll 000332 brief_opt mll 000333 object_opt mll 000334 source_opt mll 000335 one_fun_opt mll 000336 one_fun mll 000436 not_a_lisp_seg mll 000437 argx mll 000440 argptr mll 000442 arglen mll 000444 source_map_ptr mll 000446 source_x mll 000450 oi mll on unit on line 270 000100 foo on unit on line 270 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs enter_begin call_ext_out_desc call_ext_out begin_return return tra_ext alloc_auto_adj enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr date_time_ dump_lisp_code_ expand_path_ hcs_$initiate_count hcs_$make_ptr hcs_$terminate_name hcs_$terminate_noname ioa_$ioa_switch iox_$attach_ioname iox_$close iox_$detach_iocb iox_$open iox_$put_chars make_lisp_xref_ object_info_$brief unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 15 000317 91 000322 10 000331 119 000350 120 000352 121 000367 122 000372 123 000401 125 000414 126 000423 127 000436 128 000440 129 000441 130 000456 131 000460 132 000512 134 000513 135 000520 137 000521 138 000553 139 000554 140 000555 141 000557 142 000561 143 000562 144 000564 145 000565 146 000567 147 000571 148 000572 149 000574 151 000575 152 000637 154 000640 155 000642 158 000644 160 000677 163 000700 164 000723 166 000725 167 000757 171 000760 172 000775 173 001037 175 001044 176 001110 181 001111 182 001130 183 001133 188 001136 189 001174 191 001200 192 001241 194 001242 195 001252 196 001254 197 001256 199 001257 200 001322 202 001323 203 001327 207 001334 208 001341 209 001342 210 001351 212 001355 214 001357 215 001365 217 001367 218 001374 220 001376 233 001401 260 001427 265 001434 266 001466 270 001471 272 001505 273 001514 274 001517 275 001570 276 001615 283 001620 284 001627 285 001643 289 001645 290 001654 291 001661 292 001666 296 001670 300 001720 301 001721 302 001726 303 001735 305 001741 306 001742 309 001773 311 002011 312 002026 313 002046 316 002063 320 002065 321 002070 322 002075 323 002105 324 002116 327 002132 328 002134 330 002135 331 002150 336 002152 338 002162 339 002171 340 002200 341 002206 347 002211 350 002245 351 002325 353 002330 355 002366 358 002370 359 002411 360 002414 361 002455 363 002457 364 002473 365 002505 366 002520 367 002521 368 002552 370 002620 371 002640 372 002664 379 002734 381 002742 383 002745 385 002751 386 002756 387 002766 389 003031 390 003043 391 003050 392 003051 396 003054 400 003060 401 003067 404 003107 406 003125 408 003127 411 003204 413 003233 415 003273 416 003305 418 003307 420 003345 422 003365 425 003367 432 003406 433 003420 435 003432 437 003450 459 003452 440 003453 442 003454 443 003500 444 003503 445 003545 446 003552 447 003555 448 003572 449 003575 450 003633 452 003634 453 003645 458 003665 460 003666 ----------------------------------------------------------- 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