COMPILATION LISTING OF SEGMENT coreload Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1627.7 mst Mon 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 coreload: proc; 12 13 /* coreload is a program to make an absolute object deck 14* produced by map355 into a coreimage file. 15* 16* Coded by R.B.Snyder many moons ago. 17* Re-written by Mike Grady 5/21/76 to make better. */ 18 19 /* Automatic storage */ 20 21 dcl (i, argl, code, reclen, loc, full_count) fixed bin; 22 dcl (argp, hdrp, wdp, segp, bufp) pointer; 23 24 dcl dir char (168); 25 dcl ename char (32); 26 dcl ascii_card char (80); 27 dcl (in_name, out_name) char (32); 28 dcl fname char (168); 29 dcl eofsw bit (1); 30 dcl rcrdhdr bit (12); 31 dcl st bit (72); 32 33 /* Based storage */ 34 35 dcl err fixed bin based (addr (st)); 36 37 dcl 1 card aligned based (bufp), 38 2 hdrw bit (36) unal, 39 2 cksum bit (36) unal, 40 2 words (44) bit (18) unal; 41 42 dcl 1 header unaligned based (hdrp), /* model of text header word */ 43 2 type bit (12) unaligned, 44 2 count bit (6) unaligned, 45 2 reladdr bit (18) unaligned; 46 47 dcl words (44) bit (18) unal based (wdp); 48 49 dcl 1 seg aligned based (segp), 50 2 count fixed bin, 51 2 core (0:32768) bit (18) unal; 52 53 dcl name char (argl) based (argp); 54 55 /* builtins */ 56 57 dcl null builtin; 58 59 /* External Entries */ 60 61 dcl gcos_gsr_read_ ext entry (char (*), pointer, fixed bin, bit (12), bit (1), fixed bin); 62 dcl gcos_gsr_read_$gsr_read_init ext entry (char (*), fixed bin); 63 dcl gcos_gsr_read_$gsr_read_close entry (char(*), fixed bin); 64 dcl ios_$attach ext entry (char (*), char (*), char (*), char (*), bit (72)); 65 dcl ios_$setsize ext entry (char (*), fixed bin, bit (72)); 66 dcl (ioa_, com_err_) ext entry options (variable); 67 dcl cu_$arg_count ext entry returns (fixed bin); 68 dcl cu_$arg_ptr ext entry (fixed bin, pointer, fixed bin, fixed bin); 69 dcl gcos_cv_gebcd_ascii_ ext entry (pointer, fixed bin, pointer, fixed bin); 70 dcl expand_path_ ext entry (pointer, fixed bin, pointer, pointer, fixed bin); 71 dcl ios_$detach ext entry (char (*), char (*), char (*), bit (72)); 72 dcl hcs_$make_seg ext entry (char (*) aligned, char (*), char (*), fixed bin (5), pointer, fixed bin); 73 dcl hcs_$set_bc_seg ext entry (ptr, fixed bin, fixed bin); 74 dcl get_wdir_ ext entry returns (char (168) aligned); 75 76 if cu_$arg_count () = 0 then do; /* tell user how to use command */ 77 call com_err_ (0, "coreload", "Usage: coreload {name - objdk from map355}"); 78 return; 79 end; 80 81 call cu_$arg_ptr (1, argp, argl, code); /* get input file name */ 82 call expand_path_ (argp, argl, addr (dir), addr (ename), code); /* get entry name */ 83 if code ^= 0 then go to error; 84 85 if index (ename, ".objdk") > 0 then do; 86 in_name = ename; 87 out_name = substr (ename, 1, index (ename, ".") -1); 88 end; 89 else do; 90 in_name = substr (ename, 1, index (ename, " ") -1) || ".objdk"; 91 out_name = ename; 92 end; 93 fname = substr (dir, 1, index (dir, " ") -1) || ">" || in_name; 94 95 call ios_$attach ("in", "file_", fname, "r", st); /* attach name "in" to file */ 96 if err ^= 0 then go to ios_err; 97 call ios_$setsize ("in", 36, st); /* set el size to 1 word */ 98 99 call hcs_$make_seg (get_wdir_ (), out_name, "", 01010b, segp, code); /* make new seg */ 100 if segp = null then go to error; 101 102 call gcos_gsr_read_$gsr_read_init ("in", code); /* init reading */ 103 if code ^= 0 then go to gc_error; 104 loop: call gcos_gsr_read_ ("in", bufp, reclen, rcrdhdr, eofsw, code); /* get a record */ 105 if code ^= 0 then go to gc_error; 106 if eofsw then go to finis; 107 108 if substr (rcrdhdr, 5, 2) = "10"b then do; /* hollerith card image */ 109 call gcos_cv_gebcd_ascii_ (bufp, reclen*6, addr (ascii_card), 0); /* convert to ascii */ 110 call ioa_ ("^a", ascii_card); /* let's see it */ 111 go to loop; 112 end; 113 114 if substr (rcrdhdr, 5, 2) ^= "01"b then do; /* non-binary card image */ 115 call com_err_ (0, "coreload", "illegal card type, not hollerith or binary"); 116 go to det; 117 end; 118 119 full_count = 0; 120 hdrp = addr (card.hdrw); 121 122 if header.type = "000000000101"b then go to finis; /* transfer card, end of deck */ 123 if header.type ^= "001000000101"b then do; 124 call com_err_ (0, "coreload", "Illegal card type. Not abs text."); 125 return; 126 end; 127 128 loc = fixed (header.reladdr); 129 wdp = addr (card.words); 130 131 do while (setup_block()); 132 do i = 1 to fixed (header.count); 133 seg.core (loc) = words (i); 134 loc = loc + 1; 135 end; 136 full_count = full_count + fixed (header.count); 137 end; 138 go to loop; 139 140 finis: seg.count = divide (loc + 1, 2, 17, 0); 141 call hcs_$set_bc_seg (segp, seg.count*36, code); 142 if code ^= 0 then go to error; 143 144 det: call gcos_gsr_read_$gsr_read_close("in", code); 145 call ios_$detach ("in", "", "", st); 146 return; 147 148 ios_err: call com_err_ (err, "coreload", "^a", in_name); 149 go to det; 150 151 error: call com_err_ (code, "coreload", "^a", name); 152 go to det; 153 154 gc_error: call com_err_ (code, "coreload", "From gcos_gsr_read_"); 155 go to det; 156 157 158 setup_block: proc returns (bit (1) aligned); 159 160 dcl nhdr fixed bin; 161 162 if full_count = 0 then return ("1"b); 163 if full_count > 42 then return ("0"b); 164 165 nhdr = fixed (header.count) + 1; 166 hdrp = addr (words (nhdr)); 167 168 if header.type ^= "001000000101"b then return ("0"b); 169 170 wdp = addr (words (nhdr + 2)); 171 full_count = full_count + 2; 172 loc = fixed (header.reladdr); 173 return ("1"b); 174 175 end; 176 177 end coreload; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1504.3 coreload.pl1 >dumps>old>recomp>coreload.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. argl 000101 automatic fixed bin(17,0) dcl 21 set ref 81* 82* 151 151 argp 000106 automatic pointer dcl 22 set ref 81* 82* 151 ascii_card 000202 automatic char(80) unaligned dcl 26 set ref 109 109 110* bufp 000116 automatic pointer dcl 22 set ref 104* 109* 120 129 card based structure level 1 dcl 37 code 000102 automatic fixed bin(17,0) dcl 21 set ref 81* 82* 83 99* 102* 103 104* 105 141* 142 144* 151* 154* com_err_ 000024 constant entry external dcl 66 ref 77 115 124 148 151 154 core 1 based bit(18) array level 2 packed unaligned dcl 49 set ref 133* count based fixed bin(17,0) level 2 in structure "seg" dcl 49 in procedure "coreload" set ref 140* 141 count 0(12) based bit(6) level 2 in structure "header" packed unaligned dcl 42 in procedure "coreload" ref 132 136 165 cu_$arg_count 000026 constant entry external dcl 67 ref 76 cu_$arg_ptr 000030 constant entry external dcl 68 ref 81 dir 000120 automatic char(168) unaligned dcl 24 set ref 82 82 93 93 ename 000172 automatic char(32) unaligned dcl 25 set ref 82 82 85 86 87 87 90 90 91 eofsw 000320 automatic bit(1) unaligned dcl 29 set ref 104* 106 err based fixed bin(17,0) dcl 35 set ref 96 148* expand_path_ 000034 constant entry external dcl 70 ref 82 fname 000246 automatic char(168) unaligned dcl 28 set ref 93* 95* full_count 000105 automatic fixed bin(17,0) dcl 21 set ref 119* 136* 136 162 163 171* 171 gcos_cv_gebcd_ascii_ 000032 constant entry external dcl 69 ref 109 gcos_gsr_read_ 000010 constant entry external dcl 61 ref 104 gcos_gsr_read_$gsr_read_close 000014 constant entry external dcl 63 ref 144 gcos_gsr_read_$gsr_read_init 000012 constant entry external dcl 62 ref 102 get_wdir_ 000044 constant entry external dcl 74 ref 99 99 hcs_$make_seg 000040 constant entry external dcl 72 ref 99 hcs_$set_bc_seg 000042 constant entry external dcl 73 ref 141 hdrp 000110 automatic pointer dcl 22 set ref 120* 122 123 128 132 136 165 166* 168 172 hdrw based bit(36) level 2 packed unaligned dcl 37 set ref 120 header based structure level 1 packed unaligned dcl 42 i 000100 automatic fixed bin(17,0) dcl 21 set ref 132* 133* in_name 000226 automatic char(32) unaligned dcl 27 set ref 86* 90* 93 148* ioa_ 000022 constant entry external dcl 66 ref 110 ios_$attach 000016 constant entry external dcl 64 ref 95 ios_$detach 000036 constant entry external dcl 71 ref 145 ios_$setsize 000020 constant entry external dcl 65 ref 97 loc 000104 automatic fixed bin(17,0) dcl 21 set ref 128* 133 134* 134 140 172* name based char unaligned dcl 53 set ref 151* nhdr 000334 automatic fixed bin(17,0) dcl 160 set ref 165* 166 170 null builtin function dcl 57 ref 100 out_name 000236 automatic char(32) unaligned dcl 27 set ref 87* 91* 99* rcrdhdr 000321 automatic bit(12) unaligned dcl 30 set ref 104* 108 114 reclen 000103 automatic fixed bin(17,0) dcl 21 set ref 104* 109 reladdr 0(18) based bit(18) level 2 packed unaligned dcl 42 ref 128 172 seg based structure level 1 dcl 49 segp 000114 automatic pointer dcl 22 set ref 99* 100 133 140 141* 141 st 000322 automatic bit(72) unaligned dcl 31 set ref 95* 96 97* 145* 148 type based bit(12) level 2 packed unaligned dcl 42 ref 122 123 168 wdp 000112 automatic pointer dcl 22 set ref 129* 133 166 170* 170 words based bit(18) array unaligned dcl 47 in procedure "coreload" set ref 133 166 170 words 2 based bit(18) array level 2 in structure "card" packed unaligned dcl 37 in procedure "coreload" set ref 129 NAMES DECLARED BY EXPLICIT CONTEXT. coreload 000100 constant entry external dcl 11 det 001026 constant label dcl 144 ref 116 149 152 155 error 001125 constant label dcl 151 ref 83 100 142 finis 001003 constant label dcl 140 ref 106 122 gc_error 001162 constant label dcl 154 ref 103 105 ios_err 001074 constant label dcl 148 set ref 96 loop 000507 constant label dcl 104 ref 111 138 setup_block 001214 constant entry internal dcl 158 ref 131 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 82 82 82 82 96 109 109 120 129 148 166 170 divide builtin function ref 140 fixed builtin function ref 128 132 136 165 172 index builtin function ref 85 87 90 93 substr builtin function ref 87 90 93 108 114 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1472 1540 1305 1502 Length 1730 1305 46 154 165 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME coreload 348 external procedure is an external procedure. setup_block internal procedure shares stack frame of external procedure coreload. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME coreload 000100 i coreload 000101 argl coreload 000102 code coreload 000103 reclen coreload 000104 loc coreload 000105 full_count coreload 000106 argp coreload 000110 hdrp coreload 000112 wdp coreload 000114 segp coreload 000116 bufp coreload 000120 dir coreload 000172 ename coreload 000202 ascii_card coreload 000226 in_name coreload 000236 out_name coreload 000246 fname coreload 000320 eofsw coreload 000321 rcrdhdr coreload 000322 st coreload 000334 nhdr setup_block THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr expand_path_ gcos_cv_gebcd_ascii_ gcos_gsr_read_ gcos_gsr_read_$gsr_read_close gcos_gsr_read_$gsr_read_init get_wdir_ hcs_$make_seg hcs_$set_bc_seg ioa_ ios_$attach ios_$detach ios_$setsize NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000077 76 000105 77 000115 78 000144 81 000145 82 000164 83 000207 85 000211 86 000220 87 000223 88 000235 90 000236 91 000262 93 000266 95 000323 96 000363 97 000367 99 000414 100 000462 102 000466 103 000505 104 000507 105 000545 106 000547 108 000552 109 000560 110 000603 111 000622 114 000623 115 000625 116 000654 119 000655 120 000656 122 000660 123 000664 124 000670 125 000717 128 000720 129 000726 131 000731 132 000736 133 000753 134 000766 135 000767 136 000771 137 001001 138 001002 140 001003 141 001007 142 001024 144 001026 145 001045 146 001073 148 001074 149 001124 151 001125 152 001161 154 001162 155 001213 158 001214 162 001216 163 001223 165 001227 166 001237 168 001245 170 001255 171 001261 172 001263 173 001272 ----------------------------------------------------------- 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