COMPILATION LISTING OF SEGMENT value Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/12/82 1244.1 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 value: proc; 12 13 dcl en char (32) aligned int static, 14 dn char (168) aligned int static, 15 segptr ptr int static init (null), 16 ap ptr, al fixed bin, bchr char (al) unal based (ap), 17 answer char (32) varying, 18 bvcs char (al) varying based (ap), 19 ec fixed bin, 20 i fixed bin, 21 string char (168) aligned; 22 23 dcl (null, substr, addr, min) builtin; 24 25 dcl com_err_ entry options (variable), 26 adjust_bit_count_ entry (char (*) aligned, char (*) aligned, bit (1), fixed bin (24), fixed bin (17)), 27 get_wdir_ entry () returns (char (168) aligned), 28 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin), 29 active_fnc_err_ entry options (variable), 30 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin), 31 cu_$af_arg_count entry (fixed bin, fixed bin), 32 cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin), 33 cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin), 34 error_table_$wrong_no_of_args fixed bin ext, 35 hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, 36 fixed bin (1), fixed bin (2), ptr, fixed bin), 37 hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, 38 fixed bin (5), ptr, fixed bin), 39 ioa_ entry options (variable); 40 41 dcl 1 valueseg based (segptr) aligned, 42 2 laste fixed bin, 43 2 freep fixed bin, 44 2 pad (6) fixed bin, 45 2 arry (14506), 46 3 name char (32), 47 3 valu char (32), 48 3 lth fixed bin, 49 3 chain fixed bin; 50 51 /* ========================================= */ 52 53 if segptr = null then do; 54 55 dn = get_wdir_ (); 56 en = "value_seg"; 57 call hcs_$initiate (dn, en, "", 0, 1, segptr, ec); 58 if segptr = null then do; 59 aer: call active_fnc_err_ (ec, "value", "^a>^a", dn, en); 60 return; 61 end; 62 end; 63 64 call cu_$af_arg_count (i, ec); 65 if ec ^= 0 then go to aer; 66 if i ^= 1 then do; 67 ec = error_table_$wrong_no_of_args; 68 go to aer; 69 end; 70 call cu_$af_arg_ptr (1, ap, al, ec); 71 if ec ^= 0 then go to aer; 72 73 do i = 1 to laste; 74 if chain (i) = 0 then if name (i) ^= "" then 75 if bchr = name (i) then go to found; 76 end; 77 answer = "undefined!"; 78 go to give; 79 80 found: answer = substr (valu (i), 1, lth (i)); 81 give: call cu_$af_return_arg (i, ap, al, ec); 82 if ec ^= 0 then go to aer; 83 bvcs = answer; 84 return; 85 86 /* ---------------------------------- */ 87 88 set: entry; 89 90 if segptr = null then do; 91 dn = get_wdir_ (); 92 en = "value_seg"; 93 call hcs_$initiate (dn, en, "", 0, 1, segptr, ec); 94 if segptr = null then do; 95 er: call com_err_ (ec, "value", "^a>^a", dn, en); 96 return; 97 end; 98 end; 99 100 call cu_$arg_ptr (1, ap, al, ec); 101 if ec ^= 0 then go to er; 102 string = bchr; 103 104 call cu_$arg_ptr (2, ap, al, ec); 105 if ec ^= 0 then do; 106 do i = 1 to laste; 107 if string = name (i) then do; 108 chain (i) = freep; 109 freep = i; 110 name (i) = ""; 111 end; 112 end; 113 return; 114 end; 115 116 do i = 1 to laste; 117 if chain (i) = 0 then if name (i) ^= "" then 118 if name (i) = string then do; 119 go to f1; 120 end; 121 end; 122 if freep = 0 then i, laste = laste + 1; 123 else do; 124 i = freep; 125 freep = chain (i); 126 end; 127 name (i) = string; 128 f1: valu (i) = bchr; 129 chain (i) = 0; 130 lth (i) = min (al, 32); 131 132 call adjust_bit_count_ (dn, en, "0"b, (0), ec); 133 134 return; 135 136 /* ----------------------------------- */ 137 138 set_seg: entry; 139 140 call cu_$arg_ptr (1, ap, al, ec); 141 if ec ^= 0 then go to er; 142 string = bchr; 143 call expand_path_ (addr (string), al, addr (dn), addr (en), ec); 144 if ec ^= 0 then go to er; 145 call hcs_$initiate (dn, en, "", 0, 1, segptr, ec); 146 if segptr = null then do; 147 call hcs_$make_seg (dn, en, "", 1011b, segptr, ec); 148 if segptr = null then go to er; 149 call ioa_ ("value: Creating ^a>^a", dn, en); 150 end; 151 return; 152 153 /* ------------------------------------------ */ 154 155 dump: entry; 156 157 if segptr = null then do; 158 dn = get_wdir_ (); 159 en = "value_seg"; 160 call hcs_$initiate (dn, en, "", 0, 1, segptr, ec); 161 if segptr = null then go to er; 162 end; 163 164 call cu_$arg_ptr (1, ap, al, ec); 165 do i = 1 to laste; 166 if name (i) = "" then go to nop; 167 if chain (i) = 0 then do; 168 if ec = 0 then if name (i) ^= bchr then go to nop; 169 call ioa_ ("^-^a^-^a", name (i), substr (valu (i), 1, lth (i))); 170 end; 171 nop: end; 172 call ioa_ (""); 173 174 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/12/82 1111.7 value.pl1 >spec>on>11/12/82>value.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. active_fnc_err_ 000104 constant entry external dcl 25 ref 59 addr builtin function dcl 23 ref 143 143 143 143 143 143 adjust_bit_count_ 000076 constant entry external dcl 25 ref 132 al 000102 automatic fixed bin(17,0) dcl 13 set ref 70* 74 81* 83 100* 102 104* 128 130 140* 142 143* 164* 168 answer 000103 automatic varying char(32) dcl 13 set ref 77* 80* 83 ap 000100 automatic pointer dcl 13 set ref 70* 74 81* 83 100* 102 104* 128 140* 142 164* 168 arry 10 based structure array level 2 dcl 41 bchr based char unaligned dcl 13 ref 74 102 128 142 168 bvcs based varying char dcl 13 set ref 83* chain 31 based fixed bin(17,0) array level 3 dcl 41 set ref 74 108* 117 125 129* 167 com_err_ 000074 constant entry external dcl 25 ref 95 cu_$af_arg_count 000110 constant entry external dcl 25 ref 64 cu_$af_arg_ptr 000112 constant entry external dcl 25 ref 70 cu_$af_return_arg 000114 constant entry external dcl 25 ref 81 cu_$arg_ptr 000106 constant entry external dcl 25 ref 100 104 140 164 dn 000020 internal static char(168) dcl 13 set ref 55* 57* 59* 91* 93* 95* 132* 143 143 145* 147* 149* 158* 160* ec 000114 automatic fixed bin(17,0) dcl 13 set ref 57* 59* 64* 65 67* 70* 71 81* 82 93* 95* 100* 101 104* 105 132* 140* 141 143* 144 145* 147* 160* 164* 168 en 000010 internal static char(32) dcl 13 set ref 56* 57* 59* 92* 93* 95* 132* 143 143 145* 147* 149* 159* 160* error_table_$wrong_no_of_args 000116 external static fixed bin(17,0) dcl 25 ref 67 expand_path_ 000102 constant entry external dcl 25 ref 143 freep 1 based fixed bin(17,0) level 2 dcl 41 set ref 108 109* 122 124 125* get_wdir_ 000100 constant entry external dcl 25 ref 55 91 158 hcs_$initiate 000120 constant entry external dcl 25 ref 57 93 145 160 hcs_$make_seg 000122 constant entry external dcl 25 ref 147 i 000115 automatic fixed bin(17,0) dcl 13 set ref 64* 66 73* 74 74 74* 80 80 81* 106* 107 108 109 110* 116* 117 117 117* 122* 124* 125 127 128 129 130 165* 166 167 168 169 169 169 169 169* ioa_ 000124 constant entry external dcl 25 ref 149 169 172 laste based fixed bin(17,0) level 2 dcl 41 set ref 73 106 116 122 122* 165 lth 30 based fixed bin(17,0) array level 3 dcl 41 set ref 80 130* 169 169 min builtin function dcl 23 ref 130 name 10 based char(32) array level 3 dcl 41 set ref 74 74 107 110* 117 117 127* 166 168 169* null builtin function dcl 23 ref 53 58 90 94 146 148 157 161 segptr 000072 internal static pointer initial dcl 13 set ref 53 57* 58 73 74 74 74 80 80 90 93* 94 106 107 108 108 109 110 116 117 117 117 122 122 122 124 125 125 127 128 129 130 145* 146 147* 148 157 160* 161 165 166 167 168 169 169 169 169 169 string 000116 automatic char(168) dcl 13 set ref 102* 107 117 127 142* 143 143 substr builtin function dcl 23 ref 80 169 169 valu 20 based char(32) array level 3 dcl 41 set ref 80 128* 169 169 valueseg based structure level 1 dcl 41 NAMES DECLARED BY EXPLICIT CONTEXT. aer 000136 constant label dcl 59 ref 65 68 71 82 dump 001163 constant entry external dcl 155 er 000442 constant label dcl 95 ref 101 141 144 148 161 f1 000661 constant label dcl 128 ref 119 found 000277 constant label dcl 80 ref 74 give 000314 constant label dcl 81 ref 78 nop 001371 constant label dcl 171 ref 166 168 set 000346 constant entry external dcl 88 set_seg 000735 constant entry external dcl 138 value 000043 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1602 1730 1405 1612 Length 2144 1405 126 200 174 64 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME value 182 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 en value 000020 dn value 000072 segptr value STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME value 000100 ap value 000102 al value 000103 answer value 000114 ec value 000115 i value 000116 string value THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ adjust_bit_count_ com_err_ cu_$af_arg_count cu_$af_arg_ptr cu_$af_return_arg cu_$arg_ptr expand_path_ get_wdir_ hcs_$initiate hcs_$make_seg ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000042 53 000050 55 000054 56 000062 57 000066 58 000131 59 000136 60 000172 64 000173 65 000203 66 000205 67 000210 68 000213 70 000214 71 000233 73 000235 74 000245 76 000267 77 000271 78 000276 80 000277 81 000314 82 000331 83 000333 84 000344 88 000345 90 000353 91 000360 92 000366 93 000372 94 000435 95 000442 96 000476 100 000477 101 000515 102 000517 104 000524 105 000543 106 000545 107 000555 108 000566 109 000572 110 000574 112 000600 113 000602 116 000603 117 000613 119 000633 121 000634 122 000636 124 000647 125 000650 127 000653 128 000661 129 000671 130 000672 132 000700 134 000733 138 000734 140 000742 141 000761 142 000763 143 000770 144 001015 145 001017 146 001063 147 001070 148 001126 149 001133 151 001161 155 001162 157 001170 158 001175 159 001203 160 001207 161 001252 164 001257 165 001275 166 001305 167 001316 168 001321 169 001331 170 001370 171 001371 172 001373 174 001404 ----------------------------------------------------------- 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