2 .*************** SLEUTH SIMULATOR VERSION 0.10 ****************** 4 DB YY,7,0 6 DB ZZ,118,-1 8 ASSIGN ZZ(39),0 10 DB SS,16,-1 12 DB WW,110,0 14 DB RR,24 16 ASSIGN RR(0),0,!100,!200,!300,!400,!500,!600,!700,!800,!900 18 ASSIGN RR(10),!A00,!B00,!C00,!D00,!E00,!F00,!1500,!1100,!8000,!4000 20 ASSIGN RR(20),%330,%202,!1300,!1000 22 DB TT,7,!AAAA 24 DB &WW,72,"EOFEOTRejUDC625 - Run - - PwrPosIFC" 26 LET &WW(36,71):="BOTSTEProOnL - TimRewBsyMFDPErFCUIFC" 28 DB &XX,7,"&l 3 V" .SEL VFC #3 30 DB &ZZ,6 32 DB AA,1 34 DB BB,1 36 DB CC,1 38 DB DD,1 40 DB EE,1 42 DB FF,1 44 DB GG,1 46 DB HH,1 48 DB II,1 50 DB JJ,1 52 DB KK,1 54 DB LL,1 56 DB MM,1 58 DB NN,1 60 GOTO 4990 62 PRINTEX 0,"Error"; 64 PRINTEX " in line ";STATENUM;": "; 66 RETURN 68 PRINTEX 0,"Warning"; 70 GOTO 64 72 GOSUB 92 74 RETURN 76 PRINTEX 0,"SEEK ERROR ON LOGICAL UNIT #";VALUE1 78 LET ZZ(49):=0 80 GOSUB 128 82 PRINTEX "SEEK STARTED AT CYLINDER ";VALUE2;" HEAD ";VALUE3; 84 PRINTEX " SECTOR ";VALUE4 86 GOSUB 136 88 RETURN 90 .CK STAT, CPVA & ERR COUNT 92 LET SS(3):=!1F00 XOR ZZ(Z),SS(4):=ZZ(O) 94 LET SS(5):=!FFFF,SS(6):=ZZ(P) 96 IF WW(18)=-1 THEN 122 .SUPP STAT? 98 IFN SS(10)=-1 THEN 108 100 IF SS(3) XOR SS(0) AND SS(5) THEN 104 .STAT WD 1 OK? 102 IFN SS(4) XOR SS(1) AND SS(6) THEN 122 .STAT WD 2 OK? 104 LET OFFSET:=1 .STAT ERR 106 GOTO 122 108 IF SS(10) XOR SS(0) AND SS(11) THEN 114 110 IF SS(12) XOR SS(1) AND SS(13) THEN 114 112 RETURN 114 GOSUB 394 116 LET U:=SS(10),SS(4):=SS(12),X:=SS(11),SS(6):=SS(13),Q:=6,R:=4 118 GOSUB 490 120 GOSUB 132 122 LET SS(10):=-1 124 RETURN 126 .DISC STAT ERR MSGS 128 GOSUB 394 130 GOSUB 488 132 GOSUB 784 .GET ADDR 134 IFN ZZ(49) THEN 146 136 GOSUB 152 138 IF ZZ(Y)=1 THEN 148 .ERR CNT EXP 140 LET ZZ(Y):=ZZ(Y)-1 .DEC ERR CNT 142 IFN WW(19)=-1 THEN 146 144 PPRINT "ERROR PAUSE" 146 RETURN 148 PRINT 0,"ERROR COUNT ON LOGICAL UNIT ";ZZ(Z);" HAS EXPIRED" 150 END 152 LET WW(28):=WW(5) AND !1F00 LSR 8,WW(29):=WW(5) AND !FF 154 PRINTEX "INTERNAL DISC ADDRESS = "; 156 PRINTEX "CYLINDER ";WW(4);2;"HEAD ";WW(28);2;"SECTOR ";WW(29),0 158 RETURN 160 .CK FOR LUN LIMITS & SET PNTRS 162 LET V:=VALUE1 164 IF -1 LT V LT 8 THEN 170 166 GOSUB 62 168 GOTO 194 170 IF ZZ(V)=VALUE1 THEN 178 172 PRINT 0,"LUN ";VALUE1;" HAS NOT BEEN DEFINED "; 174 PRINT "FOR LINE # ";STATENUM,0 176 END 178 IF MAXMEMORY>39 THEN 184 180 PRINT 0,"NOT ENOUGH MEM (MAXMEM-39) TO RUN PGM "; 182 GOTO 174 184 LET V:=VALUE1,W:=V+10,X:=V+20,Y:=V+30,Z:=V+40,O:=V+50,P:=V+60 186 LET Q:=V+70,R:=V+80,CHANNEL:=ZZ(W),DEVICE:=ZZ(X) 188 IFN -1 LT VALUE1 LT 8 THEN 194 .CK LUN 190 RETURN 192 .DEV FUNC ERR MSGS 194 PRINT 0,"LOGICAL UNIT NUMBER ENTERED (";VALUE1;") "; 196 GOTO 220 198 PRINT 0,"CHANNEL NUMBER ENTERED (";VALUE2;") "; 200 GOSUB 226 202 PRINT "1 THRU 15" 204 END 206 PRINT 0,"DEVICE NUMBER ENTERED (";VALUE3;") "; 208 GOTO 220 210 PRINT 0,"ERROR COUNT ENTERED (";VALUE4;") "; 212 GOSUB 226 214 PRINT "1 THRU 999" 216 END 218 PRINT 0,"UNIT NUMBER ENTERED (";VALUE5;") "; 220 GOSUB 226 222 PRINT "0 THRU 7" 224 END 226 PRINT "IS NOT WITHIN THE SPECIFIED LIMITS OF "; 228 RETURN 230 .GET DISC STAT 232 LET SS(2):=!300 XOR ZZ(Z) 234 BSIO XX 236 IF WW(18)=-1 THEN 242 .SUPP STAT? 238 WR 8,SS(2),2 .STAT CMD 240 RR 8,SS(0),4 .RD STAT 242 IN H,1,1 244 RSIO XX 246 RETURN 248 IF YY(1) THEN 254 .CK CPVA1 250 PRINTEX "CHANNEL PROGRAM DID NOT COMPLETE - CPVA(1) = ";YY(1); 252 PRINTEX ", SHOULD BE 1." 254 LET YY(1):=0 .RESET CPVA1 TO 0 256 IFN YY(0) THEN 246 .CK CPVA0 258 PRINTEX 0,"CHANNEL PROGRAM ABORT - CPVA(0) = ";!YY(0) 260 LET YY(0):=0 262 END 264 .CK GETNAMEINFO TYPE, ELEMENT # & BUF LEN 266 LET U:=!C000 AND R .U=TYPE 268 IFN U THEN 294 .BUF? 270 IF U=!4000 THEN 294 .STRING BUF 272 IF U=!8000 THEN 286 .RES VAR? 274 IFN U=!C000 THEN 290 .SIMPLE VAR? 276 PRINT "SIMPLE VARIABLE HAS BEEN ENTERED "; 278 PRINT "IN PLACE OF DATA BUFFER ";0,"FOR THE "; 280 LET OFFSET:=1 282 LET &ZZ(1):=R AND !FF 284 RETURN 286 PRINT "RESERVED VARIABLE HAS BEEN ENTERED "; 288 GOTO 278 290 PRINT "PROGRAM ABORTED - GETNAMEINFO (TYPE) WAS NOT RECEIVED "; 292 GOTO 280 294 IFN S THEN 282 .BUF (0)? 296 PRINT "BUFFER ELEMENT ENTERED (";S;") WAS NOT (0) "; 298 GOTO 280 300 .ISSUE SFM CMD 302 LET VALUE2:=VALUE2 AND !F,WW(0):=!F00 XOR VALUE2 304 BSIO XX 306 WR 8,WW(0),2 .SFM CMD 308 DSJ 310;WW(10) 310 IN H,1,1 312 RSIO XX 314 IFN WW(10) THEN 334 316 PRINTEX 0,"SET FILE MASK ERROR FOR "; 318 GOTO 340 320 .ISSUE AR CMD 322 BSIO XX 324 WR 8,WW(6),6 326 WAIT 328 DSJ 330;WW(10) 330 IN H,1,1 332 RSIO XX 334 RETURN 336 .PR DSJ ERR MSG & STAT 338 LET SS(3):=ZZ(Z) 340 PRINTEX "LOGICAL UNIT #";VALUE1;" FAILED." 342 PRINTEX 0,"DSJ = ";WW(10) 344 GOSUB 232 .STAT 346 GOSUB 128 .PR STAT 348 GOTO 248 .CPVA 350 .ISSUE WD CMD 352 BSIO XX 354 WR 8,WW(0),2 356 WR 0,NAME1,T 358 WAIT 360 DSJ 238;WW(20) 362 GOTO 238 364 .CK FOR VAR IN GETNAMEINFO 366 IF R AND !C000 EQ !C000 THEN 374 368 PRINT 0,"THE ELEMENT PASSED WAS NOT A VARIABLE FOR THE "; 370 LET OFFSET:=1 372 RETURN 374 LET &ZZ(0):=!FF AND R 376 IF %100 LT &ZZ(0) LT %117 THEN 372 378 IF WW(11)=-1 THEN 388 .ACCEPT SLEUTHSM VAR? 380 PRINT 0,"VARIABLE ENTERED (";&ZZ(0);") IS ALLOCATED "; 382 PRINT "TO THE SLEUTH SIMULATOR." 384 PRINT "USER VARIABLES CONSIST OF VARIABLES A THRU N." 386 END 388 LET OFFSET:=3,WW(11):=0 390 RETURN 392 .PR STAT WORD 1 & 2 IN DISC FMT 394 PRINTEX 0,"79XX DISC STATUS";4;"WORD 1";18;"WORD 2" 396 PRINTEX "BIT NUMBER";2;"0";11;"8";7;"15";2;"0";11;"8";13;"15" 398 PRINTEX "STATUS IS ";2; 400 LET U:=SS(0),X:=-1,R:=1,Q:=14,WW(12):=-1 402 FOR W:=15 STEP -1 UNTIL 13 404 GOSUB 470 406 PRINTEX 1; 408 NEXT 402 410 FOR W:=12 STEP -1 UNTIL 8 412 GOSUB 470 414 NEXT 410 416 PRINTEX 1; 418 FOR W:=7 STEP -1 UNTIL 4 420 GOSUB 470 422 NEXT 418 424 PRINTEX 1; 426 FOR W:=3 STEP -1 UNTIL 0 428 GOSUB 470 430 NEXT 426 432 PRINTEX 1;"/";1; 434 LET U:=SS(R),X:=SS(Q) 436 LET W:=15 438 GOSUB 470 440 PRINTEX 1; 442 FOR W:=14 STEP -1 UNTIL 13 444 GOSUB 470 446 NEXT 442 448 PRINTEX 1; 450 FOR W:=12 STEP -1 UNTIL 9 452 GOSUB 470 454 NEXT 450 456 PRINTEX 1; 458 FOR W:=8 STEP -1 UNTIL 0 460 GOSUB 470 462 PRINTEX 1; 464 NEXT 458 466 PRINTEX 468 RETURN 470 IF X LSR W AND 1 THEN 476 472 PRINTEX "X"; 474 RETURN 476 IF U LSR W AND 1 THEN 482 478 PRINTEX "0"; 480 RETURN 482 PRINTEX "1"; 484 RETURN 486 .PR DISC SHOULD BE STAT 488 LET U:=SS(3),X:=SS(5),SS(6):=ZZ(P),Q:=6,R:=4 490 PRINTEX "SHOULD BE ";2; 492 GOSUB 402 494 PRINTEX 496 RETURN 498 . 500 PRINTEX 0,"MAG TAPE STATUS ";5;"BYTE 1";12;"BYTE 2";12;"BYTE 3",0 502 PRINTEX "BIT NUMBER ";5;"0 1 2 3 4 5 6 7";3;"0 1 2 3 4 5 6 7";3; 504 PRINTEX "0 1 2 3 4 5 6 7",0;"STATUS IS ";6; 506 LET X:=-1,U:=SS(8) 508 GOSUB 582 510 PRINTEX " ";1; 512 LET U:=SS(8) LSL 8 514 GOSUB 582 516 PRINTEX " ";1; 518 LET U:=SS(9) 520 GOSUB 582 522 PRINTEX 524 RETURN 526 .PRINT 2608 STAT 528 PRINTEX 0,22;"BYTE 1";12;"BYTE 2" 530 PRINTEX "BIT NUMBER ";6;"0 1 2 3 4 5 6 7";3;"0 1 2 3 4 5 6 7" 532 PRINTEX "2608 STATUS IS";3; 534 LET X:=-1,U:=SS(7) 536 GOSUB 582 538 PRINTEX " ";1; 540 LET U:=SS(7) LSL 8 542 GOSUB 582 544 PRINTEX 546 GOTO 248 .CPVA 548 . 550 BSIO XX 552 IFN U THEN 556 .Can't clear 7976 554 CLEAR 556 IDENT U 558 IN H,1,1 560 RSIO 562 RETURN 564 .PRINT 2631 STAT 566 PRINTEX 0,"BIT NUMBER ";9;"0 1 2 3 4 5 6 7" 568 IF ZZ(18)=!2002 THEN 574 570 PRINTEX "2619 "; 572 GOTO 576 574 PRINTEX "2631 "; 576 PRINTEX "I/O STATUS =";3; 578 LET X:=-1,U:=SS(7) 580 GOTO 542 582 FOR W:=15 STEP -1 UNTIL 8 584 GOSUB 470 586 PRINTEX 1; 588 NEXT 582 590 RETURN 592 IF SS(10) XOR SS(7) AND SS(11) THEN 596 594 RETURN 596 IF ZZ(18)=!2002 THEN 566 598 GOTO 528 600 .SET DISC LIMITS 602 LET R:=ZZ(V)+80,S:=ZZ(R) 604 IFN S=!81 THEN 610 606 LET WW(13):=76,WW(14):=2,WW(15):=30 .7902 608 RETURN 610 IFN S=1 THEN 616 612 LET WW(13):=747,WW(14):=2,WW(15):=32 .7910 614 RETURN 616 IFN S=2 THEN 636 618 IFN ZZ(Q)=0 THEN 624 620 LET WW(13):=410,WW(14):=4,WW(15):=48 .7906 622 RETURN 624 IFN ZZ(Q)=%1000 THEN 630 626 LET WW(13):=822,WW(14):=5,WW(15):=48 .7920 628 RETURN 630 IFN ZZ(Q)=%3000 THEN 636 632 LET WW(13):=822,WW(14):=9,WW(15):=64 .7925 634 RETURN 636 PRINT "LOGICAL DEVICE ";VALUE1;", A NON DISC DEVICE, IS"; 638 PRINT " ATTEMPTING TO USE A DISC FUNCTION" 640 END 642 . 644 PRINTEX "COMPARE BUFFER ERROR LUN ";VALUE1 646 PRINTEX "BUFFER ";&ZZ(0);&ZZ(0);"(";S;") = "; 648 ZEROESON 650 PRINTEX %W 652 ZEROESOFF 654 PRINTEX "BUFFER ";&ZZ(1);&ZZ(1);"(";S;") = "; 656 ZEROESON 658 PRINTEX %Y,0 660 ZEROESOFF 662 LET R:=80+VALUE1,Y:=VALUE1+30 664 IF ZZ(R)>!81 THEN 668 666 GOSUB 132 668 IF WW(17) THEN 672 670 LET WW(17):=VALUE2 672 LET WW(17):=WW(17)-1 674 IF WW(17) THEN 634 676 PRINT 0,"ERROR COUNT FOR SCB FUNCTION EXPIRED" 678 END 680 .ISSUE SFM & WD CMDS 682 GOSUB 302 .SFM 684 LET WW(0):=!800 XOR ZZ(Z),T:=T*2,SS(2):=!300 XOR ZZ(Z) 686 GOSUB 352 .WD CMD 688 LET SS(3):=ZZ(Z),SS(4):=ZZ(O) AND !FF7F 690 GOSUB 94 692 RETURN 694 PRINTEX "WRITE DATA ERROR FOR LUN ";VALUE1 696 GOSUB 128 .PR STAT 698 GOTO 248 .CPVA 700 .ISSUE SFM & RD CMD 702 GOSUB 302 .SFM 704 LET WW(0):=!500 XOR ZZ(Z),SS(2):=!300 XOR ZZ(Z),T:=T*2 706 BSIO XX 708 WR 8,WW(0),2 710 RR 0,NAME1,T 712 WAIT 714 GOSUB 236 .GET STAT 716 LET SS(3):=ZZ(Z),SS(4):=ZZ(O) AND !FF7F,ZZ(48):=ZZ(P) 718 LET ZZ(P):=ZZ(P) AND !FFBF 720 GOSUB 94 .CK STAT 722 GOTO 728 724 PRINTEX "READ ERROR ON LOGICAL UNIT #";VALUE1 726 GOSUB 128 .FIN MSG 728 LET ZZ(P):=ZZ(48) 730 RETURN 732 . 734 PRINT " FUNCTION FAILURE","DEVICE TYPE RECEIVED (";U;") IS NOT "; 736 PRINT "RECOGNIZED BY THE SLEUTH SIMULATOR." 738 END 740 .RD FULL DISC SECT 742 LET WW(0):=!600 OR ZZ(Z),T:=T*2 744 BSIO XX 746 WR 8,WW(0),2 748 RR 0,NAME1,T 750 WAIT 752 DSJ 754;WW(10) 754 IN H,1,1 756 RSIO XX 758 IFN WW(10) THEN 798 760 GOSUB 232 .STAT 762 GOTO 724 .ERR MSG 764 .CK LUN & BUF 766 GOSUB 162 .CK VAL1 768 GETNAMEINFO NAME1,R,S,T 770 GOTO 266 .CK BUF 772 .OVRN CNTR 774 LET ZZ(29):=ZZ(29)+1 776 IF ZZ(29)=0 THEN 798 778 LET ZZ(29):=-1 780 GOTO 370 782 .GET DISC ADDR 784 LET WW(3):=!1400 .REQ ADDR 786 BSIO VV 788 WR 8,WW(3),2 790 RR 8,WW(4),4 792 DSJ 794;WW(10) 794 IN H,1,1 796 RSIO VV 798 RETURN 800 IF SS(10)=-1 THEN 952 802 RSIO QQ 804 GOSUB 592 806 GOTO 952 808 . 810 LET SS(2):=!300 XOR ZZ(Z) 812 BSIO XX 814 WR 10,SS(2),2 .BUFF REQ STAT 816 WAIT .FOR IBM DISCS 818 GOSUB 240 .RD STAT 820 RETURN 822 . 824 IF ZZ(58)=58 THEN 844 826 IF VALUE2>63 THEN 840 828 LET &XX(6):="U" 830 IF VALUE2>7 THEN 836 832 LET &XX(4):=VALUE2+%60 834 GOTO 860 836 LET &XX(4):=VALUE2 LSR 3+%60,&XX(5):=VALUE2 AND 7+%60 838 GOTO 860 840 LET &XX(4):=VALUE2 AND 7+%61,&XX(5):=" " 842 GOTO 860 844 LET &XX(4):=%63,&XX(5):=" ",&XX(6):="V" 846 BSIO XX 848 WB 0,&YY(Q),VALUE2,128 850 JUMP 872 852 WAIT 854 DSJ 856,856,894;WW(10) 856 JUMP 848 858 GOTO 872 860 BSIO XX 862 WB 0,NAME1,T,128 864 JUMP 872 866 WAIT 868 DSJ 870,870,894;WW(10) 870 JUMP 862 872 WAIT 874 DSJ 876,876,894;WW(10) 876 WR 2,RR(18),1 878 WAIT 880 DSJ 882,882,894;WW(10) 882 WR 0,&XX(0),7 884 WAIT 886 DSJ 888,888,894;WW(10) 888 WR 2,RR(21),1,,R 890 WAIT 892 DSJ 894;WW(10) 894 RR 14,SS(7),1 896 GOTO 974 898 .RIPPLE PRINT 900 LET X:=%40,Y:=ZZ(8):=0,&XX(4):=%63,&XX(6):="V" 902 FOR S:=0 UNTIL 263 904 LET &YY(S):=X,X:=X+1 906 IF X NE %176 THEN 910 908 LET X:=%40 910 NEXT 902 912 FOR R:=0 UNTIL 32766 914 IF ZZ(18)<>!200A THEN 920 916 GOSUB 824 918 GOTO 934 920 BSIO XX 922 WR 0,&YY(Q),VALUE2 924 WR 8,RR(1),1 926 WAIT 928 DSJ 930;WW(10) 930 IN H,1,1 932 RSIO XX 934 IFN WW(10) THEN 800 936 PRINTEX 0,"RP FUNCTION ERROR - DSJ=";WW(10) 938 RSIO VV .GET STAT 940 IF ZZ(18)>=!2002 THEN 946 942 GOSUB 528 .STAT 944 GOTO 952 946 GOSUB 566 .STAT 948 PRINTEX "DSJ = ";WW(10);", SHOULD BE 0." 950 GOSUB 248 .CPVA 952 LET Q:=Q+1 954 IFN Q=93 THEN 958 956 LET Q:=0 958 IF ZZ(8):=ZZ(8)+1 NE 59 THEN 966 960 IF ZZ(18)=!200A THEN 964 962 RSIO UU 964 LET ZZ(8):=0 966 NEXT 912 968 RETURN 970 BSIO VV 972 RR 14,SS(7),2 974 IN H,1,1 976 RSIO 978 RETURN 980 . 982 IF ZZ(18)<>1 THEN 370 984 RDA VALUE1 986 IF WW(4)<>WW(30) THEN 978 988 GOTO 370 990 .SELECT MAG TAPE UNIT 992 GOSUB 162 .CK VAL1 994 LET X:=ZZ(V)+40,Y:=ZZ(X) 996 FOR W:=1 UNTIL 4 998 IF Y+1 EQ W THEN 1002 1000 NEXT 996 1002 BSIO UU 1004 WR 1,RR(W),1 1006 WAIT 1008 DSJ 1010;WW(20) 1010 RR 1,SS(8),3 1012 IN H,1,1 1014 RSIO 1016 IFN WW(20) THEN 978 1018 GOSUB 62 1020 PRINT 0,"UNABLE TO SELECT UNIT #";ZZ(X) 1022 GOSUB 500 .STAT 1024 GOSUB 248 .CPVA 1026 END 1028 PRINT "FOR LOGICAL UNIT ";VALUE1;" IS NOT READY OR AVAILABLE." 1030 RETURN 1032 BSIO VV 1034 WR 10,RR(2),1 .STAT 1036 WAIT 1038 RR 10,SS(7),2 1040 IN H,1,1 1042 RSIO 1044 RETURN 1046 IF ZZ(R)<>1 THEN 1058 1048 GOSUB 1054 1050 PRINT "7910 DISCS." 1052 END 1054 PRINT 0,"STATEMENT AT LINE #";STATENUM;" IS NOT ALLOWED FOR "; 1056 RETURN 1058 IF ZZ(R)<>!81 THEN 1056 1060 GOSUB 1054 1062 PRINT "7902 DISCS." 1064 END 1066 LET R:=VALUE1+80 1068 GOTO 1058 1070 GOSUB 162 1072 GOSUB 1046 1074 RETURN 1076 LET WW(0):=!100 1078 BSIO XX 1080 WR 16,WW(0),1 1082 DSJ 1084;WW(10) 1084 RR 14,SS(7),1 1086 GOTO 242 1088 .************************************************************* 1090 FUNCTION DEV VALUE1,VALUE2,VALUE3,VALUE4,VALUE5,VALUE6 1092 CPVA YY(0) .CPVA PNTR=YY(0) 1094 GOSUB 178 .CK VAL1 1096 LET ZZ(V):=VALUE1,ZZ(W):=VALUE2,ZZ(X):=VALUE3 1098 LET ZZ(Y):=VALUE4,SS(3):=ZZ(Z):=VALUE5 1100 IFN 0 LT VALUE2 LT 16 THEN 198 .CK EACH 1102 IFN -1 LT VALUE3 LT 8 THEN 206 .ENTRY 1104 IFN 0 LT VALUE4 LT 1000 THEN 210 .FOR 1106 IFN -1 LT VALUE5 LT 8 THEN 218 .LIMITS 1108 ROCL S 1110 FOR T:=R:=1 UNTIL 15 .CHAN PRESENT? 1112 LET S:=S LSL 1 1114 IFN S AND !8000 THEN 1120 1116 IF T=VALUE2 THEN 1134 .YES! = ENT CHAN? 1118 LET R:=R+1 1120 NEXT 1110 1122 IF R<>1 THEN 1128 1124 PRINT "THIS SYSTEM DOES NOT CONTAIN ANY CHANNELS" 1126 END 1128 PRINT "CHANNEL NUMBER ENTERED (";VALUE2;") IS NOT "; 1130 PRINT "USED IN THIS SYSTEM" 1132 END 1134 LET CHANNEL:=ZZ(W),DEVICE:=ZZ(X),U:=0 1136 INIT 1138 RIOC 14,S .GIC? 1140 IFN S AND !1FFF THEN 1146 .ERR MSG 1142 PRINT "CHANNEL NUMBER ENTERED (";VALUE2;") IS NOT A GIC." 1144 END 1146 GOSUB 550 .ISSUE IDENT (U) 1148 LET R:=ZZ(V)+80,ZZ(R):=ZZ(18):=U 1150 IF U=!176 THEN 1306 .7976? 1152 GOSUB 550 .U<>0, Clear 1154 IF 0 LT U LT 3 THEN 1180 .13037 OR 7910? 1156 IF U=!81 THEN 1174 .7902? 1158 IF U=!2001 THEN 1248 .2608? 1160 IF U=!2002 THEN 1214 .2631? 1162 IF U=!183 THEN 1284 .7970? 1164 IF U=!200A THEN 1208 .2619? 1166 PRINT 0,"UNABLE TO IDENTIFY DEVICE ";VALUE3;" ON CHANNEL ";VALUE2; 1168 PRINT " FOR LOGICAL UNIT ";VALUE1;0,"IDENTITY CODE RECEIVED = ";!U 1170 GOSUB 248 .CPVA 1172 END 1174 GOSUB 810 1176 LET ZZ(O):=!C00,ZZ(P):=!8457 1178 ENDF 1180 LET WW(0):=!200+ZZ(Z),WW(1):=WW(2):=0,SS(2):=!300+ZZ(Z) 1182 BSIO XX 1184 WR 8,WW(0),6 .SEEK 1186 WAIT 1188 GOSUB 236 .STAT 1190 IF SS(0) EQ !1F00+ZZ(Z) THEN 1200 1192 PRINT 0,"DEV FUNCTION FAILURE",0,0;"79XX DISC "; 1194 GOSUB 1028 1196 GOSUB 394 1198 END 1200 LET ZZ(Q):=SS(4):=!1E00 AND SS(1),ZZ(O):=!20 XOR ZZ(Q),ZZ(P):=!9ED7 1202 IFN U=1 THEN 1206 1204 LET ZZ(Q):=ZZ(O):=0,ZZ(P):=!809F 1206 ENDF 1208 GOSUB 1076 1210 IFN WW(10) THEN 1304 1212 GOTO 1232 1214 BSIO XX 1216 CLEAR 1 1218 WR 1,RR(20),1,,R .SET PL MSK 1220 WR 2,RR(21),1,,R .SET PR & SP MODE 1222 DSJ 1226;WW(10) 1224 RR 14,SS(7),2 1226 IN H,1,1 1228 RSIO XX 1230 IF WW(10) NE 2 THEN 1304 1232 PRINT 0,"DEV FUNCTION FAILURE",0 1234 IF U=!2002 THEN 1240 1236 PRINT "2619 PRINTER "; 1238 GOTO 1242 1240 PRINT "2631 PRINTER "; 1242 GOSUB 1028 1244 GOSUB 566 1246 END 1248 GOSUB 1032 1250 IF SS(7) AND !8000 THEN 1258 1252 PRINT 0,"2608 PRINTER "; 1254 GOSUB 1028 1256 GOTO 1280 1258 BSIO XX 1260 WR 5,RR(0),1 .MSTR CL 1262 WAIT 1264 DSJ 1272;WW(20) 1266 WR 10,RR(2),1 1268 WAIT 1270 RR 10,SS(7),2 1272 IN H,1,1 1274 RSIO XX 1276 IFN WW(20) THEN 1304 1278 PRINT "DEV FUNCTION FAILURE FOR LUN ";VALUE1 1280 GOSUB 528 1282 END 1284 GOSUB 994 .SEL UNIT 1286 IF SS(8) AND !100=!100 THEN 1296 1288 PRINT 0,"MAG TAPE "; 1290 GOSUB 1028 1292 GOSUB 500 .PR STAT 1294 END 1296 BSIO XX 1298 CHP !94 .DEV CL 1300 WAIT 1302 GOTO 3402 1304 ENDF 1306 IFN VALUE5 THEN 1314 1308 GOSUB 62 1310 PRINTEX "Unit number must be 0." 1312 END 1314 IFN VALUE6<>6250 NE VALUE6=1600 NE VALUE6<>0 THEN 1328 .0,1600,6250 1316 GOSUB 62 1318 PRINTEX "Density must be 1600 or 6250." 1320 END 1322 . 1324 .ZZ(P=50) true if density 'took', meaning density set and 1326 .an operation occured which actually established it. 1328 LET ZZ(P):=S:=0 .untook 1330 LET ZZ(O):=VALUE6<>1600 1333 GOSUB 3604 .chan pgm(S=0 does clear) 1336 IF S:=WW(20)=0 THEN 1344 .cpva,s:=-1 1338 GOSUB 62 1340 PRINTEX "Clear failed." 1342 END 1344 GOSUB 3604 .sta 1346 IF ZZ(Q) AND !100 THEN 1354 1348 GOSUB 62 1350 PRINTEX "7976 not online." 1352 END 1354 IF ZZ(Q) AND !4400<>!4000 THEN 1368 .bot 1356 LET S:=STATENUM 1358 ESTA !4100,!80,0,0,0,!FF 1360 LET STATENUM:=S,S:=17 .6250 1362 IF VALUE6=1600 THEN 3604 1364 LET S:=23 .1600 1366 GOTO 3604 .Set dens 1368 ENDF 1370 .************************************************************ 1372 FUNCTION SEEK VALUE1,VALUE2,VALUE3,VALUE4 1374 GOSUB 162 1376 LET WW(0):=!200 XOR ZZ(Z),WW(1):=VALUE2,WW(2):=VALUE3 LSL 8+VALUE4 1378 LET SS(2):=!300+ZZ(Z),WW(30):=VALUE2,WW(31):=VALUE3,WW(32):=VALUE4 1380 BSIO XX 1382 WR 8,WW(0),6 1384 WAIT 1386 GOSUB 236 .GET STAT 1388 IF ZZ(R)=1 THEN 1392 1390 LET ZZ(48):=ZZ(P),ZZ(P):=ZZ(P) AND !FFBF 1392 GOSUB 72 .CK STAT 1394 IF ZZ(R)=1 THEN 1398 1396 LET ZZ(P):=ZZ(48) 1398 ENDF 1400 .************************************************************* 1402 FUNCTION RC VALUE1 1404 GOSUB 1070 .CK VAL1 1406 LET WW(0):=!100 XOR ZZ(Z),SS(2):=!300 XOR ZZ(Z) 1408 BSIO XX 1410 WR 8,WW(0),2 .RC CMD 1412 WAIT 1414 GOSUB 236 .STAT 1416 GOSUB 92 .CK STAT 1418 ENDF 1420 PRINTEX "RECALIBRATE ERROR ON LOGICAL UNIT # ";VALUE1,1 1422 GOSUB 128 1424 ENDF 1426 .************************************************************* 1428 FUNCTION RS VALUE1 1430 GOSUB 162 .CK VAL1 1432 GOSUB 602 .DISC LIMITS 1434 RANDOM U 1436 LET W:=!7FFF AND U .POS RAND # 1438 LET X:=W MOD WW(13),Y:=W MOD WW(14),Z:=W MOD WW(15) 1440 SEEK VALUE1,X,Y,Z 1442 ENDF 1444 .**************************************************************** 1446 FUNCTION SFM VALUE1,VALUE2 1448 GOSUB 1070 .CK VAL1 1450 IF -1 LT VALUE2 LT 16 THEN 1460 1452 PRINT 0,"SFM MASK VALUE ENTERED (";VALUE2;") "; 1454 GOSUB 226 1456 PRINT "0 THRU 15." 1458 END 1460 LET WW(0):=!F00 XOR VALUE2 1462 GOSUB 302 .SFM CMD 1464 IFN WW(10) THEN 1470 1466 PRINTEX 0,"SET FILE MASK FOR "; 1468 GOSUB 340 1470 ENDF 1472 .**************************************************************** 1474 FUNCTION RD VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5 1476 LET WW(30):=VALUE3,WW(31):=VALUE4,WW(32):=VALUE5 1478 GOSUB 766 .CK VAL1 & NAME1 1480 GOTO 1486 1482 PRINT "READ FUNCTION." 1484 END 1486 LET R:=ZZ(V)+80,ZZ(18):=ZZ(R) .ID CODE 1488 IF ZZ(18)=1 THEN 1546 .7910? 1490 IF ZZ(18)=2 THEN 1544 .13037? 1492 IF ZZ(18)=!81 THEN 1546 .7902? 1494 IF ZZ(18)=!183 THEN 1504 .7970? 1496 LET R:=T ASL 1,S:=8 1498 IF ZZ(18)=!176 THEN 1552 .7976 1500 PRINT 0,"READ"; 1502 GOTO 734 1504 GOSUB 994 1506 LET P:=8 1508 LET X:=T*2 .BYTE COUNT 1510 BSIO XX 1512 .WARNING!! 7976 CLREAD enters here ***** 1514 WR 1,RR(P),1 .CMD 1516 WAIT 1518 DSJ 1520,1536;WW(10) 1520 RB 0,NAME1,X,64 .BL=64 1522 JUMP 1528 1524 WAIT 1526 JUMP 1518 1528 WR 7,RR(22),1 .END 1530 RR 2,ZZ(48),2 1532 WAIT 1534 DSJ 1536;WW(10) 1536 RR 1,SS(8),3 1538 IN H,1,1 1540 RSIO 1542 GOTO 3410 1544 GOSUB 302 .SFM 1546 SEEK VALUE1,VALUE3,VALUE4,VALUE5 1548 GOSUB 704 1550 ENDF 1552 IF SS(10)<>-1 THEN 3604 1554 LET U:=STATENUM 1556 ESTA !100,!3400,0,!1F,0,!FF00 1558 GOTO 3450 1560 .************************************************************* 1562 FUNCTION AR VALUE1,VALUE2,VALUE3,VALUE4 1564 GOSUB 162 .CK VAL1 1566 GOSUB 1058 1568 LET WW(6):=!C00,WW(7):=VALUE2,WW(8):=VALUE3 LSL 8+VALUE4 1570 LET SS(3):=ZZ(Z) 1572 GOSUB 322 .AR CMD 1574 IFN WW(10) THEN 1580 .DSJ OK? 1576 PRINTEX "AR FUNCTION ERROR" 1578 GOSUB 340 1580 ENDF 1582 .************************************************************** 1584 FUNCTION WD VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5 1586 GOSUB 766 .CK VAL1 & NAME1 1588 GOTO 1594 1590 PRINT "WD FUNCTION." 1592 END 1594 LET R:=ZZ(V)+80,ZZ(18):=U:=ZZ(R),ZZ(58):=-1 1596 IF U=1 THEN 1618 .7910? 1598 IF U=2 THEN 1616 .13037? 1600 IF U=!81 THEN 1618 .7902? 1602 IF U=!183 THEN 1624 .7970? 1604 IF !2000 LT U LT !2003 THEN 1656 .PRNTR? 1606 IF U=!200A THEN 1656 1608 LET R:=T ASL 1,S:=5 1610 IF U=!176 THEN 1814 .7976 1612 PRINT 0,"WD"; 1614 GOTO 734 1616 GOSUB 302 .SFM 1618 SEEK VALUE1,VALUE3,VALUE4,VALUE5 1620 GOSUB 684 .WD & CK STAT 1622 ENDF 1624 LET P:=T*2 .BYTE CNT 1626 GOSUB 994 1628 BSIO XX 1630 WR 1,RR(5),1 .CMD 1632 WAIT 1634 DSJ 1636,1648;WW(10) 1636 WB 0,NAME1,P,64 .BL=64 1638 JUMP 1644 1640 WAIT 1642 JUMP 1634 1644 WAIT 1646 DSJ 1650;WW(10) 1648 RR 1,SS(8),3 1650 IN H,1,1 1652 RSIO 1654 GOTO 3410 1656 LET T:=T*2 .BUF=BYTES 1658 IF 0 LT VALUE3 LT 133 THEN 1664 1660 PRINT 0,"LINELENGTH IS NOT 1 TO 132 FOR LUN ";VALUE1 1662 END 1664 IF U<>!200A THEN 1688 1666 LET U:=R:=T 1668 FOR P:=0 UNTIL U/VALUE3 1670 LET T:=VALUE3 1672 IF R>T THEN 1678 1674 LET T:=R 1676 IF T<=0 THEN 1682 1678 GOSUB 824 1680 LET R:=R-VALUE3 1682 NEXT 1668 1684 GOSUB 1782 1686 ENDF 1688 IF U=!2002 THEN 1696 1690 IFN VALUE2 AND !40 EQ !40 THEN 1694 1692 LET VALUE2:=VALUE2 AND %17+%200 1694 LET RR(19):=!8000 1696 LET RR(1):=VALUE2 LSL 8,S:=VALUE2 1698 BSIO UU 1700 WR 8,RR(19),1 .TOF 1702 WAIT 1704 DSJ 1706;WW(10) 1706 IN H,1,1 1708 ESIO 1710 IFN ZZ(38) THEN 1716 1712 RSIO UU 1714 GOSUB 1782 1716 BSIO XX 1718 DSJ 1720,1742,1742,1742;WW(10) 1720 WB 0,NAME1,T,VALUE3,,,E .LD PR BUF 1722 JUMP 1734 1724 UPDATEOFF 1726 WR 8,RR(1),1 .PR CMD 1728 UPDATEON 1730 WAIT 1732 JUMP 1718 1734 WR 8,RR(1),1 1736 WAIT 1738 DSJ 1740;WW(10) 1740 IN H,1,1 1742 IN H,2,2 1744 ESIO 1746 IF S THEN 1750 1748 LET S:=1 1750 LET ZZ(38):=0,ZZ(9):=0,ZZ(28):=58*VALUE3-ZZ(39)/S 1752 IF T=ZZ(28) THEN 1756 1778 LET XX(12):=T 1780 GOTO 1756 1782 IF WW(10)=0 THEN 1800 1784 PRINTEX 0,"WRITE DATA ERROR";4;"DSJ = ";WW(10);", SHOULD BE 0" 1786 IF ZZ(18)=!2001 THEN 1796 1788 GOSUB 970 .GET STAT 1790 GOSUB 566 1792 GOSUB 142 .PE 1794 RETURN 1796 GOSUB 1032 1798 GOSUB 528 .2608 STAT 1800 IF SS(10)=-1 THEN 1808 1802 IF ZZ(18)=!2001 THEN 1810 1804 GOSUB 970 1806 GOSUB 592 1808 RETURN 1810 GOSUB 1032 1812 GOTO 1806 1814 IF SS(10)<>-1 THEN 3604 1816 LET U:=STATENUM 1818 ESTA !100,!1000,0,!1F,0,!FF00 1820 GOTO 3450 1822 .*********************************************************** 1824 FUNCTION FMT VALUE1,VALUE2 1826 GOSUB 162 .CK VAL1 1828 GOSUB 602 .DISC LIMITS 1830 LET ZZ(18):=ZZ(R),SS(2):=!300+ZZ(Z),SS(3):=ZZ(Z) 1832 IF ZZ(18)=!81 THEN 1842 .7902? 1834 IF 0 LT ZZ(18) LT 3 THEN 1918 .13037 / 7910? 1836 PRINT 0,"LOGICAL UNIT # ENTERED (";VALUE1;") FOR FMT FUNCTION "; 1838 PRINT "IS NOT A DOUBLE SIDED 7902 OR 79XX DISC." 1840 END 1842 LET TIMEOUT:=17 .APPR 1.4 MIN 1844 GOSUB 810 1846 PPRINT 0,"PLACE DISKETTE YOU WISH TO FORMAT INTO UNIT AND TYPE GO.",0 1848 RQST VALUE1 1850 LET X:=!8202,W:=76 1852 PRINT 0,"&dH&dJBEGIN HP FORMAT&d@" 1854 IFN VALUE2 THEN 1858 1856 LET X:=!202 1858 LET WW(2):=!1800 XOR ZZ(Z),WW(3):=X,WW(4):=%106615 1860 BSIO XX 1862 WR !C,WW(2),5 .FMT 1864 WAIT 1866 DSJ 1868;WW(10) 1868 WR 8,SS(2),2 1870 GOSUB 240 .GET STAT 1872 IF WW(10)=0 THEN 1882 1874 PRINT 0,"FORMAT FAILED",0 1876 GOSUB 394 .PR STAT 1878 GOSUB 248 1880 END 1882 LET TIMEOUT:=0 .=3 SEC 1884 PRINT 0,"&dDBEGIN VERIFYING FORMATTED DISC&d@" 1886 IFN VALUE2 THEN 1894 1888 LET W:=-VALUE2/2+W 1890 IF VALUE2 AND 1 EQ 0 THEN 1894 1892 LET W:=W-1 1894 FOR ZZ(19):=0 UNTIL W 1896 SEEK VALUE1,ZZ(19),0,0 1898 LET WW(4):=!700 XOR ZZ(Z),WW(5):=WW(14)*WW(15),SS(3):=ZZ(Z) 1900 BSIO XX 1902 WR 8,WW(4),4 1904 WAIT 1906 GOSUB 236 .STAT 1908 IF SS(0)=ZZ(Z) THEN 1914 1910 PRINTEX 0,"VERIFY ERROR" 1912 GOSUB 128 .PR STAT 1914 NEXT 1894 1916 ENDF 1918 PRINT 0,"BEGIN FORMAT",0 1920 IF ZZ(18)=1 THEN 1942 1922 RQST VALUE1 1924 IF SS(1) AND !20 THEN 1934 1926 PRINT 0,"FORMAT SWITCH IS NOT ENABLED. SET "; 1928 PRINT "SWITCH AND TYPE GO.",0 1930 PAUSE 1932 GOTO 1922 1934 IFN SS(1) AND !40 THEN 1940 1936 PRINT 0,"DISC IS READ ONLY. RESET "; 1938 GOTO 1928 1940 SFM VALUE1,2 1942 LET WW(16):=!B00 XOR ZZ(Z),WW(17):=WW(15)*256 1944 LET WW(21):=WW(15)*WW(14),WW(22):=!200+ZZ(Z) 1946 BSIO UU 1948 WR 8,WW(22),6 1950 WAIT 1952 WR 8,SS(2),2 1954 RR 8,SS(0),4 1956 IN H,1,1 1958 ESIO 1960 BSIO QQ 1962 WR 8,WW(16),2 .INIT 1964 ADDRESSOFF 1966 WR 0,TT(0),WW(17) 1968 ADDRESSON 1970 WAIT 1972 DSJ 1974;WW(10) 1974 IN H,1,1 1976 ESIO 1978 FOR WW(23):=0 UNTIL WW(13) 1980 FOR WW(24):=0 STEP 256 UNTIL WW(14)-1*256 1982 RSIO UU 1984 IF SS(0)<>!1F00+ZZ(Z) THEN 2048 1986 RSIO QQ 1988 IF WW(10) THEN 2024 1990 NEXT 1980 1992 VER VALUE1,WW(21),WW(23),0,0 1994 IFN WW(20) THEN 2018 1996 LET WW(25):=WW(14)-WW(28)-1,WW(20):=0 1998 IF ZZ(18)=1 THEN 2002 2000 SFM VALUE1,2 2002 IFN WW(25) THEN 2018 2004 LET WW(26):=WW(25)*WW(15)+WW(15)-WW(29)-1 2006 LET WW(27):=WW(29)+1 2008 IF WW(29) NE WW(15)-1 THEN 2012 2010 LET WW(28):=WW(28)+1,WW(27):=0 2012 VER VALUE1,WW(26),WW(23),WW(28),WW(27) 2014 IF WW(4)<>WW(30) THEN 2018 2016 GOTO 1994 2018 NEXT 1978 2020 PRINT "END FORMAT" 2022 ENDF 2024 LET SS(3):=ZZ(Z) 2026 GOSUB 232 .STAT 2028 GOSUB 982 2030 GOTO 1990 2032 IF SS(0) NE !E00+ZZ(Z) THEN 2038 2034 GOSUB 774 2036 GOTO 1982 2038 PRINTEX 0,"ID ERROR IN FMT FUNCTION" 2040 GOSUB 128 2042 GOSUB 248 .CK CPVA 2044 LET ZZ(29):=-1 2046 GOTO 1990 2048 IF SS(0) AND !E000 THEN 1986 2050 GOSUB 72 2052 GOTO 1986 2054 .************************************************************** 2056 FUNCTION RAND NAME1 2058 GETNAMEINFO NAME1,R,S,T 2060 GOSUB 366 .CK VAR 2062 GOTO 2068 2064 PRINT "RANDOM FUNCTION" 2066 END 2068 RANDOM U 2070 LET NAME1:=!7FFF AND U .POS # 2072 ENDF 2074 .**************************************************************** 2076 FUNCTION MC VALUE1 2078 GOSUB 162 .CK VAL1 2080 IF ZZ(R)=!176 THEN 2116 2082 BSIO XX 2084 CLEAR 2086 IN H,1,1 2088 RSIO 2090 IFN 0 LT ZZ(R) LT !82 THEN 2096 2092 RQST VALUE1 2094 ENDF 2096 IF ZZ(R)<>!183 THEN 2100 2098 GOTO 1296 2100 IF ZZ(R)<>!2001 THEN 2104 2102 GOTO 1214 2104 IF ZZ(R)<>!2002 THEN 2108 2106 GOTO 1258 2108 IF ZZ(R)<>!200A THEN 2112 2110 GOTO 1076 2112 PRINT 0,"MC"; 2114 GOTO 734 2116 LET S:=0 2118 GOSUB 3604 .clear 7976 2120 IF WW(20) THEN 1338 2122 ENDF 2124 .**************************************************************** 2126 FUNCTION GET VALUE1,NAME1 2128 GOSUB 162 .CK VAL1 2130 GETNAMEINFO NAME1,R,S,T 2132 LET WW(11):=-1 .ALLOW USE OF "U" 2134 GOSUB 366 .ACCPTBLE VAR? 2136 GOTO 2148 2138 PRINT "GET FUNCTION." 2140 END 2142 IF &ZZ(0)=%125 THEN 2146 .U? 2144 GOTO 380 .NO 2146 INPUT ZZ(Z) .UNIT # 2148 IFN &ZZ(0)=%103 THEN 2154 .C? 2150 INPUT ZZ(W) .CHAN # 2152 ENDF 2154 IFN &ZZ(0)=%104 THEN 2160 .D? 2156 INPUT ZZ(X) .DEV # 2158 ENDF 2160 IFN &ZZ(0)=%105 THEN 2164 2162 INPUT ZZ(Y) .# ERR 2164 ENDF 2166 .***************************************************************** 2168 FUNCTION STAT VALUE1,NAME1 2170 GOSUB 162 .CK VAL1 2172 LET U:=ZZ(R) 2174 GETNAMEINFO NAME1,R,S,T 2176 GOSUB 366 .CK NAME1 2178 GOTO 2184 2180 PRINT "STAT FUNCTION." 2182 END 2184 IF &ZZ(0)=%103 THEN 2232 .CHAN STAT? 2186 IFN &ZZ(0)=%104 THEN 2228 .DEV STAT? 2188 IF U<>!183 THEN 2196 2190 GOSUB 994 2192 GOSUB 500 2194 GOTO 2242 2196 IFN 0 LT U LT 3 THEN 2204 2198 GOSUB 232 2200 GOSUB 394 2202 ENDF 2204 IF U=!81 THEN 2198 2206 IF U<>!2001 THEN 2214 2208 GOSUB 1032 2210 GOSUB 528 2212 ENDF 2214 IF U<>!2002 THEN 2222 2216 GOSUB 970 2218 GOSUB 566 2220 ENDF 2222 IF U=!176 THEN 3768 .7976 2224 PRINT 0,"STAT"; 2226 GOTO 734 2228 PRINT 0,"VARIABLE ENTERED (";&ZZ(0);") FOR STAT IS NOT C OR D." 2230 END 2232 PRINT 0,"CHANNEL ";ZZ(W);" REGISTER INFORMATION ",0 2234 FOR Z:=!0 UNTIL !F 2236 RIOC Z,Q 2238 PRINT "REGISTER ";Z;" = ";%Q 2240 NEXT 2234 2242 ENDF 2244 .**************************************************************** 2246 FUNCTION VERI VALUE1,VALUE2 2248 GOSUB 162 .CK VAL1 2250 LET WW(0):=!700+ZZ(Z),WW(1):=VALUE2,SS(3):=ZZ(Z),ZZ(18):=ZZ(R) 2252 BSIO XX 2254 WR 8,WW(0),4 2256 WAIT 2258 DSJ 2260;WW(20) 2260 IN H,1,1 2262 RSIO XX 2264 IFN WW(20) THEN 2276 2266 GOSUB 232 .STAT 2268 GOSUB 982 2270 GOTO 2276 2272 PRINTEX 0,"VERIFY ERROR FOR LUN ";VALUE1 2274 GOSUB 128 .PR 2276 ENDF 2278 .********************************************************** 2280 FUNCTION VER VALUE1,VALUE2,VALUE3,VALUE4,VALUE5 2282 SEEK VALUE1,VALUE3,VALUE4,VALUE5 2284 VERI VALUE1,VALUE2 2286 ENDF 2288 .*************************************************************** 2290 FUNCTION IDI VALUE1,NAME1,VALUE2,NAME2 2292 GOSUB 162 2294 LET ZZ(18):=ZZ(R),ZZ(29):=-1 2296 IF ZZ(18)<>2 THEN 2300 2298 SFM VALUE1,VALUE2 2300 GETNAMEINFO NAME1,R,S,T 2302 GOSUB 266 2304 GOTO 2308 2306 GOTO 2318 2308 LET WW(0):=!B00 OR ZZ(Z),WW(11):=-1 2310 GETNAMEINFO NAME2,R 2312 IF R AND !FF EQ %42 THEN 2346 2314 GOSUB 366 2316 GOTO 2322 2318 PRINT "ID OR IDI FUNCTION." 2320 END 2322 IFN &ZZ(0)=%120 THEN 2328 .PROT? 2324 LET WW(0):=!4B00 XOR ZZ(Z) 2326 GOTO 2346 2328 IFN &ZZ(0)=%123 THEN 2334 .SP? 2330 LET WW(0):=!8B00 XOR ZZ(Z) 2332 GOTO 2346 2334 IFN &ZZ(0)=%104 THEN 2340 .DEF? 2336 LET WW(0):=!2B00 XOR ZZ(Z) 2338 GOTO 2346 2340 IF &ZZ(0)=%116 THEN 2346 .NORM? 2342 PRINT 0,"VARIABLE ENTERED (";&ZZ(0);") IS NOT S, P, D OR N." 2344 END 2346 LET SS(2):=!300 XOR ZZ(Z),T:=T*2 2348 BSIO XX 2350 WR 8,WW(0),2 .ID CMD 2352 WR 0,NAME1,T 2354 WAIT 2356 GOSUB 236 .STAT 2358 IF ZZ(18)<>2 THEN 2366 2360 IF SS(0) NE !E00+ZZ(Z) THEN 2366 2362 GOSUB 774 2364 GOTO 2348 2366 IF ZZ(Z) EQ SS(0) AND !FFF THEN 2380 2368 PRINTEX 0,"ID OR IDI FUNCTION ERROR" 2370 LET SS(3):=WW(0) AND !E000+ZZ(Z),ZZ(39):=ZZ(P) 2372 IF ZZ(18)=1 THEN 2376 2374 LET ZZ(P):=ZZ(P)+!20 2376 GOSUB 128 .PR STAT 2378 LET ZZ(P):=ZZ(39) 2380 ENDF 2382 .*************************************************************** 2384 FUNCTION ID VALUE1,NAME1,VALUE2,NAME2,VALUE3,VALUE4,VALUE5 2386 GOSUB 162 2388 IF ZZ(R)=!81 THEN 2396 2390 AR VALUE1,VALUE3,VALUE4,VALUE5 2392 IDI VALUE1,NAME1,VALUE2,NAME2 2394 ENDF 2396 SEEK VALUE1,VALUE3,VALUE4,VALUE5 2398 GOTO 2392 2400 .*************************************************************** 2402 FUNCTION RDB NAME1,VALUE1 2404 GETNAMEINFO NAME1,R,S,T 2406 GOSUB 266 2408 GOTO 2414 2410 PRINT "SDB FUNCTION" 2412 END 2414 LET X:=&ZZ(1) 2416 GOSUB 2482 2418 DB AA,VALUE1 2420 GOTO 2472 2422 DB BB,VALUE1 2424 GOTO 2472 2426 DB CC,VALUE1 2428 GOTO 2472 2430 DB DD,VALUE1 2432 GOTO 2472 2434 DB EE,VALUE1 2436 GOTO 2472 2438 DB FF,VALUE1 2440 GOTO 2472 2442 DB GG,VALUE1 2444 GOTO 2472 2446 DB HH,VALUE1 2448 GOTO 2472 2450 DB II,VALUE1 2452 GOTO 2472 2454 DB JJ,VALUE1 2456 GOTO 2472 2458 DB KK,VALUE1 2460 GOTO 2472 2462 DB LL,VALUE1 2464 GOTO 2472 2466 DB MM,VALUE1 2468 GOTO 2472 2470 DB NN,VALUE1 2472 FOR W:=0 UNTIL VALUE1-1 2474 RANDOM U 2476 SETNAMEDATA NAME1,W,U 2478 NEXT 2472 2480 ENDF 2482 LET OFFSET:=X-%101*2 2484 RETURN 2486 .******************************************************* 2488 FUNCTION CHB NAME1,NAME2 2490 GETNAMEINFO NAME1,R,S,T 2492 GOSUB 266 .CK NAME1 2494 GOTO 2498 2496 GOTO 2506 2498 GETNAMEINFO NAME2,R,WW(20),WW(21) 2500 LET WW(11):=-1 2502 GOSUB 366 .CK VAR NAME2 2504 GOTO 2546 2506 PRINT "CHB FUNCTION." 2508 END 2510 IFN &ZZ(0)=%122 THEN 2514 2512 RDB NAME1,T 2514 IFN &ZZ(0)=%123 THEN 2526 2516 FOR W:=0 UNTIL T-1 2518 GETNAMEDATA NAME1,W,X 2520 LET X:=X CSL 1 2522 SETNAMEDATA NAME1,W,X 2524 NEXT 2516 2526 IFN &ZZ(0)=%127 THEN 2546 .CIRC WD SHIFT? 2528 FOR W:=0 UNTIL T-1 2530 GETNAMEDATA NAME1,W,X 2532 IF W THEN 2538 2534 LET U:=X 2536 GOTO 2542 2538 LET Y:=W-1 2540 SETNAMEDATA NAME1,Y,X .BUF(1) INTO (0);(2) INTO (1) ETC. 2542 NEXT 2528 2544 SETNAMEDATA NAME1,W,U .BUF(0) TO LAST ELEMENT 2546 IFN &ZZ(0)=%101 THEN 2554 .FILL WITH ADDR 2548 FOR W:=0 UNTIL T-1 2550 SETNAMEDATA NAME1,W,W 2552 NEXT 2548 2554 IFN &ZZ(0)=%104 THEN 2566 .DEC WORD? 2556 FOR W:=0 UNTIL T-1 2558 GETNAMEDATA NAME1,W,X 2560 LET X:=X-1 2562 SETNAMEDATA NAME1,W,X 2564 NEXT 2556 2566 IFN &ZZ(0)=%111 THEN 2578 .INC WORD? 2568 FOR W:=0 UNTIL T-1 2570 GETNAMEDATA NAME1,W,X 2572 LET X:=X+1 2574 SETNAMEDATA NAME1,W,X 2576 NEXT 2568 2578 ENDF 2580 .******************************************************* 2582 FUNCTION SCB VALUE1,NAME1,NAME2,VALUE2,VALUE3 2584 GOSUB 766 .CK VAL1 & NAME1 2586 GOTO 2592 2588 PRINT "SCB FUNCTION" 2590 END 2592 GETNAMEINFO NAME1,R,S,T 2594 LET &ZZ(0):=R AND !FF 2596 GOSUB 266 2598 GOTO 2602 2600 GOTO 2588 .ERR MSG 2602 GETNAMEINFO NAME2,R,S,X 2604 GOSUB 266 .CK NAME1 2606 GOTO 2610 2608 GOTO 2588 .ERR MSG 2610 IFN VALUE3 THEN 2616 2612 LET T:=VALUE3 2614 GOTO 2620 2616 IF T GT X THEN 2620 2618 LET T:=X 2620 CB NAME1,NAME2,T 2622 IF INDEX=-1 THEN 2648 .ANY ERRORS? 2624 GETNAMEDATA NAME1,INDEX,W 2626 GETNAMEDATA NAME2,INDEX,Y 2628 LET S:=INDEX 2630 GOSUB 644 .REPORT ERR 2632 LET INDEX:=INDEX+1,T:=T-1 2634 IFN T THEN 2648 2636 FOR S:=INDEX UNTIL T 2638 GETNAMEDATA NAME1,S,W 2640 GETNAMEDATA NAME2,S,Y 2642 IF W=Y THEN 2646 2644 GOSUB 644 2646 NEXT 2636 2648 ENDF 2650 .********************************************************** 2652 FUNCTION WDI VALUE1,NAME1,VALUE2 2654 GOSUB 766 .CK VAL1 & NAME1 2656 GOTO 2662 2658 PRINT "WDI FUNCTION" 2660 END 2662 LET R:=VALUE1+80 2664 IF ZZ(R)=2 THEN 2670 2666 GOSUB 684 .WD 2668 ENDF 2670 GOSUB 682 .SFM & WD 2672 ENDF 2674 .******************************************************* 2676 FUNCTION RDI VALUE1,NAME1,VALUE2 2678 GOSUB 766 .CK VAL1 & NAME1 2680 GOTO 2686 2682 PRINT "RDI FUNCTION" 2684 END 2686 LET R:=VALUE1+80 2688 IF ZZ(R)=2 THEN 2694 2690 GOSUB 704 2692 ENDF 2694 GOSUB 702 .SFM & RD 2696 ENDF 2698 .****************************************************** 2700 FUNCTION SKRD VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5 2702 GOTO 1476 2704 .****************************************************** 2706 FUNCTION SKWD VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5 2708 GOTO 1586 2710 .************************************************* 2712 FUNCTION RQST VALUE1 2714 GOSUB 162 2716 GOSUB 232 .STAT 2718 ENDF 2720 .*********************************************************** 2722 FUNCTION RSA VALUE1 2724 GOSUB 1070 2726 LET WW(3):=!400 XOR ZZ(Z) 2728 BSIO XX 2730 WR 8,WW(3),2 2732 RR 8,WW(4),2 2734 GOTO 2980 2736 .************************************************* 2738 FUNCTION DISP VALUE1,NAME1 2740 GOSUB 162 .CK VAL1 2742 GETNAMEINFO NAME1,R,S,T 2744 LET WW(11):=-1,W:=ZZ(V)+80,X:=ZZ(W) 2746 GOSUB 366 .CK NAME1 2748 GOTO 2754 2750 PRINT "DISP FUNCTION" 2752 END 2754 LET T:=&ZZ(0) 2756 IFN T=%122 THEN 2764 2758 PRINTEX 0,"REQUESTED STATUS FOR LOGICAL UNIT ";VALUE1;" IS:",0 2760 GOSUB 394 .PR STAT 2762 ENDF 2764 IFN T=%123 THEN 2790 2766 IFN !79 LT X LT !82 THEN 2774 2768 PRINT "SECTOR ADDRESS INFORMATION IS NOT AVAILABLE "; 2770 PRINT "FOR 7902 DISCS" 2772 END 2774 IF X=2 THEN 2782 2776 PRINT "DISP FUNCTION ERROR",0;"LUN ";VALUE1;", A NON "; 2778 PRINT "DISC DEVICE, IS REQUESTING SECTOR ADDRESS INFO." 2780 END 2782 RSA VALUE1 2784 PRINT "REQUESTED SECTOR ADDRESS FOR LOGICAL UNIT ";ZZ(V); 2786 PRINT " IS: ";WW(4) 2788 ENDF 2790 IFN T=%131 THEN 2810 2792 IFN TT(0)=-1 THEN 2800 2794 PRINT 0,"LOGICAL UNIT ";ZZ(V);" DOES NOT HAVE ANY "; 2796 PRINT "SYNDROME INFORMATION",0 2798 END 2800 PRINT "LAST SYNDROME FOR LOGICAL UNIT ";ZZ(V);" WAS: ";%TT(0) 2802 FOR W:=1 UNTIL 6 2804 PRINT 38;%TT(W) 2806 NEXT 2802 2808 ENDF 2810 IF &ZZ(0)=%104 THEN 2818 2812 PRINT "VARIABLE ENTERED ";&ZZ(0);" FOR THE DISP FUNCTION IS "; 2814 PRINT "NOT D,R,S OR Y." 2816 END 2818 PRINT 0,"REQUESTED DISC ADDRESS FOR LUN ";ZZ(V);" IS: "; 2820 GOSUB 784 2822 GOSUB 152 2824 ENDF 2826 .********************************************************* 2828 FUNCTION CL VALUE1 2830 GOSUB 1070 2832 LET WW(0):=!A00 OR ZZ(Z) 2834 BSIO XX 2836 WR 8,WW(0),2 2838 GOTO 2980 2840 .************************************************************* 2842 FUNCTION RFSI VALUE1,NAME1 2844 GOSUB 766 .CK VAL1,NAME1 2846 GOTO 2852 2848 PRINT "RFS OR RFSI FUNCTION." 2850 END 2852 GOSUB 1066 2854 GOSUB 742 2856 ENDF 2858 .************************************************************* 2860 FUNCTION RFS VALUE1,NAME1,VALUE2,VALUE3,VALUE4 2862 GOSUB 1066 2864 SEEK VALUE1,VALUE2,VALUE3,VALUE4 2866 RFSI VALUE1,NAME1 2868 ENDF 2870 .************************************************************* 2872 FUNCTION WFSI VALUE1,NAME1 2874 GOSUB 1066 2876 GOSUB 766 .CK VAL1,NAME1 2878 GOTO 2884 2880 PRINT "WFS OR WFSI FUNCTION." 2882 END 2884 LET WW(0):=!900+ZZ(Z),T:=T*2,SS(2):=!300+ZZ(Z),ZZ(39):=ZZ(P),ZZ(P):=!9EF7 2886 GOSUB 352 .WD & GET STAT 2888 IF SS(0) NE !600+ZZ(Z) THEN 2894 2890 GOSUB 774 2892 GOTO 2886 2894 GOSUB 688 2896 LET ZZ(P):=ZZ(39) 2898 ENDF 2900 .************************************************************** 2902 FUNCTION WFS VALUE1,NAME1,VALUE2,VALUE3,VALUE4 2904 GOSUB 1066 2906 SEEK VALUE1,VALUE2,VALUE3,VALUE4 2908 WFSI VALUE1,NAME1 2910 ENDF 2912 .**************************************************************** 2914 FUNCTION SST 2916 LET WW(18):=-1 2918 ENDF 2920 .**************************************************************** 2922 FUNCTION RDA VALUE1 2924 GOSUB 162 .CK VAL1 2926 GOSUB 784 .GET DISC ADDR 2928 IFN WW(10) THEN 2940 2930 GOSUB 62 2932 GOSUB 232 .STAT 2934 LET SS(3):=ZZ(Z) 2936 GOSUB 128 .PR STAT 2938 GOSUB 248 .CK CPVA 2940 ENDF 2942 .**************************************************************** 2944 FUNCTION PE VALUE1 2946 GOSUB 162 2948 LET WW(19):=-1 2950 ENDF 2952 .*************************************************************** 2954 FUNCTION POLL VALUE1 2956 GOSUB 162 .CK VAL1 2958 LET WW(0):=!1500 2960 BSIO XX 2962 WR 8,WW(0),2 2964 GOTO 2982 2966 .**************************************************************** 2968 FUNCTION RSYN VALUE1 2970 GOSUB 1070 2972 LET WW(0):=!D00 2974 BSIO XX 2976 WR 8,WW(0),2 2978 RR 8,TT(0),14 2980 WAIT 2982 DSJ 2984;WW(10) 2984 IN H,1,1 2986 RSIO XX 2988 IF WW(10) THEN 2950 2990 GOTO 2930 2992 .**************************************************************** 2994 FUNCTION RWOI VALUE1,NAME1,VALUE2,VALUE3 2996 GOSUB 1070 2998 GOSUB 768 3000 GOTO 3006 3002 PRINT "RWO OR RWOI FUNCTION." 3004 END 3006 SFM VALUE1,VALUE2 3008 LET WW(0):=!E00 OR ZZ(Z),WW(1):=VALUE3,T:=T*2 3010 BSIO XX 3012 WR 8,WW(0),4 3014 RR 0,NAME1,T 3016 WAIT 3018 DSJ 3020;WW(10) 3020 IN H,1,1 3022 RSIO 3024 IFN WW(10) THEN 3030 3026 PRINTEX "RWO OR RWOI FUNCTION FAILURE FOR "; 3028 GOSUB 338 3030 ENDF 3032 .*************************************************************** 3034 FUNCTION RWO VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5,VALUE6 3036 SEEK VALUE1,VALUE4,VALUE5,VALUE6 3038 RWOI VALUE1,NAME1,VALUE2,VALUE3 3040 ENDF 3042 .*************************************************************** 3044 FUNCTION RWVI VALUE1,NAME1,VALUE2 3046 GOSUB 1070 3048 GOSUB 768 3050 GOTO 3056 3052 PRINT "FOR THE RWV OR RWVI FUNCTION" 3054 END 3056 SFM VALUE1,VALUE2 3058 LET WW(0):=!1200 OR ZZ(Z),T:=T*2,SS(2):=!300+ZZ(Z) 3060 BSIO XX 3062 WR 8,WW(0),2 3064 RR 0,NAME1,T 3066 WAIT 3068 GOSUB 236 .STAT 3070 IF SS(0)=ZZ(Z) THEN 3082 3072 IF SS(0) NE !600+ZZ(Z) THEN 3078 3074 GOSUB 774 3076 GOTO 3060 3078 PRINTEX "RWV OR RWVI FUNCTION FAILED",0 3080 GOSUB 128 3082 ENDF 3084 .**************************************************************** 3086 FUNCTION RWV VALUE1,NAME1,VALUE2,VALUE3,VALUE4,VALUE5 3088 AR VALUE1,VALUE3,VALUE4,VALUE5 3090 RWVI VALUE1,NAME1,VALUE2 3092 ENDF 3094 .**************************************************************** 3096 FUNCTION CORB VALUE1,NAME1 3098 GOSUB 766 .CK VAL1,NAME1 3100 GOTO 3106 3102 PRINT "CORB FUNCTION." 3104 END 3106 GOSUB 602 .DISC LIMITS 3108 IF TT(0) AND !F00 EQ !800 THEN 3118 3110 IF TT(0) AND !F00 EQ !F00 THEN 3126 3112 PRINT "RECEIVED STATUS (";%TT(0);") THAT IS UNACCEPTABLE FOR "; 3114 PRINT "THE CORB FUNCTION." 3116 END 3118 LET SS(0):=TT(0),SS(3):=!F00+ZZ(Z),SS(4):=ZZ(O),SS(6):=ZZ(P) 3120 PRINTEX "UNCORRECTABLE DATA ERROR" 3122 GOSUB 128 .PR STAT 3124 ENDF 3126 IFN -3 LT TT(3) LT 128 THEN 3152 3128 LET WW(34):=TT(2) AND !FF,WW(33):=TT(2) LSR 8 3130 LET WW(21):=WW(14)*WW(15) 3132 LET W:=TT(1)-WW(30)*WW(21)+WW(33)-WW(31)*WW(15)+WW(34)-WW(32) 3134 FOR X:=4 UNTIL 6 3136 IFN -1 LT TT(3) LT 128 THEN 3152 3138 LET Y:=W*128+TT(3) 3140 GETNAMEDATA NAME1,Y,U 3142 LET V:=U XOR TT(X) 3144 SETNAMEDATA NAME1,Y,V 3146 LET TT(3):=TT(3)+1 3148 NEXT 3134 3150 LET TT(0):=!AAAA 3152 ENDF 3154 .**************************************************************** 3156 FUNCTION SOUT 3158 IF WW(18) THEN 3172 3160 LET WW(35):=WW(35)+1 3162 IF WW(35)=2 THEN 3168 3164 LPON 3166 GOTO 3172 3168 LPOFF 3170 LET WW(35):=0 3172 ENDF 3174 .*********************************************************** 3176 FUNCTION ES 3178 LET WW(18):=0 3180 ENDF 3182 .************************************************************** 3184 FUNCTION ESTA VALUE1,VALUE2,VALUE3,VALUE4,VALUE5,VALUE6 3186 LET SS(10):=VALUE1,SS(11):=NOT VALUE2,SS(12):=VALUE3 3188 LET SS(13):=NOT VALUE4,SS(14):=VALUE5,SS(15):=NOT VALUE6 AND !FF00 3190 ENDF 3192 .****************************************************** 3194 FUNCTION IS VALUE1,VALUE2,VALUE3,VALUE4 3196 GOSUB 162 .CK VAL1 3198 GOSUB 602 .DISC LIMITS 3200 LET R:=40,S:=49,T:=1,P:=WW(13)+1,Q:=0,O:=VALUE2,Z:=0 3202 GOSUB 3208 3204 ENDF 3206 .************************************************************** 3208 FOR Y:=R UNTIL S 3210 IF WW(Y)=STATENUM THEN 3236 3212 NEXT 3208 3214 FOR Y:=R UNTIL S 3216 IFN WW(Y) THEN 3228 3218 NEXT 3214 3220 PRINT 0,"THIS FUNCTION CAN NOT BE EXCECUTED FOR LINE # ";STATENUM; 3222 PRINT ". MORE THAN 10 OF THESE","FUNCTION CALLS ARE NOT ALLOWED "; 3224 PRINT "IN A USERS PROGRAM." 3226 END 3228 LET WW(Y):=STATENUM,W:=Y+10,WW(W):=O 3230 IFN Z=-1 THEN 3250 3232 LET X:=Y-R+100,WW(X):=VALUE2 3234 GOTO 3254 3236 LET W:=Y+10,X:=Y-R+100 3238 LET WW(W):=WW(W)+T 3240 IFN WW(W)=P THEN 3248 3242 LET WW(W):=Q,WW(X):=WW(X)+1 3244 IF WW(X) NE WW(13)+1 THEN 3248 3246 LET WW(X):=0 3248 IF Z=-1 THEN 3254 3250 SEEK VALUE1,WW(W),VALUE3,VALUE4 3252 RETURN 3254 SEEK VALUE1,WW(X),WW(W),VALUE4 3256 RETURN 3258 .************************************************************** 3260 FUNCTION IT VALUE1,VALUE2,VALUE3,VALUE4 3262 GOSUB 162 .CK VAL1 3264 GOSUB 602 3266 LET R:=80,S:=89,T:=1,P:=WW(14),Q:=0,O:=VALUE3,Z:=-1 3268 GOSUB 3208 3270 ENDF 3272 .****************************************************** 3274 FUNCTION DS VALUE1,VALUE2,VALUE3,VALUE4 3276 GOSUB 162 .CK VAL1 3278 GOSUB 602 .DISC LIMITS 3280 LET R:=60,S:=69,T:=-1,P:=-1,Q:=WW(13),O:=VALUE2,Z:=0 3282 GOSUB 3208 3284 ENDF 3286 .*************** LINE PRINTER FUNCTIONS ******************* 3288 FUNCTION RP VALUE1,VALUE2 3290 GOSUB 162 .CK VAL1 3292 IF 0 LT VALUE2 LT 133 THEN 3296 3294 GOTO 1660 3296 DB &YY,264 3298 LET R:=ZZ(V)+80,ZZ(18):=ZZ(R),Q:=0,ZZ(58):=58 3300 IF ZZ(18)=!200A THEN 3336 3302 IF ZZ(18)=!2002 THEN 3308 3304 LET P:=18 3306 GOTO 3310 3308 LET P:=19 3310 BSIO UU 3312 WR 8,RR(P),1 .TOF 3314 WAIT 3316 IN H 3318 ESIO 3320 BSIO VV 3322 WR 10,RR(2),1 3324 RR 10,SS(7),2 3326 IN H,1,1 3328 ESIO 3330 IF ZZ(18)=!2002 THEN 3336 3332 GOSUB 900 .RIPPLE PR 3334 ENDF 3336 BSIO VV 3338 RR !E,SS(7),2 3340 IN H,1,1 3342 ESIO 3344 GOSUB 900 .RP PR 3346 ENDF 3348 .********************** MAG TAPE FUNCTIONS ********************* 3350 FUNCTION BSF VALUE1 3352 LET S:=12 3354 GOTO 3370 3356 .****************************************************************** 3358 FUNCTION BSR VALUE1 3360 LET S:=10 3362 GOTO 3440 3364 .****************************************************************** 3366 FUNCTION FSF VALUE1 3368 LET S:=11 3370 GOSUB 3382 3372 GOTO 3394 3374 GOTO 3604 3376 LET U:=STATENUM 3378 ESTA !8100,!400,0,0,0,!FF00 3380 GOTO 3450 3382 GOSUB 162 3384 IFN ZZ(18)=!176 THEN 3392 3386 LET OFFSET:=1 3388 IF SS(10)<>-1 THEN 3392 3390 LET OFFSET:=2 3392 RETURN 3394 GOSUB 994 3396 BSIO XX .7970E siop 3398 WR 1,RR(S),1 3400 WAIT 3402 DSJ 3406;WW(10) 3404 RR 1,SS(8),3 3406 IN H,1,1 3408 RSIO 3410 IFN WW(10) THEN 3418 3412 GOSUB 62 3414 GOSUB 500 .STATUS 3416 GOSUB 142 .PE 3418 IF SS(10)=-1 THEN 3432 3420 GOSUB 994 .GET STAT 3422 IF SS(10) XOR SS(8) AND SS(11) THEN 3428 3424 IFN SS(12) XOR SS(9) AND SS(13) THEN 3430 3426 GOSUB 62 3428 GOSUB 500 3430 LET SS(10):=-1 3432 ENDF 3434 .***************************************************************** 3436 FUNCTION FSR VALUE1 3438 LET S:=9 3440 GOSUB 3382 3442 GOTO 3394 .7970 3444 GOTO 3604 .7976 and user esta 3446 LET U:=STATENUM 3448 ESTA !100,!400,0,0,0,!FF00 3450 LET STATENUM:=U 3452 GOTO 3604 3454 .***************************************************************** 3456 FUNCTION GAP VALUE1 3458 LET S:=7 3460 GOSUB 3382 3462 GOTO 3394 3464 GOTO 3604 3466 LET U:=STATENUM 3468 ESTA !100,0,0,0,0,!FF00 3470 GOTO 3450 3472 .************************************************************** 3474 FUNCTION RRB VALUE1,NAME1 3476 GOSUB 766 3478 GOTO 3482 3480 GOTO 1482 3482 LET R:=V+80 3484 IF ZZ(R)=!176 THEN 3492 3486 GOSUB 992 3488 LET P:=15 3490 GOTO 1508 3492 LET R:=T ASL 1,S:=!F 3494 GOTO 1552 3496 .***************************************************************** 3498 FUNCTION REW VALUE1 3500 LET S:=13,T:=16 3502 LET TIMEOUT:=25 3504 GOSUB 3382 3506 GOTO 3520 .7970 3508 GOTO 3604 .7976, USER ESTA 3510 LET U:=STATENUM 3512 ESTA !4100,!480,0,0,0,!FF00 3514 IF S=13 THEN 3450 3516 ESTA 0,!2480,0,0,0,!FF00 .change 400 to 0 3518 GOTO 3450 3520 GOSUB 994 3522 BSIO VV .7970 siop 3524 WR 1,RR(S),1 3526 WAIT 3528 IF S=14 THEN 3536 3530 DSJ 3532,3538;WW(10) 3532 WR 7,RR(T),1 .END 3534 WAIT 3536 DSJ 3538;WW(10) 3538 RR 1,SS(8),3 3540 IN H,1,1 3542 RSIO 3544 LET TIMEOUT:=1 3546 IF SS(8) AND !4100=!4100 THEN 3432 3548 GOTO 3410 3550 .***************************************************************** 3552 FUNCTION REWOFF VALUE1 3554 LET S:=14,T:=16 3556 GOTO 3504 3558 .***************************************************************** 3560 FUNCTION SELU VALUE1,VALUE2 3562 GOSUB 162 .CK VAL1 3564 IF -1 LT VALUE2 LT 4 THEN 3570 3566 PRINT "UNIT # ENTERED (";VALUE2;") FOR SELU FUNCTION IS NOT 0-3" 3568 END 3570 IF ZZ(R)=!176 THEN 3578 .7976 3572 LET W:=VALUE2+1 3574 GOSUB 1002 3576 ENDF 3578 IF VALUE2 THEN 1308 3580 ENDF 3582 .******************************************************************* 3584 FUNCTION WFM VALUE1 3586 LET S:=6 3588 GOSUB 3382 3590 GOTO 3394 3592 GOTO 3604 3594 LET U:=STATENUM 3596 ESTA !8100,0,0,0,0,!FF00 3598 GOTO 3450 3600 .******************************************************************* 3602 .MC, motion siop, and sta routine 3604 LET Q:=3*V+90,ZZ(Q):=!FF00,Q:=Q-1,ZZ(Q):=-1,Q:=Q-1,ZZ(Q):=-1 3605 LET WW(20):=0 3606 IF S THEN 3626 3608 LET S:=DEVICE OR !20.sel dev clr 3610 IF DEVICE=7 THEN 3614 3612 IF DEVICE=1 EQ DEVICE=2 EQ DEVICE=4 THEN 3616 3614 LET S:=S OR !80.parity 3616 BSIO XX 3618 CHP !DF,!BF,S,4,!DF,!BF .clr 3620 IN H,1,1 3622 RSIO 3624 LET S:=0 3626 IFN 11 LE S LE 13 THEN 3630 .rew, b/fsf 3628 LET TIMEOUT:=80 .400 sec 3630 BSIO XX 3632 IF S<0 THEN 3654 .sta only 3634 IFN S THEN 3646 3636 WR 1,RR(0),1 .sel u0 3638 WR 1,RR(S),1 .cmd 3640 IF S<>5 THEN 3646 .5=wd 3642 DSJ 3644,3656;WW(20) 3644 WR 0,NAME1,R 3646 WAIT 3648 IF S=8 EQ S=!F THEN 3654 .branch ifn read,rrb 3650 DSJ 3652,3656;WW(20) 3652 RR 0,NAME1,R 3654 DSJ 3656;WW(10) 3656 RR 1,ZZ(Q),5 .sta 3658 .must save sta from ea lu for STAT D: '76 clears sta after read. 3660 WR 7,RR(8),1 .end 3662 IN H,1,1 3663 RSIO 3664 IF WW(20) THEN 3666 3665 LET WW(20):=WW(10).2nd dsj good only if 1st=0 3666 IFN WW(20) AND !FFFE THEN 3672 3668 GOSUB 62 3670 PRINTEX "Dsj=";WW(20);", should be 0 or 1.",1 3672 IF S<1 THEN 3734 .rsb if DEV, MC, sta 3674 LET TIMEOUT:=1 3676 IF WW(18) THEN 3430 .sst 3678 LET R:=S=13,R:=S=14 OR R,R:=S=23 OR R,R:=S=17 OR R .s=13,14,17,23? 3680 IF R OR ZZ(P) THEN 3698 3682 LET ZZ(P):=!FFFF .took 3684 IFN ZZ(Q) XOR ZZ(O) AND !80 THEN 3700 3686 GOSUB 68 3688 PRINTEX "Specified density overridden by tape density of "; 3690 IF ZZ(O):=NOT ZZ(O) THEN 3696 .change dens 3692 PRINTEX "1600." 3694 GOTO 3700 3696 PRINTEX "6250." 3698 .look for recovered r/w err 3700 LET T:=Q+1,T:=ZZ(T) AND !1F .count 3702 IFN ZZ(Q) AND !1200=!1000 THEN 3710 .ste and not udc? 3704 GOSUB 68 3706 PRINTEX "Recovered media"; 3708 GOSUB 3724 3710 IF T=0 OR ZZ(Q) AND !1000 THEN 3718 .ste or no count? 3712 GOSUB 68 3714 PRINTEX "Recovered internal"; 3716 GOSUB 3724 3718 IFN ZZ(Q) AND !200 THEN 3736 .udc 3720 LET SS(11):=SS(11) OR !1000 .ste=care 3722 GOTO 3736 3724 PRINTEX " error, requiring ";T; 3726 IFN T=1 THEN 3732 3728 PRINTEX " retry." 3730 RETURN 3732 PRINTEX " retries." 3734 RETURN 3736 LET SS(10):=SS(10) AND !F7FF,SS(10):=ZZ(O) AND !80 OR SS(10).dens 3738 LET WW(1):=ZZ(Q) XOR SS(10) AND SS(11),Q:=Q+1 3740 LET WW(2):=ZZ(Q) XOR SS(12) AND SS(13),Q:=Q+1 3742 LET WW(3):=ZZ(Q) XOR SS(14) AND SS(15),U:=0 3744 IFN WW(1) OR WW(2) OR WW(3) THEN 3748 .u=1 if err 3746 LET U:=1 3748 IFN U XOR WW(20) AND 1 THEN 3760 3750 GOSUB 68 3752 PRINTEX " DSJ=";WW(20);" but status shows "; 3754 IF U THEN 3758 3756 PRINTEX "no "; 3758 PRINTEX "errors." 3760 IFN U THEN 3872 .no errs, no print sta 3762 GOSUB 62 3764 PRINTEX "Operation failed." 3766 LET U:=0 .sta d flag 3768 PRINTEX 0," 0--- Byte 1---7 0--- Byte 2---7 0--- Byte 3---7 --"; 3770 PRINTEX " 4-- 0--- Byte 5---7",0 3772 .print heading if associated bit in err 3774 LET W:=0,X:=2,Q:=1 3776 GOSUB 3878 3778 LET Q:=V*3+88,R:=Q+1,T:=ZZ(Q) AND !800 OR U 3780 IFN ZZ(R) AND !10E0 OR T THEN 3786 3782 PRINTEX "Dtail"; 3784 GOTO 3788 3786 PRINTEX 5; 3788 PRINTEX 7; 3790 IFN T:=ZZ(Q) AND !200 OR WW(3) OR U THEN 3794 3792 PRINTEX "Data Check"; 3794 PRINTEX 3796 .print actual sta bits: 3798 FOR R:=0 UNTIL 23 3800 GOSUB 3908 3802 NEXT 3798 3804 LET ZZ(Q):=ZZ(Q) CSL 8 .byte 3,4 3806 LET R:=ZZ(Q) AND !E0 LSR 5 .dtail 3808 PRINTEX 1;R; 3810 PRINTEX 2; 3812 IF 9 LT R:=ZZ(Q) AND !1F THEN 3816 .count 3814 PRINTEX 1; 3816 PRINTEX R;"d "; 3818 LET Q:=Q+1 3820 FOR R:=0 UNTIL 7 3822 GOSUB 3908 .print byte 5 bits 3824 NEXT 3820 3826 LET ZZ(Q):=ZZ(Q) CSL 8 3828 PRINTEX 0,2; 3830 .print bottom legends 3832 LET WW(1):=WW(1) CSL 1,WW(2):=WW(2) CSL 1,Q:=1 3834 GOSUB 3878 3836 LET WW(1):=WW(1) CSR 1,WW(2):=WW(2) CSR 1,R:=WW(2) AND !1F 3838 IFN WW(1) AND !1000 OR R OR U THEN 3844 3840 PRINTEX " Count";4; 3842 GOTO 3846 3844 PRINTEX 10; 3846 LET Q:=3*V+89 3848 IF R:=ZZ(Q) AND !E0=!40 THEN 3850 3850 IFN WW(1) AND !800 AND R OR U OR WW(3) THEN 3856 3852 PRINTEX "Reject "; 3854 GOTO 3860 3856 PRINTEX 7; 3858 IFN T THEN 3862 3860 PRINTEX "Code"; 3862 PRINTEX .done with sta print 3864 IF U THEN 3430 .if sta d, endf 3866 GOSUB 248 .cpva 3868 GOSUB 138 .err count, PE 3870 GOTO 3430 3872 GOSUB 248 3874 GOTO 3430 3876 .print legends above and below bits 3878 FOR R:=0 UNTIL 11 3880 IF WW(Q) AND !8000 OR U THEN 3886 3882 PRINTEX 4; 3884 GOTO 3888 3886 PRINTEX &WW(W,X);1; 3888 LET WW(Q):=WW(Q) CSL 2 3890 IFN R AND 3=3 THEN 3898 3892 PRINTEX 1; .space between bytes 3894 IF R<>7 THEN 3898 3896 LET Q:=Q+1 .next byte 3898 LET W:=W+3,X:=X+3 3900 NEXT 3878 3902 LET WW(Q):=WW(Q) CSL 8 3904 RETURN 3906 .print sta bits: 3908 IF ZZ(Q) AND !8000 THEN 3914 3910 PRINTEX " 0"; 3912 GOTO 3916 3914 PRINTEX " 1"; 3916 LET ZZ(Q):=ZZ(Q) CSL 1 3918 IFN R AND 7 EQ 7 THEN 3926 3920 PRINTEX 1; .space between bytes 3922 IFN R=15 THEN 3926 3924 LET Q:=Q+1 3926 RETURN 3928 .************************************************************** 3930 FUNCTION CLREAD VALUE1,NAME1 3932 GOSUB 766 .chk parms 3934 LET R:=V+80 3936 IF S:=ZZ(R)=!176 THEN 3944 .s:=-1 3938 GOSUB 62 3940 PRINTEX "Not 7976." 3942 END 3944 GOSUB 3604 .sta 3946 IF ZZ(Q) AND !4100=!4100 THEN 3954 3948 GOSUB 62 3950 PRINTEX "Not online, BOT." 3952 END 3954 LET X:=T ASL 1,P:=8,ZZ(Q):=0,Q:=Q+1,ZZ(Q):=0,Q:=Q+1,ZZ(Q):=0 3956 BSIO XX 3958 WR 1,RR(1),1 .C/L selu 3960 WAIT 3962 DSJ 1514,1536;WW(10) 3964 GOTO 1514 4990 .***************************************************************