image of READY prompt

Wang2200.org

Listing of file='@DSTAPER' on disk='vmedia/CS_D_cassette_diags.wvd.zip'

# Sector 231, program filename = '@DSTAPER'
0010 REM ! @DSTAPER - 08/16/88 - Restore Disk Platters from Cassette Utility
0020 REM ! (C) Copyright, Wang Laboratories, Inc., 1988.  All rights reserved.
0030 REM % VARIABLE DEFINITIONS
0040 DIM S$64
0050 DIM S0$(255)64
   : REM - INDEX ENTRIES
0060 DIM K,I
   : REM - FOR...NEXT LOOP INDEX VARIABLES
0070 DIM D$3
   : REM - TAPE DRIVE ADDRESS
0080 DIM K$1
   : REM - KEYIN BYTE
0090 DIM G$15
   : REM - $GIO STATUS REGISTERS
0100 DIM B$(8)64
   : REM - 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
0150 REM % MAINLINE
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,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed";
0195 D$="D5F"
0200 REM %get tape address
   : PRINT AT(2,12);"Address of tape cassette drive (D5F, D6F, or D7F): ";
   : LINPUT HEX(0E),-D$
   : IF D$="RUN"THEN 195
   : PRINT HEX(06);
   : GOSUB '50(" "," ")
   : $TRAN(D$,"BbDdFf")R
   : IF POS("DB"=STR(D$,1,1))<>0 AND POS("567"=STR(D$,2,1))<>0 AND STR(D$,3,1)
     ="F" THEN 210
   : GOSUB '201("Illegal address")
   : GOTO 200
0210 SELECT #1 <D$>
   : ERRORGOSUB '201("Invalid address")
   : GOTO 200
0220 REM %get tape address status
   : GOSUB '201("Getting tape status")
   : S$=" "
   : $GIO STATUS REQUEST #1(0E14 0F00 12E2 0600 0700 70A0 68D0 7040 682E 6816
     4000 8705 1A00 C340, 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 270
0260 GOSUB '50(HEX(0E),"Not a DS tape cassette drive")
   : GOTO 200
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(" "," ")
0290 $TRAN(D1$,"AaBbCcDdEeFf")R
   : IF D1$="340" THEN 300
   : IF POS("DB3"=STR(D1$,1,1))<>0 AND POS("123567"=STR(D1$,2,1))<>0 AND VER(S
     TR(D1$,3,1),"H")<>0 AND 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))=0 OR POS("123"=STR(D1$,2,1))=0 OR 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 SELECT #2 <D1$>
   : ERRORGOSUB '50(HEX(0E),"Invalid address")
   : GOTO 280
0320 REM %---------- TAPE OPERATIONS -----------------------------------------
     ---
   : PRINT AT(22,61,19);AT(23,61,19);
0330 REM %HOG TAPE DS
   : GOSUB '201("Waiting for DS")
   : $OPEN 330,#1
0340 REM %REWIND TAPE
   : GOSUB '201("Rewinding tape")
   : $GIO REWIND TAPE #1 (0600 0700 70A0 68D0 7040 682E 6830 8B67 4000 8706, G
     $)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
0350 REM %already retensioned?
   : IF T$="T" THEN 370
0360 REM %RETENSION TAPE
   : GOSUB '50(HEX(0E),"Retensioning tape")
   : $GIO RETENSION TAPE #1 (0600 0700 70A0 68D0 7040 682E 6832 8B67 4000 8706
     , G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
   : T$="T"
0370 REM %POSITION TO BEGINNING OF TAPE DIRECTORY
   : GOSUB '201 ("Positioning to tape directory")
   : STR(G$,3,3)=HEX(000000)
   : $GIO SEEK DIRECTORY BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 680
     1 6A30 6A40 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
0380 REM %READ TAPE DIRECTORY
   : GOSUB '201 ("Reading tape directory")
   : S0$()=ALL(00)
   : C=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:
     PLATTER 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=255 THEN 430
   : C=C+1
   : S0$(C)=STR(B$(),,64)
   : 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 REM %DISPLAY TAPE DIRECTORY
   : PRINT AT(21,51);"SPACE/BACKSPACE - Select Item";AT(23,60);"FN/TAB - Exit"
     ;AT(22,60);"RETURN - Proceed";AT(6,2);"\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\
     A0\A0\A0\A0\A0\D4\E1\F0\E5\A0\C4\E9\F2\E5\E3\F4\EF\F2\F9\A0\A0\A0\A0\A0\A
     0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0 \D0\EC\E1\F4\F4\E5\F2 \D3\F4\E1\
     F2\F4 \A0\C5\EE\E4\A0 \A0\A0\CD\E2\A0\A0"
   : K=1
   : X=1
   : GOSUB '201("Select item to restore")
0440 REM R=row, X=current item selected, K=item at top of list
0450 REM display section of directory
   : PRINT AT(7,0,1040);
   : FOR R=7 TO 19
   : Y=K+R-7
   : IF Y>C THEN 480
   : S$=S0$(Y)
   : S=VAL(STR(S$,53,2),2)
   : E=VAL(STR(S$,55,2),2)
   : PRINT AT(R,0);HEX(85);AT(R,53);"/";STR(S$,50,3);AT(R,2);STR(S$,,49);AT(R,
     60);
   : PRINTUSING "#####",S;
   : PRINT AT(R,66);
   : PRINTUSING "#####",E;
0455 PRINT AT(R,72);
   : PRINTUSING "###.#",ROUND(((E-S+1)/4096,1);
0460 NEXT R
0470 REM flush keyboard buffer
   : KEYIN K$,470,470
0480 REM %SELECT AN ITEM (X)
   : PRINT AT(X-K+7,0);HEX(0E8B20);STR(S0$(X),,49);HEX(0F);
0490 KEYIN K$,,500
   : ON POS(HEX(08200D)=K$) GOTO 510,520,530
   : GOTO 490
0500 ON POS(HEX(465645557E7F)=K$) GOTO 510,510,520,520,1100,1100
   : GOTO 490
0510 REM previous item
   : IF X=1 THEN 490
   : PRINT AT(X-K+7,0);HEX(8520);STR(S0$(X),,49);
   : X=X-1
   : IF X>=K THEN 480
   : K=K-13
   : GOTO 450
0520 REM next item
   : IF X=C THEN 490
   : PRINT AT(X-K+7,0);HEX(8520);STR(S0$(X),,49);
   : X=X+1
   : IF X-K+7<20 THEN 480
   : K=K+13
   : GOTO 450
0530 REM X selected
   : PRINT AT(21,51,29);AT(22,60,20);AT(23,60,20);
0540 REM %POSITION TO DATA TO BE RESTORED
   : GOSUB '201("Positioning to data to restore")
   : STR(G$,3,3)=STR(S0$(X),58,3)
   : $GIO SEEK BLOCK #1 (0600 0700 70A0 68D0 7040 682E 683F 8B67 6800 6A30 6A4
     0 6A50 4000 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
0542 REM % STARTING SECTOR
   : S=VAL(STR(S0$(X),53,2),2)
0544 REM % ENDING SECTOR
   : E=VAL(STR(S0$(X),55,2),2)
0550 REM % # SECTORS TO RESTORE
   : N=E-S+1
0560 REM %DS DISK OR EXTERNAL DISK?
   : GOSUB '201 ("Copying data from tape to disk platter")
   : D2$=D1$ OR HEX(000400)
   : IF STR(D1$,1,1)<>"D" OR STR(D2$,2,1)<>STR(D$,2,1) THEN 630
0570 REM %RESTORE TO DS DISK
   : REM disk address
   : HEXPACK STR(G$,4,1) FROM STR(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=S TO E STEP 256
0590 REM starting sector
   : STR(G$,2,2)=BIN(J,2)
0600 REM # sectors
   : STR(G$,11,2)=BIN(MIN(E-J+1,256),2)
0610 $GIO RESTORE SECTORS #1 (0600 0700 70A0 68D0 7040 682E 6835 6A40 6800 6A2
     0 6230 8B67 6AB0 6AC0 8B67 4000 870B 870C 8706, G$)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
0620 NEXT J
   : GOTO 680
0630 REM %RESTORE TO EXTERNAL DISK
   : FOR J=S TO E STEP 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
0670 NEXT J
0680 REM %REWIND TAPE
   : GOSUB '201("Rewinding tape")
   : $GIO REWIND TAPE #1 (0600 0700 70A0 68D0 7040 682E 6830 8B67 4000 8706, G
     $)
   : IF STR(G$,6,3)<>HEX(000000) THEN 760
0690 REM %RESTORE DONE
   : 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
   : $GIO READ BLOCK #1(0600 0700 70A0 68D0 7040 682E 684A 8B67 4000 8B76 D00F
      C341 8B52 E00F 0626 0800, G$) B$()
   : IF STR(G$,6,3)<>HEX(260000) THEN RETURN
0720 REM retry if LRC error
   : FOR I=1 TO 16
   : $GIO REREAD BLOCK #1(0600 0700 70A0 68D0 7040 682E 684C 8B67 4000 8B76 D0
     0F C341 8B52 E00F 0626 0800, 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$)-15 GOTO 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 ERR TO 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,61);"FN/TAB - Exit";AT(22,61);"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,61);"FN/TAB - Exit";AT(22,61);"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);
   : REM  KEYIN K$
   : RETURN