Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 1 1:D 0 (* sccs info: @(#) cs80 8.1 84/05/04 00:16:44 *) 2:S 3:D 0 $modcal, debug off, range off, ovflcheck off, stackcheck off, callabs off$ 4:S 5:D 0 $search 'BRDECS', 'SR', 'MISCASM'$ 6:S 7:D 0 (*****************************************************************************) 8:D 0 (* *) 9:D 0 (* *** *** *** *** *) 10:D 0 (* * * * * * * * * *) 11:D 0 (* * * * * * * *) 12:D 0 (* * * *** * * *) 13:D 0 (* * * * * * * *) 14:D 0 (* * * * * * * * * *) 15:D 0 (* *** *** *** *** *) 16:D 0 (* *) 17:D 0 (*****************************************************************************) 18:S 19:D 0 module csCS80; {Command Set '80} 20:S 21:D 1 import 22:D 1 brdecs, sr; 23:S 24:D 1 export 25:S 26:D 1 type 27:D 1 unsgn24 = 0..16777215; 28:S 29:D 1 sva_type = {single-vector address (6 bytes)} 30:D 1 packed record 31:D 1 utb: signed16; {upper two bytes} 32:D 1 lfb: integer {lower four bytes (all we manage internally)} 33:D 1 end; 34:S 35:S 36:D 1 describe_type = {info returned by describe of unit other than controller} 37:D 1 packed record 38:D 1 {CONTROLLER DESCRIPTION FIELD} 39:D 1 iu: signed16; {installed unit word: 1 bit per unit} 40:D 1 mitr: signed16; {max instantaneous xfr rate (Kbytes)} 41:D 1 ct: unsgn8; {controller type} 42:D 1 {UNIT DESCRIPTION FIELD} 43:D 1 gdt: unsgn8; {generic device type} 44:D 1 dn: unsgn24; {device number (6 BCD digits)} 45:D 1 nbpb: signed16; {# of bytes per block} 46:D 1 nbb: unsgn8; {# of blocks which can be buffered} 47:D 1 rbs: unsgn8; {recommended burst size} 48:D 1 blocktime: signed16; {block time in microseconds} 49:D 1 catr: signed16; {continuous avg xfr rate (Kbytes)} 50:D 1 ort: signed16; {optimal retry time in centiseconds} 51:D 1 atp: signed16; {access time parameter in centiseconds} 52:D 1 mif: unsgn8; {maximum interleave factor} 53:D 1 fvb: unsgn8; {fixed volume byte: 1 bit/volume} 54:D 1 rvb: unsgn8; {removeable volume byte: 1 bit/vol} 55:D 1 {VOLUME DESCRIPTION FIELD} 56:D 1 maxcadd: unsgn24; {maximum cylinder address} 57:D 1 maxhadd: unsgn8; {maximum head address} 58:D 1 maxsadd: signed16; {maximum sector address} 59:D 1 maxsvadd: sva_type; {maximum single-vector address} 60:D 1 currentif: unsgn8; {current interleave factor} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 2 61:D 1 end; Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 3 62:D 1 $page$ 63:S 64:D 1 errorbit_type = {error bit assignments in status & status mask} 65:D 1 ( 66:D 1 {REJECT ERRORS FIELD} 67:D 1 { 0} eb0, 68:D 1 { 1} eb1, 69:D 1 { 2} channel_parity_error, 70:D 1 { 3} eb3, 71:D 1 { 4} eb4, 72:D 1 { 5} illegal_opcode, 73:D 1 { 6} module_addressing, 74:D 1 { 7} address_bounds, 75:D 1 { 8} parameter_bounds, 76:D 1 { 9} illegal_parameter, 77:D 1 {10} message_sequence, 78:D 1 {11} eb11, 79:D 1 {12} message_length, 80:D 1 {13} eb13, 81:D 1 {14} eb14, 82:D 1 {15} eb15, 83:D 1 {FAULT ERRORS FIELD} 84:D 1 {16} eb16, 85:D 1 {17} cross_unit, 86:D 1 {18} eb18, 87:D 1 {19} controller_fault, 88:D 1 {20} eb20, 89:D 1 {21} eb21, 90:D 1 {22} unit_fault, 91:D 1 {23} eb23, 92:D 1 {24} diagnostic_result, 93:D 1 {25} eb25, 94:D 1 {26} operator_release_required, 95:D 1 {27} diagnostic_release_required, 96:D 1 {28} internal_maintenance_required, 97:D 1 {29} eb29, 98:D 1 {30} power_fail, 99:D 1 {31} retransmit, 100:D 1 {ACCESS ERRORS FIELD} 101:D 1 {32} illegal_parallel_operation, 102:D 1 {33} uninitialized_media, 103:D 1 {34} no_spares_available, 104:D 1 {35} not_ready, 105:D 1 {36} write_protect, 106:D 1 {37} no_data_found, 107:D 1 {38} eb38, 108:D 1 {39} eb39, 109:D 1 {40} unrecoverable_data_overflow, 110:D 1 {41} unrecoverable_data, 111:D 1 {42} eb42, 112:D 1 {43} end_of_file, 113:D 1 {44} end_of_volume, 114:D 1 {45} eb45, 115:D 1 {46} eb46, 116:D 1 {47} eb47, Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 4 117:D 1 $page$ 118:D 1 {INFORMATION ERRORS FIELD} 119:D 1 {48} operator_request, 120:D 1 {49} diagnostic_request, 121:D 1 {50} internal_maintenance_request, 122:D 1 {51} media_wear, 123:D 1 {52} data_overrun, 124:D 1 {53} eb53, 125:D 1 {54} eb54, 126:D 1 {55} auto_sparing_invoked, 127:D 1 {56} eb56, 128:D 1 {57} recoverable_data_overflow, 129:D 1 {58} marginal_data, 130:D 1 {59} recoverable_data, 131:D 1 {60} eb60, 132:D 1 {61} maintenance_track_overflow, 133:D 1 {62} eb62, 134:D 1 {63} eb63 135:D 1 ); 136:S 137:S 138:D 1 status_mask_type = 139:D 1 packed array[errorbit_type] of boolean; 140:S 141:S 142:D 1 status_type = 143:D 1 packed record 144:D 1 {IDENTIFICATION FIELD} 145:D 1 current_vol: unsgn4; {current volume} 146:D 1 current_unit: unsgn4; {current unit} 147:D 1 requesting_unit: signed8; {unit requesting service} 148:D 1 {ERROR REPORTING FIELDS} 149:D 1 errorbits: status_mask_type; 150:D 1 {PARAMETER FIELD} 151:D 1 case integer of 152:D 1 {positive case numbers correspond to error bits} 153:D 1 -1: (nta: sva_type; {new target address} 154:D 1 faultlog: integer); {fault log} 155:D 1 -2: (aaa: sva_type; {affected area address} 156:D 1 afl: integer); {affected field length} 157:D 1 17: (uee: packed array[1..6] of signed8); {units experiencing errors} 158:D 1 24: (dor: packed array[1..6] of unsgn8); {diagnostic results} 159:D 1 38: (ta: sva_type); {target address} 160:D 1 41: (bba: sva_type); {bad block address} 161:D 1 48..50: (urr: packed array[1..6] of signed8); {units requesting release} 162:D 1 58: (btbs: sva_type); {block to be spared} 163:D 1 59: (rba: sva_type) {recoverable block address} 164:D 1 end; {case} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 5 165:D 1 $page$ 166:S 167:D 1 function qstat: unsgn8; 168:S 169:S { 170:S NOTE: the following functions each perform a COMPLETE transaction. They: 171:S . issue a (device or transparent) command (Command message) 172:S . transfer data if applicable (Execution message) 173:S . return the resulting QSTAT (Reporting message) 174:D 1 } 175:D 1 function chan_indep_clr: unsgn8; 176:D 1 function status(var status_bytes: status_type): unsgn8; 177:D 1 function describe(var describe_bytes: describe_type): unsgn8; 178:D 1 function set_unit(unit: unsgn4): unsgn8; 179:D 1 function release(unit: unsgn4): unsgn8; 180:D 1 function set_status_mask(status_mask: status_mask_type): unsgn8; 181:D 1 function read(addr: integer; bufptr: anyptr; length: integer; bit_bucket_length: signed16): unsgn8; 182:S 183:S 184:D 1 implement {csCS80} 185:S 186:D 1 type 187:D 1 CMD_type = {enumerated opcodes for device commands} 188:D 1 ( 189:D 1 CMDlocate_and_read, CMD1 , CMDlocate_and_wrt , CMD3 , 190:D 1 CMDlocate_and_ver , CMD5 , CMDspare_block , CMD7 , 191:D 1 CMDcopy_data , CMD9 , CMDcold_load_read , CMD11 , 192:D 1 CMD12 , CMDrequest_status , CMDrelease , CMDrelease_denied , 193:D 1 CMDset_address_1V , CMDset_address_3V , CMDset_block_disp , CMD19 , 194:D 1 CMD20 , CMD21 , CMD22 , CMD23 , 195:D 1 CMDset_length , CMD25 , CMD26 , CMD27 , 196:D 1 CMD28 , CMD29 , CMD30 , CMD31 , 197:D 1 CMDset_unit_0 , CMDset_unit_1 , CMDset_unit_2 , CMDset_unit_3 , 198:D 1 CMDset_unit_4 , CMDset_unit_5 , CMDset_unit_6 , CMDset_unit_7 , 199:D 1 CMDset_unit_8 , CMDset_unit_9 , CMDset_unit_10 , CMDset_unit_11 , 200:D 1 CMDset_unit_12 , CMDset_unit_13 , CMDset_unit_14 , CMDset_unit_15 , 201:D 1 CMDinit_util_NEM , CMDinit_util_REM , CMDinit_util_SEM , CMDinit_diagnostic, 202:D 1 CMDno_op , CMDdescribe , CMD54 , CMDinit_media , 203:D 1 CMDset_options , CMDset_rps , CMDset_retry_time , CMDset_release , 204:D 1 CMDset_burst_LBO , CMDset_burst_ABT , CMDset_status_mask, CMD63 , 205:D 1 CMDset_vol_0 , CMDset_vol_1 , CMDset_vol_2 , CMDset_vol_3 , 206:D 1 CMDset_vol_4 , CMDset_vol_5 , CMDset_vol_6 , CMDset_vol_7 , 207:D 1 CMDset_retadd_mode, CMDwrite_file_mark, CMD74 , CMD75 , 208:D 1 CMD76 , CMD77 , CMD78 , CMD79 , 209:D 1 CMD80 , CMD81 , CMD82 , CMD83 , 210:D 1 CMD84 , CMD85 , CMD86 , CMD87 , 211:D 1 CMD88 , CMD89 , CMD90 , CMD91 , 212:D 1 CMD92 , CMD93 , CMD94 , CMD95 , 213:D 1 CMD96 , CMD97 , CMD98 , CMD99 , 214:D 1 CMD100 , CMD101 , CMD102 , CMD103 , 215:D 1 CMD104 , CMD105 , CMD106 , CMD107 , 216:D 1 CMD108 , CMD109 , CMD110 , CMD111 , 217:D 1 CMD112 , CMD113 , CMD114 , CMD115 , 218:D 1 CMD116 , CMD117 , CMD118 , CMD119 , 219:D 1 CMD120 , CMD121 , CMD122 , CMD123 , 220:D 1 CMD124 , CMD125 , CMD126 , CMD127 , 221:D 1 CMD128 {the field width is forced to 8 bits for packing considerations} 222:D 1 ); Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 6 223:D 1 $page$ 224:S 225:D 1 const 226:D 1 transparent_sec = 18; 227:D 1 command_sec = 5; 228:D 1 execution_sec = 14; 229:D 1 reporting_sec = 16; 230:S 231:S 232:D 1 function qstat: unsgn8; 233:S { 234:S receive a REPORTING message 235:S return the QSTAT byte 236:D 2 } 237:D 2 var 238:D 2 qstat_byte: {the 1 byte in the reporting message} 239:D 2 packed record 240:D 2 b: unsgn8 241:D -2 2 end; 242:C 2 begin {qstat} 243:C 2 HPIB_short_msge_in(reporting_sec, addr(qstat_byte), sizeof(qstat_byte)); 244:C 2 qstat := qstat_byte.b 245:C 2 end; {qstat} 246:S 247:S 248:D 1 function chan_indep_clr: unsgn8; 249:S { 250:S issue the CHANNEL_INDEPENDENT_CLEAR command 251:S return the QSTAT byte 252:D 2 } 253:D 2 var 254:D 2 cic: {the 2 bytes in the channel independent clear command message} 255:D 2 packed record 256:D 2 setunit: CMD_type; 257:D 2 ci_clr: unsgn8 258:D -2 2 end; 259:C 2 begin {chan_indep_clr} 260:C 2 cic.setunit := CMD_type(signed16(CMDset_unit_0)+f_area^.m_msus.un4); 261:C 2 cic.ci_clr := 8; 262:C 2 HPIB_short_msge_out(transparent_sec, addr(cic), sizeof(cic)); 263:C 2 HPIB_wait_for_ppol; 264:C 2 chan_indep_clr := qstat; 265:C 2 end; {chan_indep_clr} 266:S 267:S 268:D 1 procedure ICc(cmd: CMD_type); 269:S { 270:S issue the specified command 271:D 2 } 272:D 2 var 273:D 2 c: {the 1-byte command message} 274:D 2 packed record 275:D 2 cmd: CMD_type; 276:D -2 2 end; 277:C 2 begin {ICuc} 278:C 2 c.cmd := cmd; 279:C 2 HPIB_short_msge_out(command_sec, addr(c), sizeof(c)) 280:C 2 end; {ICc} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 7 281:D 1 $page$ 282:S 283:D 1 procedure ICuc(unit: unsgn4; cmd: CMD_type); 284:S { 285:S issue specified SET_UNIT & command 286:D 2 } 287:D 2 var 288:D 2 uc: {the 2-byte command message} 289:D 2 packed record 290:D 2 setunit: CMD_type; 291:D 2 cmd: CMD_type; 292:D -2 2 end; 293:C 2 begin {ICuc} 294:C 2 uc.setunit := CMD_type(signed16(CMDset_unit_0)+unit); 295:C 2 uc.cmd := cmd; 296:C 2 HPIB_short_msge_out(command_sec, addr(uc), sizeof(uc)); 297:C 2 end; {ICuc} 298:S 299:S 300:D 1 function status(var status_bytes: status_type): unsgn8; 301:S { 302:S issue the REQUEST_STATUS command 303:S place the 20 bytes of status in the passed variable 'status_bytes' 304:S return the QSTAT byte 305:D 2 } 306:C 2 begin {status} 307:C 2 ICc(CMDrequest_status); 308:C 2 HPIB_wait_for_ppol; 309:C 2 HPIB_short_msge_in(execution_sec, addr(status_bytes), sizeof(status_bytes)); 310:C 2 HPIB_wait_for_ppol; 311:C 2 status := qstat; 312:C 2 end; {status} 313:S 314:S 315:D 1 function describe(var describe_bytes: describe_type): unsgn8; 316:S { 317:S SET_UNIT & issue the DESCRIBE command 318:S place the 37 bytes of description in the passed variable 'describe_bytes' 319:S return the QSTAT byte 320:D 2 } 321:C 2 begin {describe} 322:C 2 ICuc(f_area^.m_msus.un4, CMDdescribe); 323:C 2 HPIB_wait_for_ppol; 324:C 2 HPIB_short_msge_in(execution_sec, addr(describe_bytes), sizeof(describe_bytes)); 325:C 2 HPIB_wait_for_ppol; 326:C 2 describe := qstat; 327:C 2 end; {describe} 328:S 329:S 330:D 1 function set_unit(unit: unsgn4): unsgn8; 331:S { 332:S issue the SET_UNIT command 333:S return the QSTAT byte 334:D 2 } 335:C 2 begin {set_unit} 336:C 2 ICc(CMD_type(signed16(CMDset_unit_0)+unit)); 337:C 2 HPIB_wait_for_ppol; 338:C 2 set_unit := qstat; 339:C 2 end; {set_unit} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 8 340:D 1 $page$ 341:S 342:D -8 1 function set_status_mask(status_mask: status_mask_type): unsgn8; 343:D -8 2 var 344:D -8 2 ssm: {the 10 bytes in the SET_STATUS_MASK command message} 345:D -8 2 packed record 346:D -8 2 nop: CMD_type; 347:D -8 2 setstsmsk: CMD_type; 348:D -8 2 stsmsk: status_mask_type; 349:D -18 2 end; 350:C 2 begin {set_status_mask} 351:C 2 ssm.nop := CMDno_op; 352:C 2 ssm.setstsmsk := CMDset_status_mask; 353:C 2 ssm.stsmsk := status_mask; 354:C 2 HPIB_short_msge_out(command_sec, addr(ssm), sizeof(ssm)); 355:C 2 HPIB_wait_for_ppol; 356:C 2 set_status_mask := qstat; 357:C 2 end; {set_status_mask} 358:S 359:S 360:D 1 procedure ICvalc(address, len: integer; cmd: CMD_type); 361:S { 362:S issue the following command sequence: 363:S . SET_VOLUME (v) 364:S . SET_ADDRESS (a) 365:S . SET_LENGTH (l) 366:S . specified COMMAND (c) 367:D 2 } 368:D 2 var 369:D 2 valc: {the 15 bytes in the command message} 370:D 2 packed record 371:D 2 setvol: CMD_type; {set volume} 372:D 2 setadd: CMD_type; {set address} 373:D 2 sva: sva_type; {single vector address} 374:D 2 nop: CMD_type; {nop} 375:D 2 setlen: CMD_type; {set length} 376:D 2 length: integer; {length} 377:D 2 cmd: CMD_type; {specified command} 378:D -16 2 end; 379:C 2 begin {ICvalc} 380:C 2 valc.setvol := CMD_type(signed16(CMDset_vol_0)+f_area^.m_msus.vn4); 381:C 2 valc.setadd := CMDset_address_1V; 382:C 2 valc.sva.utb := 0; 383:C 2 valc.sva.lfb := address; 384:C 2 valc.nop := CMDno_op; 385:C 2 valc.setlen := CMDset_length; 386:C 2 valc.length := len; 387:C 2 valc.cmd := cmd; 388:C 2 HPIB_short_msge_out(command_sec, addr(valc), sizeof(valc)) 389:C 2 end; {ICvalc} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 9 390:D 1 $page$ 391:S 392:D 1 function release(unit: unsgn4): unsgn8; 393:S { 394:S issue the SET_UNIT & RELEASE commands 395:S return the QSTAT byte 396:D 2 } 397:C 2 begin {release} 398:C 2 ICuc(unit, CMDrelease); 399:C 2 HPIB_wait_for_ppol; 400:C 2 release := qstat; 401:C 2 end; {release} 402:S 403:S 404:D 1 function read(addr: integer; bufptr: anyptr; length: integer; bit_bucket_length: signed16): unsgn8; 405:S { 406:S set VOL/ADDRESS/LENGTH & issue LOCATE_AND_READ 407:S transfer the data into buf 408:S return QSTAT 409:D 2 } 410:C 2 begin {read} 411:C 2 ICvalc(addr, length+bit_bucket_length, CMDlocate_and_read); 412:C 2 HPIB_wait_for_ppol; 413:C 2 try 414:C 3 HPIB_long_msge_in(execution_sec, bufptr, length, bit_bucket_length); 415:C 3 recover 416:C 3 if escapecode<>ec_bad_error_state then escape(escapecode); 417:C 2 HPIB_wait_for_ppol; 418:C 2 read := qstat; 419:C 2 end; {read} 420:S 421:S 422:C 1 end; {csCS80} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 10 423:D 1 $page$ 424:S 425:D 1 module ddCS80; 426:S 427:D 1 import 428:D 1 brdecs, sr, miscasm, csCS80; 429:S 430:D 1 export 431:D 1 function controllersID(cardID: unsgn8; HPIBident: signed16): boolean; 432:D 1 procedure setdevicename(var device_name: string255); 433:D 1 procedure controller_init; 434:D 1 procedure unit_init; 435:D 1 procedure deviceread(buf_ptr: anyptr; length, start_addr: integer); 436:S 437:D 1 implement {ddCS80} 438:S 439:S 440:D 1 procedure handle_bad_status(var retry_required: boolean); forward; 441:S 442:S 443:D 1 procedure configure; 444:S 445:D 2 const 446:D 2 masked = true; 447:D 2 unmasked = false; 448:S 449:D 2 my_status_mask = status_mask_type 450:D 2 [ 451:D 2 {REJECT ERRORS FIELD} 452:D 2 { 0 eb0: } unmasked, 453:D 2 { 1 eb1: } unmasked, 454:D 2 { 2 channel_parity_error: } unmasked, 455:D 2 { 3 eb3: } unmasked, 456:D 2 { 4 eb4: } unmasked, 457:D 2 { 5 illegal_opcode: } unmasked, 458:D 2 { 6 module_addressing: } unmasked, 459:D 2 { 7 address_bounds: } unmasked, 460:D 2 { 8 parameter_bounds: } unmasked, 461:D 2 { 9 illegal_parameter: } unmasked, 462:D 2 {10 message_sequence: } unmasked, 463:D 2 {11 eb11: } unmasked, 464:D 2 {12 message_length: } unmasked, 465:D 2 {13 eb13: } unmasked, 466:D 2 {14 eb14: } unmasked, 467:D 2 {15 eb15: } unmasked, 468:D 2 {FAULT ERRORS FIELD} 469:D 2 {16 eb16: } unmasked, {unmaskable error} 470:D 2 {17 cross_unit: } unmasked, {unmaskable error} 471:D 2 {18 eb18: } unmasked, {unmaskable error} 472:D 2 {19 controller_fault: } unmasked, {unmaskable error} 473:D 2 {20 eb20: } unmasked, {unmaskable error} 474:D 2 {21 eb21: } unmasked, {unmaskable error} 475:D 2 {22 unit_fault: } unmasked, {unmaskable error} 476:D 2 {23 eb23: } unmasked, {unmaskable error} 477:D 2 {24 diagnostic_result: } unmasked, {unmaskable error} 478:D 2 {25 eb25: } unmasked, {unmaskable error} 479:D 2 {26 operator_release_required: } unmasked, {unmaskable error} 480:D 2 {27 diagnostic_release_required: } unmasked, {unmaskable error} 481:D 2 {28 internal_maintenance_required: } unmasked, {unmaskable error} 482:D 2 {29 eb29: } unmasked, {unmaskable error} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 11 483:D 2 {30 power_fail: } unmasked, {unmaskable error} 484:D 2 {31 retransmit: } unmasked, {unmaskable error} 485:D 2 {ACCESS ERRORS FIELD} 486:D 2 {32 illegal_parallel_operation: } unmasked, 487:D 2 {33 uninitialized_media: } unmasked, 488:D 2 {34 no_spares_available: } unmasked, 489:D 2 {35 not_ready: } unmasked, 490:D 2 {36 write_protect: } unmasked, 491:D 2 {37 no_data_found: } unmasked, 492:D 2 {38 eb38: } unmasked, 493:D 2 {39 eb39: } unmasked, 494:D 2 {40 unrecoverable_data_overflow: } unmasked, 495:D 2 {41 unrecoverable_data: } unmasked, 496:D 2 {42 eb42: } unmasked, 497:D 2 {43 end_of_file: } unmasked, 498:D 2 {44 end_of_volume: } unmasked, 499:D 2 {45 eb45: } unmasked, 500:D 2 {46 eb46: } unmasked, 501:D 2 {47 eb47: } unmasked, 502:D 2 {INFORMATION ERRORS FIELD} 503:D 2 {48 operator_request: } unmasked, 504:D 2 {49 diagnostic_request: } unmasked, 505:D 2 {50 internal_maintenance_request: } unmasked, 506:D 2 {51 media_wear: } masked, 507:D 2 {52 data_overrun: } masked, 508:D 2 {53 eb53: } masked, 509:D 2 {54 eb54: } masked, 510:D 2 {55 auto_sparing_invoked: } masked, 511:D 2 {56 eb56: } masked, 512:D 2 {57 recoverable_data_overflow: } masked, 513:D 2 {58 marginal_data: } masked, 514:D 2 {59 recoverable_data: } masked, 515:D 2 {60 eb60: } masked, 516:D 2 {61 maintenance_track_overflow: } masked, 517:D 2 {62 eb62: } masked, 518:D 2 {63 eb63: } masked 519:D 2 ]; 520:S 521:D 2 var 522:D -1 2 retry_required: boolean; 523:S 524:C 2 begin {configure} 525:C 2 repeat 526:C 3 retry_required := false; 527:C 3 if set_status_mask(my_status_mask)<>0 then 528:C 4 handle_bad_status(retry_required); 529:C 3 until not retry_required; 530:C 2 end; {configure} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 12 531:D 1 $page$ 532:S 533:D 1 procedure handle_bad_status(var retry_required: boolean); 534:S 535:D 2 var 536:D -2 2 pending_escape: signed16; 537:D -22 2 status_bytes: status_type; 538:D -24 2 original_unit: unsgn4; 539:D -26 2 eb_scan: errorbit_type; 540:D -27 2 release_needed: boolean; 541:D -28 2 reconfiguration_needed: boolean; 542:D -30 2 urr_index: signed16; 543:S 544:C 2 begin {handle_bad_status} 545:S 546:C 2 pending_escape := -1; 547:C 2 retry_required := false; 548:C 2 reconfiguration_needed := false; 549:S 550:C 2 repeat 551:S 552:C 3 if status(status_bytes)<>0 then 553:C 4 escape(ec_bad_hardware); 554:S 555:C 3 original_unit := status_bytes.current_unit; 556:S 557:C 3 release_needed := false; 558:S 559:C 3 for eb_scan := eb63 downto eb0 do {go backwards so highest priority error left in ec} 560:C 4 if status_bytes.errorbits[eb_scan] then 561:C 5 case eb_scan of 562:S 563:C 6 {specific fatal errors} 564:C 6 channel_parity_error, 565:C 6 controller_fault, 566:C 6 unit_fault, 567:C 6 diagnostic_result: 568:C 6 pending_escape := ec_bad_hardware; 569:C 6 module_addressing: 570:C 6 pending_escape := ec_no_device; 571:C 6 not_ready: 572:C 6 pending_escape := ec_not_ready; 573:C 6 address_bounds, 574:C 6 no_data_found, 575:C 6 unrecoverable_data_overflow, 576:C 6 unrecoverable_data, 577:C 6 end_of_file, 578:C 6 end_of_volume: 579:C 6 pending_escape := ec_read_error; 580:S 581:C 6 {powerfail} 582:C 6 power_fail: 583:C 6 begin 584:C 6 reconfiguration_needed := true; 585:C 6 retry_required := true; 586:C 6 end; Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 13 587:C 6 $page$ 588:C 6 {retryable errors} 589:C 6 operator_release_required, 590:C 6 diagnostic_release_required, 591:C 6 internal_maintenance_required, 592:C 6 retransmit, 593:C 6 uninitialized_media: {7908/Linus always says this the first time after loading} 594:C 6 retry_required := true; 595:S 596:C 6 {errors indicating release requested} 597:C 6 operator_request, 598:C 6 diagnostic_request, 599:C 6 internal_maintenance_request: 600:C 6 release_needed := true; 601:S 602:C 6 {errors indicating reconfiguration needed} 603:C 6 media_wear, {supposed to be masked out} 604:C 6 data_overrun, {supposed to be masked out} 605:C 6 eb53, {supposed to be masked out} 606:C 6 eb54, {supposed to be masked out} 607:C 6 auto_sparing_invoked, {supposed to be masked out} 608:C 6 eb56, {supposed to be masked out} 609:C 6 recoverable_data_overflow, {supposed to be masked out} 610:C 6 marginal_data, {supposed to be masked out} 611:C 6 recoverable_data, {supposed to be masked out} 612:C 6 eb60, {supposed to be masked out} 613:C 6 maintenance_track_overflow, {supposed to be masked out} 614:C 6 eb62, {supposed to be masked out} 615:C 6 eb63: {supposed to be masked out} 616:C 6 reconfiguration_needed := true; 617:S 618:C 6 {errors not covered by the above cases} 619:C 6 otherwise 620:C 6 pending_escape := ec_bad_error_state; 621:S 622:C 6 end; {case} 623:S 624:C 3 if pending_escape>=0 then escape(pending_escape); 625:S 626:C 3 if release_needed then 627:C 4 begin 628:C 4 urr_index := 1; 629:C 4 while (urr_index<=6) and (status_bytes.urr[urr_index]>=0) do 630:C 5 begin 631:C 5 if release(status_bytes.urr[urr_index])<>0 then 632:C 6 {handle it elsewhere}; 633:C 5 urr_index := urr_index+1; 634:C 5 end; {while} 635:C 4 end; {if} 636:S 637:C 3 until set_unit(original_unit)=0; 638:S 639:C 2 if reconfiguration_needed then 640:C 3 configure; {and hope this doesn't somehow lead to endless recursion!} 641:S 642:C 2 end; {handle_bad_status} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 14 643:D 1 $page$ 644:S 645:D 1 function controllersID(cardID: unsgn8; HPIBident: signed16): boolean; 646:C 2 begin {controllersID} 647:C 2 controllersID := HPIBident div 256=2; 648:C 2 end; {controllersID} 649:S 650:S 651:D 1 procedure check_ident; 652:C 2 begin {check_ident} 653:C 2 if HPIB_amigo_identify div 256<>2 then escape(ec_no_device); 654:C 2 end; {check_ident} 655:S 656:S 657:D 1 procedure setdevicename(var device_name: string255); 658:D 2 var 659:D -1 2 retry_required: boolean; 660:D -38 2 describe_bytes: describe_type; 661:D -38 2 bcd_product_number: {within the describe bytes} 662:D -38 2 packed record case integer of 663:D -38 2 0: (dn: unsgn24); 664:D -38 2 1: (bcd: packed array[1..6] of unsgn4); 665:D -42 2 end; 666:D -46 2 index, digit: signed16; 667:D -47 2 significant_digits: boolean; 668:C 2 begin {setdevicename} 669:S 670:C 2 check_ident; 671:S 672:C 2 repeat 673:C 3 retry_required := false; 674:C 3 if describe(describe_bytes)<>0 then 675:C 4 handle_bad_status(retry_required); 676:C 3 until not retry_required; 677:S 678:C 2 bcd_product_number.dn := describe_bytes.dn; 679:C 2 significant_digits := false; 680:C 2 device_name := 'HP'; 681:C 2 for index := 1 to 5 do 682:C 3 begin 683:C 3 digit := bcd_product_number.bcd[index]; 684:C 3 if digit<>0 then significant_digits := true; 685:C 3 if significant_digits then 686:C 4 begin 687:C 4 setstrlen(device_name, strlen(device_name)+1); 688:C 4 device_name[strlen(device_name)] := chr(ord('0')+digit); 689:C 4 end; 690:C 3 end; {for} 691:S 692:C 2 with describe_bytes do 693:C 3 begin 694:C 3 if gdt=1 then {removable disc or combination: tell whether fixed or removable} 695:C 4 if bit_tst(rvb, 0, f_area^.m_msus.vn4) 696:C 5 then device_name := device_name+' REMV' 697:C 5 else device_name := device_name+' FIXD'; 698:C 3 if gdt=2 then {tape} 699:C 4 device_name := device_name+' TAPE'; 700:C 3 end; {with} 701:S 702:C 2 end; {setdevicename} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 15 703:D 1 $page$ 704:S 705:D 1 procedure controller_init; 706:S 707:D 2 var 708:D -1 2 retry_required: boolean; 709:S 710:C 2 begin {controller_init} 711:S 712:C 2 HPIB_amigo_clear; 713:C 2 HPIB_wait_for_ppol; 714:C 2 if qstat<>0 then {bad diagnostic result} 715:C 3 begin 716:C 3 handle_bad_status(retry_required); {should escape} 717:C 3 escape(ec_bad_error_state); {if not, I will here!} 718:C 3 end; {if} 719:S 720:C 2 end; {controller_init} 721:S 722:S 723:D 1 procedure unit_init; 724:S 725:D 2 var 726:D -1 2 retry_required: boolean; 727:D -2 2 vb: char; 728:D -40 2 describe_bytes: describe_type; 729:S 730:C 2 begin {unit_init} 731:S 732:C 2 if f_area^.m_msus.un4>14 then 733:C 3 escape(ec_no_device); 734:S 735:C 2 HPIB_clear; 736:C 2 check_ident; 737:S 738:C 2 if chan_indep_clr<>0 then {no unit present or bad diagnostic_result} 739:C 3 begin 740:C 3 handle_bad_status(retry_required); {should escape} 741:C 3 escape(ec_bad_error_state); {if not, I will here!} 742:C 3 end; {if} 743:S 744:C 2 configure; 745:S 746:C 2 repeat 747:C 3 retry_required := false; 748:C 3 if describe(describe_bytes)<>0 then 749:C 4 handle_bad_status(retry_required); 750:C 3 until not retry_required; 751:S 752:C 2 with describe_bytes, f_area^.m_msus do 753:C 3 begin 754:C 3 vb := chr(fvb+rvb); 755:C 3 if not bit_tst(vb, 0, vn4) then {volume not present} 756:C 4 escape(ec_no_device); 757:C 3 if nbpb=256 758:C 4 then dev := CS80_256 759:C 4 else dev := CS80_other; 760:C 3 end; {with} 761:S 762:C 2 end; {unit_init} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 16 763:D 1 $page$ 764:S 765:D 1 procedure deviceread(buf_ptr: anyptr; length, start_addr: integer); 766:S 767:D 2 var 768:D -2 2 bit_bucket_length: signed16; 769:D -40 2 describe_bytes: describe_type; 770:D -42 2 sectors_per_block: signed16; 771:D -44 2 bytes_per_block: signed16; 772:D -46 2 unsuccessful_tries: signed16; 773:D -47 2 retry_required: boolean; 774:S 775:C 2 begin {deviceread} 776:S 777:C 2 check_ident; 778:S 779:C 2 repeat 780:C 3 retry_required := false; 781:C 3 if set_unit(f_area^.m_msus.un4)<>0 then 782:C 4 handle_bad_status(retry_required); 783:C 3 until not retry_required; 784:S 785:C 2 if f_area^.m_msus.dev=CS80_256 then 786:C 3 bit_bucket_length := 0 787:C 3 else 788:C 3 begin {block size other than 256 bytes} 789:S 790:C 3 repeat 791:C 4 retry_required := false; 792:C 4 if describe(describe_bytes)<>0 then 793:C 5 handle_bad_status(retry_required); 794:C 4 until not retry_required; 795:S 796:C 3 bytes_per_block := describe_bytes.nbpb; 797:C 3 if bytes_per_block>256 then 798:C 4 begin 799:C 4 if (bytes_per_block mod 256)<>0 then 800:C 5 escape(ec_bad_error_state); {must be a multiple of 256} 801:C 4 sectors_per_block := bytes_per_block div 256; 802:C 4 bit_bucket_length := (start_addr mod sectors_per_block)*256; 803:C 4 start_addr := start_addr div sectors_per_block; 804:C 4 end {then} 805:C 4 else 806:C 4 begin 807:C 4 if (256 mod bytes_per_block)<>0 then 808:C 5 escape(ec_bad_error_state); {must be an even divisor of 256} 809:C 4 bit_bucket_length := 0; 810:C 4 start_addr := start_addr*(256 div bytes_per_block); 811:C 4 end; {else} 812:S 813:C 3 end; {else} Pascal [Rev 3.0M 6/ 4/84] CS80.TEXT 28-Jun-89 17:44:39 Page 17 814:C 2 $page$ 815:S 816:C 2 unsuccessful_tries := 0; 817:C 2 repeat 818:C 3 retry_required := false; 819:C 3 if read(start_addr, buf_ptr, length, bit_bucket_length)<>0 then 820:C 4 begin 821:C 4 handle_bad_status(retry_required); 822:C 4 if retry_required then 823:C 5 begin 824:C 5 unsuccessful_tries := unsuccessful_tries+1; 825:C 5 if unsuccessful_tries>=3 then escape(ec_read_error); 826:C 5 end; {then} 827:C 4 end; {then} 828:C 3 until not retry_required; 829:S 830:C 2 end; {deviceread} 831:S 832:S 833:C 1 end. {ddCS80} 834:S 835:S 836:S No errors. No warnings. ***** Nonstandard language features enabled *****