COMPILATION LISTING OF SEGMENT check_storage_manager_ Compiled by: Experimental PL/I Compiler of Friday, July 31, 1981 at 13:16 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 08/08/81 2007.0 mst Sat 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 /* Program to check an allocation package. */ 11 /* PG 760312 */ 12 /* Modified 790328 by PG to bring up to coding standards, and to put memory 13* segment into the user's home dir. */ 14 15 check_storage_manager_$allocate: 16 procedure (bv_storage_ptr, bv_n_words); 17 18 /* parameters */ 19 20 dcl ( 21 bv_storage_ptr ptr unal, 22 bv_n_words fixed bin (18) 23 ) parameter; 24 25 /* automatic */ 26 27 dcl code fixed bin (35), 28 dname char (168), 29 ename char (32), 30 offset fixed bin, 31 person_id char (22), 32 project_id char (9), 33 segno fixed bin, 34 segx fixed bin; 35 36 /* internal static */ 37 38 dcl memory_seg_ptr ptr internal static initial (null); 39 40 /* based */ 41 42 dcl 1 memory aligned based (memory_seg_ptr), 43 2 last_memory_slot 44 fixed bin, 45 2 segno (35) fixed bin, 46 2 allocated (35) bit (262144) unaligned; 47 48 /* entries */ 49 50 dcl com_err_ entry options (variable), 51 cu_$cl entry (), 52 hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)), 53 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 54 hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)), 55 ioa_ entry options (variable), 56 user_info_ entry options (variable); 57 58 /* builtins */ 59 60 dcl (baseno, binary, copy, lbound, hbound, null, rel, rtrim, substr) 61 builtin; 62 63 /* program */ 64 65 if memory_seg_ptr = null 66 then call initialize; 67 68 segno = binary (baseno (bv_storage_ptr), 15); 69 offset = binary (rel (bv_storage_ptr), 18) + 1; /* convert to 1-origin */ 70 71 do segx = lbound (memory.segno, 1) to last_memory_slot while (memory.segno (segx) ^= segno); 72 end; 73 74 if segx <= last_memory_slot 75 then do; 76 if substr (memory.allocated (segx), offset, bv_n_words) ^= ""b 77 then do; 78 call ioa_ ("check_storage_manager_: ^d words at ^p reuses storage", bv_n_words, bv_storage_ptr); 79 call cu_$cl; 80 end; 81 end; 82 else if last_memory_slot < hbound (memory.segno, 1) 83 then do; 84 segx, last_memory_slot = last_memory_slot + 1; 85 memory.segno (segx) = segno; 86 end; 87 else do; 88 call ioa_ ("check_storage_manager_: no more room for memory maps"); 89 return; 90 end; 91 92 93 substr (memory.allocated (segx), offset, bv_n_words) = copy ("1"b, bv_n_words); 94 return; 95 96 free: 97 entry (bv_storage_ptr, bv_n_words); 98 99 if memory_seg_ptr = null 100 then call initialize; 101 102 segno = binary (baseno (bv_storage_ptr), 15); 103 offset = binary (rel (bv_storage_ptr), 18) + 1; /* convert to 1-origin */ 104 105 do segx = lbound (memory.segno, 1) to last_memory_slot while (memory.segno (segx) ^= segno); 106 end; 107 108 if segx > last_memory_slot 109 then do; 110 call ioa_ ("check_storage_manager_: no map for ^d at ^p", bv_n_words, bv_storage_ptr); 111 call cu_$cl; 112 return; 113 end; 114 115 if (^substr (memory.allocated (segx), offset, bv_n_words)) ^= ""b 116 then do; 117 call ioa_ ("check_storage_manager_: not all words allocated at free time: ^d at ^p", bv_n_words, 118 bv_storage_ptr); 119 call ioa_ ("pattern is ^b", substr (memory.allocated (segx), offset, bv_n_words)); 120 call cu_$cl; 121 end; 122 123 substr (memory.allocated (segx), offset, bv_n_words) = ""b; 124 return; 125 126 clear: 127 entry (); 128 129 call initialize; 130 return; 131 132 initialize: 133 procedure; 134 135 if memory_seg_ptr = null /* have we found the segment yet? */ 136 then do; /* no */ 137 call user_info_ (person_id, project_id); 138 dname = ">user_dir_dir>" || rtrim (project_id) || ">" || person_id; 139 ename = rtrim (person_id) || ".csm"; 140 141 call hcs_$initiate (dname, ename, "", 0b, 0b, memory_seg_ptr, code); 142 if memory_seg_ptr = null 143 then do; /* not there, try creating it. */ 144 call hcs_$make_seg (dname, ename, "", 01010b, memory_seg_ptr, code); 145 if memory_seg_ptr = null 146 then do; 147 call com_err_ (code, "check_storage_manager_", "Cannot create ^a>^a", dname, ename); 148 return; 149 end; 150 151 call ioa_ ("check_storage_manager_: Creating ^a>^a", dname, ename); 152 end; 153 end; 154 155 call hcs_$truncate_seg (memory_seg_ptr, 0, code); 156 if code ^= 0 157 then do; 158 call com_err_ (code, "check_storage_manager_", "Cannot truncate ^a>^a to 0 words.", dname, ename); 159 memory_seg_ptr = null; 160 return; 161 end; 162 163 memory.last_memory_slot = lbound (memory.segno, 1) - 1; 164 return; 165 166 end /* initialize */; 167 168 end /* check_storage_manager_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/08/81 1600.0 check_storage_manager_.pl1 >dumps>old_dumps>on>MIB-073181>check_storage_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. allocated 44 based bit(262144) array level 2 packed unaligned dcl 42 set ref 76 93* 115 119 119 123* baseno builtin function dcl 60 ref 68 102 binary builtin function dcl 60 ref 68 69 102 103 bv_n_words parameter fixed bin(18,0) dcl 20 set ref 15 76 78* 93 93 96 110* 115 117* 119 119 123 bv_storage_ptr parameter pointer unaligned dcl 20 set ref 15 68 69 78* 96 102 103 110* 117* code 000100 automatic fixed bin(35,0) dcl 27 set ref 141* 144* 147* 155* 156 158* com_err_ 000012 constant entry external dcl 50 ref 147 158 copy builtin function dcl 60 ref 93 cu_$cl 000014 constant entry external dcl 50 ref 79 111 120 dname 000101 automatic char(168) unaligned dcl 27 set ref 138* 141* 144* 147* 151* 158* ename 000153 automatic char(32) unaligned dcl 27 set ref 139* 141* 144* 147* 151* 158* hbound builtin function dcl 60 ref 82 hcs_$initiate 000016 constant entry external dcl 50 ref 141 hcs_$make_seg 000020 constant entry external dcl 50 ref 144 hcs_$truncate_seg 000022 constant entry external dcl 50 ref 155 ioa_ 000024 constant entry external dcl 50 ref 78 88 110 117 119 151 last_memory_slot based fixed bin(17,0) level 2 dcl 42 set ref 71 74 82 84 84* 105 108 163* lbound builtin function dcl 60 ref 71 105 163 memory based structure level 1 dcl 42 memory_seg_ptr 000010 internal static pointer initial dcl 38 set ref 65 71 71 71 74 76 82 82 84 84 85 93 99 105 105 105 108 115 119 119 123 135 141* 142 144* 145 155* 159* 163 163 null builtin function dcl 60 ref 65 99 135 142 145 159 offset 000163 automatic fixed bin(17,0) dcl 27 set ref 69* 76 93 103* 115 119 119 123 person_id 000164 automatic char(22) unaligned dcl 27 set ref 137* 138 139 project_id 000172 automatic char(9) unaligned dcl 27 set ref 137* 138 rel builtin function dcl 60 ref 69 103 rtrim builtin function dcl 60 ref 138 139 segno 1 based fixed bin(17,0) array level 2 in structure "memory" dcl 42 in procedure "check_storage_manager_$allocate" set ref 71 71 82 85* 105 105 163 segno 000175 automatic fixed bin(17,0) dcl 27 in procedure "check_storage_manager_$allocate" set ref 68* 71 85 102* 105 segx 000176 automatic fixed bin(17,0) dcl 27 set ref 71* 71* 74 76 84* 85 93 105* 105* 108 115 119 119 123 substr builtin function dcl 60 set ref 76 93* 115 119 119 123* user_info_ 000026 constant entry external dcl 50 ref 137 NAMES DECLARED BY EXPLICIT CONTEXT. check_storage_manager_$allocate 000174 constant entry external dcl 15 clear 000601 constant entry external dcl 126 free 000361 constant entry external dcl 96 initialize 000610 constant entry internal dcl 132 ref 65 99 129 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1352 1402 1217 1362 Length 1612 1217 30 174 132 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME check_storage_manager_$allocate 252 external procedure is an external procedure. initialize internal procedure shares stack frame of external procedure check_storage_manager_$alloca STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 memory_seg_ptr check_storage_manager_$allocate STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_storage_manager_$allocate 000100 code check_storage_manager_$allocate 000101 dname check_storage_manager_$allocate 000153 ename check_storage_manager_$allocate 000163 offset check_storage_manager_$allocate 000164 person_id check_storage_manager_$allocate 000172 project_id check_storage_manager_$allocate 000175 segno check_storage_manager_$allocate 000176 segx check_storage_manager_$allocate THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs alloc_bs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$cl hcs_$initiate hcs_$make_seg hcs_$truncate_seg ioa_ user_info_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 15 000170 65 000201 68 000206 69 000217 71 000223 72 000237 74 000241 76 000245 78 000262 79 000305 81 000312 82 000313 84 000316 85 000321 86 000324 88 000325 89 000340 93 000341 94 000356 96 000357 99 000366 102 000374 103 000405 105 000411 106 000425 108 000427 110 000433 111 000457 112 000464 115 000465 117 000503 119 000526 120 000561 123 000567 124 000577 126 000600 129 000606 130 000607 132 000610 135 000611 137 000616 138 000632 139 000701 141 000730 142 000774 144 001001 145 001037 147 001044 148 001105 151 001106 155 001131 156 001145 158 001147 159 001206 160 001211 163 001212 164 001215 ----------------------------------------------------------- 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