COMPILATION LISTING OF SEGMENT tape_ansi_tape_io_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/24/86 1456.2 mst Wed 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 /****^ HISTORY COMMENTS: 14* 1) change(86-08-18,GWMay), approve(), audit(), install(): 15* old history comments: 16* Modified 9/79 by R.J.C. Kissel to handle 6250 bpi tapes 17* Modified 4/82 by J. A. Bush for block sizes > 8192 Bytes 18* 2) change(86-08-18,GWMay), approve(86-09-09,MCR7536), audit(86-09-17,Dupuis), 19* install(86-09-24,MR12.0-1162): 20* Changed to look up the wait switch for a given drive using the cseg.vl 21* entry. 22* END HISTORY COMMENTS */ 23 24 25 /* format: style3,ind3,dclind6,idind32 */ 26 tape_ansi_tape_io_: 27 proc; 28 1 1 /* BEGIN INCLUDE FILE: tape_ansi_cseg.incl.pl1 */ 1 2 /* */ 1 3 /* 1) Modified: 12/01/75 by Ross E. Klinger -- to allow */ 1 4 /* for allocation of the attach and open descriptions */ 1 5 /* within the cseg structure. */ 1 6 /* 2) Modified for resource management. */ 1 7 /* 3) Modified 9/79 by R.J.C. Kissel to handle the new tseg. */ 1 8 /* 4) Modified 4/82 by J.A. Bush for block sizes > 8192 bytes */ 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ 1 11 dcl cP ptr; /* pointer on which cseg structure is based */ 1 12 dcl cseg_tseg_version_2 fixed bin internal static options (constant) init (2); 1 13 1 14 dcl 1 cseg based (cP), /* control structure */ 1 15 2 file_set_lock bit (1) aligned, /* "1"b if file set in use */ 1 16 2 invalid bit (1) aligned, /* invalid cseg - delete at detach time bit */ 1 17 2 standard fixed bin, /* label standard */ 1 18 /* 1 - ANSI standard */ 1 19 /* 2 - IBM/OS-VS */ 1 20 /* 3 - IBM/DOS-VM */ 1 21 2 attach_description, /* iox_ attach description */ 1 22 3 length fixed bin (17), /* actual length of string */ 1 23 3 string char (256), /* maximum is 256 characters */ 1 24 2 open_description, /* iox_ open description */ 1 25 3 length fixed bin (17), /* actual length of string */ 1 26 3 string char (32), /* maximum is 32 */ 1 27 2 module char (12) varying, /* IO module name */ 1 28 2 ndrives fixed bin, /* maximum number of drives to be used */ 1 29 2 nactive fixed bin, /* number of drives actually in use */ 1 30 2 write_ring bit (1) aligned, /* volumes mounted with write rings */ 1 31 2 protect bit (1) aligned, /* volumes have rings, but are hardware protected */ 1 32 2 density fixed bin, /* file set recording density */ 1 33 /* 2 - 800 bpi NRZI */ 1 34 /* 3 - 1600 bpi PE */ 1 35 2 vcN fixed bin, /* number of links in volume chain */ 1 36 2 fcP ptr, /* file chain pointer */ 1 37 2 flP ptr, /* pointer to file link of current file */ 1 38 2 hdw_status, /* hardware status structure */ 1 39 3 bits bit (72) aligned, /* IOM status */ 1 40 3 no_minor fixed bin, /* number of minor status codes */ 1 41 3 major fixed bin (35), /* major status */ 1 42 3 minor (10) fixed bin (35), /* minor status */ 1 43 2 lbl_buf char (80), /* label I/O buffer */ 1 44 2 open_mode fixed bin, /* opening mode */ 1 45 /* 4 - sequential_input */ 1 46 /* 5 - sequential_output */ 1 47 2 close_rewind bit (1) aligned, /* rewind volume at next close */ 1 48 2 force bit (1) aligned, /* force file overwrite switch */ 1 49 2 user_labels bit (1) aligned, /* process user labels switch */ 1 50 2 no_labels bit (1) aligned, /* "1"b if volume has no labels */ 1 51 2 output_mode fixed bin, /* 0 - input */ 1 52 /* 1 - extend */ 1 53 /* 2 - modify */ 1 54 /* 3 - write */ 1 55 /* 4 - create */ 1 56 2 replace_id char (17), /* replace file identifier */ 1 57 2 retain fixed bin, /* 0 - default to rcp_ defaults */ 1 58 /* 1 - unassign drives and volumes */ 1 59 /* 2 - retain drives, unassign volumes */ 1 60 /* 3 - unassign drives, retain volumes */ 1 61 /* 4 - retain drives and volumes */ 1 62 2 lrec, /* logical record IO control data */ 1 63 3 bufP ptr, /* pointer to current processing buffer */ 1 64 3 nc_buf fixed bin, /* number of characters in buffer */ 1 65 3 offset fixed bin, /* current processing offset within buffer */ 1 66 3 saveP ptr, /* pointer to current D/V format RCW/RDW */ 1 67 3 file_lock bit (1) aligned, /* "1"b if file in use */ 1 68 3 blkcnt fixed bin (35), /* physical block count */ 1 69 3 reccnt fixed bin (35), /* logical record count (not presently used) */ 1 70 3 code fixed bin (35), /* lrec_io_ non-restartable error code */ 1 71 2 read_length, /* read_length control data */ 1 72 3 rlP ptr, /* pointer to read_length segment */ 1 73 3 rlN fixed bin (21), /* number of characters in segment */ 1 74 2 user_label_routine (6) variable entry (char (80), bit (1)), 1 75 /* 1 - read UHL */ 1 76 /* 2 - write UHL */ 1 77 /* 3 - read UTL */ 1 78 /* 4 - write UTL */ 1 79 /* 5 - read UVL */ 1 80 /* 6 - write UVL */ 1 81 /* THE FOLLOWING IS NEEDED ONLY WHILE TAPEIO_ / TDCM IS THE IO PROCEDURE */ 1 82 2 syncP ptr, /* pointer to synchronous IO buffer */ 1 83 2 mode fixed bin, /* 0 = binary -- 1 = 9 mode */ 1 84 2 soft_status, /* software status structure */ 1 85 3 nbuf fixed bin, /* number of suspended buffers */ 1 86 3 buf (2), 1 87 4 bufP ptr, /* pointer to buffer */ 1 88 4 count fixed bin, /* buffer character count */ 1 89 2 ( 1 90 free_list, 1 91 busy_list, 1 92 chain (3), 1 93 bufct (3) 1 94 ) fixed bin, /* buffer management variables */ 1 95 2 wait_switch (1:63) bit (1) unaligned, /* per-drive event wait switches */ 1 96 2 buf_size fixed bin, /* size of each tseg buffer in chars (bytes) */ 1 97 2 tseg aligned, 1 98 3 version_num fixed bin, 1 99 3 areap ptr, /* pointer to DSM area */ 1 100 3 ev_chan fixed bin (71), /* event channel number */ 1 101 3 write_sw fixed bin (1), /* 0 = read, 1 = write */ 1 102 3 sync fixed bin (1), /* non-zero for synchronous i/o */ 1 103 3 get_size fixed bin (1), /* ON for record sizes to be returned */ 1 104 3 ws_segno bit (18), /* rcp_ kluge */ 1 105 3 drive_name char (32), 1 106 3 tracks fixed bin, 1 107 3 density bit (36), 1 108 3 speed bit (36), /* bits are 75, 125, 200 ips respectively */ 1 109 3 pad99 bit (36), /* see tseg.incl.pl1 */ 1 110 3 buffer_offset fixed bin (12), /* offset of first buffer to be processed */ 1 111 3 buffer_count fixed bin (12), /* number of buffers to be processed */ 1 112 3 completion_status 1 113 fixed bin (2), /* 0 = no pending i/o or no status */ 1 114 /* 1 = normal termination of i/o */ 1 115 /* 2 = non-zero major status from previous i/o */ 1 116 3 hardware_status bit (36) aligned, /* major and sub-status */ 1 117 3 error_buffer fixed bin (12), /* buffer in which i/o error occurred */ 1 118 3 command_count fixed bin (12), /* number of non-data commands to execute */ 1 119 3 command_queue (10) fixed bin (6) aligned, /* non-data-transfer commands */ 1 120 3 bufferptr (12) fixed bin (18) aligned,/* relative ptrs to buffers */ 1 121 3 buffer_size (12) fixed bin (18) aligned,/* size of buffer */ 1 122 3 mode (12) fixed bin (2) aligned, /* 0 = bin, 1 = bcd, 2 = 9 track */ 1 123 3 buffer (4) char (cseg.buf_size) aligned, 1 124 /* data buffers */ 1 125 /* END OF TAPEIO_ / TDCM DATA */ 1 126 2 vl (63), /* volume chain link */ 1 127 3 position, /* volume position */ 1 128 4 fflX fixed bin unal, /* index of first file link on volume */ 1 129 4 cflX fixed bin unal, /* index of current file link */ 1 130 4 pos fixed bin unal, /* intra-file position code */ 1 131 /* 0 = in HDR group */ 1 132 /* 1 - in data / passed HDR TM */ 1 133 /* 2 = in EOx group / passed data TM */ 1 134 4 lflX fixed bin unal, /* index of last file link on volume */ 1 135 3 vol_data, 1 136 4 volname char (32), /* volume name */ 1 137 4 canonical_volname 1 138 char (6), /* volume name as appears on label */ 1 139 4 comment char (64) varying, /* mount comment */ 1 140 4 auth_code char (3) aligned, /* authentication code for this volume */ 1 141 4 rcp_id fixed bin (6), /* TDCM DUMMY - CHANGE TO BIT (36) ALIGNED */ 1 142 4 event_chan fixed bin (71), /* rcp_ attach event channel */ 1 143 4 tape_drive char (32), /* name of tape drive */ 1 144 4 ws_segno bit (18), /* segno of IOI workspace (per drive) */ 1 145 4 write_VOL1 fixed bin, /* 0 - correct VOL1 label */ 1 146 /* 1 - blank tape */ 1 147 /* 2 - can't read 1st block */ 1 148 /* 3 - 1st block not VOL1 label */ 1 149 /* 4 - valid VOL1 label but wrong volume ID (Obsolete) */ 1 150 /* 5 - correct VOL1 label, but wrong density */ 1 151 /* 6 - invalid file-set format (Obsolete) */ 1 152 /* -1 - correct VOL1 label of an earlier format */ 1 153 /* (no authentication code) */ 1 154 4 ioi_index fixed bin, /* ioi_ index for IO */ 1 155 3 reg_data, /* registration data */ 1 156 4 tracks fixed bin unal, /* number of tracks */ 1 157 4 density fixed bin unal, /* density code */ 1 158 4 label_type fixed bin unal, /* volume format */ 1 159 4 usage_count fixed bin unal, /* number of attachment to this volume */ 1 160 4 read_errors fixed bin unal, /* number of read errors */ 1 161 4 write_errors fixed bin unal, /* number of write errors */ 1 162 2 chain_area area; /* file chain allocation area */ 1 163 1 164 /* END INCLUDE FILE: tape_ansi_cseg.incl.pl1 */ 29 30 31 dcl (bP, CP) ptr, /* parameters */ 32 ccount fixed bin, /* character count argument */ 33 code fixed bin (35), /* returned error code */ 34 operation char (3); /* order code */ 35 36 dcl ( 37 error_table_$tape_error, /* error codes returned */ 38 error_table_$nine_mode_parity, 39 error_table_$blank_tape, 40 error_table_$eov_on_write, 41 error_table_$positioned_on_bot, 42 error_table_$eof_record, 43 error_table_$fatal_error, 44 tape_status_$ready_at_bot, /* error codes referenced */ 45 tape_status_$subsystem_ready, 46 tape_status_$device_data_alert, 47 tape_status_$end_of_tape, 48 tape_status_$end_of_file, 49 tape_status_$command_reject, 50 tape_status_$mpc_device_data_alert, 51 tape_status_$blank_tape_on_read, 52 tape_status_$reject_at_bot 53 ) fixed bin (35) ext; 54 55 dcl (addr, bin, divide, fixed, index, lbound, null, rel) 56 builtin; 57 58 59 dcl ecode fixed bin (35) init (0), 60 /* automatic storage */ 61 (synchro, loop_bit, reset_wait) bit (1), /* internal logic switches */ 62 (i, indx, errc) fixed bin; /* temporary storage */ 63 dcl drive_number fixed bin; /* Set by setup. */ 64 65 dcl ( 66 tmodes (0:1) fixed bin (2) initial (0, 2), 67 /* internal static variables */ 68 oplist (17) bit (6) aligned 69 initial ("47"b3, "46"b3, "54"b3, "45"b3, "44"b3, "00"b3, "40"b3, "70"b3, "72"b3, 70 "55"b3, "62"b3, "63"b3, "64"b3, "61"b3, "60"b3, "65"b3, "41"b3), 71 /* decimal orders */ 72 codechart char (52) initial ("bsf bsr ers fsf fsr rqs rss rew run eof pro per sdn") 73 ) internal static; 74 75 dcl 1 internal_codes based (addr (oplist)), 76 2 (bsf, bsr, ers, fsf, fsr, rqs, rss, rew, run, eof, pro, per, s200, s556, s800, s1600, s6250) 77 bit (6) aligned; 78 79 dcl tdcm_$tdcm_iocall ext entry (ptr, fixed bin (35)), 80 tdcm_$tdcm_set_signal ext entry (ptr, fixed bin (35)), 81 tdcm_$tdcm_reset_signal ext entry (ptr, fixed bin (35)), 82 tape_ansi_interpret_status_ ext entry (ptr), 83 ipc_$block ext entry (ptr, ptr, fixed bin (35)); 84 85 attach: 86 entry (CP); /* attach entry - initializes tseg */ 87 cP = CP; /* copy pointer to cseg */ 88 cseg.syncP = addr (tseg.buffer (4)); 89 tseg.mode (4) = 2; /* always 9 mode for synchronous (label) buffer */ 90 do i = 1 to 4; /* set tseg buffer pointers */ 91 tseg.bufferptr (i) = fixed (rel (addr (tseg.buffer (i)))); 92 end; 93 cseg.wait_switch (*) = "0"b; /* not waiting for any wakeups */ 94 return; 95 96 open: 97 entry (CP); /* open entry - initialize buffer management */ 98 cP = CP; 99 free_list = 1; /* initialize buffer indices */ 100 busy_list = 0; 101 chain (1) = 2; /* initialize free chain */ 102 chain (2) = 3; 103 chain (3) = 0; 104 soft_status.nbuf = 0; /* initialize software status */ 105 do i = 1 to 3; /* initialize IO buffer modes */ 106 tseg.mode (i) = tmodes (cseg.mode); 107 end; 108 return; 109 110 111 /* This entry can return one of two codes: */ 112 /* */ 113 /* 1) 0 - normal */ 114 /* 2) error_table_$fatal_error - processing cannot continue */ 115 /* Note that EOT on a write synchronize is suppressed. */ 116 117 synchronize: 118 close: 119 entry (CP, code); /* synchronize entry - synchronize read/write */ 120 call setup; 121 if code ^= 0 122 then return; 123 tseg.sync = 1; 124 if tseg.write_sw ^= 1 125 then 126 do; /* check for read synchronization */ 127 if busy_list ^= 0 128 then 129 do; /* if any buffers */ 130 tseg.command_count = 1; /* must backspace one record */ 131 tseg.buffer_count = 0; /* no buffers involved */ 132 tseg.command_queue (1) = bin (bsr); /* set backspace record code */ 133 retry: 134 call tdcm_$tdcm_iocall (addr (tseg), ecode); 135 /* do backspace */ 136 if ecode ^= 0 137 then 138 do; /* error calling tdcm */ 139 code = error_table_$fatal_error; 140 return; 141 end; 142 if tseg.completion_status ^= 1 143 then 144 do; /* something unusual happened */ 145 if tseg.command_count = 1 146 then go to retry; /* previous read erroneous - retry bsr */ 147 hdw_status.bits = tseg.hardware_status || (36)"0"b; 148 /* pad to 72 bits */ 149 call tape_ansi_interpret_status_ (addr (hdw_status)); 150 /* see what happened */ 151 if hdw_status.major ^= tape_status_$end_of_file 152 then 153 do; /* error if ^ EOF */ 154 code = error_table_$fatal_error; 155 /* set error code */ 156 return; /* exit */ 157 end; 158 end; 159 if free_list ^= 0 160 then chain (busy_list) = free_list; 161 free_list = busy_list; 162 busy_list = 0; 163 end; 164 return; 165 end; 166 167 if busy_list = 0 168 then return; /* write case */ 169 synchro = "1"b; 170 tseg.command_count, tseg.buffer_count = 0; /* set tseg */ 171 indx = busy_list; 172 errc = 10; 173 loop_bit = "0"b; 174 go to synch_write; /* join write code at iocall */ 175 176 177 /* This entry returns one of two error codes: */ 178 /* 1) 0 - normal */ 179 /* 2) error_table_$fatal_error */ 180 181 get_buffer: 182 entry (CP, bP, code); /* get_buffer entry - sets pointer to io_buffer */ 183 cP = CP; /* copy pointer */ 184 bP = null; /* null buffer pointer */ 185 code = 0; /* and zero rc */ 186 findfree: 187 if free_list ^= 0 188 then 189 do; /* if there is a free bufer hand it to him */ 190 indx = free_list; /* set index to free buffer */ 191 free_list = chain (indx); /* and take it off free chain */ 192 chain (indx) = 0; /* no successor */ 193 bP = addr (tseg.buffer (indx)); /* return address to buffer */ 194 return; 195 end; 196 if busy_list = 0 197 then 198 do; /* check for all buffers allocated */ 199 code = error_table_$fatal_error; 200 return; 201 end; 202 call synchronize (cP, code); /* synchrionize the tape */ 203 if code ^= 0 204 then return; /* give up if error */ 205 go to findfree; /* check for buffer again */ 206 207 208 /* This entry returns either 0 or error_table_$fatal_error */ 209 210 release_buffer: 211 entry (CP, bP, code); /* release_buffer entry - returns buffer to free pool */ 212 cP = CP; /* copy pointer */ 213 code = 0; 214 do indx = 1 to 3; /* search for buffer pointer match */ 215 if bP = addr (cseg.buffer (indx)) 216 then go to gotbuf; /* look for match */ 217 end; 218 code = error_table_$fatal_error; /* no match found, return error code */ 219 return; 220 gotbuf: 221 chain (indx) = free_list; /* put onto beginning of free list chain */ 222 free_list = indx; 223 bP = null; /* null out pointer */ 224 return; 225 226 227 /* This entry returns one of five error codes: */ 228 /* 1) 0 - normal */ 229 /* 2) error_table_$eof_record - read end of file mark */ 230 /* 3) error_table_$blank_tape - read blank tape, bad volume format */ 231 /* 4) error_table_$tape_error - parity-type tape error */ 232 /* 5) error_table_$fatal_error - cannot continue processing */ 233 /* Note that with tape_error, ccount and bP are valid */ 234 235 read: 236 entry (CP, bP, ccount, code); /* returns one block */ 237 bP = null; /* initialize in case of error */ 238 ccount = 0; /* ditto */ 239 call setup; /* initialize */ 240 if code ^= 0 241 then return; /* trouble with rewind wait */ 242 243 read_ahead: 244 if free_list = 0 245 then 246 do; /* check for free buffer */ 247 if busy_list ^= 0 248 then 249 do; /* check for busy buffer */ 250 errc = 25; /* can't read ahead. initialize error retry count */ 251 tseg.command_count, tseg.buffer_count = 0;/* clear (tdcm will just wait) */ 252 go to await_tape; /* call tdcm to wait or tape */ 253 end; /* end of code for locked buffer */ 254 code = error_table_$fatal_error; /* there are just no buffers left */ 255 return; /* so return to the buffer hog with an error */ 256 end; /* end of code for no free buffer */ 257 indx = free_list; /* set index into first free buffer */ 258 free_list = chain (indx); /* reset free list start */ 259 chain (indx) = 0; 260 if busy_list = 0 261 then busy_list = indx; 262 else chain (busy_list) = indx; 263 tseg.sync = 0; /* read asynchronously */ 264 errc = 25; /* initialize in case of error */ 265 266 restart_read: 267 tseg.buffer_offset = indx - 1; /* set tseg buffer pointer */ 268 tseg.buffer_count = 1; /* one buffer @ a time */ 269 tseg.command_count = 0; /* indicate reading */ 270 tseg.write_sw = 0; /* "" */ 271 tseg.buffer_size (indx) = divide (cseg.buf_size, 4, 18, 0); 272 273 await_tape: 274 call tdcm_$tdcm_iocall (addr (tseg), ecode); /* call tdcm to do io */ 275 if ecode ^= 0 276 then go to r_fatal; /* error in call is fatal */ 277 278 if tseg.completion_status = 0 279 then go to read_ahead; /* not complete - read another record while waiting */ 280 else bufct (busy_list) = tseg.buffer_size (busy_list);/* complete - set buffer size */ 281 282 hdw_status.bits = tseg.hardware_status || (36)"0"b; /* set hardware_status string */ 283 284 if tseg.completion_status = 1 285 then 286 do; /* read complete and valid */ 287 hdw_status.major = tape_status_$subsystem_ready;/* return minimal status information */ 288 hdw_status.no_minor = 0; /* to avoid expense of interpretation call */ 289 return_data: 290 bP = addr (cseg.buffer (busy_list)); /* return buffer pointer */ 291 ccount = bufct (busy_list) * 4; /* and buffer count */ 292 busy_list = chain (busy_list); /* unbusy buffer */ 293 return; 294 end; 295 296 call tape_ansi_interpret_status_ (addr (hdw_status)); /* ERROR or EVENT - see what happened */ 297 298 if hdw_status.major = tape_status_$end_of_file 299 then 300 do; /* EOF ? */ 301 code = error_table_$eof_record; 302 go to r_exit; 303 end; 304 305 i = chain (busy_list); /* error - free the last busied buffer */ 306 if i ^= 0 307 then 308 do; 309 chain (busy_list) = 0; 310 chain (i) = free_list; 311 free_list = i; 312 end; 313 indx = busy_list; 314 315 if hdw_status.minor (1) = tape_status_$blank_tape_on_read 316 then 317 do; /* give up */ 318 code = error_table_$blank_tape; 319 go to r_exit; 320 end; 321 322 if hdw_status.major = tape_status_$device_data_alert 323 then go to check_retry; /* may be recoverable */ 324 if hdw_status.major = tape_status_$mpc_device_data_alert 325 then 326 do; /* ditto */ 327 check_retry: 328 if errc = 0 329 then 330 do; /* retries exhausted? */ 331 if bufct (busy_list) = 0 332 then go to r_fatal; /* no data at all - not a parity-type error */ 333 code = error_table_$tape_error; /* data returned, albeit erroneously */ 334 go to return_data; 335 end; 336 else 337 do; /* retries not exhausted */ 338 errc = errc - 1; /* decrement retry count */ 339 tseg.command_queue (1) = bin (bsr); /* set backspace record order code */ 340 tseg.command_count = 1; /* one order code to execute */ 341 tseg.buffer_count = 0; /* no buffers to read */ 342 tseg.sync = 1; /* retries are synchronous */ 343 call tdcm_$tdcm_iocall (addr (tseg), ecode); 344 /* call tdcm to backspace tape */ 345 if ecode ^= 0 346 then go to bsr_error; 347 if tseg.completion_status ^= 1 348 then 349 do; 350 bsr_error: 351 code = error_table_$fatal_error; 352 go to r_exit; 353 end; 354 go to restart_read; /* restart the read operation */ 355 end; 356 end; 357 358 r_fatal: 359 code = error_table_$fatal_error; 360 361 r_exit: 362 if chain (busy_list) = 0 363 then i = busy_list; /* free the last busied buffer */ 364 else i = chain (busy_list); 365 chain (i) = free_list; 366 free_list = busy_list; 367 busy_list = 0; 368 return; 369 370 371 /* This entry can return one of five error codes: */ 372 /* 1) 0 - normal */ 373 /* 2) error_table_$eof_record - read end of file mark */ 374 /* 3) error_table_$blank_tape - read blank tape, bad vol format */ 375 /* 4) error_table_$tape_error - unrecoverable tape error */ 376 /* 5) error_table_$fatal_error - cannot continue processing */ 377 378 sync_read: 379 entry (CP, ccount, code); /* entry to read 1 block using syncP buffer */ 380 ccount = 0; /* initialize in case of error */ 381 call setup; /* initialize */ 382 if code ^= 0 383 then return; /* trouble with rewind */ 384 call synchronize (cP, code); /* synchronize IO */ 385 if code ^= 0 386 then return; 387 tseg.write_sw = 0; /* set write off, we're reading */ 388 i = 1; /* one order code for recovery */ 389 errc = 25; /* set read retry count */ 390 go to sync_com; /* join common erb code */ 391 392 393 /* This entry can return one of four error codes: */ 394 /* 1) 0 - normal */ 395 /* 2) error_table_$eov_on_write - EOT detected */ 396 /* 3) error_table_$tape_error - unrecoverable tape error */ 397 /* 4) error_table_$fatal_error - cannot continue processing */ 398 399 sync_write: 400 entry (CP, ccount, code); /* entry to write a block using syncP buffer */ 401 call setup; /* initialize */ 402 if code ^= 0 403 then return; /* trouble with rewind */ 404 call synchronize (cP, code); /* synchronize IO */ 405 if code ^= 0 406 then return; 407 tseg.write_sw = 1; /* set tseg write switch */ 408 i = 2; /* 2 order codes for recovery */ 409 errc = 10; /* set write retry count */ 410 tseg.command_queue (2) = bin (ers); /* set bin (ers) code */ 411 412 413 sync_com: 414 tseg.sync = 1; /* synchronous operation */ 415 tseg.command_queue (1) = bin (bsr); /* set backspace record recovery op */ 416 tseg.buffer_offset = 3; /* buffer 4 is the recovery buffer */ 417 418 sync_restart: 419 if i = 2 420 then tseg.buffer_size (4) = ccount / 4; /* set count for write */ 421 else tseg.buffer_size (4) = divide (cseg.buf_size, 4, 18, 0); 422 /* read: try to get maximum */ 423 tseg.command_count = 0; /* we are reading or writing */ 424 tseg.buffer_count = 1; /* .... */ 425 call tdcm_$tdcm_iocall (addr (tseg), ecode); /* do io */ 426 427 if ecode ^= 0 428 then 429 do; /* error from tdcm */ 430 sync_fatal: 431 code = error_table_$fatal_error; /* set return code */ 432 return; /* exit */ 433 end; 434 435 hdw_status.bits = tseg.hardware_status || (36)"0"b; /* get and pad hardware status */ 436 call tape_ansi_interpret_status_ (addr (hdw_status)); /* interpret it */ 437 438 if tseg.completion_status ^= 1 439 then 440 do; /* something untoward happened */ 441 if hdw_status.major = tape_status_$end_of_file 442 then 443 do; /* EOF detected */ 444 if i = 1 445 then 446 do; /* on a read */ 447 code = error_table_$eof_record; /* set return code */ 448 go to sync_return; 449 end; 450 else go to sync_error; /* just shouldn't happen when writing */ 451 end; 452 453 if hdw_status.major = tape_status_$subsystem_ready 454 then 455 do; /* but no major status */ 456 code = error_table_$nine_mode_parity; /* must be invalid 9 mode data */ 457 hdw_status.major = code; 458 hdw_status.no_minor = 0; 459 return; 460 end; 461 462 if hdw_status.no_minor = 1 463 then 464 do; /* simple cases */ 465 if hdw_status.minor (1) = tape_status_$end_of_tape 466 then 467 do; /* EOT detected */ 468 if i = 1 469 then go to sync_error; /* shouldn't happen on read */ 470 code = error_table_$eov_on_write; 471 return; 472 end; 473 if hdw_status.minor (1) = tape_status_$blank_tape_on_read 474 then 475 do; /* trouble */ 476 if i = 2 477 then go to sync_error; /* shouldn't happen on write */ 478 code = error_table_$blank_tape; 479 return; 480 end; 481 end; 482 483 if hdw_status.major = tape_status_$device_data_alert 484 then go to sync_repos; /* reposition */ 485 if hdw_status.major = tape_status_$mpc_device_data_alert 486 then 487 do; /* reposition */ 488 sync_repos: 489 tseg.command_count = i; /* set count */ 490 tseg.buffer_count = 0; /* and clear buffer count */ 491 errc = errc - 1; /* decrement retry count */ 492 call tdcm_$tdcm_iocall (addr (tseg), ecode); 493 /* have tdcm reposition */ 494 if ecode ^= 0 495 then go to sync_fatal; /* call to tdcm failed */ 496 if tseg.completion_status = 2 497 then 498 do; /* io failed */ 499 hdw_status.bits = tseg.hardware_status || (36)"0"b; 500 /* trouble - get status */ 501 call tape_ansi_interpret_status_ (addr (hdw_status)); 502 /* interpret it */ 503 if hdw_status.no_minor = 1 504 then 505 do; /* simple case ? */ 506 if hdw_status.minor (1) = tape_status_$end_of_tape 507 then go to sync_test; /* EOT ok */ 508 end; 509 go to sync_error; /* give up */ 510 end; 511 sync_test: 512 if errc >= 0 513 then go to sync_restart; /* retry if count not exhausted */ 514 end; /* end of recovery loop */ 515 516 sync_error: 517 code = error_table_$tape_error; /* indicate trouble with tape */ 518 return; /* exit */ 519 end; 520 521 sync_return: 522 if i = 1 523 then ccount = 4 * tseg.buffer_size (4); /* return count if read */ 524 return; /* and return to caller */ 525 526 527 /* This entry returns one of four error codes: */ 528 /* 1) 0 - normal */ 529 /* 2) error_table_$eov_on_write - EOT detected */ 530 /* 3) error_table_$tape_error - unrecoverable tape error */ 531 /* 4) error_table_$fatal_error - cannot continue processing */ 532 533 write: 534 entry (CP, bP, ccount, code); /* write entry - stacks one write */ 535 call setup; /* initizlize */ 536 if code ^= 0 537 then return; /* trouble with rewind */ 538 synchro = "0"b; /* set flag - this is not a synchronize operation */ 539 do indx = 1 to 3; /* find buffer index */ 540 if bP = addr (cseg.buffer (indx)) 541 then go to gotbuf1; 542 end; 543 go to w_fatal; /* invalid buffer */ 544 545 gotbuf1: 546 bufct (indx) = ccount / 4; /* set count */ 547 if busy_list = 0 548 then busy_list = indx; 549 else chain (busy_list) = indx; 550 chain (indx) = 0; 551 tseg.buffer_size (indx) = bufct (indx); /* set tseg buffer size */ 552 553 rstrtw: 554 if ^synchro 555 then tseg.sync = 0; /* write asynchronously if ^synchronize call */ 556 loop_bit = "0"b; /* restart (or start) afresh */ 557 errc = 10; /* initialize in case of error */ 558 559 rtryw: 560 tseg.write_sw = 1; 561 tseg.buffer_offset = indx - 1; /* set tseg buffer index */ 562 tseg.buffer_count = 1; /* one buffer to deal with */ 563 tseg.command_count = 0; /* no order codes */ 564 565 synch_write: 566 call tdcm_$tdcm_iocall (addr (tseg), ecode); /* call tseg to write buffer */ 567 568 if ecode ^= 0 569 then 570 do; /* call to tdcm failed */ 571 w_fatal: 572 code = error_table_$fatal_error; /* set error code */ 573 return; /* give up */ 574 end; 575 576 if tseg.completion_status = 1 577 then 578 do; /* check for write completed */ 579 indx = chain (busy_list); 580 chain (busy_list) = free_list; 581 free_list = busy_list; 582 busy_list = indx; 583 end; 584 585 else if tseg.completion_status = 0 586 then ; /* operation not complete */ 587 588 else 589 do; /* error or event occurred */ 590 hdw_status.bits = tseg.hardware_status || (36)"0"b; 591 /* get hardware status and pad */ 592 call tape_ansi_interpret_status_ (addr (hdw_status)); 593 /* interpret it */ 594 if hdw_status.no_minor = 1 595 then 596 do; /* simple case? */ 597 if hdw_status.minor (1) = tape_status_$end_of_tape 598 then 599 do; /* report it */ 600 code = error_table_$eov_on_write; /* set error code */ 601 indx = chain (busy_list); /* buffer _w_a_s written: get next in queue */ 602 chain (busy_list) = free_list; /* fill the queue slot */ 603 free_list = busy_list; /* the buffer written is now free */ 604 busy_list = indx; /* buffer pulled from queue is now busy */ 605 if busy_list = 0 606 then go to synch_check; /* queue was empty - exit */ 607 tseg.sync = 1; /* do this buffer synchronously */ 608 go to synch_write; /* write it */ 609 end; 610 end; 611 612 if hdw_status.major = tape_status_$subsystem_ready 613 then 614 do; /* but no major status */ 615 code = error_table_$nine_mode_parity; /* must be invalid 9 mode data */ 616 hdw_status.major = code; 617 hdw_status.no_minor = 0; 618 go to w_error1; 619 end; 620 621 if hdw_status.major = tape_status_$device_data_alert 622 then go to reposit; /* reposition */ 623 if hdw_status.major = tape_status_$mpc_device_data_alert 624 then 625 do; /* reposition */ 626 reposit: 627 tseg.sync = 1; /* retries synchronous */ 628 loop_bit = "1"b; /* indicate retrying */ 629 errc = errc - 1; /* decrement error retry count */ 630 tseg.command_queue (1) = bin (bsr); /* set backspace code */ 631 tseg.command_queue (2) = bin (ers); /* and erase code */ 632 tseg.command_count = 2; /* 2 commands to execute */ 633 indx = busy_list; /* retry first write */ 634 tseg.buffer_count = 0; /* reset buffer count */ 635 call tdcm_$tdcm_iocall (addr (tseg), ecode); 636 /* call tdcm to backspace and erase */ 637 if ecode ^= 0 638 then go to w_fatal; /* tdcm call failed - give up */ 639 if tseg.completion_status = 2 640 then 641 do; /* error occurred */ 642 hdw_status.bits = tseg.hardware_status || (36)"0"b; 643 /* trouble - get status */ 644 call tape_ansi_interpret_status_ (addr (hdw_status)); 645 /* interpret it */ 646 if hdw_status.no_minor = 1 647 then 648 do; /* simple case? */ 649 if hdw_status.minor (1) = tape_status_$end_of_tape 650 then go to w_test; /* EOT is reasonable */ 651 end; 652 go to w_error; /* anything else is error */ 653 end; 654 w_test: 655 if errc >= 0 656 then go to rtryw; /* retry write if error count not exhausted */ 657 end; 658 659 w_error: 660 code = error_table_$tape_error; 661 w_error1: 662 indx = busy_list; /* report _a_l_l queued buffers */ 663 664 w_report: 665 soft_status.nbuf = 0; /* set suspended count */ 666 do while (indx ^= 0); /* set up suspended buffer list */ 667 soft_status.nbuf = soft_status.nbuf + 1; 668 soft_status.bufP (nbuf) = addr (tseg.buffer (indx)); 669 soft_status.count (nbuf) = bufct (indx) * 4; /* set buffer count */ 670 indx = chain (indx); /* and go to next buffer */ 671 end; /* end of code for setting up list of suspended buffers */ 672 busy_list = 0; 673 go to synch_check; /* return to caller */ 674 end; 675 676 if loop_bit 677 then if busy_list ^= 0 678 then 679 do; /* see if more buffers (first in error) */ 680 indx = busy_list; /* index to suspended buffer */ 681 go to rstrtw; /* restart write */ 682 end; /* end of buffer error loop code */ 683 684 synch_check: 685 if ^synchro 686 then bP = null; /* write entry: null buffer pointer */ 687 else 688 do; /* synchronize/close entry */ 689 if code = error_table_$eov_on_write 690 then code = 0; /* ignore EOT */ 691 else if code = error_table_$tape_error 692 then code = error_table_$fatal_error; /* treat as fatal */ 693 end; 694 return; /* return to caller */ 695 696 697 /* The following codes may be returned: */ 698 /* 1) 0 - all orders */ 699 /* 2) error_table_$fatal_error - all orders */ 700 /* 3) error_table_$positioned_on_bot - bsf, bsr */ 701 /* 4) error_table_$eov_on_write - ers, eof */ 702 /* 5) error_table_$eof_record - fsr, bsr */ 703 /* 6) error_table_$tape_error - all orders */ 704 705 order: 706 entry (CP, operation, ccount, code); /* order entry - performs synchronous order calls */ 707 call setup; /* initialize */ 708 if code ^= 0 709 then return; /* trouble with rewind */ 710 711 call synchronize (cP, code); /* synchronize */ 712 if code ^= 0 713 then return; /* trouble with synch */ 714 errc = 10; /* set error retry count */ 715 tseg.sync = 1; /* synchronous for order codes */ 716 tseg.buffer_count = 0; /* indicate order code to tdcm */ 717 718 i = index (codechart, operation); /* pick up index for order code */ 719 if i = 0 720 then 721 do; /* illegal operation */ 722 code = error_table_$fatal_error; 723 return; 724 end; 725 else if i = 49 726 then i = 13 + ccount; /* set density index */ 727 else i = i / 4 + 1; 728 729 if i = 8 730 then 731 do; /* rewind */ 732 call tdcm_$tdcm_set_signal (addr (tseg), code); /* set signal */ 733 if code ^= 0 734 then go to er_fatal; /* troubles */ 735 cseg.wait_switch (drive_number) = "1"b; /* set switch for rewind wait */ 736 end; 737 738 rtryo: 739 tseg.command_queue (1) = bin (oplist (i)); /* set operation code */ 740 tseg.command_count = 1; /* only one order code */ 741 reset_wait = "0"b; /* tdcm signal not to be reset */ 742 743 call tdcm_$tdcm_iocall (addr (tseg), code); /* have tdcm do my thing */ 744 if code ^= 0 745 then 746 do; /* did tdcm call fail? */ 747 er_fatal: 748 reset_wait = "1"b; /* reset tdcm signal if set */ 749 code = error_table_$fatal_error; /* tdcm failure is fatal */ 750 go to wait_test; /* check tdcm signal */ 751 end; 752 753 hdw_status.bits = tseg.hardware_status || (36)"0"b; /* pad hardware status to 72 bits */ 754 call tape_ansi_interpret_status_ (addr (hdw_status)); /* generate error code structure from hdw status */ 755 756 if i = 6 757 then return; /* request status - exit because any result is ok */ 758 if i = 7 759 then return; /* reset status - ditto */ 760 761 if tseg.completion_status = 1 762 then 763 do; /* implies Subsystem Ready major status */ 764 if i = 4 765 then go to er_notry; /* forward file didn't get EOF: error */ 766 if i < 3 767 then 768 do; /* bsf, bsr - are they at BOT? */ 769 if check (tape_status_$ready_at_bot) 770 then 771 do; /* minor status shows tape at BOT */ 772 code = error_table_$positioned_on_bot; 773 /* not an error */ 774 return; 775 end; 776 else 777 do; /* not at BOT */ 778 if i = 1 779 then code = error_table_$fatal_error; 780 /* bad if bsf */ 781 return; 782 end; 783 end; 784 go to wait_test; /* ok: check tdcm signal */ 785 end; 786 787 if hdw_status.major = tape_status_$end_of_file 788 then 789 do; /* End of File major status */ 790 go to eof (i); /* perform appropriate action */ 791 eof (1): 792 eof (4): 793 return; /* bsf/fsf - normal */ 794 eof (2): 795 eof (5): 796 code = error_table_$eof_record; /* bsr/fsr - an event, not an error */ 797 return; /* exit */ 798 eof (3): 799 eof (10): /* ers/eof - error, no retry */ 800 eof (8): 801 eof (9): 802 eof (11): 803 go to er_notry; /* rew/run/sdn - error, give up */ 804 end; 805 806 if hdw_status.major = tape_status_$device_data_alert 807 then 808 do; /* Device Data Alert major status */ 809 if hdw_status.no_minor = 1 810 then 811 do; /* simple case ? */ 812 if hdw_status.minor (1) = tape_status_$end_of_tape 813 then 814 do; /* EOT? */ 815 code = error_table_$eov_on_write; 816 return; 817 end; 818 end; 819 if i = 3 820 then 821 do; /* multiple errors - erase case */ 822 tseg.command_queue (2) = bin (fsr); /* recovery will forward space after backspace */ 823 go to er_retry; /* retry with positioning */ 824 end; 825 if i = 10 826 then 827 do; /* write eof case */ 828 tseg.command_queue (2) = bin (ers); /* set recovery code to erase bad tape mark */ 829 go to er_retry; /* retry with positioning */ 830 end; 831 go to er_notry; /* give up */ 832 end; 833 834 if hdw_status.major = tape_status_$mpc_device_data_alert 835 then 836 do; /* MPC Device Data Alert major status */ 837 if i = 10 838 then 839 do; /* write eof case */ 840 tseg.command_queue (2) = bin (ers); /* erase the bad tape mark */ 841 go to er_retry; /* retry it */ 842 end; 843 go to er_notry; /* give up on any other order */ 844 end; 845 846 if hdw_status.major = tape_status_$command_reject 847 then 848 do; /* Command Reject major status */ 849 if i < 3 850 then 851 do; /* bsf or bsr cases */ 852 if check (tape_status_$reject_at_bot) 853 then 854 do; /* was tape at BOT? */ 855 code = error_table_$positioned_on_bot; 856 /* set return code */ 857 return; /* exit */ 858 end; 859 end; /* other bsf/bsr cases fall through */ 860 end; /* other orders fall through */ 861 862 863 /* Device Busy major status */ 864 /* MPC Device Attention major status */ 865 /* MPC Command Reject major status */ 866 /* Device Attention major status */ 867 868 er_notry: 869 reset_wait = "1"b; /* reset tdcm signal if set */ 870 code = error_table_$tape_error; 871 872 wait_test: 873 if cseg.wait_switch (drive_number) 874 then if reset_wait 875 then 876 do; /* rewind at bot or error */ 877 call tdcm_$tdcm_reset_signal (addr (tseg), 0); 878 cseg.wait_switch (drive_number) = "0"b; 879 end; 880 return; /* return to caller */ 881 882 er_retry: 883 if errc > 0 884 then 885 do; /* has retry count been exhausted? */ 886 tseg.command_queue (1) = bin (bsr); /* set tdcm to backspace 1 record */ 887 tseg.command_count = 2; /* error code has set tseg.command_queue (2) */ 888 call tdcm_$tdcm_iocall (addr (tseg), code); /* do io */ 889 if code ^= 0 890 then go to er_fatal; /* tdcm failed - give up */ 891 if tseg.completion_status = 1 892 then go to rtryo; /* io was uneventful - retry order */ 893 hdw_status.bits = tseg.hardware_status || (36)"0"b; 894 /* trouble - get status */ 895 call tape_ansi_interpret_status_ (addr (hdw_status)); 896 /* interpret it */ 897 if hdw_status.major = tape_status_$end_of_file 898 then go to rtryo; /* well, EOF is reasonable */ 899 if hdw_status.no_minor = 1 900 then 901 do; /* simple case? */ 902 if hdw_status.minor (1) = tape_status_$end_of_tape 903 then go to rtryo; /* so is EOT */ 904 end; 905 end; 906 go to er_notry; /* exhausted or non-reasonable */ 907 908 setup: 909 proc; /* internal proc for call initialization */ 910 911 dcl 1 wait_list, /* parameter lists for block */ 912 2 n fixed bin, 913 2 chn fixed bin (71); 914 915 dcl 1 message, 916 2 channel fixed bin (71), 917 2 mess fixed bin (71), 918 2 sender bit (36), 919 2 origin, 920 3 dev_sig bit (18) unal, 921 3 ring bit (18) unal, 922 2 channel_index fixed bin; 923 924 925 cP = CP; /* copy pointer */ 926 code = 0; /* zero out rc */ 927 928 do drive_number = lbound(cseg.vl, 1) to cseg.vcN 929 while (cseg.vl(drive_number).tape_drive ^= tseg.drive_name); 930 end; 931 932 if drive_number > cseg.vcN then do; 933 code = error_table_$fatal_error; 934 return; 935 end; 936 937 if cseg.wait_switch (drive_number) 938 then 939 do; /* see if tape rewinding */ 940 cseg.wait_switch (drive_number) = "0"b; /* clear switch */ 941 wait: 942 wait_list.n = 1; /* initialize arg for block */ 943 wait_list.chn = tseg.ev_chan; 944 call ipc_$block (addr (wait_list), addr (message), code); 945 /* go blocked waiting for tape rewind */ 946 if code ^= 0 947 then code = error_table_$fatal_error; 948 call tdcm_$tdcm_reset_signal (addr (tseg), 0); /* reset */ 949 end; /* end of code for rewind wait */ 950 return; /* return to main line */ 951 end; /* end of procedure setup */ 952 953 check: 954 procedure (min_code) returns (bit (1)); /* internal proc for status checking */ 955 956 dcl min_code fixed bin (35), /* minor status code to be checked */ 957 ix fixed bin; /* index into minor status code array */ 958 959 do ix = 1 to hdw_status.no_minor; /* check each element */ 960 if min_code = hdw_status.minor (ix) 961 then return ("1"b); /* got it */ 962 end; 963 return ("0"b); /* not there */ 964 965 end check; 966 967 end tape_ansi_tape_io_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/24/86 1453.1 tape_ansi_tape_io_.pl1 >spec>install>1162>tape_ansi_tape_io_.pl1 29 1 06/10/82 1045.3 tape_ansi_cseg.incl.pl1 >ldd>include>tape_ansi_cseg.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. CP parameter pointer dcl 31 ref 85 87 96 98 117 117 181 183 210 212 235 378 399 533 705 925 addr builtin function dcl 55 ref 88 91 132 133 133 149 149 193 215 273 273 289 296 296 339 343 343 410 415 425 425 436 436 492 492 501 501 540 565 565 592 592 630 631 635 635 644 644 668 732 732 743 743 754 754 822 828 840 877 877 886 888 888 895 895 944 944 944 944 948 948 bP parameter pointer dcl 31 set ref 181 184* 193* 210 215 223* 235 237* 289* 533 540 684* bin builtin function dcl 55 ref 132 339 410 415 630 631 738 822 828 840 886 bits 134 based bit(72) level 3 dcl 1-14 set ref 147* 282* 435* 499* 590* 642* 753* 893* bsr 1 based bit(6) level 2 dcl 75 ref 132 339 415 630 886 buf 266 based structure array level 3 unaligned dcl 1-14 bufP 266 based pointer array level 4 dcl 1-14 set ref 668* buf_size 310 based fixed bin(17,0) level 2 dcl 1-14 ref 88 88 88 91 91 91 193 193 193 215 215 215 271 289 289 289 421 540 540 540 668 668 668 928 928 bufct 303 based fixed bin(17,0) array level 2 dcl 1-14 set ref 280* 291 331 545* 551 669 buffer 424 based char array level 3 dcl 1-14 set ref 88 91 193 215 289 540 668 buffer_count 341 based fixed bin(12,0) level 3 dcl 1-14 set ref 131* 170* 251* 268* 341* 424* 490* 562* 634* 716* buffer_offset 340 based fixed bin(12,0) level 3 dcl 1-14 set ref 266* 416* 561* buffer_size 374 based fixed bin(18,0) array level 3 dcl 1-14 set ref 271* 280 418* 421* 521 551* bufferptr 360 based fixed bin(18,0) array level 3 dcl 1-14 set ref 91* busy_list 277 based fixed bin(17,0) level 2 dcl 1-14 set ref 100* 127 159 161 162* 167 171 196 247 260 260* 262 280 280 289 291 292* 292 305 309 313 331 361 361 364 366 367* 547 547* 549 579 580 581 582* 601 602 603 604* 605 633 661 672* 676 680 cP 000100 automatic pointer dcl 1-11 set ref 87* 88 88 88 88 88 89 91 91 91 91 91 93 98* 99 100 101 102 103 104 106 106 123 124 127 130 131 132 133 133 142 145 147 147 149 149 151 159 159 159 159 161 161 162 167 170 170 171 183* 186 190 191 191 192 193 193 193 193 196 202* 212* 215 215 215 215 220 220 222 243 247 251 251 257 258 258 259 260 260 262 262 263 266 268 269 270 271 271 273 273 278 280 280 280 280 282 282 284 287 288 289 289 289 289 289 291 291 292 292 292 296 296 298 305 305 309 309 310 310 311 313 315 322 324 331 331 339 340 341 342 343 343 347 361 361 361 364 364 365 365 366 366 367 384* 387 404* 407 410 413 415 416 418 421 421 423 424 425 425 435 435 436 436 438 441 453 457 458 462 465 473 483 485 488 490 492 492 496 499 499 501 501 503 506 521 540 540 540 540 545 547 547 549 549 550 551 551 553 559 561 562 563 565 565 576 579 579 580 580 580 581 581 582 585 590 590 592 592 594 597 601 601 602 602 602 603 603 604 605 607 612 616 617 621 623 626 630 631 632 633 634 635 635 639 642 642 644 644 646 649 661 664 667 667 668 668 668 668 668 668 669 669 669 670 672 676 680 711* 715 716 732 732 735 738 740 743 743 753 753 754 754 761 787 806 809 812 822 828 834 840 846 872 877 877 878 886 887 888 888 891 893 893 895 895 897 899 902 925* 928 928 928 928 928 928 932 937 940 943 948 948 959 960 ccount parameter fixed bin(17,0) dcl 31 set ref 235 238* 291* 378 380* 399 418 521* 533 545 705 725 chain 300 based fixed bin(17,0) array level 2 dcl 1-14 set ref 101* 102* 103* 159* 191 192* 220* 258 259* 262* 292 305 309* 310* 361 364 365* 549* 550* 579 580* 601 602* 670 chn 2 000126 automatic fixed bin(71,0) level 2 dcl 911 set ref 943* code parameter fixed bin(35,0) dcl 31 set ref 117 117 121 139* 154* 181 185* 199* 202* 203 210 213* 218* 235 240 254* 301* 318* 333* 350* 358* 378 382 384* 385 399 402 404* 405 430* 447* 456* 457 470* 478* 516* 533 536 571* 600* 615* 616 659* 689 689* 691 691* 705 708 711* 712 722* 732* 733 743* 744 749* 772* 778* 794* 815* 855* 870* 888* 889 926* 933* 944* 946 946* codechart 000013 constant char(52) initial unaligned dcl 65 ref 718 command_count 345 based fixed bin(12,0) level 3 dcl 1-14 set ref 130* 145 170* 251* 269* 340* 423* 488* 563* 632* 740* 887* command_queue 346 based fixed bin(6,0) array level 3 dcl 1-14 set ref 132* 339* 410* 415* 630* 631* 738* 822* 828* 840* 886* completion_status 342 based fixed bin(2,0) level 3 dcl 1-14 set ref 142 278 284 347 438 496 576 585 639 761 891 count 270 based fixed bin(17,0) array level 4 dcl 1-14 set ref 669* cseg based structure level 1 unaligned dcl 1-14 divide builtin function dcl 55 ref 271 421 drive_name 324 based char(32) level 3 dcl 1-14 set ref 928 drive_number 000111 automatic fixed bin(17,0) dcl 63 set ref 735 872 878 928* 928* 932 937 940 ecode 000102 automatic fixed bin(35,0) initial dcl 59 set ref 59* 133* 136 273* 275 343* 345 425* 427 492* 494 565* 568 635* 637 errc 000110 automatic fixed bin(17,0) dcl 59 set ref 172* 250* 264* 327 338* 338 389* 409* 491* 491 511 557* 629* 629 654 714* 882 error_table_$blank_tape 000036 external static fixed bin(35,0) dcl 36 ref 318 478 error_table_$eof_record 000044 external static fixed bin(35,0) dcl 36 ref 301 447 794 error_table_$eov_on_write 000040 external static fixed bin(35,0) dcl 36 ref 470 600 689 815 error_table_$fatal_error 000046 external static fixed bin(35,0) dcl 36 ref 139 154 199 218 254 350 358 430 571 691 722 749 778 933 946 error_table_$nine_mode_parity 000034 external static fixed bin(35,0) dcl 36 ref 456 615 error_table_$positioned_on_bot 000042 external static fixed bin(35,0) dcl 36 ref 772 855 error_table_$tape_error 000032 external static fixed bin(35,0) dcl 36 ref 333 516 659 691 870 ers 2 based bit(6) level 2 dcl 75 ref 410 631 828 840 ev_chan 316 based fixed bin(71,0) level 3 dcl 1-14 set ref 943 fixed builtin function dcl 55 ref 91 free_list 276 based fixed bin(17,0) level 2 dcl 1-14 set ref 99* 159 159 161* 186 190 191* 220 222* 243 257 258* 310 311* 365 366* 580 581* 602 603* fsr 4 based bit(6) level 2 dcl 75 ref 822 hardware_status 343 based bit(36) level 3 dcl 1-14 set ref 147 282 435 499 590 642 753 893 hdw_status 134 based structure level 2 unaligned dcl 1-14 set ref 149 149 296 296 436 436 501 501 592 592 644 644 754 754 895 895 i 000106 automatic fixed bin(17,0) dcl 59 set ref 90* 91 91* 105* 106* 305* 306 310 311 361* 364* 365 388* 408* 418 444 468 476 488 521 718* 719 725 725* 727* 727 729 738 756 758 764 766 778 790 819 825 837 849 index builtin function dcl 55 ref 718 indx 000107 automatic fixed bin(17,0) dcl 59 set ref 171* 190* 191 192 193 214* 215* 220 222 257* 258 259 260 262 266 271 313* 539* 540* 545 547 549 550 551 551 561 579* 582 601* 604 633* 661* 666 668 669 670* 670 680* internal_codes based structure level 1 unaligned dcl 75 ipc_$block 000102 constant entry external dcl 79 ref 944 ix 000150 automatic fixed bin(17,0) dcl 956 set ref 959* 960* lbound builtin function dcl 55 ref 928 loop_bit 000104 automatic bit(1) unaligned dcl 59 set ref 173* 556* 628* 676 major 137 based fixed bin(35,0) level 3 dcl 1-14 set ref 151 287* 298 322 324 441 453 457* 483 485 612 616* 621 623 787 806 834 846 897 message 000132 automatic structure level 1 unaligned dcl 915 set ref 944 944 min_code parameter fixed bin(35,0) dcl 956 ref 953 960 minor 140 based fixed bin(35,0) array level 3 dcl 1-14 set ref 315 465 473 506 597 649 812 902 960 mode 410 based fixed bin(2,0) array level 3 in structure "cseg" dcl 1-14 in procedure "tape_ansi_tape_io_" set ref 89* 106* mode 262 based fixed bin(17,0) level 2 in structure "cseg" dcl 1-14 in procedure "tape_ansi_tape_io_" ref 106 n 000126 automatic fixed bin(17,0) level 2 dcl 911 set ref 941* nbuf 264 based fixed bin(17,0) level 3 dcl 1-14 set ref 104* 664* 667* 667 668 669 no_minor 136 based fixed bin(17,0) level 3 dcl 1-14 set ref 288* 458* 462 503 594 617* 646 809 899 959 null builtin function dcl 55 ref 184 223 237 684 operation parameter char(3) unaligned dcl 31 ref 705 718 oplist 000010 internal static bit(6) initial array dcl 65 set ref 132 339 410 415 630 631 738 822 828 840 886 rel builtin function dcl 55 ref 91 reset_wait 000105 automatic bit(1) unaligned dcl 59 set ref 741* 747* 868* 872 soft_status 264 based structure level 2 unaligned dcl 1-14 sync 321 based fixed bin(1,0) level 3 dcl 1-14 set ref 123* 263* 342* 413* 553* 607* 626* 715* syncP 260 based pointer level 2 dcl 1-14 set ref 88* synchro 000103 automatic bit(1) unaligned dcl 59 set ref 169* 538* 553 684 tape_ansi_interpret_status_ 000100 constant entry external dcl 79 ref 149 296 436 501 592 644 754 895 tape_drive based char(32) array level 4 packed unaligned dcl 1-14 ref 928 tape_status_$blank_tape_on_read 000066 external static fixed bin(35,0) dcl 36 ref 315 473 tape_status_$command_reject 000062 external static fixed bin(35,0) dcl 36 ref 846 tape_status_$device_data_alert 000054 external static fixed bin(35,0) dcl 36 ref 322 483 621 806 tape_status_$end_of_file 000060 external static fixed bin(35,0) dcl 36 ref 151 298 441 787 897 tape_status_$end_of_tape 000056 external static fixed bin(35,0) dcl 36 ref 465 506 597 649 812 902 tape_status_$mpc_device_data_alert 000064 external static fixed bin(35,0) dcl 36 ref 324 485 623 834 tape_status_$ready_at_bot 000050 external static fixed bin(35,0) dcl 36 set ref 769* tape_status_$reject_at_bot 000070 external static fixed bin(35,0) dcl 36 set ref 852* tape_status_$subsystem_ready 000052 external static fixed bin(35,0) dcl 36 ref 287 453 612 tdcm_$tdcm_iocall 000072 constant entry external dcl 79 ref 133 273 343 425 492 565 635 743 888 tdcm_$tdcm_reset_signal 000076 constant entry external dcl 79 ref 877 948 tdcm_$tdcm_set_signal 000074 constant entry external dcl 79 ref 732 tmodes 000030 constant fixed bin(2,0) initial array dcl 65 ref 106 tseg 312 based structure level 2 dcl 1-14 set ref 133 133 273 273 343 343 425 425 492 492 565 565 635 635 732 732 743 743 877 877 888 888 948 948 vcN 126 based fixed bin(17,0) level 2 dcl 1-14 ref 928 932 vl based structure array level 2 unaligned dcl 1-14 ref 928 vol_data based structure array level 3 unaligned dcl 1-14 wait_list 000126 automatic structure level 1 unaligned dcl 911 set ref 944 944 wait_switch 306 based bit(1) array level 2 packed unaligned dcl 1-14 set ref 93* 735* 872 878* 937 940* write_sw 320 based fixed bin(1,0) level 3 dcl 1-14 set ref 124 270* 387* 407* 559* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cseg_tseg_version_2 internal static fixed bin(17,0) initial dcl 1-12 NAMES DECLARED BY EXPLICIT CONTEXT. attach 000061 constant entry external dcl 85 await_tape 000637 constant label dcl 273 ref 252 bsr_error 001032 constant label dcl 350 ref 345 check 002665 constant entry internal dcl 953 ref 769 852 check_retry 000770 constant label dcl 327 ref 322 close 000213 constant entry external dcl 117 eof 000000 constant label array(11) dcl 791 ref 790 er_fatal 002225 constant label dcl 747 ref 733 889 er_notry 002421 constant label dcl 868 ref 764 798 831 843 906 er_retry 002460 constant label dcl 882 ref 823 829 841 findfree 000407 constant label dcl 186 ref 205 get_buffer 000367 constant entry external dcl 181 gotbuf 000526 constant label dcl 220 ref 215 gotbuf1 001503 constant label dcl 545 ref 540 open 000146 constant entry external dcl 96 order 002060 constant entry external dcl 705 r_exit 001042 constant label dcl 361 ref 302 319 352 r_fatal 001037 constant label dcl 358 ref 275 331 read 000543 constant entry external dcl 235 read_ahead 000565 constant label dcl 243 ref 278 release_buffer 000455 constant entry external dcl 210 reposit 001672 constant label dcl 626 ref 621 restart_read 000623 constant label dcl 266 ref 354 retry 000262 constant label dcl 133 ref 145 return_data 000675 constant label dcl 289 ref 334 rstrtw 001526 constant label dcl 553 ref 681 rtryo 002200 constant label dcl 738 ref 891 897 902 rtryw 001535 constant label dcl 559 ref 654 setup 002540 constant entry internal dcl 908 ref 120 239 381 401 535 707 sync_com 001172 constant label dcl 413 ref 390 sync_error 001417 constant label dcl 516 ref 444 468 476 509 sync_fatal 001242 constant label dcl 430 ref 494 sync_read 001065 constant entry external dcl 378 sync_repos 001342 constant label dcl 488 ref 483 sync_restart 001202 constant label dcl 418 ref 511 sync_return 001423 constant label dcl 521 ref 448 sync_test 001415 constant label dcl 511 ref 506 sync_write 001127 constant entry external dcl 399 synch_check 002032 constant label dcl 684 ref 605 673 synch_write 001546 constant label dcl 565 ref 174 608 synchronize 000227 constant entry external dcl 117 ref 202 384 404 711 tape_ansi_tape_io_ 000047 constant entry external dcl 26 w_error 001763 constant label dcl 659 ref 652 w_error1 001766 constant label dcl 661 ref 618 w_fatal 001564 constant label dcl 571 ref 543 637 w_report 001770 constant label dcl 664 w_test 001761 constant label dcl 654 ref 649 wait 002617 constant label dcl 941 wait_test 002426 constant label dcl 872 ref 750 784 write 001434 constant entry external dcl 533 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3306 3412 2723 3316 Length 3720 2723 104 271 363 22 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tape_ansi_tape_io_ 144 external procedure is an external procedure. setup internal procedure shares stack frame of external procedure tape_ansi_tape_io_. check internal procedure shares stack frame of external procedure tape_ansi_tape_io_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 oplist tape_ansi_tape_io_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tape_ansi_tape_io_ 000100 cP tape_ansi_tape_io_ 000102 ecode tape_ansi_tape_io_ 000103 synchro tape_ansi_tape_io_ 000104 loop_bit tape_ansi_tape_io_ 000105 reset_wait tape_ansi_tape_io_ 000106 i tape_ansi_tape_io_ 000107 indx tape_ansi_tape_io_ 000110 errc tape_ansi_tape_io_ 000111 drive_number tape_ansi_tape_io_ 000126 wait_list setup 000132 message setup 000150 ix check THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_in call_ext_out return_mac ext_entry trunc_fx2 set_chars_eis index_chars_eis divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ipc_$block tape_ansi_interpret_status_ tdcm_$tdcm_iocall tdcm_$tdcm_reset_signal tdcm_$tdcm_set_signal THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$blank_tape error_table_$eof_record error_table_$eov_on_write error_table_$fatal_error error_table_$nine_mode_parity error_table_$positioned_on_bot error_table_$tape_error tape_status_$blank_tape_on_read tape_status_$command_reject tape_status_$device_data_alert tape_status_$end_of_file tape_status_$end_of_tape tape_status_$mpc_device_data_alert tape_status_$ready_at_bot tape_status_$reject_at_bot tape_status_$subsystem_ready LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 59 000043 26 000046 85 000055 87 000067 88 000073 89 000101 90 000103 91 000111 92 000126 93 000130 94 000143 96 000144 98 000154 99 000160 100 000162 101 000163 102 000165 103 000167 104 000170 105 000171 106 000177 107 000204 108 000206 117 000207 120 000240 121 000241 123 000243 124 000246 127 000251 130 000253 131 000255 132 000256 133 000262 136 000276 139 000300 140 000303 142 000304 145 000310 147 000313 149 000317 151 000330 154 000335 156 000337 159 000340 161 000344 162 000346 164 000347 167 000350 169 000352 170 000354 171 000356 172 000357 173 000361 174 000362 181 000363 183 000400 184 000404 185 000406 186 000407 190 000412 191 000413 192 000415 193 000417 194 000431 196 000432 199 000434 200 000437 202 000440 203 000450 205 000452 210 000453 212 000466 213 000472 214 000473 215 000501 217 000520 218 000522 219 000525 220 000526 222 000531 223 000533 224 000535 235 000536 237 000556 238 000561 239 000562 240 000563 243 000565 247 000570 250 000572 251 000574 252 000576 254 000577 255 000602 257 000603 258 000604 259 000606 260 000610 262 000615 263 000620 264 000621 266 000623 268 000627 269 000631 270 000632 271 000633 273 000637 275 000652 278 000654 280 000657 282 000662 284 000666 287 000671 288 000674 289 000675 291 000710 292 000714 293 000717 296 000720 298 000731 301 000736 302 000740 305 000741 306 000744 309 000745 310 000746 311 000751 313 000753 315 000755 318 000760 319 000762 322 000763 324 000766 327 000770 331 000772 333 000775 334 000777 338 001000 339 001002 340 001005 341 001007 342 001010 343 001012 345 001024 347 001026 350 001032 352 001035 354 001036 358 001037 361 001042 364 001051 365 001052 366 001055 367 001057 368 001060 378 001061 380 001100 381 001101 382 001102 384 001104 385 001114 387 001116 388 001120 389 001122 390 001124 399 001125 401 001142 402 001143 404 001145 405 001155 407 001157 408 001162 409 001164 410 001166 413 001172 415 001174 416 001200 418 001202 421 001216 423 001222 424 001223 425 001225 427 001240 430 001242 432 001245 435 001246 436 001253 438 001264 441 001270 444 001274 447 001277 448 001301 453 001302 456 001304 457 001306 458 001307 459 001310 462 001311 465 001314 468 001317 470 001322 471 001324 473 001325 476 001327 478 001332 479 001334 483 001335 485 001340 488 001342 490 001344 491 001345 492 001347 494 001361 496 001363 499 001367 501 001373 503 001404 506 001410 509 001414 511 001415 516 001417 518 001422 521 001423 524 001431 533 001432 535 001447 536 001450 538 001452 539 001453 540 001461 542 001500 543 001502 545 001503 547 001513 549 001520 550 001523 551 001524 553 001526 556 001532 557 001533 559 001535 561 001540 562 001543 563 001545 565 001546 568 001562 571 001564 573 001567 576 001570 579 001574 580 001577 581 001601 582 001603 583 001605 585 001606 590 001611 592 001615 594 001626 597 001632 600 001636 601 001640 602 001643 603 001645 604 001647 605 001651 607 001652 608 001654 612 001655 615 001661 616 001663 617 001664 618 001665 621 001666 623 001670 626 001672 628 001674 629 001676 630 001700 631 001703 632 001706 633 001710 634 001712 635 001713 637 001725 639 001727 642 001733 644 001737 646 001750 649 001754 652 001760 654 001761 659 001763 661 001766 664 001770 666 001771 667 001774 668 001776 669 002012 670 002016 671 002020 672 002021 673 002023 676 002024 680 002030 681 002031 684 002032 689 002040 691 002046 694 002052 705 002053 707 002073 708 002074 711 002076 712 002106 714 002110 715 002112 716 002115 718 002116 719 002126 722 002127 723 002132 725 002133 727 002141 729 002154 732 002156 733 002171 735 002173 738 002200 740 002206 741 002210 743 002211 744 002223 747 002225 749 002227 750 002232 753 002233 754 002240 756 002251 758 002254 761 002256 764 002262 766 002265 769 002267 772 002303 774 002306 778 002307 781 002315 784 002316 787 002317 790 002323 791 002325 794 002326 797 002330 798 002331 806 002332 809 002334 812 002337 815 002342 816 002344 819 002345 822 002350 823 002353 825 002354 828 002356 829 002361 831 002362 834 002363 837 002365 840 002370 841 002373 843 002374 846 002375 849 002377 852 002402 855 002415 857 002420 868 002421 870 002423 872 002426 877 002436 878 002452 880 002457 882 002460 886 002462 887 002465 888 002467 889 002501 891 002503 893 002507 895 002513 897 002524 899 002531 902 002534 906 002537 908 002540 925 002541 926 002545 928 002546 930 002576 932 002600 933 002604 934 002607 937 002610 940 002614 941 002617 943 002621 944 002623 946 002642 948 002647 950 002664 953 002665 959 002667 960 002677 962 002712 963 002714 ----------------------------------------------------------- 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