COMPILATION LISTING OF SEGMENT gcos_convert_sst Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/19/82 1014.3 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 /* ******************************************************************** 12* * * 13* * WRITTEN BY: P. Haber March 21, 1974 * 14* * MODIFIED BY: R.H. Morrison September 3, 1974 * 15* * * 16* ******************************************************************** */ 17 18 19 gcos_convert_sst: gcs: proc; 20 21 /* DECLARATIONS */ 22 /* ------------ */ 23 24 25 /* fixed bin */ 26 /* ----- --- */ 27 28 dcl ( 29 i, 30 j, 31 k 32 ) fixed bin aligned; 33 34 dcl ( 35 code, 36 error_table_$badopt ext 37 ) fixed bin (35) aligned; 38 39 40 /* pointers */ 41 /* -------- */ 42 43 dcl ( 44 rh_ptr, 45 sp 46 ) ptr aligned; 47 48 49 /* bit strings */ 50 /* --- ------- */ 51 52 53 dcl ( 54 end_of_tape init ("0"b), 55 gsr_write_init_was_called init ("0"b), 56 tape_is_attached (2) init ("0"b, "0"b) 57 ) bit (1) aligned; 58 59 dcl ( 60 rheader init ("0"b) 61 ) bit (12) aligned; 62 63 dcl ( 64 status_bits 65 ) bit (72) aligned; 66 67 68 /* character strings */ 69 /* --------- ------- */ 70 71 dcl ( 72 mode (2) init ("r", "w") 73 ) char (1) aligned; 74 75 dcl ( 76 tape_name (2) init ("input", "output") 77 ) char (8) aligned; 78 79 dcl ( 80 stream_name (2) init ("gcs_input", "gcs_output") 81 ) char (12) aligned; 82 83 dcl ( 84 tape_label (2) 85 ) char (32) aligned; 86 87 dcl buffer char (112) aligned; /* 28 words */ 88 89 90 /* built-in functions */ 91 /* -------- --------- */ 92 93 dcl ( 94 addr, 95 null, 96 substr 97 ) builtin; 98 99 100 /* masks */ 101 /* ----- */ 102 103 dcl 1 rheader_mask aligned based (rh_ptr), 104 2 pad bit (2) unaligned, 105 2 media_code bit (4) unaligned; 106 107 dcl 1 status aligned based (sp), 108 2 scode fixed bin (35) aligned; 109 110 111 /* conditions */ 112 /* ---------- */ 113 114 dcl ( 115 cleanup 116 ) condition; 117 118 119 /* external entries */ 120 /* -------- ------- */ 121 122 dcl com_err_ ext entry 123 options (variable); 124 125 dcl gcos_gsr_write_ ext entry 126 (char (*) aligned, ptr aligned, fixed bin aligned, bit (12) aligned, 127 bit (1) aligned, fixed bin (35) aligned); 128 129 dcl gcos_gsr_write_$gsr_write_close ext entry 130 (char (*) aligned, fixed bin (35) aligned); 131 132 dcl gcos_gsr_write_$gsr_write_init ext entry 133 (char (*) aligned, fixed bin (35) aligned); 134 135 dcl ioa_$nnl ext entry 136 options (variable); 137 138 dcl ios_$attach ext entry 139 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, 140 bit (72) aligned); 141 142 dcl ios_$detach ext entry 143 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 144 145 dcl ios_$order ext entry 146 (char (*) aligned, char (*) aligned, ptr aligned, bit (72) aligned); 147 148 dcl ios_$read ext entry 149 (char (*) aligned, ptr aligned, fixed bin aligned, fixed bin aligned, fixed bin aligned, 150 bit (72) aligned); 151 152 dcl ios_$read_ptr ext entry 153 (ptr, fixed bin aligned, fixed bin aligned); 154 155 dcl ios_$write ext entry 156 (char (*) aligned, ptr, fixed bin aligned, fixed bin aligned, fixed bin aligned, 157 bit (72) aligned); 158 159 /* */ 160 161 rh_ptr = addr (rheader); 162 sp = addr (status_bits); 163 on condition (cleanup) 164 go to RETURN; 165 166 do i = 1 to 2; 167 168 call ioa_$nnl ("Type ^a tape label: ", tape_name (i)); 169 call ios_$read_ptr (addr (buffer), 32, j); 170 tape_label (i) = substr (buffer, 1, j-1); 171 172 call ios_$attach (stream_name (i), "nstd_", tape_label (i), mode (i), status_bits); 173 if scode ^= 0 174 then do; 175 call com_err_ (scode, "gcos_convert_sst", "Error attaching ^a", tape_label (i)); 176 go to RETURN; 177 end; 178 tape_is_attached = "1"b; 179 180 end; 181 182 call gcos_gsr_write_$gsr_write_close (stream_name (2), code); 183 call gcos_gsr_write_$gsr_write_init (stream_name (2), code); 184 if code ^= 0 185 then do; 186 call com_err_ (code, "gcos_convert_sst", "Error in gsr_write_init call"); 187 go to RETURN; 188 end; 189 gsr_write_init_was_called = "1"b; 190 191 do i = 1 to 2; 192 193 call ios_$read (stream_name (1), addr (buffer), 0, 27, j, status_bits); 194 if substr (status_bits, 1, 3) ^= "100"b /* not eof */ 195 then if scode ^= 0 196 then do; 197 call com_err_ (scode, "gcos_convert_sst", "ios_$read call(^d)", i); 198 go to RETURN; 199 end; 200 201 if i = 1 202 then do; 203 call ios_$write (stream_name (2), addr (buffer), 0, j, k, status_bits); 204 if scode ^= 0 205 then do; 206 call com_err_ (scode, "gcos_convert_sst", "ios_$write call error"); 207 go to RETURN; 208 end; 209 end; 210 211 else 212 do; 213 call ios_$order (stream_name (2), "eof", null, status_bits); 214 if scode ^= 0 215 then do; 216 call com_err_ (scode, "gcos_convert_sst", "Error writing eof"); 217 go to RETURN; 218 end; 219 end; 220 221 end; 222 223 do while (^end_of_tape); 224 225 call ios_$read (stream_name (1), addr (buffer), 0, 27, j, status_bits); 226 if substr (status_bits, 1, 3) = "100"b 227 then end_of_tape = "1"b; 228 else 229 if scode ^= 0 230 then do; 231 call com_err_ (0, "gcos_convert_sst", "Error from ios_$read"); 232 go to RETURN; 233 end; 234 235 if j = 14 /* bcd image */ 236 then media_code = "0010"b; 237 else 238 if j = 27 /* binary image */ 239 then media_code = "0001"b; 240 else 241 if j ^= 0 242 then do; 243 call com_err_ (0, "gcos_convert_sst", "Unrecognized tape record on ^a", tape_label (1)); 244 go to RETURN; 245 end; 246 247 call gcos_gsr_write_ (stream_name (2), addr (buffer), j, rheader, end_of_tape, code); 248 if code ^= 0 249 then do; 250 call com_err_ (code, "gcos_convert_sst", "Error from gsr_write_"); 251 go to RETURN; 252 end; 253 254 end; 255 256 call ios_$order (stream_name (2), "eof", null, status_bits); 257 if scode ^= 0 258 then do; 259 call com_err_ (scode, "gcos_convert_sst", "Error writing eof"); 260 go to RETURN; 261 end; 262 263 call ios_$read (stream_name (1), addr (buffer), 0, 27, j, status_bits); 264 if scode ^= 0 265 then do; 266 call com_err_ (scode, "gcos_convert_sst", "Error reading after second eof"); 267 go to RETURN; 268 end; 269 270 call ios_$write (stream_name (2), addr (buffer), 0, j, k, status_bits); 271 if scode ^= 0 272 then call com_err_ (scode, "gcos_convert_sst", "Error writing trailer label"); 273 274 RETURN: 275 276 do i = 1 to 2; 277 278 if tape_is_attached (i) 279 then do; 280 call ios_$detach (stream_name (i), tape_label (i), "", status_bits); 281 if scode ^= 0 282 then call com_err_ (scode, "gcos_convert_sst", "Error detaching ^a", tape_label (i)); 283 tape_is_attached (i) = "0"b; 284 end; 285 286 end; 287 288 if gsr_write_init_was_called 289 then do; 290 call gcos_gsr_write_$gsr_write_close (stream_name (i), code); 291 if code ^= 0 292 then call com_err_ (code, "gcos_convert_sst", "error closing stream ""^a""", stream_name (2)); 293 end; 294 295 return; 296 297 end gcos_convert_sst; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/19/82 0933.9 gcos_convert_sst.pl1 >spec>on>11/19/82>gcos_convert_sst.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 93 ref 161 162 169 169 193 193 203 203 225 225 247 247 263 263 270 270 buffer 000154 automatic char(112) dcl 87 set ref 169 169 170 193 193 203 203 225 225 247 247 263 263 270 270 cleanup 000210 stack reference condition dcl 114 ref 163 code 000103 automatic fixed bin(35,0) dcl 34 set ref 182* 183* 184 186* 247* 248 250* 290* 291 291* com_err_ 000010 constant entry external dcl 122 ref 175 186 197 206 216 231 243 250 259 266 271 281 291 end_of_tape 000110 automatic bit(1) initial dcl 53 set ref 53* 223 226* 247* gcos_gsr_write_ 000012 constant entry external dcl 125 ref 247 gcos_gsr_write_$gsr_write_close 000014 constant entry external dcl 129 ref 182 290 gcos_gsr_write_$gsr_write_init 000016 constant entry external dcl 132 ref 183 gsr_write_init_was_called 000111 automatic bit(1) initial dcl 53 set ref 53* 189* 288 i 000100 automatic fixed bin(17,0) dcl 28 set ref 166* 168 170 172 172 172 175* 191* 197* 201* 274* 278 280 280 281 283* 290 ioa_$nnl 000020 constant entry external dcl 135 ref 168 ios_$attach 000022 constant entry external dcl 138 ref 172 ios_$detach 000024 constant entry external dcl 142 ref 280 ios_$order 000026 constant entry external dcl 145 ref 213 256 ios_$read 000030 constant entry external dcl 148 ref 193 225 263 ios_$read_ptr 000032 constant entry external dcl 152 ref 169 ios_$write 000034 constant entry external dcl 155 ref 203 270 j 000101 automatic fixed bin(17,0) dcl 28 set ref 169* 170 193* 203* 225* 235 237 240 247* 263* 270* k 000102 automatic fixed bin(17,0) dcl 28 set ref 203* 270* media_code 0(02) based bit(4) level 2 packed unaligned dcl 103 set ref 235* 237* mode 000120 automatic char(1) initial array dcl 71 set ref 71* 71* 172* null builtin function dcl 93 ref 213 213 256 256 rh_ptr 000104 automatic pointer dcl 43 set ref 161* 235 237 rheader 000114 automatic bit(12) initial dcl 59 set ref 59* 161 247* rheader_mask based structure level 1 dcl 103 scode based fixed bin(35,0) level 2 dcl 107 set ref 173 175* 194 197* 204 206* 214 216* 228 257 259* 264 266* 271 271* 281 281* sp 000106 automatic pointer dcl 43 set ref 162* 173 175 194 197 204 206 214 216 228 257 259 264 266 271 271 281 281 status based structure level 1 dcl 107 status_bits 000116 automatic bit(72) dcl 63 set ref 162 172* 193* 194 203* 213* 225* 226 256* 263* 270* 280* stream_name 000126 automatic char(12) initial array dcl 79 set ref 79* 79* 172* 182* 183* 193* 203* 213* 225* 247* 256* 263* 270* 280* 290* 291* substr builtin function dcl 93 ref 170 194 226 tape_is_attached 000112 automatic bit(1) initial array dcl 53 set ref 53* 53* 178* 278 283* tape_label 000134 automatic char(32) array dcl 83 set ref 170* 172* 175* 243* 280* 281* tape_name 000122 automatic char(8) initial array dcl 75 set ref 75* 75* 168* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_table_$badopt external static fixed bin(35,0) dcl 34 NAMES DECLARED BY EXPLICIT CONTEXT. RETURN 001636 constant label dcl 274 ref 163 176 187 198 207 217 232 244 251 260 267 gcos_convert_sst 000271 constant entry external dcl 19 gcs 000261 constant entry external dcl 19 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2166 2224 2024 2176 Length 2422 2024 36 162 142 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcs 216 external procedure is an external procedure. on unit on line 163 64 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcs 000100 i gcs 000101 j gcs 000102 k gcs 000103 code gcs 000104 rh_ptr gcs 000106 sp gcs 000110 end_of_tape gcs 000111 gsr_write_init_was_called gcs 000112 tape_is_attached gcs 000114 rheader gcs 000116 status_bits gcs 000120 mode gcs 000122 tape_name gcs 000126 stream_name gcs 000134 tape_label gcs 000154 buffer gcs THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ gcos_gsr_write_ gcos_gsr_write_$gsr_write_close gcos_gsr_write_$gsr_write_init ioa_$nnl ios_$attach ios_$detach ios_$order ios_$read ios_$read_ptr ios_$write NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 53 000175 59 000206 71 000207 75 000220 79 000237 19 000260 161 000277 162 000301 163 000303 166 000322 168 000327 169 000351 170 000370 172 000401 173 000440 175 000442 176 000503 178 000504 180 000515 182 000517 183 000534 184 000551 186 000553 187 000603 189 000604 191 000606 193 000613 194 000653 197 000661 198 000715 201 000716 203 000721 204 000757 206 000761 207 001011 209 001012 213 001013 214 001044 216 001046 217 001101 221 001102 223 001104 225 001107 226 001147 228 001156 231 001160 232 001211 235 001212 237 001222 240 001231 243 001233 244 001270 247 001271 248 001330 250 001332 251 001362 254 001363 256 001364 257 001415 259 001417 260 001452 263 001453 264 001513 266 001515 267 001545 270 001546 271 001604 274 001636 278 001643 280 001645 281 001676 283 001741 286 001743 288 001745 290 001747 291 001765 295 002023 ----------------------------------------------------------- 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