COMPILATION LISTING OF SEGMENT apl_segment_manager_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1616.5 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 11 /* The following module is used to manage temporary segments in APL. These segments are used for stacks, 12* editor, save and load temporaries, etc. The get entry is called with no arguments and will return a pointer which 13* will be set to point to the base of a temporary segment. The free entry takes such a pointer, but it need not point 14* at the base of the segment. This module replaces an earlier version that did not attempt to reuse 15* the segments. Here a table is kept of pointers to the segments, along with a table of bits telling if the 16* segment is in use. If no previously-created segments are in use, a new one is created with the name 17* "apl_seg_NNN" where NNN is a three-digit decimal number starting and zero and increasing for each new segment 18* created. 19* 20* Created 11/28/73 by G. Gordon Benedict. 21* Modified 761007 by PG to have set_temp_dir do a reset when directory is changed. 22**/ 23 24 apl_segment_manager_$get: /* entry to get pointer to temporary segment */ 25 procedure () returns (pointer); /* pointer will be filled in with pointer to base of segment */ 26 27 declare a_seg_ptr pointer parameter; 28 declare seg_ptr pointer; /* just a random pointer */ 29 declare packed_seg_ptr pointer unaligned; /* for fast compares with packed ptrs in seg table */ 30 31 declare segment_counter /* contains NNN (last three digits of temporary segment next to be allocated) */ 32 fixed decimal precision (3,0) internal static initial (0); 33 34 declare segment_counter_picture picture "999"; 35 36 declare segment_pointers /* contains pointers to all segments so far created (which are NEVER deleted) */ 37 dimension (0 : 31) pointer unaligned internal static initial ( (32) null () ); 38 39 declare segment_used /* contains one bit for every segment, allocated or not. 1 = in use 40* (i.e. allocated but not yet freed) 0 = not in use or not allocated */ 41 dimension (0 : 31) bit (1) internal static unaligned initial ( (32) (1) "0"b); 42 43 declare (apl_error_table_$temp_seg_already_exists, /* happens if segment_used says not existent but does */ 44 apl_error_table_$cant_create_seg, /* happens if in dir without modify access */ 45 apl_error_table_$wsfull_out_of_segs, /* happens if more than 32 segments are needed */ 46 apl_error_table_$attempt_to_free_not_temp, /* Attempt to free segment not known to storage manager */ 47 apl_error_table_$cant_truncate_seg) /* hcs_$truncate_seg refuses to truncate */ 48 fixed binary precision (35) external static; 49 50 declare segment_index /* used to loop thru segment_pointers table */ 51 fixed binary; 52 53 declare temp_dir /* contains name of directory into which to place temporary segments */ 54 character (168) internal static initial (""); 55 56 declare (hbound, 57 index, 58 null, 59 pointer, 60 string) builtin; 61 62 declare apl_system_error_ /* used to signal all of those gruesome errors above */ 63 entry (fixed binary precision (35)); 64 65 declare hcs_$make_seg /* used to create temp segs when no unused segs are in existence */ 66 entry (character (*), character (*), character (*), fixed binary precision (4), pointer, 67 fixed binary precision (35)); 68 69 declare unique_chars_ /* used to guarantee unique names */ 70 entry (bit (*)) returns (char (15)); 71 declare hcs_$delentry_seg /* used to delete temp segs when clear command (reset entry) is used */ 72 entry (pointer, fixed binary precision (35)); 73 74 declare hcs_$truncate_seg /* used to reduce freed segments to zero length */ 75 entry (pointer, fixed binary, fixed binary precision (35)); 76 77 declare code /* error code */ 78 fixed binary precision (35); 79 80 /* Now comes main code for get entry. See if there is an unused segment with a non-null pointer */ 81 82 segment_index = index (string (segment_used), "0"b) - 1; /* find first unused bit */ 83 if segment_index < 0 then do; /* unfortunately all entries in table are used up, so... */ 84 call apl_system_error_ (apl_error_table_$wsfull_out_of_segs); /* if you get this one, tell me 85* to increase size of this table */ 86 return; 87 end; 88 89 seg_ptr = segment_pointers (segment_index); /* fetch pointer for unused segment */ 90 91 if seg_ptr = null () then do; /* segment does not exist, no unused segments were available. get one */ 92 segment_counter_picture = segment_counter; /* convert to 001, 002, etc. */ 93 call hcs_$make_seg (temp_dir, /* use this dir */ 94 unique_chars_ (""b) || ".apl_seg_" || segment_counter_picture, "", 1011b, seg_ptr, code); 95 96 if seg_ptr = null () then do; /* for some reason make_seg refused to make it */ 97 call apl_system_error_ (apl_error_table_$cant_create_seg); 98 return; 99 end; 100 101 if code ^= 0 then do; /* uhoh... there's another apl running in this losers process who is 102* using his own table... los,e, lose, lose */ 103 call apl_system_error_ (apl_error_table_$temp_seg_already_exists); 104 return; 105 end; 106 107 segment_counter = /* increment NNN suffix for next time */ 108 segment_counter + 1; 109 segment_pointers (segment_index) = seg_ptr; /* fill in for next time */ 110 end; 111 112 segment_used (segment_index) = "1"b; /* indicate in use */ 113 return (seg_ptr); /* return pointer to allocated segment */ 114 115 116 /* Now comes the free entry. Mostly system-error checking */ 117 118 apl_segment_manager_$free: 119 entry (a_seg_ptr); /* pointer into segment to free */ 120 121 packed_seg_ptr, /* more efficient to compare packed to packed than packed to unpacked */ 122 seg_ptr = pointer (a_seg_ptr, 0); /* copy and get ptr to base of segment */ 123 124 /* search thru the segment table for one which matches */ 125 126 do segment_index = 0 by 1 while (segment_index <= hbound (segment_pointers, 1)); /* thru whole table */ 127 128 if segment_pointers (segment_index) = packed_seg_ptr then do; /* found it! */ 129 segment_used (segment_index) = "0"b; /* indicate not used for next allocate */ 130 call hcs_$truncate_seg (seg_ptr, 0, code); /* reduce to zero length */ 131 if code ^= 0 then do; /* truncate refuses */ 132 segment_pointers (segment_index) = null (); /* do not let APL re-use this segment */ 133 call apl_system_error_ (apl_error_table_$cant_truncate_seg); 134 return; 135 end; 136 137 return; 138 end; 139 end; 140 141 /* The loser gave me a segment I couldn't find in my segment table */ 142 143 call apl_system_error_ (apl_error_table_$attempt_to_free_not_temp); 144 return; 145 146 /* This entry is used to initialize the temp_dir to some directory, or to change to a new directory. */ 147 148 apl_segment_manager_$set_temp_dir: 149 entry (directory); 150 151 declare directory character (*) parameter; /* the new directory */ 152 153 if temp_dir ^= "" /* If temp_dir is initialized */ 154 then if temp_dir ^= directory /* And we are changing directories */ 155 then do; 156 call apl_segment_manager_$reset; /* delete old temp segs */ 157 temp_dir = directory; 158 end; 159 else; /* directory is staying the same */ 160 else temp_dir = directory; /* just initialize temp_dir first time thru */ 161 return; 162 163 /* This entry is used to tell the segment manager to get rid of all apl temporary segments and clear the 164* table of segments, and reset the segment counter to zero. */ 165 166 apl_segment_manager_$reset: 167 entry (); 168 169 segment_counter = 0; /* reset to zero */ 170 string (segment_used) = ""b; /* no segments are in use */ 171 172 do segment_index =0 by 1 while (segment_index <= hbound (segment_pointers, 1)); 173 if segment_pointers (segment_index) ^= null () then do; /* delete this segment */ 174 seg_ptr = segment_pointers (segment_index); 175 segment_pointers (segment_index) = null (); /* will be no segment there soon */ 176 call hcs_$delentry_seg (seg_ptr, code); /* delete this temp seg */ 177 end; 178 end; 179 return; 180 181 /* This entry is used to inquire the segment manager to give the name of the current temp_dir and value 182* of the segment_counter */ 183 184 apl_segment_manager_$get_dir_and_count: 185 entry (directory, count); 186 187 declare count fixed decimal (3, 0) parameter; 188 189 directory = temp_dir; 190 count = segment_counter; 191 192 end apl_segment_manager_$get; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1347.2 apl_segment_manager_.pl1 >special_ldd>on>apl.1129>apl_segment_manager_.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_seg_ptr parameter pointer dcl 27 ref 118 121 apl_error_table_$attempt_to_free_not_temp 000132 external static fixed bin(35,0) dcl 43 set ref 143* apl_error_table_$cant_create_seg 000126 external static fixed bin(35,0) dcl 43 set ref 97* apl_error_table_$cant_truncate_seg 000134 external static fixed bin(35,0) dcl 43 set ref 133* apl_error_table_$temp_seg_already_exists 000124 external static fixed bin(35,0) dcl 43 set ref 103* apl_error_table_$wsfull_out_of_segs 000130 external static fixed bin(35,0) dcl 43 set ref 84* apl_system_error_ 000136 constant entry external dcl 62 ref 84 97 103 133 143 code 000105 automatic fixed bin(35,0) dcl 77 set ref 93* 101 130* 131 176* count parameter fixed dec(3,0) dcl 187 set ref 184 190* directory parameter char unaligned dcl 151 set ref 148 153 157 160 184 189* hbound builtin function dcl 56 ref 126 172 hcs_$delentry_seg 000144 constant entry external dcl 71 ref 176 hcs_$make_seg 000140 constant entry external dcl 65 ref 93 hcs_$truncate_seg 000146 constant entry external dcl 74 ref 130 index builtin function dcl 56 ref 82 null builtin function dcl 56 ref 91 96 132 173 175 packed_seg_ptr 000102 automatic pointer unaligned dcl 29 set ref 121* 128 pointer builtin function dcl 56 ref 121 seg_ptr 000100 automatic pointer dcl 28 set ref 89* 91 93* 96 109 113 121* 130* 174* 176* segment_counter 000010 internal static fixed dec(3,0) initial dcl 31 set ref 92 107* 107 169* 190 segment_counter_picture 000103 automatic picture(3) unaligned dcl 34 set ref 92* 93 segment_index 000104 automatic fixed bin(17,0) dcl 50 set ref 82* 83 89 109 112 126* 126* 128 129 132* 172* 172* 173 174 175* segment_pointers 000011 internal static pointer initial array unaligned dcl 36 set ref 89 109* 126 128 132* 172 173 174 175* segment_used 000051 internal static bit(1) initial array unaligned dcl 39 set ref 82 112* 129* 170* string builtin function dcl 56 set ref 82 170* temp_dir 000052 internal static char(168) initial unaligned dcl 53 set ref 93* 153 153 157* 160* 189 unique_chars_ 000142 constant entry external dcl 69 ref 93 NAMES DECLARED BY EXPLICIT CONTEXT. apl_segment_manager_$free 000255 constant entry external dcl 118 apl_segment_manager_$get 000030 constant entry external dcl 24 apl_segment_manager_$get_dir_and_count 000530 constant entry external dcl 184 apl_segment_manager_$reset 000453 constant entry external dcl 166 ref 156 apl_segment_manager_$set_temp_dir 000372 constant entry external dcl 148 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1064 1234 567 1074 Length 1450 567 150 200 274 114 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_segment_manager_$get 117 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 segment_counter apl_segment_manager_$get 000011 segment_pointers apl_segment_manager_$get 000051 segment_used apl_segment_manager_$get 000052 temp_dir apl_segment_manager_$get STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_segment_manager_$get 000100 seg_ptr apl_segment_manager_$get 000102 packed_seg_ptr apl_segment_manager_$get 000103 segment_counter_picture apl_segment_manager_$get 000104 segment_index apl_segment_manager_$get 000105 code apl_segment_manager_$get THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_in call_ext_out_desc call_ext_out return signal shorten_stack ext_entry ext_entry_desc index_bs_1_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_system_error_ hcs_$delentry_seg hcs_$make_seg hcs_$truncate_seg unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$attempt_to_free_not_temp apl_error_table_$cant_create_seg apl_error_table_$cant_truncate_seg apl_error_table_$temp_seg_already_exists apl_error_table_$wsfull_out_of_segs LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 24 000025 82 000037 83 000045 84 000046 86 000054 89 000062 91 000064 92 000070 93 000075 96 000166 97 000173 98 000202 101 000210 103 000212 104 000221 107 000227 109 000233 112 000236 113 000242 118 000253 121 000263 126 000271 128 000275 129 000301 130 000305 131 000320 132 000322 133 000326 134 000334 137 000342 139 000350 143 000352 144 000361 148 000367 153 000406 156 000422 157 000426 159 000435 160 000436 161 000444 166 000452 169 000461 170 000465 172 000467 173 000473 174 000477 175 000502 176 000504 178 000514 179 000516 184 000524 189 000544 190 000553 192 000555 ----------------------------------------------------------- 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