COMPILATION LISTING OF SEGMENT lisp_compiler 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.7 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 rseserved 9**/ 10 11 lcp: 12 lisp_compiler: proc; 13 14 /* 15* * This is a command interface to the LISP compiler. 16* * It copies its argument list, putting in a first 17* * argument of the pathname of the compiler saved environment, 18* * which is assumed to be in the same directory as this command. 19* * It calls lisp with these arguments, which causes it 20* * to unsave and run the compiler. 21* * It also initiates the two compiler object segments because 22* * at present the referencing_dir search rule doesn't work right for 23* * lisp links. 24* * 25* * coded 4 May 1973 by D. A. Moon 26* */ 27 28 29 declare 30 (i, j, n) fixed bin, 31 cu_$arg_list_ptr entry returns(ptr), 32 old_ap ptr, 33 com_err_ entry options(variable), 34 hcs_$fs_get_path_name entry(ptr, char(*), fixed bin, char(*), fixed bin(35)), 35 hcs_$initiate entry(char(*), char(*), char(*), fixed bin, fixed bin, ptr, fixed bin(35)), 36 (null, addr, index, substr) builtin, 37 pathname char(168), 38 lisp ext entry, 39 cu_$gen_call entry(ptr, ptr), 40 41 1 old_argl aligned based(old_ap), 42 2 argc fixed bin(16) unal, 43 2 type fixed bin(18) unal, 44 2 descc fixed bin(16) unal, 45 2 ptr(1000) ptr, 46 47 1 a1desc unaligned, 48 2 type bit(9), 49 2 len fixed bin(26); 50 51 declare label_me label variable, /* kludge to get ptr to myself */ 52 ptr_to_me ptr aligned based(addr(label_me)); 53 54 dcl lap_flag bit(1); 55 56 lap_flag = "0"b; 57 go to join; 58 59 lap: entry; /* LISP Assembly Program */ 60 61 lap_flag = "1"b; 62 63 join: 64 old_ap = cu_$arg_list_ptr(); 65 n = old_argl.argc; 66 if n = 0 then do; 67 if lap_flag 68 then call com_err_(0, "lap", 69 "Correct usage is:^/^-lap pathname -options-^/"); 70 else call com_err_(0, "lisp_compiler", 71 "Correct usage is:^/^-lisp_compiler pathname -options-^/or^-lcp pathname -options-"); 72 return; 73 end; 74 /* find pathname of compiler.sv.lisp */ 75 76 label_me = label; 77 label: call hcs_$fs_get_path_name(ptr_to_me, pathname, (0), (""), (0)); 78 if lap_flag 79 then call hcs_$initiate(pathname, "lap_", "lap_", 0, 0, (null), (0)); 80 else do; 81 call hcs_$initiate(pathname, "lcp_semant_", "lcp_semant_", 0, 0, (null), (0)); /* can't err */ 82 call hcs_$initiate(pathname, "lcp_cg_", "lcp_cg_", 0, 0, (null), (0)); 83 end; 84 i = index(pathname, " "); 85 if lap_flag 86 then substr(pathname, i, 4) = ">lap"; 87 else substr(pathname, i, 9) = ">compiler"; /* full pn shorn of .sv.lisp extension */ 88 a1desc.type = "101010100"b; /* 524 */ 89 a1desc.len = i+8; 90 91 begin; /* allocate space for new argument list */ 92 93 dcl 1 new_argl aligned, 94 2 argc fixed bin(16) unal, 95 2 type fixed bin(18) unal, 96 2 descc fixed bin(16) unal, 97 2 mbz fixed bin(18) unal, 98 2 aptr (n+1) ptr, 99 2 dptr(n+1) ptr; 100 101 new_argl.argc, new_argl.descc = n+1; 102 new_argl.type = 4; 103 new_argl.mbz = 0; 104 105 /* set first arg to pathname */ 106 107 new_argl.aptr(1) = addr(pathname); 108 new_argl.dptr(1) = addr(a1desc); 109 110 /* copy rest of args */ 111 112 do i = 1 to n; 113 new_argl.aptr(i+1) = old_argl.ptr(i); 114 if old_argl.type = 4 then 115 new_argl.dptr(i+1) = old_argl.ptr(i+n); 116 else new_argl.dptr(i+1) = old_argl.ptr(i+n+1); 117 end; 118 119 /* call out */ 120 121 call cu_$gen_call(addr(lisp), addr(new_argl)); 122 end; 123 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1541.4 lisp_compiler.pl1 >special_ldd>on>06/27/83>lisp_compiler.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) a1desc 000156 automatic structure level 1 packed unaligned dcl 29 set ref 108 addr builtin function dcl 29 ref 77 107 108 121 121 121 121 aptr 2 000100 automatic pointer array level 2 dcl 93 set ref 107* 113* argc based fixed bin(16,0) level 2 in structure "old_argl" packed unaligned dcl 29 in procedure "lisp_compiler" ref 65 argc 000100 automatic fixed bin(16,0) level 2 in structure "new_argl" packed unaligned dcl 93 in begin block on line 91 set ref 101* com_err_ 000012 constant entry external dcl 29 ref 67 70 cu_$arg_list_ptr 000010 constant entry external dcl 29 ref 63 cu_$gen_call 000022 constant entry external dcl 29 ref 121 descc 1 000100 automatic fixed bin(16,0) level 2 packed unaligned dcl 93 set ref 101* dptr 000100 automatic pointer array level 2 dcl 93 set ref 108* 114* 116* hcs_$fs_get_path_name 000014 constant entry external dcl 29 ref 77 hcs_$initiate 000016 constant entry external dcl 29 ref 78 81 82 i 000100 automatic fixed bin(17,0) dcl 29 set ref 84* 85 87 89 112* 113 113 114 114 116 116* index builtin function dcl 29 ref 84 j automatic fixed bin(17,0) dcl 29 join 000126 constant label dcl 63 ref 57 label 000230 constant label dcl 77 ref 76 label_me 000160 automatic label variable dcl 51 set ref 76* 77 lap 000117 constant entry external dcl 59 lap_flag 000164 automatic bit(1) unaligned dcl 54 set ref 56* 61* 67 78 85 lcp 000107 constant entry external dcl 11 len 0(09) 000156 automatic fixed bin(26,0) level 2 packed unaligned dcl 29 set ref 89* lisp 000020 constant entry external dcl 29 set ref 121 121 lisp_compiler 000100 constant entry external dcl 11 mbz 1(17) 000100 automatic fixed bin(18,0) level 2 packed unaligned dcl 93 set ref 103* n 000101 automatic fixed bin(17,0) dcl 29 set ref 65* 66 93 93 101 108 112 114 114 116 116 new_argl 000100 automatic structure level 1 dcl 93 set ref 121 121 null builtin function dcl 29 ref 78 81 82 old_ap 000102 automatic pointer dcl 29 set ref 63* 65 113 114 114 116 old_argl based structure level 1 dcl 29 pathname 000104 automatic char(168) unaligned dcl 29 set ref 77* 78* 81* 82* 84 85* 87* 107 ptr 2 based pointer array level 2 dcl 29 ref 113 114 116 ptr_to_me based pointer dcl 51 set ref 77* substr builtin function dcl 29 set ref 85* 87* type 000156 automatic bit(9) level 2 in structure "a1desc" packed unaligned dcl 29 in procedure "lisp_compiler" set ref 88* type 0(17) 000100 automatic fixed bin(18,0) level 2 in structure "new_argl" packed unaligned dcl 93 in begin block on line 91 set ref 102* type 0(17) based fixed bin(18,0) level 2 in structure "old_argl" packed unaligned dcl 29 in procedure "lisp_compiler" ref 114 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1000 1024 672 1010 Length 1210 672 24 147 106 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_compiler 232 external procedure is an external procedure. begin block on line 91 78 begin block uses auto adjustable storage. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 91 000100 new_argl begin block on line 91 lisp_compiler 000100 i lisp_compiler 000101 n lisp_compiler 000102 old_ap lisp_compiler 000104 pathname lisp_compiler 000156 a1desc lisp_compiler 000160 label_me lisp_compiler 000164 lap_flag lisp_compiler THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. enter_begin leave_begin call_ext_out_desc call_ext_out return alloc_auto_adj ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_list_ptr cu_$gen_call hcs_$fs_get_path_name hcs_$initiate lisp NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000077 56 000114 57 000115 59 000116 61 000124 63 000126 65 000135 66 000140 67 000141 70 000173 72 000224 76 000225 77 000230 78 000263 81 000335 82 000413 84 000462 85 000473 87 000501 88 000504 89 000506 91 000510 93 000513 101 000527 102 000543 103 000547 107 000553 108 000555 112 000561 113 000572 114 000602 116 000630 117 000650 121 000652 122 000667 123 000670 ----------------------------------------------------------- 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