COMPILATION LISTING OF SEGMENT lisp_linker_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0847.4 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_linker_: procedure(link_ptr); 7 8 /* Routine to handle the process of locating a compiled object segment referenced by 9* a lisp environment. 10* D. Reed */ 11 12 dcl link_ptr ptr, 13 (error_table_$namedup, error_table_$noentry) fixed bin(35) external, 14 hcs_$initiate entry(char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)), 15 hcs_$make_ptr entry (ptr, char(*), char(*), ptr, fixed bin(35)), 16 code fixed bin(35), 17 message char(200) varying, 18 signal_ entry(char(*), pointer, pointer), 19 convert_status_code_ entry(fixed bin(35), char(8) aligned, char(100) aligned), 20 error_table_message char(100) aligned, 21 (length, verify, substr, reverse) builtin, 22 23 1 condition_info_structure automatic aligned structure, 1 1 1 2 /* begin include file ... cond_info_structure.incl.pl1 */ 1 3 /* last modified 5/7/73 */ 1 4 1 5 2 length fixed bin, /* length in words of this structure */ 1 6 2 version fixed bin, /* version number of this structure */ 1 7 2 action_flags aligned, /* tell handler how to proceed */ 1 8 3 cant_restart bit(1) unal, /* caller doesn't ever want to be returned to */ 1 9 3 default_restart bit(1) unal, /* caller can be returned to with no further action */ 1 10 3 pad bit(34) unal, 1 11 2 info_string char(256) var, /* may contain printable message */ 1 12 2 status_code fixed bin(35), /* if^=0, code interpretable by com_err_ */ 1 13 /* end include file ... cond_info_structure.incl.pl1 */ 24 25 null builtin, 26 sblkp ptr; 27 2 1 /* MACLISP Compiled SUBR Block */ 2 2 2 3 dcl 1 subr_block_head based aligned, /* this is the first part of the subr block */ 2 4 2 next_compiled_block ptr, /* for xctblt */ 2 5 2 instructions(4) bit(36), /* the common entry code */ 2 6 2 subr_code_link_offset bin(17) unal, /* points to subr code link */ 2 7 2 rest_of_tsplp bit(18) unal, /* tsplp ,ic* */ 2 8 2 gcmark bit(18) unal, /* for garbage collector to remember seeing this block */ 2 9 2 gc_length fixed bin(17) unal, /* number garbage collectable objects */ 2 10 2 constants(1000) fixed bin(71); /* the compiled constants */ 2 11 2 12 /* alternate declaration of above */ 2 13 2 14 dcl 1 subr_block_head_overlay based aligned, 2 15 2 first_word bit(36), 2 16 2 second_word aligned, 2 17 3 padding bit(28) unaligned, 2 18 3 no_links_are_snapped bit(1) unaligned, /* "1"b if no itp links in this block have been snapped */ 2 19 3 more_padding bit(7) unaligned; 2 20 2 21 2 22 2 23 dcl 1 lisp_subr_links(1000) based aligned, /* the subr links follow the constants, and are the last gc'ed items */ 2 24 2 itp_base bit(3) unal, 2 25 2 itp_info bit(27) unal, /* produced by compiler */ 2 26 2 itp_mod bit(6) unal, 2 27 2 link_opr_tv_offset bit(18) unal, 2 28 2 mbz bit(12) unal, 2 29 2 further_mod bit(6) unal; /* when itp; this is indirect */ 2 30 2 31 2 32 dcl 1 subr_entries(1000) based aligned, /* these are next in block, not gc'able */ 2 33 2 nargs bit(18) unal, 2 34 2 code_offset bit(18) unal, /* offset of entrypoint in object segment */ 2 35 2 head_offset bin(17) unal, /* offset to common entry sequence in subr_block_head */ 2 36 2 rest_of_tsx0 bit(18) unal; /* tsx0 ,ic */ 2 37 2 38 2 39 dcl 1 link_to_subr_code based aligned, /* used by lisp_linker_ to find object segment */ 2 40 2 itp_to_linker ptr, /* points to linker, reset by linker to point to base of object seg */ 2 41 2 compilation_time fixed bin(71), /* used to verify linking to correct segment */ 2 42 2 name_length fixed bin(24), /* length of subroutines name...both segname and ename */ 2 43 2 name char(0 refer(link_to_subr_code.name_length)) unal; 2 44 2 45 dcl instructions_for_subr (4) bit(36) static init("000000000000000100110010111000001111"b, 2 46 "001111111111111100110101000001001111"b, 2 47 "001111111111111110010101010001001111"b, 2 48 "111111111111111110111010000000001000"b), 2 49 tsplp_ic_ind bit(18) static init("110111000000010100"b), 2 50 tsx0_ic bit(18) static init("111000000000000100"b); 2 51 2 52 dcl 1 array_links (1000) aligned based, /* come after entries, before link_to_subr_code */ 2 53 2 instruction bit(36) aligned, /* tspbp to array_link_snap operator 2 54* or eppbb *+2,* when snapped */ 2 55 2 control_word unaligned, /* controls what to snap to */ 2 56 3 type fixed bin(8), /* 0=S-expr, 2=fixnum, 3=flonum */ 2 57 3 ndims fixed bin(8), 2 58 3 atomic_symbol fixed bin(17), /* offset in constants to symbol which names array */ 2 59 2 pointer pointer; /* -> array_info block when snapped */ 2 60 2 61 dcl 1 array_link_count aligned based, /* comes after array_links, before link_to_subr_code */ 2 62 2 unused bit(36), 2 63 2 number_of_array_links fixed bin(17) unaligned, 2 64 2 must_be_zero bit(18) unaligned; /* 0 to distinguish from tsx0 in subr block with no array links */ 2 65 2 66 /* End of description of Compiled SUBR Block */ 28 3 1 /* BEGIN INCLUDE SEGMENT ... symbol_block.incl.pl1 3 2*coded February 8, 1972 by Michael J. Spier */ 3 3 3 4 /* last modified may 3, 1972 by M. Weaver */ 3 5 3 6 declare 1 sb aligned based(sblkp), /* structure describing a standard symbol block */ 3 7 2 decl_vers fixed bin, /* version number of current structure format */ 3 8 2 identifier char(8) aligned, /* symbolic code to define purpose of this symb block */ 3 9 2 gen_version_number fixed bin, /* positive integer designating version of object generator */ 3 10 2 gen_creation_time fixed bin(71), /* clock reading of date/time generator was created */ 3 11 2 obj_creation_time fixed bin(71), /* clock reading of date/time object was generated */ 3 12 2 generator char(8) aligned, /* name of processor which generated segment */ 3 13 2 gen_name_offset bit(18) unaligned, /* offset of generator name in words rel to base of symbol block */ 3 14 2 gen_name_length bit(18) unaligned, /* length of printable generator version name in characters */ 3 15 2 uid_offset bit(18) unaligned, /* offset of creator id in words rel to base of symbol block */ 3 16 2 uid_length bit(18) unaligned, /* length of standard Multics id of object creator in characters */ 3 17 2 comment_offset bit(18) unaligned, /* offset of comment in words relative to base of symbol block */ 3 18 2 comment_length bit(18) unaligned, /* length of printable generator comment in characters */ 3 19 2 tbound bit(18) unaligned, /* specifies mod of text section base boundary */ 3 20 2 stat_bound bit(18) unaligned, /* specifies mod of internal static base boundary */ 3 21 2 source_map bit(18) unaligned, /* offset relative to base of symbol block of source map structure */ 3 22 2 area_ptr bit(18) unaligned, /* offset of block info in words relative to base of symbol block */ 3 23 2 symb_base bit(18) unaligned, /* back pointer (rel to base of symb block) to base of symb section */ 3 24 2 block_size bit(18) unaligned, /* size in words of entire symbol block */ 3 25 2 next_block bit(18) unaligned, /* if ^= "0"b, is thread (rel to base of symb section) to next symb block */ 3 26 2 rel_text bit(18) unaligned, /* offset rel to base of symbol block of text sect relocation info */ 3 27 2 rel_def bit(18) unaligned, /* offset rel to base of symb block of def section relocation info */ 3 28 2 rel_link bit(18) unaligned, /* offset rel to base of symb block of link sect relocation info */ 3 29 2 rel_symb bit(18) unaligned, /* offset rel to base of symb block of symb sect relocation info */ 3 30 2 default_truncate bit(18) unaligned, /* offset RTBOSB for binder to automatically trunc. symb sect. */ 3 31 2 optional_truncate bit(18) unaligned; /* offset RTBOSB for binder to optionally truncate symb section */ 3 32 3 33 /* END INCLUDE SEGMENT ... symbol_block.incl.pl1 */ 29 30 31 dcl lisp_static_vars_$saved_environment_dir char(168) ext; 32 33 34 35 36 retry: 37 if lisp_static_vars_$saved_environment_dir ^= "" /* using some saved environment */ 38 then do; 39 call hcs_$initiate (lisp_static_vars_$saved_environment_dir, /* act as if we look here first */ 40 link_ptr -> link_to_subr_code.name, 41 link_ptr -> link_to_subr_code.name, 42 0,0, sblkp, code); /* don't care if successful */ 43 if sblkp = null 44 then if code ^= error_table_$noentry 45 then if code ^= error_table_$namedup 46 then go to badcode; /* linker bug prevents noaccess msg */ 47 end; 48 49 50 51 call hcs_$make_ptr(null(), link_ptr -> link_to_subr_code.name, "symbol_table", sblkp, code); 52 if code ^= 0 then do; 53 badcode: message = "Searching for " || link_ptr -> link_to_subr_code.name || "$symbol_table"; 54 go to lossage; 55 end; 56 57 if sblkp -> sb.obj_creation_time ^= link_ptr -> link_to_subr_code.compilation_time 58 then do; 59 message = "The " || link_ptr -> link_to_subr_code.name 60 || " found by search rules is not the version that was loaded into this environment."; 61 go to lossage; 62 end; 63 64 call hcs_$make_ptr(null(), link_ptr -> link_to_subr_code.name, "*segtop", 65 link_ptr -> link_to_subr_code.itp_to_linker, code); 66 if code ^= 0 then do; 67 message = "Searching for " || link_ptr -> link_to_subr_code.name || "|*segtop definition."; 68 go to lossage; 69 end; 70 71 link_ptr -> lisp_subr_links(1).further_mod = "001000"b; /* x0 modifier */ 72 73 return; 74 75 lossage: 76 condition_info_structure.length = size(condition_info_structure); 77 condition_info_structure.version = 5246; /* since none of the documentaton says what this is supposed to be */ 78 condition_info_structure.action_flags.pad = ""b; 79 condition_info_structure.cant_restart = "0"b; 80 condition_info_structure.default_restart = "0"b; /* you'd think "1"b was right, but it wants "0"b */ 81 82 /* put error table message corresponding to code in the message */ 83 84 if code = 0 then do; 85 info_string = message; 86 end; 87 else do; /* error code goes in message */ 88 call convert_status_code_(code, "", error_table_message); 89 info_string = substr(error_table_message, 1, length(error_table_message) - 90 verify(reverse(error_table_message), " ")+1) || " "; 91 info_string = info_string || message; 92 end; 93 info_string = info_string || " 94 Fix it and type start."; 95 96 condition_info_structure.status_code = 0; /* I don't need two messages, thank you */ 97 call signal_("lisp_linkage_error", null, addr(condition_info_structure)); 98 99 go to retry; 100 101 end lisp_linker_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.3 lisp_linker_.pl1 >special_ldd>on>06/27/83>lisp_linker_.pl1 24 1 05/06/74 1741.0 cond_info_structure.incl.pl1 >ldd>include>cond_info_structure.incl.pl1 28 2 03/27/82 0437.0 lisp_comp_subr_block.incl.pl1 >ldd>include>lisp_comp_subr_block.incl.pl1 29 3 05/06/74 1752.6 symbol_block.incl.pl1 >ldd>include>symbol_block.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) action_flags 2 000215 automatic structure level 2 dcl 12 addr builtin function ref 97 97 array_link_count based structure level 1 dcl 2-61 array_links based structure array level 1 dcl 2-52 badcode 000252 constant label dcl 53 ref 43 cant_restart 2 000215 automatic bit(1) level 3 packed unaligned dcl 12 set ref 79* code 000100 automatic fixed bin(35,0) dcl 12 set ref 39* 43 43 51* 52 64* 66 84 88* compilation_time 2 based fixed bin(71,0) level 2 dcl 2-39 ref 57 condition_info_structure 000215 automatic structure level 1 dcl 12 set ref 75 97 97 convert_status_code_ 000022 constant entry external dcl 12 ref 88 default_restart 2(01) 000215 automatic bit(1) level 3 packed unaligned dcl 12 set ref 80* error_table_$namedup 000010 external static fixed bin(35,0) dcl 12 ref 43 error_table_$noentry 000012 external static fixed bin(35,0) dcl 12 ref 43 error_table_message 000164 automatic char(100) dcl 12 set ref 88* 89 89 89 further_mod 1(30) based bit(6) array level 2 packed unaligned dcl 2-23 set ref 71* hcs_$initiate 000014 constant entry external dcl 12 ref 39 hcs_$make_ptr 000016 constant entry external dcl 12 ref 51 64 info_string 3 000215 automatic varying char(256) level 2 dcl 12 set ref 85* 89* 91* 91 93* 93 instructions_for_subr internal static bit(36) initial array unaligned dcl 2-45 itp_to_linker based pointer level 2 dcl 2-39 set ref 64* length 000215 automatic fixed bin(17,0) level 2 in structure "condition_info_structure" dcl 12 in procedure "lisp_linker_" set ref 75* length builtin function dcl 12 in procedure "lisp_linker_" ref 89 link_ptr parameter pointer dcl 12 ref 6 39 39 51 53 57 59 64 64 67 71 link_to_subr_code based structure level 1 dcl 2-39 lisp_linker_ 000102 constant entry external dcl 6 lisp_static_vars_$saved_environment_dir 000024 external static char(168) unaligned dcl 31 set ref 36 39* lisp_subr_links based structure array level 1 dcl 2-23 lossage 000467 constant label dcl 75 ref 54 61 68 message 000101 automatic varying char(200) dcl 12 set ref 53* 59* 67* 85 91 name 5 based char level 2 packed unaligned dcl 2-39 set ref 39* 39* 51* 53 59 64* 67 name_length 4 based fixed bin(24,0) level 2 dcl 2-39 ref 39 39 39 39 51 51 53 59 64 64 67 null builtin function dcl 12 ref 43 51 51 64 64 97 97 obj_creation_time 6 based fixed bin(71,0) level 2 dcl 3-6 ref 57 pad 2(02) 000215 automatic bit(34) level 3 packed unaligned dcl 12 set ref 78* retry 000107 constant label dcl 36 ref 99 reverse builtin function dcl 12 ref 89 sb based structure level 1 dcl 3-6 sblkp 000322 automatic pointer dcl 12 set ref 39* 43 51* 57 signal_ 000020 constant entry external dcl 12 ref 97 size builtin function ref 75 status_code 104 000215 automatic fixed bin(35,0) level 2 dcl 12 set ref 96* subr_block_head based structure level 1 dcl 2-3 subr_block_head_overlay based structure level 1 dcl 2-14 subr_entries based structure array level 1 dcl 2-32 substr builtin function dcl 12 ref 89 tsplp_ic_ind internal static bit(18) initial unaligned dcl 2-45 tsx0_ic internal static bit(18) initial unaligned dcl 2-45 verify builtin function dcl 12 ref 89 version 1 000215 automatic fixed bin(17,0) level 2 dcl 12 set ref 77* STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 762 1010 644 772 Length 1244 644 26 220 115 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_linker_ 272 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_linker_ 000100 code lisp_linker_ 000101 message lisp_linker_ 000164 error_table_message lisp_linker_ 000215 condition_info_structure lisp_linker_ 000322 sblkp lisp_linker_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_status_code_ hcs_$initiate hcs_$make_ptr signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$namedup error_table_$noentry lisp_static_vars_$saved_environment_dir LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000077 36 000107 39 000115 43 000171 51 000204 52 000250 53 000252 54 000307 57 000311 59 000320 61 000354 64 000356 66 000420 67 000422 68 000457 71 000461 73 000466 75 000467 77 000471 78 000473 79 000475 80 000477 84 000501 85 000503 86 000510 88 000511 89 000526 91 000563 93 000576 96 000610 97 000611 99 000640 ----------------------------------------------------------- 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