COMPILATION LISTING OF SEGMENT copy_out Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 02/07/84 1121.4 mst Tue 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 copy_out: cpo: proc; 12 13 /* Fixed to delete output seg if copy fails 02/08/80 S. Herbst */ 14 /* Fixed to copy non-connected segments properly, 09/19/80 W. Olin Sibert */ 15 16 dcl (bound, tc, i) fixed bin; 17 dcl bit_count fixed bin (24); 18 dcl code fixed bin (35); 19 dcl got_copy bit (1); 20 dcl (segptr, segptr0, tp) ptr; 21 dcl dirname char (168); 22 dcl (high_seg, hcsc) fixed bin; 23 dcl test_word fixed bin (35); 24 dcl tsdw fixed bin (71); 25 dcl ename char (32); 26 dcl targ char (tc) based (tp); 27 28 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 29 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 30 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 31 dcl get_wdir_ entry returns (char (168)); 32 dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 33 dcl hcs_$high_low_seg_count entry (fixed bin, fixed bin); 34 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 35 dcl hcs_$set_bc_seg entry (ptr, fixed bin(24), fixed bin(35)); 36 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 37 dcl phcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 38 dcl nd_handler_ entry (char (*), char (*), char (*), fixed bin (35)); 39 dcl pathname_ entry (char(*), char(*)) returns(char(168)); 40 dcl ring0_get_$name entry (char (*), char (*), ptr, fixed bin (35)); 41 dcl ring0_get_$segptr entry (char (*), char (*), ptr, fixed bin (35)); 42 dcl ring_zero_peek_ entry (ptr, ptr, fixed bin, fixed bin (35)); 43 dcl (com_err_, com_err_$suppress_name, ioa_) entry options (variable); 44 45 dcl (error_table_$action_not_performed, 46 error_table_$namedup, 47 error_table_$segknown) fixed bin (35) external static; 48 49 dcl myname char (32) int static options (constant) init ("copy_out"); 50 51 dcl (cleanup, linkage_error) condition; 52 53 dcl (null, addr, addrel, binary, baseno, baseptr, size) builtin; 54 55 /* */ 56 57 call cu_$arg_ptr (1, tp, tc, code); /* pick up name of segment to copy out */ 58 if code ^= 0 | tc = 0 then do; /* no arguments, give calling sequence */ 59 call com_err_$suppress_name (0, myname, "Usage: ^a name/number {alternate name}", myname); 60 return; 61 end; 62 63 segptr = null; 64 got_copy = "0"b; 65 66 i = cv_oct_check_ (targ, code); /* see if it's a number */ 67 if code ^= 0 then do; /* it isn't, must be name */ 68 call ring0_get_$segptr ("", targ, segptr0, code); /* get segptr for this name */ 69 if segptr0 = null then do; /* name not found */ 70 call expand_pathname_ (targ, dirname, ename, code); 71 if code ^= 0 then do; 72 call com_err_ (code, myname); 73 return; 74 end; 75 76 on condition (linkage_error) begin; 77 code = 0; 78 goto rzp_error; 79 end; 80 81 call phcs_$initiate (dirname, ename, "", 0, 0, segptr0, code); 82 83 revert condition (linkage_error); 84 85 if segptr0 = null then do; 86 call com_err_ (code, myname, "^a", pathname_ (dirname, ename)); 87 return; 88 end; 89 goto get_alternate_name; 90 end; 91 ename = targ; /* default name of seg to create */ 92 end; 93 94 else do; /* number was given */ 95 call hcs_$high_low_seg_count (high_seg, hcsc); 96 if i > high_seg + hcsc 97 then do; 98 call com_err_ (0, myname, "Segment ^o is greater than the highest segment number ^o.", i, high_seg+hcsc); 99 return; 100 end; 101 segptr0 = baseptr (i); /* create pointer to segment */ 102 call ring0_get_$name (dirname, ename, segptr0, code); /* get name for this segment */ 103 if code ^= 0 then do; /* no name for the segment */ 104 ename = targ; 105 goto get_alternate_name; 106 end; 107 call ioa_ ("Segment name is ^a", ename); /* tell user name of segment */ 108 end; 109 110 get_alternate_name: 111 call cu_$arg_ptr (2, tp, tc, code); /* see if optional segment name is given */ 112 if code ^= 0 | tc = 0 then do; 113 if dirname = ">" & ename = "" then ename = "root"; 114 dirname = get_wdir_ (); 115 end; 116 else do; /* if arg is given expand_path_ it, else use wdir */ 117 call expand_pathname_ (targ, dirname, ename, code); 118 if code ^= 0 then do; /* trouble with path name */ 119 cerr: call com_err_ (code, myname, targ); /* tell user */ 120 call clean_up; 121 return; 122 end; 123 end; 124 125 /* Test whether copying is possible, and also cause segment fault to get sdw.bound right */ 126 127 call ring_zero_peek_ (segptr0, addr (test_word), size (test_word), code); 128 if code ^= 0 then 129 goto rzp_error; 130 131 call ring_zero_peek_ (addr (baseptr (0) -> sdwa (binary (baseno (segptr0), 15))), 132 addr (tsdw), size (tsdw), code); 133 if code ^= 0 then 134 goto rzp_error; 135 136 bound = (binary (addr (tsdw) -> sdw.bound, 14) + 1) * 16; /* get number of words */ 137 bit_count = bound * 36; /* bit of segment */ 138 139 call ring_zero_peek_ (addrel (segptr0, bound - 1), addr (test_word), size (test_word), code); 140 if code ^= 0 then /* test whether whole segment is copyable -- in case we're */ 141 goto rzp_error; /* stuck with using metering_ring_zero_peek_ */ 142 143 on cleanup call clean_up; 144 145 CREATE: call hcs_$make_seg (dirname, ename, "", 01011b, segptr, code); /* get segment to copy data into */ 146 if code ^= 0 then 147 if code = error_table_$namedup then do; 148 call nd_handler_ ("copy_out", dirname, ename, code); 149 if code = error_table_$action_not_performed then 150 return; 151 goto CREATE; 152 end; 153 else if code ^= error_table_$segknown then go to cerr; 154 155 call ring_zero_peek_ (segptr0, segptr, bound, code); /* copy segment into user ring */ 156 if code ^= 0 then 157 goto rzp_error; 158 159 got_copy = "1"b; 160 161 call hcs_$set_bc_seg (segptr, bit_count, (0)); /* set bit count */ 162 call hcs_$terminate_noname (segptr, (0)); /* and terminate the segment */ 163 164 return; 165 166 rzp_error: 167 call com_err_ (code, myname, "This operation requires access to phcs_."); 168 call clean_up (); 169 return; 170 171 172 clean_up: proc (); 173 174 if segptr ^= null & ^got_copy then 175 call hcs_$delentry_file (dirname, ename, (0)); 176 177 end clean_up; 178 179 1 1 /* BEGIN INCLUDE FILE ... sdw.incl.pl1 ... last modified 12 May 1976 */ 1 2 1 3 dcl sdwp ptr; 1 4 1 5 dcl 1 sdw based (sdwp) aligned, /* Segment Descriptor Word */ 1 6 1 7 (2 add bit (24), /* main memory address of page table */ 1 8 2 (r1, r2, r3) bit (3), /* ring brackets for the segment */ 1 9 2 df bit (1), /* directed fault bit (0 => fault) */ 1 10 2 df_no bit (2), /* directed fault number */ 1 11 1 12 2 pad1 bit (1), 1 13 2 bound bit (14), /* boundary field (in 16 word blocks) */ 1 14 2 access, /* access bits */ 1 15 3 read bit (1), /* read permission bit */ 1 16 3 execute bit (1), /* execute permission bit */ 1 17 3 write bit (1), /* write permission bit */ 1 18 3 privileged bit (1), /* privileged bit */ 1 19 2 unpaged bit (1), /* segment is unpaged if this is 1 */ 1 20 2 entry_bound_sw bit (1), /* if this is 0 the entry bound is checked by hardware */ 1 21 2 cache bit (1), /* cache enable bit */ 1 22 2 entry_bound bit (14)) unaligned; /* entry bound */ 1 23 1 24 dcl 1 sdwa (0: 1) based (sdwp) aligned like sdw; /* SDW array (descriptor segment) */ 1 25 1 26 /* END INCLUDE FILE sdw.incl.pl1 */ 180 181 182 end copy_out; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/07/84 1121.4 copy_out.pl1 >spec>on>6666>copy_out.pl1 180 1 09/14/76 0759.8 sdw.incl.pl1 >ldd>include>sdw.incl.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. addr builtin function dcl 53 ref 127 127 131 131 131 131 136 139 139 addrel builtin function dcl 53 ref 139 139 baseno builtin function dcl 53 ref 131 131 baseptr builtin function dcl 53 ref 101 131 131 binary builtin function dcl 53 ref 131 131 136 bit_count 000103 automatic fixed bin(24,0) dcl 17 set ref 137* 161* bound 000100 automatic fixed bin(17,0) dcl 16 in procedure "cpo" set ref 136* 137 139 139 155* bound 1(01) based bit(14) level 2 in structure "sdw" packed unaligned dcl 1-5 in procedure "cpo" ref 136 cleanup 000204 stack reference condition dcl 51 ref 143 code 000104 automatic fixed bin(35,0) dcl 18 set ref 57* 58 66* 67 68* 70* 71 72* 77* 81* 86* 102* 103 110* 112 117* 118 119* 127* 128 131* 133 139* 140 145* 146 146 148* 149 153 155* 156 166* com_err_ 000046 constant entry external dcl 43 ref 72 86 98 119 166 com_err_$suppress_name 000050 constant entry external dcl 43 ref 59 cu_$arg_ptr 000010 constant entry external dcl 28 ref 57 110 cv_oct_check_ 000012 constant entry external dcl 29 ref 66 dirname 000114 automatic char(168) unaligned dcl 21 set ref 70* 81* 86* 86* 102* 113 114* 117* 145* 148* 174* ename 000174 automatic char(32) unaligned dcl 25 set ref 70* 81* 86* 86* 91* 102* 104* 107* 113 113* 117* 145* 148* 174* error_table_$action_not_performed 000054 external static fixed bin(35,0) dcl 45 ref 149 error_table_$namedup 000056 external static fixed bin(35,0) dcl 45 ref 146 error_table_$segknown 000060 external static fixed bin(35,0) dcl 45 ref 153 expand_pathname_ 000014 constant entry external dcl 30 ref 70 117 get_wdir_ 000016 constant entry external dcl 31 ref 114 got_copy 000105 automatic bit(1) unaligned dcl 19 set ref 64* 159* 174 hcs_$delentry_file 000020 constant entry external dcl 32 ref 174 hcs_$high_low_seg_count 000022 constant entry external dcl 33 ref 95 hcs_$make_seg 000024 constant entry external dcl 34 ref 145 hcs_$set_bc_seg 000026 constant entry external dcl 35 ref 161 hcs_$terminate_noname 000030 constant entry external dcl 36 ref 162 hcsc 000167 automatic fixed bin(17,0) dcl 22 set ref 95* 96 98 high_seg 000166 automatic fixed bin(17,0) dcl 22 set ref 95* 96 98 i 000102 automatic fixed bin(17,0) dcl 16 set ref 66* 96 98* 101 ioa_ 000052 constant entry external dcl 43 ref 107 linkage_error 000212 stack reference condition dcl 51 ref 76 83 myname 000000 constant char(32) initial unaligned dcl 49 set ref 59* 59* 72* 86* 98* 119* 166* nd_handler_ 000034 constant entry external dcl 38 ref 148 null builtin function dcl 53 ref 63 69 85 174 pathname_ 000036 constant entry external dcl 39 ref 86 86 phcs_$initiate 000032 constant entry external dcl 37 ref 81 ring0_get_$name 000040 constant entry external dcl 40 ref 102 ring0_get_$segptr 000042 constant entry external dcl 41 ref 68 ring_zero_peek_ 000044 constant entry external dcl 42 ref 127 131 139 155 sdw based structure level 1 dcl 1-5 sdwa based structure array level 1 dcl 1-24 set ref 131 131 segptr 000106 automatic pointer dcl 20 set ref 63* 145* 155* 161* 162* 174 segptr0 000110 automatic pointer dcl 20 set ref 68* 69 81* 85 101* 102* 127* 131 131 139 139 155* size builtin function dcl 53 ref 127 127 131 131 139 139 targ based char unaligned dcl 26 set ref 66* 68* 70* 91 104 117* 119* tc 000101 automatic fixed bin(17,0) dcl 16 set ref 57* 58 66 66 68 68 70 70 91 104 110* 112 117 117 119 119 test_word 000170 automatic fixed bin(35,0) dcl 23 set ref 127 127 127 127 139 139 139 139 tp 000112 automatic pointer dcl 20 set ref 57* 66 68 70 91 104 110* 117 119 tsdw 000172 automatic fixed bin(71,0) dcl 24 set ref 131 131 131 131 136 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. sdwp automatic pointer dcl 1-3 NAMES DECLARED BY EXPLICIT CONTEXT. CREATE 001146 constant label dcl 145 ref 151 cerr 000754 constant label dcl 119 ref 153 clean_up 001351 constant entry internal dcl 172 ref 120 143 168 copy_out 000126 constant entry external dcl 11 cpo 000117 constant entry external dcl 11 get_alternate_name 000655 constant label dcl 110 ref 89 105 rzp_error 001317 constant label dcl 166 ref 78 128 133 140 156 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1706 1770 1410 1716 Length 2212 1410 62 206 275 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cpo 252 external procedure is an external procedure. on unit on line 76 64 on unit on unit on line 143 64 on unit clean_up 80 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cpo 000100 bound cpo 000101 tc cpo 000102 i cpo 000103 bit_count cpo 000104 code cpo 000105 got_copy cpo 000106 segptr cpo 000110 segptr0 cpo 000112 tp cpo 000114 dirname cpo 000166 high_seg cpo 000167 hcsc cpo 000170 test_word cpo 000172 tsdw cpo 000174 ename cpo THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ com_err_$suppress_name cu_$arg_ptr cv_oct_check_ expand_pathname_ get_wdir_ hcs_$delentry_file hcs_$high_low_seg_count hcs_$make_seg hcs_$set_bc_seg hcs_$terminate_noname ioa_ nd_handler_ pathname_ phcs_$initiate ring0_get_$name ring0_get_$segptr ring_zero_peek_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$namedup error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000116 57 000133 58 000151 59 000155 60 000205 63 000206 64 000210 66 000211 67 000235 68 000237 69 000267 70 000273 71 000323 72 000325 73 000342 76 000343 77 000357 78 000361 81 000364 83 000427 85 000430 86 000434 87 000503 89 000504 91 000505 92 000512 95 000513 96 000524 98 000530 99 000570 101 000571 102 000575 103 000622 104 000624 105 000631 107 000632 110 000655 112 000674 113 000700 114 000713 115 000722 117 000723 118 000752 119 000754 120 001000 121 001004 127 001005 128 001026 131 001030 133 001062 136 001064 137 001072 139 001074 140 001122 143 001124 145 001146 146 001205 148 001212 149 001240 151 001244 153 001245 155 001247 156 001264 159 001266 161 001270 162 001304 164 001316 166 001317 168 001343 169 001347 172 001350 174 001356 177 001406 ----------------------------------------------------------- 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