Listing of file='@DSTAPER' on disk='vmedia/mvp-cs386-1.30-disk2.wvd.zip'
# Sector 254, program filename = '@DSTAPER' 0010 REM ! TDSTAPER - 06/05/91 - Restore Disk Platters from Cassette Utility 0020 REM ! (c) Copyright, Wang Laboratories, Inc., 1988. All rights reserved. 0030 REM % VARIABLE DEFINITIONS 0040 DIM R0$2 : REM .DS Prom Rev 0050 DIM S$70,D$(96)4,S0$(96)70 : I9=96 : REM /.Max.Index entries 0060 DIM K,I : REM - FOR...NEXT LOOP INDEX VARIABLES 0070 DIM D$3,D3$3 : REM - TAPE DRIVE ADDRESS 0080 DIM K$1 : REM - KEYIN BYTE 0090 DIM G$15 : REM - $GIO STATUS REGISTERS 0100 DIM B0$(128)64,B$(8)64 : REM .32 Sector buffer and 512-BYTE BLOCK BUFFER 0110 DIM D1$3,D2$3 : REM - destination DISK ADDRESS : D1$=" " 0120 REM TENSION FLAG : DIM T$1 : T$=" " 0130 REM MESSAGES : DIM M$50,M2$50,M1$50 0140 REM TEMPORARY : DIM T1$80 0143 S1=65 : S2=68 : REM .3 byte addr start @65 end @68 0144 REM NOTE 2 byte values are moved from 53-56 to 65-70 & processed as 3 byt es 0145 K$,D$=SELECT #0 : IF K$<>"D"THEN D$="D10" : K$=STR(D$,2) : OR (K$,04) : STR(D$,2)=K$&"F" : D3$=D$ 0150 REM % MAINLINE 0155 D$()=" " 0160 SELECT PRINT 005(80) : PRINT HEX(020D0C030F06020402000F); : REM - RESET THE DISPLAY & SHUT OFF CURSOR 0170 T1$="R e s t o r e D i s k P l a t t e r F r o m C a s s e t t e" : PRINT AT(0,40-LEN(T1$)/2);HEX(0F);T1$; 0180 GOSUB '50("(c) Copyright, Wang Laboratories, Inc., 1988"," All rights reserved.") 0190 PRINT AT(23,60);"FN/TAB - Exit";AT(22,60);"RETURN - Proceed"; 0195 D$=D3$ 0200 REM %get tape address 0202 PRINT AT(2,12);"Address of tape cassette drive (D5F, D6F, or D7F): "; : LINPUT HEX(0E),-D$ : IF D$="RUN"THEN 195 : PRINT AT(1,1,80);HEX(06); : GOSUB '50(" "," ") : $TRAN(D$,"BbDdFf")R : IF POS("DB"=STR(D$,1,1))<>0AND POS("567"=STR(D$,2,1))<>0AND STR(D$,3,1)=" F"THEN 210 : GOSUB '201("Illegal address") : GOTO 200 0210 SELECT #1<D$> : ERRORGOSUB '201("Invalid address") : GOTO 200 0215 PRINT AT(1,0,80) 0220 REM %get tape address status : D3$=D$ : GOSUB '201("Getting tape status") : Z=0 0222 $IF ON #1,225 : $BREAK : Z=Z+1 : IF Z<999THEN 222 : GOSUB '201("Drive unavailable") : GOTO 200 0225 S$=" " : $GIOSTATUSREQUEST#1(0E140F0012E20600070070A068D07040682E6816400087051A00C 340,G$)G$;STR(S$,,VAL(STR(G$,5,1))) : ERRORGOTO 260 0230 REM check for timeout : T1$=STR(G$,8,1)AND HEX(10) : IF STR(T1$,1,1)=HEX(00)THEN 240 : GOSUB '50(HEX(0E),"Tape cassette drive unavailable") : GOTO 200 0240 REM check for tape drive : IF STR(S$,2,1)<>"E"THEN 260 0250 REM check for errors : IF STR(G$,6,3)=HEX(000000)THEN 261 0260 GOSUB '50(HEX(0E),"Not a DS tape cassette drive") : GOTO 200 0261 R0$=STR(S$,4,2) : PRINT AT(1,72);"Prom=";R0$ 0262 DIM X0$(6)1,X1$(6)1 : GOSUB 9020 0265 K$=X1$(1)AND HEX(7F) : M9=45 : IF K$=HEX(17)THEN M9=150 : M$=" " : IF X0$(1)=HEX(C0)THEN M$="not in place" : ELSE DO : M$=" 45 MB" : K$=X1$(1)AND HEX(80) : IF K$=HEX(80)THEN M$="150 MB" : END DO 0266 PRINT AT(1,5); : PRINTUSING 269,M9,M$ : S9$=M$ 0267 IF LEN(M$)<9THEN 268 : C=C+1 : IF C<2THEN 220 : GOSUB '50(HEX(0E),"Adjust cassette") : GOTO 200 0268 GOTO 320 : REM "^^^^^^^^^ Re-order ^^^^^^^^^^^^^^^^^^^^^^^" 0269 % ### MB Tape drive -- Cassette is ############## 0270 GOSUB '50(" "," ") 0280 REM %get platter address : PRINT AT(3,24);"Address of disk platter to restore to: "; : LINPUT HEX(0E),-D1$ : PRINT HEX(06); : GOSUB '50(" "," ") : IF D1$=" "THEN RETURN 0290 $TRAN(D1$,"AaBbCcDdEeFf")R : IF D1$="340"THEN 300 : IF POS("DB3"=STR(D1$,1,1))<>0AND POS("123567"=STR(D1$,2,1))<>0AND VER(STR (D1$,3,1),"H")<>0AND D1$<>"D5F"AND D1$<>"D6F"AND D1$<>"D7F"THEN 300 : GOSUB '50(HEX(0E),"Illegal disk platter address") : GOTO 280 0300 IF POS("3B"=STR(D1$,1,1))=0OR POS("123"=STR(D1$,2,1))=0OR STR(D1$,3,1)<>" 0"THEN 310 : IF STR(D1$,1,1)="3"THEN STR(D1$,3,1)="1" : STR(D1$,1,1)="D" 0310 IF STR(D1$,1,1)="B"AND STR(D1$,3,1)="1"THEN 270 : SELECT #2<D1$> : ERRORGOSUB '50(HEX(0E),"Invalid address") : GOTO 280 0315 RETURN 0320 REM %---------- TAPE OPERATIONS ----------------------------------------- --- : PRINT AT(22,60,20);AT(23,60,20); 0330 REM %HOG TAPE DS : GOSUB '201("Waiting for DS") : $OPEN 330,#1 0340 REM %REWIND TAPE : GOSUB '201("Rewinding tape") : $GIOREWINDTAPE#1(0600070070A068D07040682E68308B6740008706,G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 0370 REM %POSITION TO BEGINNING OF TAPE DIRECTORY : GOSUB '201("Positioning to tape directory") : STR(G$,3,3)=HEX(000000) : $GIOSEEKDIRECTORYBLOCK#1(0600070070A068D07040682E683F8B6768016A306A406A50 40008706,G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 0380 REM %READ TAPE DIRECTORY : GOSUB '201("Reading tape directory") : S0$()=ALL(00) : C,S9=0 0390 REM read tape directory label (1st block) : GOSUB '202 : IF STR(G$,6,3)<>HEX(000000)THEN 760 : IF STR(B$(),1,32)="TAPE DIRECTORY LABEL"AND STR(B$(),33,32)="TYPE 1.1: P LATTER BACKUP"THEN 400 : M$="Data on tape is not from backup" : GOTO 1030 0400 REM read directory block : GOSUB '202 : IF STR(G$,6,3)<>HEX(000000)THEN 410 : IF C=I9THEN 430 : C=C+1 : IF STR(B$(),65,6)=" "THEN STR(B$(),65,6)=HEX(00)&STR(B$(),53,2)&HEX( 00)&STR(B$(),55,2) : S0$(C)=STR(B$(),,70) : S9=S9+(VAL(STR(S0$(C),S2),3)-VAL(STR(S0$(C),S1),3)-1) : GOTO 400 0405 S9=S9+(VAL(STR(S0$(C),S2),3)-VAL(STR(S0$(C),S1),3)-1) : GOTO 400 0410 REM ignore any file marks : IF STR(G$,6,3)=HEX(1A0000)THEN 400 0420 REM check for end of data : IF STR(G$,6,3)<>HEX(170000)THEN 760 0430 $CLOSE#1 0431 PRINT AT(23,60);"FN/TAB - Exit"; : IF C>0THEN 432 : GOSUB '201("No data in directory") : KEYIN K$ : GOTO 155 0432 REM %DISPLAY TAPE DIRECTORY : PRINT AT(21,51);"SPACE/BACKSPACE - Move cursor";AT(22,60);"RETURN - Selec t item";AT(6,2);"\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\D4\E1\F 0\E5\A0\C4\E9\F2\E5\E3\F4\EF\F2\F9\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0 \A0\A0\A0\A0\A0\A0 \C6\F2\EF\ED\A0\A0\D4\EF \C2\E5\E7 \A0\A0\A0\A0\C5\EE\ E4\A0 \A0\CD\C2\A0" 0435 PRINT AT(5,52);" Surface"; 0440 REM R=row, X=current item selected, K=item at top of list 0445 GOSUB '201("Select item to restore") 0448 X,K=1 0450 REM display section of directory : PRINT AT(7,0,1040); : FOR R=7TO 19 : Y=K+R-7 : IF Y>CTHEN 460 : S$=S0$(Y) : S=VAL(STR(S$,S1),3) : E=VAL(STR(S$,S2),3) 0455 PRINT AT(R,0);"\85 ";STR(S$,,49); : PRINTUSING " /### ### ### ######## ###.#",STR(S$,50,3),D$(Y),S,E,ROUND((( E-S+1)/4096,1); : IF S>999THEN DO : PRINT AT(R,57); : PRINTUSING "#######",S : END DO 0460 NEXT R : PRINT AT(5,74); : PRINTUSING "###.#",ROUND((S9/4096,1) 0465 REM flush keyboard buffer : KEYIN K$,465,465 0470 REM %Pick item(s) to restore : PRINT AT(X-K+7,0);HEX(0E8B20);STR(S0$(X),,49);HEX(0F); 0475 KEYIN K$,,480 : ON POS(HEX(08200D82)=K$)GOTO 485,490,492,500 : GOTO 475 0480 ON POS(HEX(465645557E7F)=K$)GOTO 485,485,490,490,155,155 : IF K$=HEX(0F)THEN GOSUB 8000 : GOTO 475 0485 REM prior item : IF X=1THEN 475 : GOSUB 530 : X=X-1 : IF X>=KTHEN 470 : K=K-13 : GOTO 450 0490 REM next item : IF X=CTHEN 475 : GOSUB 530 : X=X+1 : IF X-K+7<20THEN 470 : K=K+13 : GOTO 450 0492 PRINT AT(20,60,20) : GOSUB 270 : PRINT AT(20,63);"RUN - Proceed" : IF D1$=" "THEN 498 : Z=0 0494 $IF ON #2,496 : $BREAK : Z=Z+1 : IF Z<999THEN 494 : GOSUB '50(HEX(0E),"Drive unavailable") : D1$=" " : GOTO 498 0496 E=VAL(STR(S0$(X),68),3) : VERIFY T#2,(E,E)E : IF E=0THEN 498 : GOSUB '50(HEX(0E07),"Illegal destination sector") : D1$=" " 0498 D$(X)=D1$ : PRINT AT(X-K+7,57,5);STR(D1$,,3) : GOTO 470 0500 REM .RUN keyed : GOSUB 530 : REM .RUN keyed : E=0 : FOR X=1TO I9 : IF D$(X)=" "THEN 505 : D1$=D$(X) : FOR J=X+1TO I9 : IF D1$=D$(J)THEN E=1 : NEXT J 0505 NEXT X : X=1 : IF E>0THEN GOSUB '50(HEX(0E),"Duplicate destination found") : IF E>0THEN 448 : J=1 : FOR X=1TO I9 : IF D$(X)=" "THEN 510 : S0$(J)=S0$(X) : STR(S0$(J),50,3)=STR(D$(X),,3) : J=J+1 0510 NEXT X : X=1 : IF J=1THEN 448 : FOR X=JTO I9 : S0$(X)=ALL(00) : NEXT X : X,K=1 : PRINT AT(5,51,29);"Restore";AT(6,52);"\A0\D4\EF\A0\A0\A0\A0\A0" 0515 REM Show picks : PRINT AT(7,0,1040); : FOR X=1TO I9 : S$=S0$(X) : S=VAL(STR(S$,S1),3) : E=VAL(STR(S$,S2),3) : IF E=0THEN 520 : R=X+6 : PRINT AT(R,0);"\85 ";STR(S$,,49); : PRINTUSING " /### ####### ######## ###.#",STR(S$,50,3),S,E,ROUND(((E-S+1) /4096,1); 0520 NEXT X : PRINT AT(21,51,29);AT(22,51,29) 0525 KEYIN K$ : ON POS(HEX(827E7F)=K$)GOTO 532,155,155 : GOTO 525 0530 PRINT AT(X-K+7,0);HEX(8520);STR(S0$(X),,49); : RETURN 0532 PRINT AT(3,0,80);AT(20,60,20);HEX(02040B000E);"RESTORING";HEX(0F) 0534 REM %HOG TAPE DS : GOSUB '201("Waiting for DS") : $OPEN 534,#1 : X=1 : IF T$="T"THEN 540 0536 REM %RETENSION TAPE : GOSUB '50(HEX(0E),"Retensioning tape") : $GIORETENSIONTAPE#1(0600070070A068D07040682E68328B6740008706,G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 : T$="T" 0540 REM %POSITION TO DATA TO BE RESTORED : GOSUB '201("Positioning to data to restore") : STR(G$,3,3)=STR(S0$(X),58,3) : $GIOSEEKBLOCK#1(0600070070A068D07040682E683F8B6768006A306A406A5040008706, G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 0541 D1$=STR(S0$(X),50,3) 0542 REM % STARTING SECTOR : S=VAL(STR(S0$(X),S1),3) 0544 REM % ENDING SECTOR : E=VAL(STR(S0$(X),S2),3) 0545 REM .Get Status after seek block " : GOSUB 9020 : S$=S0$(X) 0550 REM % # SECTORS TO RESTORE : N=E-S+1 0555 PRINT AT(22,0,40);TAB(12);"of";N : PRINT AT(16,0,80) 0560 REM %DS DISK OR EXTERNAL DISK? : M$="Copying data from tape to disk platter /"&D1$ : GOSUB '201(M$) : D2$=D1$OR HEX(000400) : IF STR(D1$,1,1)<>"D"OR STR(D2$,2,1)<>STR(D$,2,1)THEN 630 0566 ON 999GOTO 630 : REM %.Remove 'ON 999' to maximize interleave with concurrent access 0570 REM %RESTORE TO DS DISK : REM disk address : HEXPACKSTR(G$,4,1)FROMSTR(D1$,2,2) : STR(G$,4,1)=AND HEX(0F) : IF STR(D1$,2,1)>"4"THEN STR(G$,4,1)=STR(G$,4,1)OR HEX(10) 0580 FOR J=STO ESTEP 256 0590 REM starting sector : STR(G$,1,3)=BIN(J,3) 0600 REM # sectors : STR(G$,11,2)=BIN(MIN(E-J+1,256),2) 0610 $GIORESTORESECTORS#1(0600070070A068D07040682E68356A406A106A2062308B676AB0 6AC08B674000870B870C8706,G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 0615 PRINT AT(22,0);J 0620 NEXT J : GOTO 675 0630 REM %RESTORE TO EXTERNAL DISK : SELECT #2<D1$> : J,B0=S : IF E-S<33THEN 638 0632 REM .Restore as many sectors as possible 32 at a time 0634 FOR J1=STO INT((E-S)/32)-1 : PRINT AT(22,0);J; : FOR Z=1TO 32*256STEP 512 : GOSUB '202 : IF STR(G$,6,3)<>HEX(000000)THEN 760 : STR(B0$(),Z,512)=STR(B$(),,512) : NEXT Z : DATA SAVE BMT#2,(J)B0$() : ERRORGOTO 1020 0636 J=J+32 : NEXT J1 : B0=J 0638 FOR J=B0TO ESTEP 2 0640 REM read next block : GOSUB '202 : IF STR(G$,6,3)<>HEX(000000)THEN 760 0650 REM write 1st sector to disk : DATA SAVE BA T#2,(J)STR(B$(),,256) : ERRORGOTO 1020 0660 REM write 2nd sector to disk : IF J+1<E+1THEN DATA SAVE BA T#2,(J+1)STR(B$(),257,256) : ERRORGOTO 1020 0665 PRINT AT(22,0);J; 0670 NEXT J 0675 PRINT AT(22,0,40) : PRINT AT(6+X,0);HEX(0202020F960202000F) : X=X+1 0678 IF STR(S0$(X),,1)>HEX(00)THEN 540 0680 REM %REWIND TAPE : GOSUB '201("Rewinding tape") : $GIOREWINDTAPE#1(0600070070A068D07040682E68308B6740008706,G$) : IF STR(G$,6,3)<>HEX(000000)THEN 760 0690 REM %RESTORE DONE : PRINT AT(20,60,20) : GOSUB '201("Restore completed") : PRINT HEX(07); : GOTO 1040 0700 REM %READ BLOCK SUBROUTINE : REM Return- B$()=data block : REM STR(G$,6,1)=error code : REM STR(G$,7,2)=command error 0710 DEFFN'202 : $GIOREADBLOCK#1(0600070070A068D07040682E684A8B6740008B76D00FC3418B52E00F0 6260800,G$)B$() : IF STR(G$,6,3)<>HEX(260000)THEN RETURN 0720 REM retry if LRC error : FOR I=1TO 16 : $GIOREREADBLOCK#1(0600070070A068D07040682E684C8B6740008B76D00FC3418B52E00 F06260800,G$)B$() : IF STR(G$,6,3)<>HEX(260000)THEN I=16 : NEXT I : RETURN 0730 REM % TAPE CASSETTE ERROR HANDLING : REM STR(G$,6,1) = ERROR CODE : REM STR(G$,7,2) = COMMAND ERROR 0740 REM if nonrecoverable error, : GOTO 1030 0750 REM if recoverable error, : GOTO 1110 0760 RETURN CLEAR ALL : IF STR(G$,7,2)=HEX(0000)THEN 770 : M$="Tape Command Error" : GOTO 1030 0770 K$=STR(G$,6,1) : ON POS(HEX(919395969899)=K$)GOTO 780,800,790,810,830,820 : GOTO 840 0780 M$="ERROR I91: Disk Drive Not Ready" : GOTO 1030 0790 M$="ERROR I95: Device Error" : GOTO 1030 0800 M$="ERROR I93: Format Error" : GOTO 1030 0810 M$="ERROR I96: Data Error" : GOTO 1030 0820 M$="ERROR I99: Read After Write Error" : GOTO 1030 0830 M$="ERROR I98: Illegal Sector Address or No Platter" : GOTO 1030 0840 ON VAL(K$)-15GOTO 860,870,880,890,900,910,920,930,,,940,950,960,,,,970,,, 980,990,,1000,1010 0850 M$="ERROR: Device Error" : GOTO 1030 0860 GOSUB '50("ERROR T10: No Tape Cassette","Mount tape cassette and press RETURN") : GOTO 1110 0870 M$="ERROR T11: No Tape Cassette Drive" : GOTO 1030 0880 GOSUB '50("ERROR T12: Write Protect","Unprotect tape cassette and press RETURN") : GOTO 1110 0890 M$="ERROR T13: End Of Tape" : GOTO 1030 0900 M$="ERROR T14: Unrecoverable Data Error" : GOTO 1030 0910 M$="ERROR T15: Bad Data Block" : GOTO 1030 0920 M$="ERROR T16: Bad Block" : GOTO 1030 0930 M$="ERROR T17: No Data" : GOTO 1030 0940 M$="ERROR T1A: Unexpected File Mark Read" : GOTO 1030 0950 M$="ERROR T1B: Illegal Command" : GOTO 1030 0960 M$="ERROR T1C: Power On/Reset" : GOTO 1030 0970 M$="ERROR T20: Invalid Number of File Marks" : GOTO 1030 0980 M$="ERROR T23: Insufficient Buffer Space" : GOTO 1030 0990 M$="ERROR T24: Tape Drive Error" : GOTO 1030 1000 M$="ERROR T26: LRC Error" : GOTO 1030 1010 M$="ERROR T27: Device Error" : GOTO 1030 1020 REM %Disk error : M$="ERROR I##: Disk Error" : CONVERT ERRTO STR(M$,8,2),(##) : GOTO 1030 1030 REM %Nonrecoverable error : GOSUB '50("Tape recover aborted",M$) : PRINT HEX(07); 1040 REM %RESTART OR EXIT? : PRINT AT(23,60);"FN/TAB - Exit";AT(22,60);"RETURN - Proceed"; 1050 REM unhog tape ds : $CLOSE#1 1060 KEYIN K$,,1070 : IF K$=HEX(0D)THEN 160 : GOTO 1060 1065 REM % TAB KEY EXIT POINTS 1070 IF K$<>HEX(7E)AND K$<>HEX(7F)THEN 1060 1090 DEFFN'127 1100 DEFFN'126 : LOAD RUN "@MENU" 1110 REM %recoverable tape error : PRINT AT(23,60);"FN/TAB - Exit";AT(22,60);"RETURN - Proceed"; : T$=" " 1120 KEYIN K$,,1130 : IF K$=HEX(0D)THEN 320 : GOTO 1120 1130 IF K$<>HEX(7E)AND K$<>HEX(7F)THEN 1120 : GOTO 1100 1140 DEFFN'50(M1$,M2$) : REM %'50 - display message at lower left corner (lines 22,23) : PRINT AT(22,0);STR(M1$);AT(23,0);STR(M2$);HEX(0F); : RETURN 1150 REM %'201 - display message at lower left corner (line 23) 1160 DEFFN'201(M$) : PRINT AT(23,0);HEX(0E);STR(M$);HEX(0F); : RETURN 8000 DEFFN'15 : PRINT AT(19,0,5*80);"List contents of cassette to printer "; 8005 D2$="215" : LINPUT -D2$ : SELECT PRINT <D2$> 8010 M$=S9$&" cassette description" : LINPUT -M$ 8020 PRINT HEX(0D0E);M$ 8060 PRINTUSING 8085 8070 FOR R=1TO I9 : S$=S0$(R) : S=VAL(STR(S$,S1),3) : E=VAL(STR(S$,S2),3) : IF E=0THEN 8080 : PRINTUSING 8090,STR(S$,,49);STR(S$,50,3),S,E,ROUND(((E-S+1)/4096,1) 8080 NEXT R 8085 % Description as recorded in directory track Source Start End MB 8090 % ################################################# /####### ##### ##### ###.# 8100 SELECT PRINT 005 : PRINT AT(19,0,5*80);HEX(06) : GOTO 430 9000 DEFFN'10 : PRINT "Index analysis" : FOR X=1TO 4 : S$=S0$(X) : GOSUB 9050 : NEXT X 9010 PRINT "ddd Disk.max Tape block data .3-byte addr. Disk area -- Tape star t" 9020 X0$(),X1$()=ALL(FF) : $GIOSTATUSREAD#1(0600070070A068D07040682E68378B674000870687051A00C340,G$) G$;STR(X0$(),,VAL(STR(G$,5,1))) : ERROR$BREAK : GOTO 9020 9030 $GIOXSTATUSREAD#1(0600070070A068D07040682E683E8B674000870687051A00C340,G$ )G$;STR(X1$(),,VAL(STR(G$,5,1))) : ERRORSTOP # 9040 RETURN 9050 PRINT STR(S$,50,3);" ";HEXOF(STR(S$,53,4));".";HEXOF(STR(S$,57,4));" ";HE XOF(STR(S$,61,4));".";HEXOF(STR(S$,65)); : PRINTUSING " ## ###### -- ##### ",VAL(STR(S$,53),2),VAL(STR(S$,55),2),VAL (STR(S$,57),4) : PRINT "ddd Disk.max Tape block data .3-byte addr. Disk area -- Tape star t" : RETURN