COMPILATION LISTING OF SEGMENT lisp_static_man_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0851.4 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1974 * 4* * * 5* ************************************************************** */ 6 lisp_static_man_: procedure; 7 8 /* This module manages static space for LISP. It replaces make_lisp_subr_block_ 9* Written 74.05.14 by DAM */ 10 11 12 13 dcl cur_stat_seg pointer defined lisp_static_vars_$cur_stat_seg, 14 stat_top fixed bin(18) defined lisp_static_vars_$cur_stat_pos, 15 lisp_static_vars_$cur_stat_seg external pointer, 16 lisp_static_vars_$cur_stat_pos fixed bin(18) external; 17 18 dcl space pointer, 19 Size fixed bin(18); 20 21 dcl sys_info$max_seg_size fixed bin(18) external; 22 23 24 dcl 1 static_seg aligned based, 25 2 chain pointer, 26 2 def_ptr pointer; 27 dcl lisp_segment_manager_$free_array entry(pointer); 28 29 dcl (addr, addrel, null, rel, divide, unspec, substr, size) builtin; 30 31 1 1 /* Include file lisp_common_vars.incl.pl1; 1 2* describes the external static variables which may be referenced 1 3* by lisp routines. 1 4* D. Reed 4/1/71 */ 1 5 1 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 1 7 2 cclist_ptr ptr, /* pointer to list of constants kept 1 8* by compiled programs */ 1 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 1 10 1 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 1 12 err_recp ptr defined (lisp_static_vars_$err_recp), 1 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 1 14 lisp_static_vars_$eval_frame ptr ext static, 1 15 lisp_static_vars_$prog_frame ptr ext aligned, 1 16 lisp_static_vars_$err_frame ptr ext aligned, 1 17 lisp_static_vars_$catch_frame ptr ext aligned, 1 18 lisp_static_vars_$unwp_frame ptr ext aligned, 1 19 lisp_static_vars_$stack_ptr ptr ext aligned, 1 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 1 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 1 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 1 23 lisp_static_vars_$binding_top ptr ext aligned, 1 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 1 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 1 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 1 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 1 28 binding_top ptr defined (lisp_static_vars_$binding_top), 1 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 1 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 1 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 1 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 1 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 1 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 1 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 1 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 1 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 1 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 1 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 1 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 1 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 1 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 1 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 1 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 1 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 1 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 1 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 1 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 1 49 1 50 1 51 /* end include file lisp_common_vars.incl.pl1 */ 32 2 1 /* Include file lisp_ptr_fmt.incl.pl1; 2 2* describes the format of lisp pointers as 2 3* a bit string overlay on the double word ITS pair 2 4* which allows lisp to access some unused bits in 2 5* the standard ITS pointer format. It should be noted that 2 6* this is somewhat of a kludge, since 2 7* it is quite machine dependent. However, to store type 2 8* fields in the pointer, saves 2 words in each cons, 2 9* plus some efficiency problems. 2 10* 2 11* D.Reed 4/1/71 */ 2 12 /* modified to move type field to other half of ptr */ 2 13 /* D.Reed 5/31/72 */ 2 14 2 15 2 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 2 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 2 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 2 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 2 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 2 21 2 type bit(9) unaligned, /* type field */ 2 22 2 itsmod bit(6) unaligned, 2 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 2 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 2 25 2 26 /* manifest constant strings for testing above type field */ 2 27 2 28 ( 2 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 2 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 2 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 2 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 2 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 2 34 Bignum init("000001000"b), /* a multiple-precision number */ 2 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 2 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 2 37* means a special internal uncollectable weird object */ 2 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 2 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 2 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 2 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 2 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 2 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 2 44 ) bit(9) static, 2 45 2 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 2 47 2 48 2 49 ( 2 50 Cons36 init("000000000000000000000000000000"b), 2 51 Fixed36 init("000000000000000000000100000000"b), 2 52 Float36 init("000000000000000000000010000000"b), 2 53 Atsym36 init("000000000000000000000001000000"b), 2 54 Atomic36 init("000000000000000000000111111100"b), 2 55 Bignum36 init("000000000000000000000000001000"b), 2 56 System_Subr36 2 57 init("000000000000000000000000000100"b), 2 58 Bigfix36 init("000000000000000000000000001000"b), 2 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 2 60 NotConsOrAtsym36 2 61 init("000000000000000000000110111111"b), 2 62 SubrNumeric36 2 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 2 64 String36 init("000000000000000000000000100000"b), 2 65 Subr36 init("000000000000000000000000010000"b), 2 66 File36 init("000000000000000000000000000001"b), 2 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 2 68 2 69 /* undefined pointer value is double word of zeros */ 2 70 2 71 Undefined bit(72) static init(""b); 2 72 2 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 33 34 /* Entry to free all the static segments (when LISP is exited) */ 35 36 free_stat_segs: entry; 37 38 do while(cur_stat_seg ^= null); 39 space = cur_stat_seg; 40 cur_stat_seg = space -> static_seg.chain; 41 call lisp_segment_manager_$free_array(space); 42 end; 43 return; 44 45 46 /* Entry to allocate a block of static storage. It was always be aligned on a double-word boundary */ 47 48 allocate: entry(block_ptr, block_size); 49 50 dcl block_ptr pointer parameter, /* (Output) -> allocated block */ 51 block_size fixed bin(18) parameter; /* (Input) number of words required */ 52 53 Size = block_size; 54 if substr(unspec(Size), 36, 1) then Size = Size + 1; /* make sure is even number of words */ 55 56 call alloc_static; 57 block_ptr = space; 58 return; 59 60 /* Internal procedure to allocate by appending to static segment */ 61 62 alloc_static: proc; 63 64 dcl new_top fixed bin(18), 65 lisp_segment_manager_$get_array entry(pointer), 66 new_stat_seg pointer; 67 68 dcl 1 static_seg_header_template aligned static structure, /* initial value for header of static segment */ 69 2 chain pointer init(null), 70 2 link_header, 71 3 def_ptr pointer init(null), /* must point to base of segment */ 72 3 thread pointer init(null), 73 3 virgin_link_pointer pointer init(null), 74 3 must_be_zero fixed bin(71) init(0), 75 1 static_seg_header aligned based structure like static_seg_header_template; 76 77 78 new_top = stat_top + Size; 79 if new_top <= sys_info$max_seg_size /* fits in current segment */ 80 then do; 81 space = addrel(cur_stat_seg, stat_top); 82 stat_top = new_top; 83 return; 84 end; 85 86 /* new segment required */ 87 88 call lisp_segment_manager_$get_array(new_stat_seg); 89 90 new_stat_seg -> static_seg_header = static_seg_header_template; 91 new_stat_seg -> static_seg_header.chain = cur_stat_seg; 92 new_stat_seg -> static_seg_header.def_ptr = new_stat_seg; 93 cur_stat_seg = new_stat_seg; 94 stat_top = size(static_seg_header); 95 space = addrel(new_stat_seg, stat_top); 96 stat_top = stat_top + Size; 97 return; 98 end alloc_static; 99 100 end lisp_static_man_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.5 lisp_static_man_.pl1 >special_ldd>on>06/27/83>lisp_static_man_.pl1 32 1 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 33 2 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) Array internal static bit(9) initial unaligned dcl 2-17 Array36 internal static bit(36) initial dcl 2-17 Atomic internal static bit(9) initial unaligned dcl 2-17 Atomic36 internal static bit(36) initial dcl 2-17 Atsym internal static bit(9) initial unaligned dcl 2-17 Atsym36 internal static bit(36) initial dcl 2-17 Bigfix internal static bit(9) initial unaligned dcl 2-17 Bigfix36 internal static bit(36) initial dcl 2-17 Bignum internal static bit(9) initial unaligned dcl 2-17 Bignum36 internal static bit(36) initial dcl 2-17 Cons internal static bit(9) initial unaligned dcl 2-17 Cons36 internal static bit(36) initial dcl 2-17 File internal static bit(9) initial unaligned dcl 2-17 File36 internal static bit(36) initial dcl 2-17 Fixed internal static bit(9) initial unaligned dcl 2-17 Fixed36 internal static bit(36) initial dcl 2-17 Float internal static bit(9) initial unaligned dcl 2-17 Float36 internal static bit(36) initial dcl 2-17 NotConsOrAtsym36 internal static bit(36) initial dcl 2-17 Numeric internal static bit(9) initial unaligned dcl 2-17 Numeric36 internal static bit(36) initial dcl 2-17 Size 000102 automatic fixed bin(18,0) dcl 18 set ref 53* 54 54* 54 78 96 String internal static bit(9) initial unaligned dcl 2-17 String36 internal static bit(36) initial dcl 2-17 Subr internal static bit(9) initial unaligned dcl 2-17 Subr36 internal static bit(36) initial dcl 2-17 SubrNumeric36 internal static bit(36) initial dcl 2-17 System_Subr internal static bit(9) initial unaligned dcl 2-17 System_Subr36 internal static bit(36) initial dcl 2-17 Uncollectable internal static bit(9) initial unaligned dcl 2-17 Undefined internal static bit(72) initial unaligned dcl 2-17 addr builtin function dcl 29 addrel builtin function dcl 29 ref 81 95 alloc_static 000103 constant entry internal dcl 62 ref 56 allocate 000062 constant entry external dcl 48 array_atom defined fixed bin(71,0) dcl 1-6 based_ptr based pointer dcl 2-16 binding_top defined pointer dcl 1-6 block_ptr parameter pointer dcl 50 set ref 48 57* block_size parameter fixed bin(18,0) dcl 50 ref 48 53 catch_frame defined pointer dcl 1-6 chain based pointer level 2 in structure "static_seg" dcl 24 in procedure "lisp_static_man_" ref 40 chain based pointer initial level 2 in structure "static_seg_header" dcl 68 in procedure "alloc_static" set ref 91* cur_stat_seg defined pointer dcl 13 set ref 38 39 40* 81 91 93* def_ptr 2 based pointer initial level 3 dcl 68 set ref 92* divide builtin function dcl 29 err_frame defined pointer dcl 1-6 err_recp defined pointer dcl 1-6 eval_frame defined pointer dcl 1-6 free_stat_segs 000026 constant entry external dcl 36 link_header 2 based structure level 2 dcl 68 lisp_ptr based structure level 1 dcl 2-17 lisp_ptr_type based bit(36) dcl 2-17 lisp_segment_manager_$free_array 000016 constant entry external dcl 27 ref 41 lisp_segment_manager_$get_array 000020 constant entry external dcl 64 ref 88 lisp_static_man_ 000017 constant entry external dcl 6 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$binding_top external static pointer dcl 1-6 lisp_static_vars_$catch_frame external static pointer dcl 1-6 lisp_static_vars_$cur_stat_pos 000012 external static fixed bin(18,0) dcl 13 set ref 78 78 81 81 82* 82 94* 94 95 95 96* 96 96 96 lisp_static_vars_$cur_stat_seg 000010 external static pointer dcl 13 set ref 38 38 39 39 40* 40 81 81 91 91 93* 93 lisp_static_vars_$err_frame external static pointer dcl 1-6 lisp_static_vars_$err_recp external static pointer dcl 1-6 lisp_static_vars_$eval_frame external static pointer dcl 1-6 lisp_static_vars_$iochan_list external static pointer dcl 1-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 1-6 lisp_static_vars_$nil external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$prog_frame external static pointer dcl 1-6 lisp_static_vars_$stack_ptr external static pointer dcl 1-6 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 1-45 lisp_static_vars_$t_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$top_level external static label variable dcl 1-6 lisp_static_vars_$tty_input_chan external static pointer dcl 1-6 lisp_static_vars_$tty_output_chan external static pointer dcl 1-6 lisp_static_vars_$unmkd_ptr external static pointer dcl 1-6 lisp_static_vars_$unwp_frame external static pointer dcl 1-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 1-45 new_stat_seg 000114 automatic pointer dcl 64 set ref 88* 90 91 92 92 93 95 new_top 000112 automatic fixed bin(18,0) dcl 64 set ref 78* 79 82 nil defined fixed bin(71,0) dcl 1-6 nil_ptr based pointer dcl 1-6 null builtin function dcl 29 ref 38 obarray defined fixed bin(71,0) dcl 1-6 prog_frame defined pointer dcl 1-6 rel builtin function dcl 29 size builtin function dcl 29 ref 94 space 000100 automatic pointer dcl 18 set ref 39* 40 41* 57 81* 95* stack_ptr defined pointer dcl 1-6 star_rset defined fixed bin(71,0) dcl 1-45 stat_top defined fixed bin(18,0) dcl 13 set ref 78 81 82* 94* 95 96* 96 static_seg based structure level 1 dcl 24 static_seg_header based structure level 1 dcl 68 set ref 90* 94 static_seg_header_template 000000 constant structure level 1 dcl 68 ref 90 substr builtin function dcl 29 ref 54 sys_info$max_seg_size 000014 external static fixed bin(18,0) dcl 21 ref 79 t_atom defined fixed bin(71,0) dcl 1-6 t_atom_ptr based pointer dcl 1-6 tty_input_chan defined pointer dcl 1-6 tty_output_chan defined pointer dcl 1-6 unmkd_ptr defined pointer dcl 1-6 unspec builtin function dcl 29 ref 54 unwp_frame defined pointer dcl 1-6 user_intr_array defined fixed bin(71,0) array dcl 1-45 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 276 320 153 306 Length 540 153 22 204 122 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_static_man_ 86 external procedure is an external procedure. alloc_static internal procedure shares stack frame of external procedure lisp_static_man_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_static_man_ 000100 space lisp_static_man_ 000102 Size lisp_static_man_ 000112 new_top alloc_static 000114 new_stat_seg alloc_static THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. lisp_segment_manager_$free_array lisp_segment_manager_$get_array THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_static_vars_$cur_stat_pos lisp_static_vars_$cur_stat_seg sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000016 36 000024 38 000033 39 000041 40 000044 41 000046 42 000054 43 000055 48 000056 53 000067 54 000072 56 000076 57 000077 58 000102 62 000103 78 000104 79 000110 81 000112 82 000117 83 000121 88 000122 90 000130 91 000134 92 000140 93 000141 94 000142 95 000144 96 000150 97 000152 ----------------------------------------------------------- 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