COMPILATION LISTING OF SEGMENT nstd_dim Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1709.6 mst Thu 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 /* The non-standard tape DIM. coded by MAP, 8/70. Liberally cribbed from NIM */ 13 /* Modified by Dick Snyder 2/71 to allow a mode request of "rw" or blank (read/write) */ 14 /* Also changed to allow order request "err_count" for on-line T&D's and to add */ 15 /* stream data block as specified in MCB 638 */ 16 /* Modified by Mike Grady to add fixed_record_length order call 11/03/72 */ 17 /* Modified on 09/19/77 by R.J.C. Kissel to call tape_nstd_ to get the max buffer size. */ 18 /* Modified on 02/15/78 by M. R. Jordan to remove the call to tape_nstd_ and add the ,block= and ,blk= strings. */ 19 /* Modified on 04/28/78 by Michael R. Jordan to _n_o_t unload tapes. */ 20 /* Modified on 08/09/78 by Bob May to add TEMPORARY GCOS facility for large buffers . 21* This interface will disappear when the GCOS simulator moves to tape_ioi_. */ 22 /* Modified 4/79 by R.J.C. Kissel to add 6250 bpi and data security erase capability. */ 23 /* Modified on 05/10/79 by C. D. Tavares to add name canonicalization support */ 24 /* Modified sometime in 1981 by M. R. Jordan to fix some bugs */ 25 26 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ 27 nstd_dim: 28 proc; 29 return; /* Shouldn't be called here */ 30 31 dcl (name1, type, name2, rw, order) 32 char (*); 33 dcl st bit (72); 34 dcl (sdb_ptr, wksp, ap) ptr; 35 dcl ( 36 error_table_$no_backspace, 37 error_table_$undefined_order_request, 38 error_table_$bad_mode, 39 error_table_$buffer_big, 40 error_table_$bad_arg, 41 error_table_$ionmat 42 ) ext fixed bin (35); 43 dcl code fixed bin (35); 44 dcl setbit bit (18), 45 rdycmd fixed bin (6), 46 fix_sw bit (1), 47 attach_sw bit (1), 48 j fixed bin; 49 dcl (off, nelem, nelemt, ring, count, i) 50 fixed bin (17); 51 dcl density fixed bin; 52 dcl temp_name char (32); 53 dcl 1 wait_list, 54 2 n fixed bin (17), 55 2 chn fixed bin (71); 56 dcl 1 message, 57 2 channel fixed bin (71), 58 2 mess fixed bin (71), 59 2 sender bit (36), 60 2 origin, 61 3 dersig bit (18) unaligned, 62 3 ring bit (18) unaligned, 63 2 channel_index fixed bin (17); 64 dcl dum (tseg.buffer_size (1)) fixed bin (35) based; 65 dcl sst bit (18) aligned based; 66 dcl ord char (32); 67 68 dcl (addr, addrel, bit, length, null, ptr, rel, rtrim, search, substr, unspec) 69 builtin; 70 dcl (bin, bool, divide, index, max, string, lbound, hbound) 71 builtin; 72 73 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin, ptr, fixed bin (35)); 74 75 dcl ( 76 tdcm_$tdcm_attach, 77 tdcm_$tdcm_detach, 78 tdcm_$tdcm_set_signal, 79 tdcm_$tdcm_reset_signal, 80 tdcm_$tdcm_iocall 81 ) entry (ptr, fixed bin (35)), 82 tdcm_$tdcm_set_buf_size 83 entry (ptr, fixed bin, fixed bin (35)), 84 tdcm_$tdcm_message entry (ptr, char (*), fixed bin, fixed bin (35)); 85 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 86 87 dcl ipc_$create_ev_chn ext entry (fixed bin (71), fixed bin (35)); 88 dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); 89 dcl ( 90 ioa_, 91 ioa_$rsnnl 92 ) entry options (variable); 93 dcl ipc_$block entry (ptr, ptr, fixed bin (35)); 94 dcl instance fixed bin (35) int static init (1); 95 /* used to generate sdb seg name */ 96 dcl segnm char (32); /* name of stream data block */ 97 dcl sav_stat bit (36); 98 dcl newerr fixed bin based (ap); 99 100 dcl cleanup condition; /* cleanup handler for interrupted attachment */ 101 102 dcl 1 hsbc aligned, /* tape status word format */ 103 2 padx bit (2) unaligned, 104 2 maj bit (4) unaligned, 105 2 min bit (6) unaligned, 106 2 pady bit (24); 107 108 dcl 1 stream_data_block aligned based (sdb_ptr), 109 2 outer_module_name char (32) aligned, 110 2 device_name_list ptr, 111 2 tseg_ptr ptr, 112 2 retry_cnt fixed bin, /* no. of times to retry i/o */ 113 2 some_bits aligned, 114 3 no_data_sw bit (1) unaligned, /* 1 = start next blocked i/o */ 115 3 fix_rec bit (1) unaligned, /* 1 = fixed record i/o (buffered i/o) */ 116 3 eot_bit bit (1) unaligned, /* 1 = end of tape was reached */ 117 3 eof_bit bit (1) unaligned, /* 1 = end of file was reached */ 118 3 rewind bit (1) unaligned, /* 1 = last tape order was rewind */ 119 3 unload bit (1) unaligned, /* 1 = last tape order was unload */ 120 3 fix_init bit (1) unaligned, /* initial io for fixed length rec. */ 121 3 spare_bits bit (29) unaligned, 122 2 max_rec_len fixed bin, /* maximum record length in words */ 123 2 fix_rec_size fixed bin, /* length of records for fixed record length option */ 124 2 buf_mask bit (18), /* used to get index to block of buffers */ 125 2 buf_count fixed bin, /* no. of buffers in data transfer */ 126 2 data_count fixed bin, /* no. of buffers read/written */ 127 2 bufchk fixed bin, /* index of current buffer in block (0 to 2*buffer_count-1) */ 128 2 device_name, 129 3 next_device_ptr ptr, 130 3 name_size fixed bin (17), 131 3 name char (256) aligned, 132 2 tsegarea fixed bin (71); 133 134 135 dcl 1 ord_tab (18) aligned internal static, 136 /* lookup table for simple order types */ 137 2 oname char (32) aligned 138 init (/* orders */ "back", "eof", "reset_status", "forward_record", "forward_file", 139 /* NOTE: order of these orders */ 140 "backspace_file", "erase", "high", "low", "protect", "unload", "rewind", 141 /* must be maintained */ 142 "d200", "d556", "d800", "d1600", "d6250", "data_security_erase"), 143 /* since there is code which is */ 144 /* dependent on it */ 145 2 cmd bit (6) aligned 146 init (/* actual orders */ "46"b3, "55"b3, "40"b3, "44"b3, "45"b3, "47"b3, "54"b3, "60"b3, 147 "61"b3, "62"b3, "72"b3, "70"b3, "64"b3, "61"b3, "60"b3, "65"b3, "41"b3, "73"b3); 148 149 1 1 /* Include segment tseg.incl.pl1 --- declaration for Tape DSM-DCM Interface Segment */ 1 2 /* Modified 10 July 1973 by MJ Grady */ 1 3 /* Modified 7/79 by R.J.C. Kissel to add a version number, tracks, density, and drive_name, and get rid of drive_number. */ 1 4 /* Modified 5 August 1981 by Chris Jones to add speed specification */ 1 5 1 6 /* NB: tape_ansi_cseg.incl.pl1 has a parallel version of this tseg declared in it. Any changes made here MUST 1 7* be made there too. */ 1 8 1 9 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ 1 10 dcl ( 1 11 nbuffs init (12), /* # of buffers in structure */ 1 12 max_rec_size init (2080) 1 13 ) fixed bin (17) int static; /* Max # of words that may be transmitted (2 * 1040) */ 1 14 1 15 dcl tsegp ptr; /* Used to access Ring-0/Ring-4 shared structure */ 1 16 dcl tseg_version_2 fixed bin internal static options (constant) init (2); 1 17 1 18 declare 1 tseg based (tsegp) aligned, 1 19 2 version_num fixed bin, 1 20 2 areap ptr, /* pointer to DSM area */ 1 21 2 ev_chan fixed bin (71), /* event channel number */ 1 22 2 write_sw fixed bin (1), /* 0 = read, 1 = write */ 1 23 2 sync fixed bin (1), /* non-zero for synchronous i/o */ 1 24 2 get_size fixed bin (1), /* ON for record sizes to be returned */ 1 25 2 ws_segno bit (18), /* segment number of IOI workspace */ 1 26 2 drive_name char (32), /* physical drive name. */ 1 27 2 tracks fixed bin, /* 0 = 9-track, 1 = 7-track. */ 1 28 2 density bit (36), /* bits are 200, 556, 800 1600, 6250 respectively. */ 1 29 2 speed bit (36), /* bits are 75, 125, 200 ips respectively */ 1 30 2 pad99 bit (36), /* so that buffers start on an evenword boundary */ 1 31 2 buffer_offset fixed bin (12), /* offset (from 1) of first buffer to be processed */ 1 32 2 buffer_count fixed bin (12), /* number of buffers to be processed */ 1 33 2 completion_status fixed bin (2), /* 0 = no pending i/o or no status */ 1 34 /* 1 = normal termination of i/o */ 1 35 /* 2 = non-zero major status from previous i/o */ 1 36 2 hardware_status bit (36) aligned, /* major and sub-status */ 1 37 2 error_buffer fixed bin (12), /* buffer in which i/o error occurred */ 1 38 2 command_count fixed bin (12), /* number of non-data commands to execute */ 1 39 2 command_queue (10) fixed bin (6) aligned, /* non-data-transfer commands */ 1 40 2 bufferptr (12) fixed bin (18) aligned,/* relative ptrs to buffers */ 1 41 2 buffer_size (12) fixed bin (18) aligned,/* size of buffer */ 1 42 2 mode (12) fixed bin (2) aligned, /* 0 = bin, 1 = bcd, 2 = 9 track */ 1 43 2 buffer (12) bit (37440) aligned, /* data buffers - 1040 words */ 1 44 2 dsm_area area ((100 /* strictly nominal */)); 1 45 /* DSM workspace */ 1 46 1 47 /* End include segment tseg.incl.pl1 */ 150 151 152 /* */ 153 154 set_block_size: 155 entry (a_user_block_size, a_code); 156 157 /* Temporary entry to allow users of the GCOS simulators to tell nstd_ to use large buffers. 158* Bob May, 08/07/78 */ 159 160 dcl a_user_block_size fixed bin, /* size in words */ 161 a_code fixed bin (35); 162 163 dcl user_block_size fixed bin int static; /* override size */ 164 165 dcl user_block_size_sw bit (1) int static init ("0"b); 166 /* to keep track of buffer needs */ 167 168 if a_user_block_size ^= 0 then do; 169 user_block_size = a_user_block_size; 170 user_block_size_sw = "1"b; 171 end; 172 else user_block_size_sw = "0"b; /* reset function */ 173 174 a_code = 0; /* assume its ok for now. we checked it before */ 175 return; 176 177 /* End of set_block_size Entry */ 178 179 180 181 /* A T T A C H E N T R Y P O I N T */ 182 183 184 185 186 187 nstd_attach: 188 entry (name1, type, name2, rw, st, sdb_ptr); 189 190 attach_sw = "0"b; 191 if sdb_ptr ^= null then do; /* check for multiple attachments */ 192 193 substr (st, 1, 36) = unspec (error_table_$ionmat); 194 return; /* if multiple attachment return error code */ 195 end; 196 197 on cleanup call clear_attach; /* cleanup in case user quits while attaching */ 198 199 /* Create name for segment to hold stream data block. Name consists of */ 200 /* "nstd_sdbN_" where N is a number which increments by one for */ 201 /* each attach call. */ 202 203 204 call ioa_$rsnnl ("nstd_sdb^d_", segnm, code, instance); 205 instance = instance + 1; /* bump instance */ 206 207 call hcs_$make_seg ("", segnm, "", 01011b, sdb_ptr, code); 208 /* Make an sdb */ 209 if sdb_ptr = null then do; /* failure? */ 210 BAD_OUT: 211 substr (st, 1, 36) = unspec (code); 212 substr (st, 52, 1) = "1"b; /* Send back a detach bit */ 213 return; 214 end; 215 216 outer_module_name = "nstd_"; /* fill in stream data block */ 217 device_name_list = addr (device_name); 218 next_device_ptr = null; /* only one device */ 219 name_size = 32; 220 name = name2; /* put in tape name */ 221 tseg_ptr = addr (tsegarea); /* set up tseg for DCM use */ 222 tsegp = tseg_ptr; /* copy tseg pointer for better code */ 223 tseg.version_num = tseg_version_2; 224 225 stream_data_block.retry_cnt = 10; /* set default error retry count */ 226 fix_init = "0"b; /* initialization for fixed rec. length */ 227 228 /* initialize tseg */ 229 230 call ipc_$create_ev_chn (tseg.ev_chan, code); /* create event channel for the */ 231 if code ^= 0 then 232 go to BAD_ATTACH; /* signalling of special interrupts */ 233 234 tseg.sync = 1; /* i/o will be synchronous */ 235 tseg.get_size = 1; /* we want DCM to tell us record sizes */ 236 tseg.buffer_offset = 0; /* start at front of buffer */ 237 tseg.bufferptr (1) = bin (rel (addr (tseg.buffer (1))), 17); 238 /* set up first buffer ptr */ 239 do i = 1 to 12; 240 tseg.mode (i) = 0; /* default mode is binary * */ 241 end; 242 243 /* Hook up the dcm */ 244 245 if (rw ^= "r" & rw ^= "w" & rw ^= "rw" & rw ^= "") then do; 246 code = error_table_$bad_mode; /* set error code */ 247 go to BAD_ATTACH; 248 end; 249 250 251 if rw = "r" then 252 ring, tseg.write_sw = 0; /* mode read */ 253 else ring, tseg.write_sw = 1; /* mode write */ 254 255 if index (name2, ",7track") ^= 0 then /* set indicator to 7 or 9 track drive type */ 256 tseg.tracks = 1; 257 else tseg.tracks = 0; 258 259 call tdcm_$tdcm_attach (tsegp, code); /* ask DCM to grab a drive */ 260 if code ^= 0 then 261 go to BAD_ATTACH; /* DCM gripped */ 262 attach_sw = "1"b; 263 264 max_rec_len = 2800; 265 i = index (name2, ",block=") + 7; 266 if i <= 7 then do; 267 i = index (name2, ",blk=") + 5; 268 if i <= 5 then 269 i = index (name2, ",bk=") + 4; 270 end; 271 if i > 4 then do; 272 if i > length (name2) then do; 273 code = error_table_$bad_arg; 274 goto BAD_ATTACH; 275 end; 276 j = search (substr (name2, i), ", ") - 1; 277 if j < 0 then 278 j = length (name2) - i + 1; 279 max_rec_len = cv_dec_check_ (substr (name2, i, j), code); 280 if code ^= 0 then do; 281 code = error_table_$bad_arg; 282 goto BAD_ATTACH; 283 end; 284 end; 285 286 /* do the special block function only when block=nnnn not specified for individual attach */ 287 288 else if user_block_size_sw then 289 max_rec_len = max (user_block_size, max_rec_len); 290 /* don't go too small */ 291 292 call tdcm_$tdcm_set_buf_size (tsegp, max_rec_len, code); 293 if code ^= 0 then 294 goto BAD_ATTACH; 295 296 density = 800; 297 tseg.density = "00100"b; 298 299 i = index (name2, ",density=") + 9; 300 if i <= 9 then 301 i = index (name2, ",den=") + 5; 302 if i > 5 then do; 303 if i > length (name2) then do; 304 code = error_table_$bad_arg; 305 goto BAD_ATTACH; 306 end; 307 j = search (substr (name2, i), ", ") - 1; 308 if j < 0 then 309 j = length (name2) - i + 1; 310 density = cv_dec_check_ (substr (name2, i, j), code); 311 if code ^= 0 then do; 312 code = error_table_$bad_arg; 313 goto BAD_ATTACH; 314 end; 315 end; 316 317 if density = 1600 then do; 318 rdycmd = bin ("65"b3); 319 tseg.density = "00010"b; 320 end; 321 322 else if density = 800 then do; 323 rdycmd = bin ("60"b3); 324 tseg.density = "00100"b; 325 end; 326 327 else if density = 556 then do; 328 rdycmd = bin ("61"b3); 329 tseg.density = "01000"b; 330 end; 331 332 else if density = 200 then do; 333 rdycmd = bin ("64"b3); 334 tseg.density = "10000"b; 335 end; 336 337 else if density = 6250 then do; 338 rdycmd = bin ("41"b3); 339 tseg.density = "00001"b; 340 end; 341 342 else do; 343 code = error_table_$bad_arg; 344 goto BAD_ATTACH; 345 end; 346 347 call tdcm_$tdcm_set_signal (tsegp, code); /* enable special interrupt so we */ 348 /* know when operator mounts tape */ 349 if code ^= 0 then 350 go to BAD_ATTACH; /* error */ 351 352 call ioa_ ("Tape ^a will be mounted with ^[a^;no^] write ring.", name, (ring = 1)); 353 354 temp_name = name; 355 call tdcm_$tdcm_message (tsegp, temp_name, ring, code); 356 /* Send mount message */ 357 if code ^= 0 then 358 go to BAD_ATTACH; /* error */ 359 /* and send info to user */ 360 361 name = temp_name; 362 name_size = length (rtrim (name)); 363 364 /* Do readiness checking/waiting */ 365 366 367 call wait; /* wait for operator */ 368 if code ^= 0 then 369 go to BAD_ATTACH; /* trouble?? */ 370 call ioa_ ("Tape ^a mounted on drive ^a with ^[a^;no^] write ring.", name, tseg.drive_name, (ring = 1)); 371 return; /* and go home */ 372 373 374 BAD_ATTACH: 375 substr (st, 52, 1) = "1"b; /* detach bit */ 376 substr (st, 1, 36) = unspec (code); 377 call clear_attach; /* release drive and stream data block */ 378 return; 379 380 DCM_ERR: 381 substr (st, 1, 36) = unspec (code); /* standard code was returned */ 382 return; /* So there */ 383 384 385 386 387 388 /* R E A D E N T R Y P O I N T */ 389 390 391 392 393 394 nstd_read: 395 entry (sdb_ptr, wksp, off, nelem, nelemt, st); 396 397 nelemt = 0; /* Clear it, right away, in case of errors or EOF */ 398 call check_rewind; 399 count = stream_data_block.retry_cnt; /* Initialize for possible retries */ 400 401 if fix_rec then do; 402 403 if fix_init then do; 404 no_data_sw = "1"b; /* no data yet */ 405 tseg.buffer_offset = 0; /* put data in first set of buffs */ 406 tseg.buffer_count = buf_count; /* no. of buffers to read */ 407 tseg.write_sw = 0; /* set io to read */ 408 call tdcm_$tdcm_iocall (tsegp, code); /* start read */ 409 fix_init = "0"b; 410 end; 411 412 if tseg.write_sw = 0 then 413 go to fix_read; /* continue reading */ 414 call reset_fix_rec; /* finish write */ 415 end; 416 417 tseg.write_sw = 0; /* set to read */ 418 if nelem > max_rec_len then 419 go to BAD_BUF; 420 421 RLOOP: 422 tseg.buffer_size (1) = nelem; /* We'll read no more than we can, and maybe less */ 423 tseg.buffer_count = 1; 424 tseg.command_count = 0; /* This is what makes the dcm know it's a read/write request */ 425 tseg.buffer_offset = 0; /* use the 1st buffer */ 426 427 call tdcm_$tdcm_iocall (tsegp, code); /* Go get 'em */ 428 if code ^= 0 then 429 go to DCM_ERR; 430 431 if tseg.completion_status = 1 then do; /* Good read */ 432 433 call move (1); /* move data to user's buffer */ 434 435 GOOD_OUT: /* Common successful return point */ 436 substr (st, 1, 36) = "0"b; 437 nelemt = tseg.buffer_size (1); 438 return; 439 end; 440 441 /* Here on bad completion status--retry if not done with count */ 442 443 RECOV: 444 if substr (tseg.hardware_status, 3, 4) = "0100"b then 445 go to BAD_ORD; /* If it's EOF send it back */ 446 if substr (tseg.hardware_status, 3, 4) = "0011"b /* data alert */ 447 then if (substr (tseg.hardware_status, 7, 6) & "100010"b) = "000010"b then 448 go to BAD_ORD; /* don't try any more--will still get blank tape */ 449 450 RECOV1: 451 if count > 0 then do; /* More re-tries left */ 452 453 count = count - 1; /* decrement error retry cnt */ 454 tseg.command_count = 1; /* we'll issue one */ 455 tseg.command_queue (1) = 100110b; /* backspace order */ 456 call tdcm_$tdcm_iocall (tsegp, code); /* let DCM do it */ 457 if code ^= 0 then 458 go to DCM_ERR; /* error */ 459 if tseg.completion_status ^= 1 then do; /* error on bksp */ 460 substr (st, 1, 36) = unspec (error_table_$no_backspace); 461 /* couldn't bksp due */ 462 return; /* to being on bot */ 463 end; 464 if tseg.write_sw = 1 then 465 go to WLOOP; /* retry write */ 466 go to RLOOP; /* retry read */ 467 468 end; 469 470 else do; /* can't recover. */ 471 472 nelemt = tseg.buffer_size (1); /* amount of buffer actually sent */ 473 if tseg.write_sw = 0 then 474 call move (1); /* put data read in user's buffer */ 475 476 end; 477 478 /* Here when re-tries or order codes fail */ 479 480 BAD_ORD: 481 substr (st, 1, 1) = "1"b; /* set high order bit of */ 482 /* status to indicate that actual */ 483 /* tape major and minor status is being returned */ 484 /* and not a standard error code */ 485 if stream_data_block.unload then 486 stream_data_block.rewind = "0"b; /* don't wait for special */ 487 /* interrupt after rewind if tape unloaded */ 488 substr (st, 25, 12) = tseg.hardware_status; /* return major/minor status */ 489 return; 490 491 492 fix_read: /* proc to do quick reads for fixed recs */ 493 fix_sw = "0"b; /* indicate read */ 494 495 fix_com: 496 if nelem ^= fix_rec_size then 497 go to BAD_BUF; /* must ask for 1 buff at a time */ 498 499 if no_data_sw then do; /* any data left ? */ 500 501 if eof_bit then do; /* did we get eof last time ? */ 502 substr (st, 1, 1) = "1"b; /* yes reflect status */ 503 substr (st, 25, 12) = substr (sav_stat, 1, 12); 504 /* put in saved eof code (9 or 7) */ 505 eof_bit = "0"b; 506 fix_init = "1"b; /* restart read */ 507 return; /* done it */ 508 end; 509 510 if eot_bit then do; /* have we already said eot ? */ 511 substr (st, 1, 1) = "1"b; /* yes, but do it again */ 512 substr (st, 25, 12) = "000011100000"b; /* eot status */ 513 return; /* maybe we can convince him */ 514 end; 515 516 bufchk = tseg.buffer_offset; /* return data starting with this buff */ 517 setbit = bit (bin (tseg.buffer_offset, 18), 18); 518 /* switch buffers with x-or */ 519 restart: 520 setbit = bool (setbit, buf_mask, "0110"b); /* do sw */ 521 tseg.buffer_offset = bin (setbit, 17); /* get number */ 522 tseg.sync = 0; /* make sure */ 523 tseg.buffer_count = buf_count; /* read n buffers of data */ 524 call tdcm_$tdcm_iocall (tsegp, code); /* start io */ 525 if code ^= 0 then 526 go to DCM_ERR; 527 if tseg.completion_status ^< 2 then do; /* bad error */ 528 529 string (hsbc) = tseg.hardware_status; /* copy status */ 530 if hsbc.maj = "0100"b then do; 531 data_count = tseg.error_buffer - 1;/* indicate amt we got */ 532 sav_stat = tseg.hardware_status; /* save for 9 or 7 code */ 533 if data_count = 0 then 534 go to BAD_ORD; /* no more data send error */ 535 eof_bit = "1"b; /* tape mark */ 536 no_data_sw = "0"b; 537 go to fix_out; /* finish proccessing data */ 538 end; 539 540 if hsbc.maj ^= "0011"b then 541 go to BAD_ORD; /* only recoverable is data alert */ 542 543 if hsbc.min & "100000"b then do; /* eot marker sensed (write only) */ 544 setbit = bool (setbit, buf_mask, "0110"b); 545 /* switch buffers */ 546 tseg.buffer_offset = bin (setbit, 17) + tseg.error_buffer; 547 /* start with one after eot mark */ 548 tseg.buffer_count = buf_count - tseg.error_buffer; 549 /* and do only ones remaining */ 550 call tdcm_$tdcm_iocall (tsegp, code); 551 setbit = bool (setbit, buf_mask, "0110"b); 552 tseg.buffer_offset = bin (setbit, 17); 553 /* set to do next bunch */ 554 tseg.buffer_count = buf_count; /* set to reissue past io(last one completed) */ 555 call tdcm_$tdcm_iocall (tsegp, code); 556 /* go to DCM */ 557 substr (st, 1, 1) = "1"b; /* reflect eot to user */ 558 substr (st, 25, 12) = "000011100000"b; 559 /* eot status */ 560 eot_bit = "1"b; /* remember this fact */ 561 return; /* go to user */ 562 end; 563 564 do j = 1 to count; /* retry io */ 565 setbit = bool (setbit, buf_mask, "0110"b); 566 /* back to buffers which failed */ 567 tseg.buffer_offset = bin (setbit, 17); 568 /* set tseg */ 569 do i = 1 to tseg.error_buffer; /* backspaces n times */ 570 tseg.command_queue (i) = 100110b; 571 /* backspace rec op */ 572 end; 573 tseg.command_count = tseg.error_buffer; 574 /* go to it */ 575 tseg.buffer_count = 0; /* clear it since last attempt didnt go */ 576 tseg.sync = 1; /* we will wait for these io's */ 577 call tdcm_$tdcm_iocall (tsegp, code); 578 /* do backup */ 579 if code ^= 0 then 580 go to DCM_ERR; 581 if tseg.completion_status ^< 2 then do; 582 /* bad error */ 583 substr (st, 1, 36) = unspec (error_table_$no_backspace); 584 return; 585 end; 586 tseg.buffer_count = buf_count; /* retry io again */ 587 call tdcm_$tdcm_iocall (tsegp, code); 588 /* go -- this is sync so it will wait */ 589 if tseg.completion_status < 2 then 590 go to restart; /* go this time restart the io we wanted */ 591 end; 592 go to BAD_ORD; /* retry failed us */ 593 end; 594 595 no_data_sw = "0"b; /* we data now */ 596 data_count = buf_count; /* this much */ 597 end; 598 599 600 fix_out: /* come here to finish sending data */ 601 call move (bufchk + 1); /* move data to buffer */ 602 bufchk = bufchk + 1; /* this one next time */ 603 data_count = data_count - 1; /* reduce number of buffers full */ 604 if data_count = 0 then 605 no_data_sw = "1"b; /* set sw saying none left */ 606 nelemt = nelem; /* set count */ 607 substr (st, 1, 36) = "0"b; /* no error */ 608 return; 609 610 611 612 /* W R I T E E N T R Y P O I N T */ 613 614 615 616 617 nstd_write: 618 entry (sdb_ptr, wksp, off, nelem, nelemt, st); 619 620 nelemt = 0; /* Clear it */ 621 call check_rewind; 622 count = stream_data_block.retry_cnt; /* no. of possible retries */ 623 624 if fix_rec then do; 625 if fix_init then do; 626 tseg.sync = 0; 627 no_data_sw = "0"b; /* mark buffers empty now */ 628 data_count = buf_count; /* n to fill before write */ 629 tseg.buffer_offset = buf_count; /* set so first switch will go */ 630 bufchk = 0; /* start filling buffers at offset 0 */ 631 tseg.write_sw = 1; 632 fix_init = "0"b; 633 end; 634 635 if tseg.write_sw = 1 then 636 go to fix_r_write; /* check for write access */ 637 call reset_fix_rec; /* clean up after read */ 638 end; 639 640 641 tseg.write_sw = 1; /* set io to write */ 642 if nelem > max_rec_len then do; /* buffer too large for DCM? */ 643 644 BAD_BUF: 645 substr (st, 1, 36) = unspec (error_table_$buffer_big); 646 /* put error in status */ 647 return; 648 end; 649 650 WLOOP: 651 tseg.buffer_size (1) = nelem; /* copy no elements */ 652 tseg.command_count = 0; /* not doing a special command */ 653 tseg.buffer_count = 1; /* one buffer */ 654 tseg.buffer_offset = 0; /* use the 1st buffer */ 655 656 call move (1); /* move data into tseg buffer for write */ 657 call tdcm_$tdcm_iocall (tsegp, code); /* issue write */ 658 if code ^= 0 then 659 go to DCM_ERR; /* error */ 660 if tseg.completion_status = 1 then 661 go to GOOD_OUT; /* success */ 662 if substr (tseg.hardware_status, 3, 5) = "00111"b then do; 663 /* If it's EOT send it back */ 664 nelemt = tseg.buffer_size (1); /* But give him the nelemt */ 665 go to BAD_ORD; 666 end; 667 go to RECOV1; /* go try to recover from write error */ 668 669 670 671 672 fix_r_write: 673 fix_sw = "1"b; /* indicate write */ 674 go to fix_com; /* go to common routine for this */ 675 676 677 /* O R D E R E N T R Y P O I N T */ 678 679 680 681 682 nstd_order: 683 entry (sdb_ptr, order, ap, st); 684 685 call check_rewind; 686 687 ord = order; /* Copy arg for better code */ 688 689 if fix_rec then 690 call reset_fix_rec; /* clear out buffers */ 691 692 do i = lbound (ord_tab, 1) to hbound (ord_tab, 1);/* look in table for common orders */ 693 694 if ord = ord_tab (i).oname then do; 695 696 tseg.command_queue (1) = bin (ord_tab (i).cmd); 697 /* hit..pick up command */ 698 if i = 11 then 699 stream_data_block.unload = "1"b; /* remember that unload done */ 700 if i = 12 then 701 stream_data_block.rewind = "1"b; /* remember that rewind done */ 702 go to COM; /* go issue command */ 703 end; 704 705 end; 706 707 708 if ord = "fixed_record_length" then do; /* fix_rec order call */ 709 710 fix_rec = "1"b; /* set bit */ 711 fix_rec_size = newerr; /* just happens to be based var with ptr to arg */ 712 buf_count = divide (max_rec_len, fix_rec_size, 17, 0); 713 /* get num buffers */ 714 if buf_count < 1 then 715 go to BAD_BUF; /* too big? */ 716 if buf_count > 6 then 717 buf_count = 6; /* 6 is most we can use */ 718 tseg.get_size = 0; /* no sizes, we know them */ 719 buf_mask = bit (bin (buf_count, 18), 18); /* for x-or of buffer offset */ 720 eof_bit, eot_bit = "0"b; /* reset bits */ 721 tseg.sync = 0; /* set sync mode for io */ 722 do i = 1 to 2 * buf_count; /* init buffer sizes and ptrs */ 723 tseg.buffer_size (i) = fix_rec_size; /* known size */ 724 tseg.bufferptr (i) = bin (rel (addrel (addr (tseg.buffer (1)), (i - 1) * fix_rec_size)), 17); 725 /* rel buf addrs */ 726 end; 727 fix_init = "1"b; /* start io on 1st read */ 728 go to ORD_OUT; /* return */ 729 end; 730 731 732 if ord = "bcd" then do; /* "bcd" hardware mode */ 733 do i = 1 to 12; 734 tseg.mode (i) = 1; 735 end; 736 go to ORD_OUT; 737 end; 738 if ord = "binary" then do; /* "binary" hardware mode */ 739 do i = 1 to 12; 740 tseg.mode (i) = 0; 741 end; 742 go to ORD_OUT; 743 end; 744 if ord = "nine" then do; /* "nine" hardware mode */ 745 do i = 1 to 12; 746 tseg.mode (i) = 2; 747 end; 748 go to ORD_OUT; 749 end; 750 if ord = "saved_status" then do; 751 STAT: 752 ap -> sst = tseg.hardware_status; /* copied from tseg; this will get special iom stuff too */ 753 go to ORD_OUT; 754 end; 755 if ord = "request_status" then do; 756 tseg.command_count = 1; 757 tseg.command_queue (1) = 000000b; 758 call tdcm_$tdcm_iocall (tsegp, code); /* call DCM */ 759 if code ^= 0 then 760 go to DCM_ERR; 761 if tseg.completion_status ^= 1 then 762 go to BAD_ORD; 763 go to STAT; 764 end; 765 if ord = "err_count" then do; 766 if ap = null then do; /* new error supplied? */ 767 stream_data_block.retry_cnt = 10; /* no..use default */ 768 go to ORD_OUT; 769 end; 770 if newerr > 100 | newerr < 0 then 771 go to UOR; /* yes..is it legal ? */ 772 stream_data_block.retry_cnt = newerr; /* yes..use it */ 773 go to ORD_OUT; 774 end; 775 776 UOR: 777 substr (st, 1, 36) = unspec (error_table_$undefined_order_request); 778 /* bum order */ 779 return; 780 781 COM: 782 if stream_data_block.rewind then do; /* rewind to be done?? */ 783 784 call tdcm_$tdcm_set_signal (tsegp, code); /* yes..tell DCM we want to know when it's done */ 785 if code ^= 0 then 786 go to DCM_ERR; /* DCM squawked */ 787 end; 788 789 tseg.command_count = 1; 790 call tdcm_$tdcm_iocall (tsegp, code); /* issue order */ 791 if tseg.completion_status ^= 1 then 792 go to BAD_ORD; 793 794 if stream_data_block.rewind then /* was a rewind just issued? */ 795 if substr (tseg.hardware_status, 3, 4) = "0"b 796 & /* yes..was the tape */ substr (tseg.hardware_status, 11, 1) then do; 797 /* positioned on load point? */ 798 799 stream_data_block.rewind = "0"b; /* yes..turn off rewind sw */ 800 call tdcm_$tdcm_reset_signal (tsegp, code); 801 /* there won't be a special interrupt */ 802 if code ^= 0 then 803 go to DCM_ERR; /* goof */ 804 end; 805 806 ORD_OUT: 807 substr (st, 1, 36) = "0"b; /* return good status */ 808 return; 809 810 nstd_getsize: 811 entry (sdb_ptr, size, st); 812 813 dcl size fixed bin; 814 815 size = 36; /* nstd_ deals only in words */ 816 817 return; 818 819 /* D E T A C H E N T R Y P O I N T */ 820 821 822 823 824 nstd_detach: 825 entry (sdb_ptr, type, name2, st); 826 827 call check_rewind; 828 if fix_rec then do; 829 call reset_fix_rec; 830 end; 831 if stream_data_block.unload then 832 go to DET; /* don't unload if user already did */ 833 tseg.buffer_count = 0; 834 tseg.command_queue (1) = 111000b; /* rewind tape */ 835 tseg.command_count = 1; 836 call tdcm_$tdcm_iocall (tsegp, code); /* have DCM do it */ 837 if code ^= 0 then 838 go to DCM_ERR; /* error */ 839 if tseg.completion_status ^= 1 then 840 go to BAD_ORD; /* failure on order */ 841 842 DET: 843 call tdcm_$tdcm_detach (tsegp, code); /* detach tape drive */ 844 if code ^= 0 then 845 go to DCM_ERR; /* error */ 846 847 call hcs_$delentry_seg (sdb_ptr, code); /* then try to get rid of sdb */ 848 if code ^= 0 then do; /* error */ 849 substr (st, 1, 36) = unspec (code); /* return error code to caller */ 850 go to DET_BIT; /* but indicate that detach worked */ 851 end; 852 853 substr (st, 1, 36) = "0"b; 854 DET_BIT: 855 substr (st, 52, 1) = "1"b; /* your detach bit */ 856 return; 857 858 859 /* */ 860 nstd_cmode: 861 entry (sdb_ptr, rw, oldrw, st); 862 863 dcl oldrw char (*); 864 865 tsegp = tseg_ptr; 866 867 if tseg.write_sw = 1 then 868 oldrw = "w"; 869 else oldrw = "r"; 870 871 if (rw ^= "w") & (rw ^= "r") & (rw ^= "rw") & (rw ^= "") then do; 872 substr (st, 1, 36) = unspec (error_table_$bad_mode); 873 return; 874 end; 875 876 if fix_rec then 877 call reset_fix_rec; /* clear buffs */ 878 879 if rw = "r" then 880 tseg.write_sw = 0; 881 else tseg.write_sw = 1; 882 883 substr (st, 1, 36) = "0"b; 884 return; 885 886 /* */ 887 888 /* internal proc to clear out write ahead buffs */ 889 890 reset_fix_rec: 891 proc; 892 tseg.sync = 1; /* set sync for orders */ 893 fix_rec = "0"b; 894 895 if fix_init then do; /* no io yet - no clean up */ 896 fix_init = "0"b; 897 return; 898 end; 899 900 if tseg.write_sw = 1 then do; /* write remaining buffers */ 901 902 setbit = bit (bin (tseg.buffer_offset, 18), 18); 903 setbit = bool (setbit, buf_mask, "0110"b); 904 tseg.buffer_offset = bin (setbit, 17); 905 tseg.buffer_count = bufchk; 906 tseg.command_count = 0; 907 call tdcm_$tdcm_iocall (tsegp, code); 908 if code ^= 0 then 909 go to DCM_ERR; 910 if tseg.completion_status ^< 2 then 911 go to BAD_ORD; 912 if ord = "eof" then do; /* RESET to fixed_length_record */ 913 fix_rec = "0"b; 914 fix_init = "1"b; 915 end; 916 return; 917 end; 918 919 if eof_bit then do; /* no io pending */ 920 data_count = data_count + 1; /* backspace over file */ 921 eof_bit = "0"b; 922 go to BACKSPACE; /* no io pending */ 923 end; 924 925 tseg.buffer_count = 0; /* no data transfer */ 926 tseg.command_count = 0; /* no commands */ 927 call tdcm_$tdcm_iocall (tsegp, code); /* complete last read */ 928 if code ^= 0 then 929 go to DCM_ERR; 930 931 if tseg.completion_status = 0 then 932 go to BACKSPACE; /* no io pending */ 933 if tseg.completion_status = 1 then do; 934 data_count = data_count + buf_count; 935 go to BACKSPACE; 936 end; 937 data_count = data_count + tseg.error_buffer; 938 939 BACKSPACE: /* backspace records read but not asked for */ 940 tseg.buffer_count = 0; 941 do i = 1 to data_count; 942 tseg.command_count = 1; 943 tseg.command_queue (1) = 100110b; 944 call tdcm_$tdcm_iocall (tsegp, code); /* backspace one record */ 945 if code ^= 0 then 946 go to DCM_ERR; 947 end; 948 949 return; 950 951 end; /* */ 952 953 954 955 /* Internal procedure to wait for a special interrupt from the tape controller. */ 956 /* Used to wait for interrupt when tape drive made ready and after a rewind. */ 957 958 959 wait: 960 proc; 961 962 963 READY_CHK: 964 wait_list.n = 1; /* will wait for one event channel */ 965 wait_list.chn = tseg.ev_chan; /* which is the one associated with this tseg */ 966 call ipc_$block (addr (wait_list), addr (message), code); 967 /* go blocked waiting */ 968 if code ^= 0 then do; /* error */ 969 substr (st, 1, 36) = unspec (code); 970 return; 971 end; 972 973 /* We could have gotten another drive's wakeup so.... */ 974 975 976 tseg.command_count = 1; /* ready to do one order */ 977 tseg.buffer_count = 0; 978 tseg.command_queue (1) = rdycmd; /* which is a reset status */ 979 call tdcm_$tdcm_iocall (tsegp, code); /* issue order */ 980 if code ^= 0 then 981 return; /* goof..exit */ 982 if tseg.completion_status ^= 1 then 983 go to READY_CHK; /* not us..wait some more */ 984 985 stream_data_block.rewind = "0"b; /* turn off rewind sw */ 986 call tdcm_$tdcm_reset_signal (tsegp, code); /* disable special interrupt */ 987 return; 988 989 end; 990 991 /* Move copies data from a tseg buffer into the user's buffer after a read or copies 992* * data from the user's buffer ito a tseg buffer before a write. 993**/ 994 995 move: 996 proc (no); 997 998 dcl no fixed bin; /* index to tseg buffer */ 999 dcl ptseg ptr; /* ptr to current tseg buffer */ 1000 dcl puser ptr; /* ptr to current user buffer */ 1001 1002 ptseg = ptr (tsegp, tseg.bufferptr (no)); /* tseg buffer */ 1003 puser = addrel (wksp, off); /* user buffer */ 1004 1005 if tseg.write_sw = 1 then 1006 ptseg -> dum = puser -> dum; /* copy into tseg buffer for a write */ 1007 else puser -> dum = ptseg -> dum; /* copy into user's buffer for a read */ 1008 1009 return; 1010 end move; 1011 1012 /* Called if attachment was not completed. It releases the stream data block and the tape drive */ 1013 1014 clear_attach: 1015 proc; 1016 1017 if attach_sw then 1018 call tdcm_$tdcm_detach (tsegp, code); /* detach tape drive */ 1019 if sdb_ptr ^= null then 1020 call hcs_$delentry_seg (sdb_ptr, code); /* delete stream data block */ 1021 1022 return; 1023 1024 end clear_attach; 1025 1026 1027 1028 /* check_rewind goes blocked if the tape is still rewinding. */ 1029 1030 check_rewind: 1031 proc; 1032 1033 tsegp = tseg_ptr; /* copy for better access */ 1034 if stream_data_block.rewind then do; /* wait if rewind just done */ 1035 rdycmd = 100000b; /* Use reset status command here. */ 1036 call wait; 1037 if code ^= 0 then 1038 go to DCM_ERR; /* error?? */ 1039 end; 1040 1041 return; 1042 1043 end check_rewind; 1044 1045 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1606.1 nstd_dim.pl1 >dumps>old>recomp>nstd_dim.pl1 150 1 06/10/82 1045.4 tseg.incl.pl1 >ldd>include>tseg.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. a_code parameter fixed bin(35,0) dcl 160 set ref 154 174* a_user_block_size parameter fixed bin(17,0) dcl 160 ref 154 168 169 addr builtin function dcl 68 ref 217 221 237 724 966 966 966 966 addrel builtin function dcl 68 ref 724 1003 ap parameter pointer dcl 34 ref 682 711 751 766 770 770 772 attach_sw 000104 automatic bit(1) unaligned dcl 44 set ref 190* 262* 1017 bin builtin function dcl 70 ref 237 318 323 328 333 338 517 521 546 552 567 696 719 724 902 904 bit builtin function dcl 68 ref 517 719 902 bool builtin function dcl 70 ref 519 544 551 565 903 buf_count 21 based fixed bin(17,0) level 2 dcl 108 set ref 406 523 548 554 586 596 628 629 712* 714 716 716* 719 722 934 buf_mask 20 based bit(18) level 2 dcl 108 set ref 519 544 551 565 719* 903 bufchk 23 based fixed bin(17,0) level 2 dcl 108 set ref 516* 600 602* 602 630* 905 buffer 112 based bit(37440) array level 2 dcl 1-18 set ref 237 724 buffer_count 27 based fixed bin(12,0) level 2 dcl 1-18 set ref 406* 423* 523* 548* 554* 575* 586* 653* 833* 905* 925* 939* 977* buffer_offset 26 based fixed bin(12,0) level 2 dcl 1-18 set ref 236* 405* 425* 516 517 521* 546* 552* 567* 629* 654* 902 904* buffer_size 62 based fixed bin(18,0) array level 2 dcl 1-18 set ref 421* 437 472 650* 664 723* 1005 1007 bufferptr 46 based fixed bin(18,0) array level 2 dcl 1-18 set ref 237* 724* 1002 chn 2 000122 automatic fixed bin(71,0) level 2 dcl 53 set ref 965* cleanup 000156 stack reference condition dcl 100 ref 197 cmd 10 000000 constant bit(6) initial array level 2 dcl 135 ref 696 code 000100 automatic fixed bin(35,0) dcl 43 set ref 204* 207* 210 230* 231 246* 259* 260 273* 279* 280 281* 292* 293 304* 310* 311 312* 343* 347* 349 355* 357 368 376 380 408* 427* 428 456* 457 524* 525 550* 555* 577* 579 587* 657* 658 758* 759 784* 785 790* 800* 802 836* 837 842* 844 847* 848 849 907* 908 927* 928 944* 945 966* 968 969 979* 980 986* 1017* 1019* 1037 command_count 33 based fixed bin(12,0) level 2 dcl 1-18 set ref 424* 454* 573* 652* 756* 789* 835* 906* 926* 942* 976* command_queue 34 based fixed bin(6,0) array level 2 dcl 1-18 set ref 455* 570* 696* 757* 834* 943* 978* completion_status 30 based fixed bin(2,0) level 2 dcl 1-18 ref 431 459 527 581 589 660 761 791 839 910 931 933 982 count 000107 automatic fixed bin(17,0) dcl 49 set ref 399* 450 453* 453 564 622* cv_dec_check_ 000050 constant entry external dcl 85 ref 279 310 data_count 22 based fixed bin(17,0) level 2 dcl 108 set ref 531* 533 596* 603* 603 604 628* 920* 920 934* 934 937* 937 941 density 000111 automatic fixed bin(17,0) dcl 51 in procedure "nstd_dim" set ref 296* 310* 317 322 327 332 337 density 23 based bit(36) level 2 in structure "tseg" dcl 1-18 in procedure "nstd_dim" set ref 297* 319* 324* 329* 334* 339* device_name 24 based structure level 2 dcl 108 set ref 217 device_name_list 10 based pointer level 2 dcl 108 set ref 217* divide builtin function dcl 70 ref 712 drive_name 12 based char(32) level 2 dcl 1-18 set ref 370* dum based fixed bin(35,0) array dcl 64 set ref 1005* 1005 1007* 1007 eof_bit 15(03) based bit(1) level 3 packed unaligned dcl 108 set ref 501 505* 535* 720* 919 921* eot_bit 15(02) based bit(1) level 3 packed unaligned dcl 108 set ref 510 560* 720* error_buffer 32 based fixed bin(12,0) level 2 dcl 1-18 ref 531 546 548 569 573 937 error_table_$bad_arg 000024 external static fixed bin(35,0) dcl 35 ref 273 281 304 312 343 error_table_$bad_mode 000020 external static fixed bin(35,0) dcl 35 ref 246 872 error_table_$buffer_big 000022 external static fixed bin(35,0) dcl 35 ref 644 error_table_$ionmat 000026 external static fixed bin(35,0) dcl 35 ref 193 error_table_$no_backspace 000014 external static fixed bin(35,0) dcl 35 ref 460 583 error_table_$undefined_order_request 000016 external static fixed bin(35,0) dcl 35 ref 776 ev_chan 4 based fixed bin(71,0) level 2 dcl 1-18 set ref 230* 965 fix_init 15(06) based bit(1) level 3 packed unaligned dcl 108 set ref 226* 403 409* 506* 625 632* 727* 895 896* 914* fix_rec 15(01) based bit(1) level 3 packed unaligned dcl 108 set ref 401 624 689 710* 828 876 893* 913* fix_rec_size 17 based fixed bin(17,0) level 2 dcl 108 set ref 495 711* 712 723 724 fix_sw 000103 automatic bit(1) unaligned dcl 44 set ref 492* 672* get_size 10 based fixed bin(1,0) level 2 dcl 1-18 set ref 235* 718* hardware_status 31 based bit(36) level 2 dcl 1-18 ref 443 446 446 488 529 532 662 751 794 794 hbound builtin function dcl 70 ref 692 hcs_$delentry_seg 000054 constant entry external dcl 88 ref 847 1019 hcs_$make_seg 000030 constant entry external dcl 73 ref 207 hsbc 000164 automatic structure level 1 dcl 102 set ref 529* i 000110 automatic fixed bin(17,0) dcl 49 set ref 239* 240* 265* 266 267* 268 268* 271 272 276 277 279 279 299* 300 300* 302 303 307 308 310 310 569* 570* 692* 694 696 698 700* 722* 723 724 724* 733* 734* 739* 740* 745* 746* 941* index builtin function dcl 70 ref 255 265 267 268 299 300 instance 000010 internal static fixed bin(35,0) initial dcl 94 set ref 204* 205* 205 ioa_ 000056 constant entry external dcl 89 ref 352 370 ioa_$rsnnl 000060 constant entry external dcl 89 ref 204 ipc_$block 000062 constant entry external dcl 93 ref 966 ipc_$create_ev_chn 000052 constant entry external dcl 87 ref 230 j 000105 automatic fixed bin(17,0) dcl 44 set ref 276* 277 277* 279 279 307* 308 308* 310 310 564* lbound builtin function dcl 70 ref 692 length builtin function dcl 68 ref 272 277 303 308 362 maj 0(02) 000164 automatic bit(4) level 2 packed unaligned dcl 102 set ref 530 540 max builtin function dcl 70 ref 288 max_rec_len 16 based fixed bin(17,0) level 2 dcl 108 set ref 264* 279* 288* 288 292* 418 642 712 message 000126 automatic structure level 1 unaligned dcl 56 set ref 966 966 min 0(06) 000164 automatic bit(6) level 2 packed unaligned dcl 102 set ref 543 mode 76 based fixed bin(2,0) array level 2 dcl 1-18 set ref 240* 734* 740* 746* n 000122 automatic fixed bin(17,0) level 2 dcl 53 set ref 963* name 27 based char(256) level 3 dcl 108 set ref 220* 352* 354 361* 362 370* name1 parameter char unaligned dcl 31 ref 187 name2 parameter char unaligned dcl 31 ref 187 220 255 265 267 268 272 276 277 279 279 299 300 303 307 308 310 310 824 name_size 26 based fixed bin(17,0) level 3 dcl 108 set ref 219* 362* nelem parameter fixed bin(17,0) dcl 49 ref 394 418 421 495 606 617 642 650 nelemt parameter fixed bin(17,0) dcl 49 set ref 394 397* 437* 472* 606* 617 620* 664* newerr based fixed bin(17,0) dcl 98 ref 711 770 770 772 next_device_ptr 24 based pointer level 3 dcl 108 set ref 218* no parameter fixed bin(17,0) dcl 998 ref 995 1002 no_data_sw 15 based bit(1) level 3 packed unaligned dcl 108 set ref 404* 499 536* 595* 604* 627* null builtin function dcl 68 ref 191 209 218 766 1019 off parameter fixed bin(17,0) dcl 49 ref 394 617 1003 oldrw parameter char unaligned dcl 863 set ref 860 867* 869* oname 000000 constant char(32) initial array level 2 dcl 135 ref 694 ord 000135 automatic char(32) unaligned dcl 66 set ref 687* 694 708 732 738 744 750 755 765 912 ord_tab 000000 constant structure array level 1 dcl 135 ref 692 692 order parameter char unaligned dcl 31 ref 682 687 outer_module_name based char(32) level 2 dcl 108 set ref 216* ptr builtin function dcl 68 ref 1002 ptseg 000230 automatic pointer dcl 999 set ref 1002* 1005 1007 puser 000232 automatic pointer dcl 1000 set ref 1003* 1005 1007 rdycmd 000102 automatic fixed bin(6,0) dcl 44 set ref 318* 323* 328* 333* 338* 978 1035* rel builtin function dcl 68 ref 237 724 retry_cnt 14 based fixed bin(17,0) level 2 dcl 108 set ref 225* 399 622 767* 772* rewind 15(04) based bit(1) level 3 packed unaligned dcl 108 set ref 485* 700* 781 794 799* 985* 1034 ring 000106 automatic fixed bin(17,0) dcl 49 set ref 251* 253* 352 355* 370 rtrim builtin function dcl 68 ref 362 rw parameter char unaligned dcl 31 ref 187 245 245 245 245 251 860 871 871 871 871 879 sav_stat 000155 automatic bit(36) unaligned dcl 97 set ref 503 532* sdb_ptr parameter pointer dcl 34 set ref 187 191 207* 209 216 217 217 218 219 220 221 221 222 225 226 264 279 288 288 292 352 354 361 362 362 370 394 399 401 403 404 406 409 418 485 485 495 499 501 505 506 510 516 519 523 531 533 535 536 544 548 551 554 560 565 586 595 596 596 600 602 602 603 603 604 604 617 622 624 625 627 628 628 629 630 632 642 682 689 698 700 710 711 712 712 712 714 716 716 719 719 720 720 722 723 724 727 767 772 781 794 799 810 824 828 831 847* 860 865 876 893 895 896 903 905 913 914 919 920 920 921 934 934 934 937 937 941 985 1019 1019* 1033 1034 search builtin function dcl 68 ref 276 307 segnm 000145 automatic char(32) unaligned dcl 96 set ref 204* 207* setbit 000101 automatic bit(18) unaligned dcl 44 set ref 517* 519* 519 521 544* 544 546 551* 551 552 565* 565 567 902* 903* 903 904 size parameter fixed bin(17,0) dcl 813 set ref 810 815* some_bits 15 based structure level 2 dcl 108 sst based bit(18) dcl 65 set ref 751* st parameter bit(72) unaligned dcl 33 set ref 187 193* 210* 212* 374* 376* 380* 394 435* 460* 480* 488* 502* 503* 511* 512* 557* 558* 583* 607* 617 644* 682 776* 806* 810 824 849* 853* 854* 860 872* 883* 969* stream_data_block based structure level 1 dcl 108 string builtin function dcl 70 set ref 529* substr builtin function dcl 68 set ref 193* 210* 212* 276 279 279 307 310 310 374* 376* 380* 435* 443 446 446 460* 480* 488* 502* 503* 503 511* 512* 557* 558* 583* 607* 644* 662 776* 794 794 806* 849* 853* 854* 872* 883* 969* sync 7 based fixed bin(1,0) level 2 dcl 1-18 set ref 234* 522* 576* 626* 721* 892* tdcm_$tdcm_attach 000032 constant entry external dcl 75 ref 259 tdcm_$tdcm_detach 000034 constant entry external dcl 75 ref 842 1017 tdcm_$tdcm_iocall 000042 constant entry external dcl 75 ref 408 427 456 524 550 555 577 587 657 758 790 836 907 927 944 979 tdcm_$tdcm_message 000046 constant entry external dcl 75 ref 355 tdcm_$tdcm_reset_signal 000040 constant entry external dcl 75 ref 800 986 tdcm_$tdcm_set_buf_size 000044 constant entry external dcl 75 ref 292 tdcm_$tdcm_set_signal 000036 constant entry external dcl 75 ref 347 784 temp_name 000112 automatic char(32) unaligned dcl 52 set ref 354* 355* 361 tracks 22 based fixed bin(17,0) level 2 dcl 1-18 set ref 255* 257* tseg based structure level 1 dcl 1-18 tseg_ptr 12 based pointer level 2 dcl 108 set ref 221* 222 865 1033 tseg_version_2 constant fixed bin(17,0) initial dcl 1-16 ref 223 tsegarea 130 based fixed bin(71,0) level 2 dcl 108 set ref 221 tsegp 000166 automatic pointer dcl 1-15 set ref 222* 223 230 234 235 236 237 237 240 251 253 255 257 259* 292* 297 319 324 329 334 339 347* 355* 370 405 406 407 408* 412 417 421 423 424 425 427* 431 437 443 446 446 454 455 456* 459 464 472 473 488 516 517 521 522 523 524* 527 529 531 532 546 546 548 548 550* 552 554 555* 567 569 570 573 573 575 576 577* 581 586 587* 589 626 629 631 635 641 650 652 653 654 657* 660 662 664 696 718 721 723 724 724 734 740 746 751 756 757 758* 761 784* 789 790* 791 794 794 800* 833 834 835 836* 839 842* 865* 867 879 881 892 900 902 904 905 906 907* 910 925 926 927* 931 933 937 939 942 943 944* 965 976 977 978 979* 982 986* 1002 1002 1005 1005 1007 1017* 1033* type parameter char unaligned dcl 31 ref 187 824 unload 15(05) based bit(1) level 3 packed unaligned dcl 108 set ref 485 698* 831 unspec builtin function dcl 68 ref 193 210 376 380 460 583 644 776 849 872 969 user_block_size 000011 internal static fixed bin(17,0) dcl 163 set ref 169* 288 user_block_size_sw 000012 internal static bit(1) initial unaligned dcl 165 set ref 170* 172* 288 version_num based fixed bin(17,0) level 2 dcl 1-18 set ref 223* wait_list 000122 automatic structure level 1 unaligned dcl 53 set ref 966 966 wksp parameter pointer dcl 34 ref 394 617 1003 write_sw 6 based fixed bin(1,0) level 2 dcl 1-18 set ref 251* 253* 407* 412 417* 464 473 631* 635 641* 867 879* 881* 900 1005 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. max_rec_size internal static fixed bin(17,0) initial dcl 1-10 nbuffs internal static fixed bin(17,0) initial dcl 1-10 NAMES DECLARED BY EXPLICIT CONTEXT. BACKSPACE 004000 constant label dcl 939 ref 922 931 935 BAD_ATTACH 001612 constant label dcl 374 ref 231 247 260 274 282 293 305 313 344 349 357 368 BAD_BUF 002573 constant label dcl 644 ref 418 495 714 BAD_ORD 002066 constant label dcl 480 ref 443 446 533 540 592 665 761 791 839 910 BAD_OUT 000633 constant label dcl 210 COM 003232 constant label dcl 781 ref 702 DCM_ERR 001626 constant label dcl 380 ref 428 457 525 579 658 759 785 802 837 844 908 928 945 1037 DET 003444 constant label dcl 842 ref 831 DET_BIT 003503 constant label dcl 854 ref 850 GOOD_OUT 001763 constant label dcl 435 ref 660 ORD_OUT 003322 constant label dcl 806 ref 728 736 742 748 753 768 773 READY_CHK 004036 constant label dcl 963 ref 982 RECOV 001774 constant label dcl 443 RECOV1 002011 constant label dcl 450 ref 667 RLOOP 001730 constant label dcl 421 ref 466 STAT 003134 constant label dcl 751 ref 763 UOR 003223 constant label dcl 776 ref 770 WLOOP 002602 constant label dcl 650 ref 464 check_rewind 004232 constant entry internal dcl 1030 ref 398 621 685 827 clear_attach 004173 constant entry internal dcl 1014 ref 197 377 fix_com 002107 constant label dcl 495 ref 674 fix_out 002457 constant label dcl 600 ref 537 fix_r_write 002646 constant label dcl 672 ref 635 fix_read 002106 constant label dcl 492 ref 412 move 004135 constant entry internal dcl 995 ref 433 473 600 656 nstd_attach 000440 constant entry external dcl 187 nstd_cmode 003511 constant entry external dcl 860 nstd_detach 003356 constant entry external dcl 824 nstd_dim 000377 constant entry external dcl 27 nstd_getsize 003333 constant entry external dcl 810 nstd_order 002656 constant entry external dcl 682 nstd_read 001641 constant entry external dcl 394 nstd_write 002511 constant entry external dcl 617 reset_fix_rec 003646 constant entry internal dcl 890 ref 414 637 689 829 876 restart 002162 constant label dcl 519 ref 589 set_block_size 000411 constant entry external dcl 154 wait 004035 constant entry internal dcl 959 ref 367 1036 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5026 5112 4471 5036 Length 5372 4471 64 243 335 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME nstd_dim 236 external procedure is an external procedure. on unit on line 197 64 on unit reset_fix_rec internal procedure shares stack frame of external procedure nstd_dim. wait internal procedure shares stack frame of external procedure nstd_dim. move internal procedure shares stack frame of external procedure nstd_dim. clear_attach 70 internal procedure is called by several nonquick procedures. check_rewind internal procedure shares stack frame of external procedure nstd_dim. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 instance nstd_dim 000011 user_block_size nstd_dim 000012 user_block_size_sw nstd_dim STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME nstd_dim 000100 code nstd_dim 000101 setbit nstd_dim 000102 rdycmd nstd_dim 000103 fix_sw nstd_dim 000104 attach_sw nstd_dim 000105 j nstd_dim 000106 ring nstd_dim 000107 count nstd_dim 000110 i nstd_dim 000111 density nstd_dim 000112 temp_name nstd_dim 000122 wait_list nstd_dim 000126 message nstd_dim 000135 ord nstd_dim 000145 segnm nstd_dim 000155 sav_stat nstd_dim 000164 hsbc nstd_dim 000166 tsegp nstd_dim 000230 ptseg move 000232 puser move THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry ext_entry_desc int_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_check_ hcs_$delentry_seg hcs_$make_seg ioa_ ioa_$rsnnl ipc_$block ipc_$create_ev_chn tdcm_$tdcm_attach tdcm_$tdcm_detach tdcm_$tdcm_iocall tdcm_$tdcm_message tdcm_$tdcm_reset_signal tdcm_$tdcm_set_buf_size tdcm_$tdcm_set_signal THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$bad_mode error_table_$buffer_big error_table_$ionmat error_table_$no_backspace error_table_$undefined_order_request LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 27 000376 29 000404 154 000405 168 000416 169 000421 170 000423 171 000425 172 000426 174 000430 175 000431 187 000432 190 000476 191 000477 193 000503 194 000511 197 000512 204 000534 205 000565 207 000572 209 000627 210 000633 212 000637 213 000642 216 000643 217 000650 218 000652 219 000656 220 000662 221 000670 222 000672 223 000676 225 000700 226 000702 230 000704 231 000715 234 000717 235 000722 236 000723 237 000724 239 000730 240 000735 241 000737 245 000741 246 000767 247 000772 251 000773 253 001003 255 001010 257 001023 259 001024 260 001035 262 001037 264 001041 265 001045 266 001056 267 001060 268 001070 271 001102 272 001104 273 001106 274 001111 276 001112 277 001131 279 001136 280 001170 281 001173 282 001176 284 001177 288 001200 292 001210 293 001225 296 001227 297 001231 299 001234 300 001245 302 001257 303 001261 304 001263 305 001266 307 001267 308 001306 310 001313 311 001343 312 001346 313 001351 317 001352 318 001355 319 001357 320 001362 322 001363 323 001365 324 001367 325 001372 327 001373 328 001375 329 001377 330 001402 332 001403 333 001405 334 001407 335 001412 337 001413 338 001415 339 001417 340 001422 343 001423 344 001426 347 001427 349 001440 352 001442 354 001474 355 001501 357 001526 361 001530 362 001535 367 001547 368 001550 370 001552 371 001611 374 001612 376 001616 377 001621 378 001625 380 001626 382 001632 394 001633 397 001653 398 001655 399 001656 401 001662 403 001665 404 001670 405 001672 406 001674 407 001676 408 001677 409 001710 412 001714 414 001717 417 001720 418 001722 421 001730 423 001734 424 001736 425 001737 427 001740 428 001751 431 001753 433 001757 435 001763 437 001767 438 001773 443 001774 446 002001 450 002011 453 002013 454 002015 455 002020 456 002022 457 002033 459 002035 460 002041 462 002047 464 002050 466 002053 472 002054 473 002060 480 002066 485 002072 488 002101 489 002105 492 002106 495 002107 499 002115 501 002120 502 002123 503 002127 505 002132 506 002134 507 002136 510 002137 511 002142 512 002146 513 002151 516 002152 517 002155 519 002162 521 002166 522 002172 523 002173 524 002175 525 002206 527 002210 529 002214 530 002217 531 002225 532 002232 533 002234 535 002236 536 002240 537 002242 540 002243 543 002245 544 002252 546 002256 548 002262 550 002265 551 002276 552 002302 554 002306 555 002310 557 002321 558 002325 560 002330 561 002334 564 002335 565 002344 567 002350 569 002354 570 002363 572 002367 573 002371 575 002374 576 002375 577 002377 579 002410 581 002412 583 002416 584 002424 586 002425 587 002431 589 002442 591 002446 592 002450 595 002451 596 002455 600 002457 602 002466 603 002471 604 002473 606 002477 607 002502 608 002506 617 002507 620 002523 621 002525 622 002526 624 002532 625 002535 626 002540 627 002542 628 002544 629 002546 630 002550 631 002551 632 002553 635 002555 637 002561 641 002562 642 002565 644 002573 647 002601 650 002602 652 002605 653 002606 654 002610 656 002611 657 002615 658 002626 660 002630 662 002634 664 002641 665 002644 667 002645 672 002646 674 002650 682 002651 685 002676 687 002677 689 002705 692 002713 694 002720 696 002727 698 002733 700 002742 702 002750 705 002751 708 002753 710 002757 711 002763 712 002767 714 002772 716 002774 718 003000 719 003002 720 003007 721 003013 722 003014 723 003024 724 003032 726 003043 727 003045 728 003051 732 003052 733 003056 734 003063 735 003067 736 003071 738 003072 739 003076 740 003103 741 003105 742 003107 744 003110 745 003114 746 003121 747 003125 748 003127 750 003130 751 003134 753 003142 755 003143 756 003147 757 003152 758 003153 759 003164 761 003166 763 003172 765 003173 766 003177 767 003204 768 003210 770 003211 772 003217 773 003222 776 003223 779 003231 781 003232 784 003237 785 003250 789 003252 790 003255 791 003266 794 003272 799 003305 800 003307 802 003320 806 003322 808 003326 810 003327 815 003345 817 003350 824 003351 827 003403 828 003404 829 003411 831 003412 833 003417 834 003421 835 003423 836 003425 837 003436 839 003440 842 003444 844 003455 847 003457 848 003470 849 003472 850 003476 853 003477 854 003503 856 003506 860 003507 865 003535 867 003541 869 003553 871 003561 872 003607 873 003615 876 003616 879 003622 881 003636 883 003641 884 003645 890 003646 892 003647 893 003652 895 003656 896 003661 897 003663 900 003664 902 003667 903 003674 904 003676 905 003701 906 003703 907 003704 908 003715 910 003717 912 003723 913 003727 914 003733 916 003735 919 003736 920 003741 921 003742 922 003744 925 003745 926 003746 927 003747 928 003760 931 003762 933 003765 934 003767 935 003773 937 003774 939 004000 941 004001 942 004012 943 004015 944 004017 945 004030 947 004032 949 004034 959 004035 963 004036 965 004040 966 004043 968 004062 969 004064 970 004070 976 004071 977 004074 978 004075 979 004077 980 004110 982 004113 985 004117 986 004123 987 004134 995 004135 1002 004137 1003 004145 1005 004153 1007 004164 1009 004171 1014 004172 1017 004200 1019 004213 1022 004231 1030 004232 1033 004233 1034 004237 1035 004244 1036 004246 1037 004247 1041 004251 ----------------------------------------------------------- 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