COMPILATION LISTING OF SEGMENT gcos_reformat_syslib Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/09/83 1101.0 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gcos_reformat_syslib: gcrs: ssyfix: proc; 7 8 /* This command reformats the softw-syslib file (the library used by GELOAD) 9* from the total system tape, so that it can be read by the simulator. 10* 11* As read from the total system tape, the file contains 321 word blocks. 12* The first appears to be a block control word, and the next 320 make up 13* a block that GELOAD interprets itself. If read from a 7 track MTS500, 14* the word count is rounded up to the next even number, 322, so a word 15* at the end must also be discarded. The number of words to be read is 16* therefore an optional argument, with the default being 321. The first 17* word is discarded, and the next 320 words are always retained. 18* 19* THe first word (the bcw) is checked for sequential bsn's, and block lengths 20* of 320 or less, to verify that the correct record length was used for 21* reading, and that the words being discarded are really bcw's. 22* 23* NOTE that this method of making the file readable by the simulator was 24* arrived at experimentally, and is not based on any knowledge of the format 25* of the subroutine library or the operation of GELOAD in real GCOS. If either 26* of those changes, this command may also have to be changed. 27* 28* USAGE: gcrs input_path -output_path- -record_length- 29* 30* If output_path is not given, the modifications will be made to the input file. 31* Since a temporary is not used, quitting and releasing while updating the 32* input file will leave it in an inconsistent state, from which recovery is 33* almost impossible. 34* 35* If record_length is not given the default is 321. Record_length is 36* distinguished from out_path by the fact that it must be numeric. 37* It may preceed or follow output_path, and output_path 38* need not be given when record_length is given. 39* 40* WRITTEN BY T.CASEY AUGUST 1973 41* MODIFIED BY T. CASEY AUGUST 1974 42* 43**/ 44 45 /* D E C L A R A T I O N S */ 46 47 dcl ioa_ ext entry options (variable); 48 dcl com_err_ ext entry options (variable); 49 dcl cv_dec_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin); 50 dcl ios_$attach ext entry 51 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 52 dcl ios_$detach ext entry 53 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 54 dcl ios_$read ext entry 55 (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); 56 dcl ios_$seek ext entry 57 (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, bit (72) aligned); 58 dcl ios_$setsize ext entry 59 (char (*) aligned, fixed bin, bit (72) aligned); 60 dcl ios_$write ext entry 61 (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); 62 dcl cu_$arg_count ext entry (fixed bin); 63 dcl cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)); 64 65 /* Work Variables */ 66 67 dcl nargs fixed bin; 68 dcl argp ptr; 69 dcl argl fixed bin; 70 dcl arg char (argl) based (argp); 71 dcl argno fixed bin; 72 73 dcl err_msg char (200) varying; 74 75 dcl err_path char (168) varying; 76 77 dcl eofbit bit (1) aligned; 78 dcl buffer char (1600) aligned; /* 400 words */ 79 dcl blkp ptr; 80 dcl 1 block aligned based (blkp), 81 2 bcw, 82 3 bsn bit (18) unaligned, 83 3 count bit (18) unaligned; 84 dcl old_bsn fixed bin init (0); /* bsns must begin with 1 */ 85 dcl new_bsn fixed bin; 86 dcl rec_len fixed bin init (321); 87 dcl (i, j, k) fixed bin; /* temporaries */ 88 dcl status bit (72) aligned init (""b); 89 dcl code fixed bin (35) aligned based (addr (status)); 90 dcl (inpath, outpath) char (168) aligned init (""); 91 dcl (instream, outstream) char (32) aligned init (""); 92 dcl me char (20) int static aligned init ("gcos_reformat_syslib"); 93 dcl rw char (1) aligned; 94 95 dcl (addr, fixed, substr) builtin; 96 97 dcl cleanup condition; 98 99 /* P R O C E D U R E */ 100 101 blkp = addr (buffer); 102 on condition (cleanup) call cleanup_proc; 103 104 call cu_$arg_count (nargs); 105 106 /* IF WRONG NUMBER OF ARGS, PRINT USAGE MESSAGE AND QUIT */ 107 108 if nargs = 0 | nargs > 3 then do; 109 err_msg = "USAGE: gcrs input_path -output_path-"; 110 goto call_com_err; 111 end; 112 113 arg_loop: do argno = 1 to nargs; 114 115 call cu_$arg_ptr (argno, argp, argl, code); 116 117 if code ^= 0 then do; 118 err_msg = arg; 119 call_com_err: call com_err_ (code, me, err_msg, err_path); 120 call cleanup_proc; 121 return; 122 end; 123 124 err_path = arg; 125 126 if argno = 1 then do; /* default is to update input file */ 127 inpath, outpath = arg; 128 instream, outstream = "gcrs_i/o"; 129 rw = " "; /* equivalent to "rw" for ios_$attach */ 130 end; 131 132 else do; /* see if output_path or record len */ 133 i = cv_dec_check_ (arg, code); 134 if code ^= 0 then do; /* non numeric */ 135 code = 0; /* clear it - its not an error_table_ code */ 136 if outpath ^= inpath then do; /* outpath already given */ 137 err_msg = "Unknown argument: ^a"; 138 goto call_com_err; 139 end; /* end outpath given */ 140 else do; /* outpath not given - assume this is it */ 141 outpath = arg; 142 outstream = "gcrs_output"; 143 instream = "gcrs_input"; 144 rw = "r"; /* attach input file for read only */ 145 end; /* end assume outpath */ 146 end; /* end non numeric */ 147 else rec_len = i; /* numeric - assume rec_len */ 148 end; /* end not firt arg */ 149 150 end arg_loop; 151 152 /* Initialize and attach files */ 153 154 err_path = inpath; /* in case of error */ 155 call ios_$attach (instream, "file_", inpath, rw, status); 156 if code ^= 0 then do; 157 attach_error: err_msg = "from ios_$attach ^a"; 158 goto call_com_err; 159 end; 160 call ios_$setsize (instream, 36, status); 161 if code ^= 0 then do; 162 setsize_error: err_msg = "from ios_$setsize 36 ^a"; 163 goto call_com_err; 164 end; 165 166 err_path = outpath; /* more possibilities of output errors now */ 167 168 if outstream ^= instream then do; /* if separate output file */ 169 call ios_$attach (outstream, "file_", outpath, "", status); 170 if code ^= 0 then goto attach_error; 171 call ios_$setsize (outstream, 36, status); 172 if code ^= 0 then goto setsize_error; 173 end; 174 175 /* whether or not input and output are the same, 176* seek the output write pointer to the beginning of the file */ 177 call ios_$seek (outstream, "write", "first", 0, status); 178 if code ^= 0 then do; 179 err_msg = "from ios_$seek write first ^a"; 180 goto call_com_err; 181 end; 182 183 /* Main loop */ 184 185 read: call ios_$read (instream, blkp, 0, rec_len, i, status); 186 eofbit = substr (status, 46, 1); /* remember end of file indicator */ 187 if code ^= 0 then do; 188 err_msg = "from ios_$read ^a"; 189 input_error: err_path = inpath; 190 goto call_com_err; 191 end; 192 193 new_bsn = fixed (bsn); 194 if new_bsn ^= old_bsn + 1 then 195 call ioa_ ("^a: block serial number error: previous bsn = ^d, current bsn = ^d.Processing continues", 196 me, old_bsn, new_bsn); 197 old_bsn = new_bsn; 198 199 k = fixed (bcw.count); 200 if k > 320 then 201 call ioa_ ("^a: bad bcw count: ^d in block ^d. Processing continues.", me, k, new_bsn); 202 203 if i = rec_len then 204 i = 320; /* throw away the rcw */ 205 else call ioa_ ("^a: short block read: ^d words in block ^d. Processing continues.", me, i, new_bsn); 206 207 call ios_$write (outstream, blkp, 1, i, j, status); /* the offset of 1 is what gets rid of the rcw */ 208 if code ^= 0 then do; 209 err_msg = "from ios_$write ^a"; 210 goto call_com_err; 211 end; 212 if i ^= j then do; 213 err_msg = "wrong number of words written to ^a"; 214 goto call_com_err; 215 end; 216 217 if ^eofbit then goto read; /* go read next record if there is one */ 218 219 else do; /* end of file */ 220 call ioa_ ("^a: Normal end of file on ^a", me, inpath); 221 222 if instream = outstream then do; /* if updating input file */ 223 call ios_$seek (instream, "last", "write", 0, status); /* get rid of garbage at end */ 224 if code ^= 0 then do; 225 err_msg = "from ios_$seek last write ^a"; 226 goto call_com_err; 227 end; 228 end; 229 230 call ios_$detach (instream, "", "", status); 231 if code ^= 0 then do; 232 err_msg = "from ios_$detach ^a"; 233 goto input_error; 234 end; 235 236 if instream ^= outstream then do; /* if separate output file, detach it too */ 237 call ios_$detach (outstream, "", "", status); 238 if code ^= 0 then do; 239 err_msg = "from ios_$detach ^a"; 240 goto call_com_err; 241 end; 242 end; 243 244 return; 245 246 end; /* end of end of file do group */ 247 248 249 cleanup_proc: proc; 250 251 call ios_$detach (instream, "", "", status); 252 call ios_$detach (outstream, "", "", status); 253 254 if code = 0 then /* if this is cleanup handler */ 255 if instream = outstream then 256 if instream ^= "" then 257 call ioa_ ("^a: WARNING: ^a may have been left in an inconsistent state", me, inpath); 258 259 return; 260 261 end cleanup_proc; 262 263 end gcos_reformat_syslib; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/09/83 1006.6 gcos_reformat_syslib.pl1 >spec>on>09/07/83-gcos>gcos_reformat_syslib.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 95 ref 101 115 117 119 133 134 135 156 161 170 172 178 187 208 224 231 238 254 arg based char unaligned dcl 70 set ref 118 124 127 133* 141 argl 000104 automatic fixed bin(17,0) dcl 69 set ref 115* 118 124 127 133 133 141 argno 000105 automatic fixed bin(17,0) dcl 71 set ref 113* 115* 126* argp 000102 automatic pointer dcl 68 set ref 115* 118 124 127 133 141 bcw based structure level 2 dcl 80 blkp 001066 automatic pointer dcl 79 set ref 101* 185* 193 199 207* block based structure level 1 dcl 80 bsn based bit(18) level 3 packed unaligned dcl 80 ref 193 buffer 000245 automatic char(1600) dcl 78 set ref 101 cleanup 001246 stack reference condition dcl 97 ref 102 code based fixed bin(35,0) dcl 89 set ref 115* 117 119* 133* 134 135* 156 161 170 172 178 187 208 224 231 238 254 com_err_ 000020 constant entry external dcl 48 ref 119 count 0(18) based bit(18) level 3 packed unaligned dcl 80 ref 199 cu_$arg_count 000040 constant entry external dcl 62 ref 104 cu_$arg_ptr 000042 constant entry external dcl 63 ref 115 cv_dec_check_ 000022 constant entry external dcl 49 ref 133 eofbit 000244 automatic bit(1) dcl 77 set ref 186* 217 err_msg 000106 automatic varying char(200) dcl 73 set ref 109* 118* 119* 137* 157* 162* 179* 188* 209* 213* 225* 232* 239* err_path 000171 automatic varying char(168) dcl 75 set ref 119* 124* 154* 166* 189* fixed builtin function dcl 95 ref 193 199 i 001073 automatic fixed bin(17,0) dcl 87 set ref 133* 147 185* 203 203* 205* 207* 212 inpath 001100 automatic char(168) initial dcl 90 set ref 90* 127* 136 154 155* 189 220* 254* instream 001224 automatic char(32) initial dcl 91 set ref 91* 128* 143* 155* 160* 168 185* 222 223* 230* 236 251* 254 254 ioa_ 000016 constant entry external dcl 47 ref 194 200 205 220 254 ios_$attach 000024 constant entry external dcl 50 ref 155 169 ios_$detach 000026 constant entry external dcl 52 ref 230 237 251 252 ios_$read 000030 constant entry external dcl 54 ref 185 ios_$seek 000032 constant entry external dcl 56 ref 177 223 ios_$setsize 000034 constant entry external dcl 58 ref 160 171 ios_$write 000036 constant entry external dcl 60 ref 207 j 001074 automatic fixed bin(17,0) dcl 87 set ref 207* 212 k 001075 automatic fixed bin(17,0) dcl 87 set ref 199* 200 200* me 000010 internal static char(20) initial dcl 92 set ref 119* 194* 200* 205* 220* 254* nargs 000100 automatic fixed bin(17,0) dcl 67 set ref 104* 108 108 113 new_bsn 001071 automatic fixed bin(17,0) dcl 85 set ref 193* 194 194* 197 200* 205* old_bsn 001070 automatic fixed bin(17,0) initial dcl 84 set ref 84* 194 194* 197* outpath 001152 automatic char(168) initial dcl 90 set ref 90* 127* 136 141* 166 169* outstream 001234 automatic char(32) initial dcl 91 set ref 91* 128* 142* 168 169* 171* 177* 207* 222 236 237* 252* 254 rec_len 001072 automatic fixed bin(17,0) initial dcl 86 set ref 86* 147* 185* 203 rw 001244 automatic char(1) dcl 93 set ref 129* 144* 155* status 001076 automatic bit(72) initial dcl 88 set ref 88* 115 117 119 133 134 135 155* 156 160* 161 169* 170 171* 172 177* 178 185* 186 187 207* 208 223* 224 230* 231 237* 238 251* 252* 254 substr builtin function dcl 95 ref 186 NAMES DECLARED BY EXPLICIT CONTEXT. arg_loop 000401 constant label dcl 113 attach_error 000663 constant label dcl 157 ref 170 call_com_err 000441 constant label dcl 119 ref 110 138 158 163 180 190 210 214 226 240 cleanup_proc 001546 constant entry internal dcl 249 ref 102 120 gcos_reformat_syslib 000326 constant entry external dcl 6 gcrs 000316 constant entry external dcl 6 input_error 001133 constant label dcl 189 ref 233 read 001064 constant label dcl 185 ref 217 setsize_error 000716 constant label dcl 162 ref 172 ssyfix 000306 constant entry external dcl 6 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2040 2104 1664 2050 Length 2310 1664 44 167 154 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ssyfix 772 external procedure is an external procedure. on unit on line 102 64 on unit cleanup_proc 98 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 me ssyfix STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ssyfix 000100 nargs ssyfix 000102 argp ssyfix 000104 argl ssyfix 000105 argno ssyfix 000106 err_msg ssyfix 000171 err_path ssyfix 000244 eofbit ssyfix 000245 buffer ssyfix 001066 blkp ssyfix 001070 old_bsn ssyfix 001071 new_bsn ssyfix 001072 rec_len ssyfix 001073 i ssyfix 001074 j ssyfix 001075 k ssyfix 001076 status ssyfix 001100 inpath ssyfix 001152 outpath ssyfix 001224 instream ssyfix 001234 outstream ssyfix 001244 rw ssyfix THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr cv_dec_check_ ioa_ ios_$attach ios_$detach ios_$read ios_$seek ios_$setsize ios_$write NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 84 000262 86 000263 88 000265 90 000267 91 000275 6 000305 101 000334 102 000336 104 000360 108 000367 109 000373 110 000400 113 000401 115 000407 117 000424 118 000430 119 000441 120 000466 121 000472 124 000473 126 000504 127 000507 128 000522 129 000531 130 000533 133 000534 134 000560 135 000564 136 000565 137 000571 138 000576 141 000577 142 000604 143 000607 144 000612 146 000614 147 000615 150 000617 154 000621 155 000626 156 000661 157 000663 158 000670 160 000671 161 000714 162 000716 163 000723 166 000724 168 000731 169 000735 170 000770 171 000772 172 001015 177 001017 178 001054 179 001056 180 001063 185 001064 186 001120 187 001124 188 001126 189 001133 190 001140 193 001141 194 001144 197 001177 199 001201 200 001204 203 001235 205 001243 207 001272 208 001327 209 001331 210 001336 212 001337 213 001342 214 001347 217 001350 220 001352 222 001376 223 001402 224 001440 225 001442 226 001447 230 001450 231 001474 232 001476 233 001503 236 001504 237 001510 238 001534 239 001536 240 001543 244 001544 249 001545 251 001553 252 001577 254 001624 259 001663 ----------------------------------------------------------- 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