image of READY prompt

Wang2200.org

Listing of file='@SCTAPER' on disk='vmedia/turbo-1.30.01.wvd.zip'

# Sector 1153, program filename = '@SCTAPER'
0010 REM % '@SCTAPER' - Program - KKB
0011 REM % modified for internal external restore MUST RUN OS 1.16X OR HIGHER
     05/07/92
0012 REM % Ver 0.4 05/19/02
0013 REM % Ver 0.4.1 06/04/92 removed first screen
0014 REM % VER 0.4.2 FIXED CRASH LINE 430 FOR BLANK INPUT
0015 REM % VER 0.5.0 added tape error traps
0030 DIM A$(16384)1,B$(32)70,D$3,D$(32)4,D0$3,D1$3,D2$3,D4$3,J$2,K$1,M$50,M1$5
     0,M2$50,N$49,S0$(32)70,T1$80,T$1,U$(8)48,P(32)
   : T$=" "
   : D$=SELECT DISK
   : STR(D$,1,1)="D"
   : STR(D$,3,1)="F"
   : CONVERT STR(D$,2,1)TO C
   : C=C+4
   : CONVERT CTO STR(D$,2,1),(#)
   : D0$=D$
0040 REM % B$() = 70*32 byte directory
   : REM 01,49 = name/description
   : REM 50,3 = disk address
   : REM 53,3 = start address
   : REM 56,3 = end address
   : REM 59,3 = #blocks
   : REM 62,3 = end bytes left
   : REM 65,1 = platter count
   : REM 66,1 = backup type
   : REM (1),67,1 = Total Platters
0041 REM (1),68,3 = directory ID 'DiR'
0050 T1$="R e s t o r e  D i s k  P l a t t e r  F r o m  S C S I  T a p e"
   : PRINT HEX(0306);AT(0,40-LEN(T1$)/2);HEX(0E);T1$;HEX(0F)
0060 GOSUB '50("(c) Copyright Wang Laboratories, Inc., 1992","    All rights r
     eserved.")
0070 PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed"
0080 REM % Get Tape and Disk addresses
0090 D$=D0$
   : PRINT HEX(06);AT(2,12,1000);"Address of SCSI Tape drive (D5F, D6F, or D7F
     ): ";
   : LINPUT HEX(0E),-D$
   : IF D$="RUN"THEN 90
   : $TRAN(D$,"DdFf")R
   : GOSUB '50(" "," ")
   : IF POS("DB"=STR(D$,1,1))<>0AND POS("123567"=STR(D$,2,1))<>0AND STR(D$,3,1
     )="F"THEN 100
   : GOSUB '50(HEX(0E),"Invalid Address")
   : GOTO 70
0100 SELECT #2<D$>
   : REM % Check if a SCSI controller
   : GOSUB '50(" "," ")
   : GOSUB '60("Getting SCSI Controller status")
   : Z=0
   : $SCSICONFIGT#2,U$()
   : ERRORZ=ERR
0110 FOR X=1TO 8
   : IF STR(U$(X),1,1)=HEX(81)AND POS("567"=STR(D$,2,1))<>0THEN DO
   : T1$=ALL(20)
   : T1$=STR(U$(X),20,28)
   : PRINT AT(1,40-LEN(T1$)/2);STR(T1$,1,LEN(T1$))
   : X1=1
   : END DO
   : NEXT X
0120 GOSUB '50(" "," ")
   : IF Z<>0THEN GOSUB '60("Not A SCSI Controller")
   : IF Z<>0THEN GOTO 70
0125 IF X1<>1THEN GOSUB '60("No Tape Drive")
   : IF X1<>1THEN GOTO 70
0130 GOSUB '50(" "," ")
0140 REM  GOSUB 2180
0150 REM % Retension and rewind the tape and read directory
0160 GOSUB '50(HEX(060E),"Rewind Tape")
   : $SCSITAPE REWIND T#2,
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Please insert tape")
   : GOSUB 8110
   : Z=0
   : GOTO 160
0170 GOSUB '50(HEX(060E),"Reading Directory")
   : $SCSITAPE READ T#2,B$()
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB 8100
   : Z=0
   : GOTO 50
0175 IF STR(B$(1),68,3)="DiR"THEN GOTO 210
   : ELSE GOSUB '50(HEX(070E),"Not a WANG mode Tape")
0180 PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed"
0190 KEYIN K$
   : IF POS(HEX(7E7F0D)=K$)<>0THEN 200
   : GOTO 190
0200 IF POS(HEX(7E7F)=K$)<>0THEN 7080
   : IF K$=HEX(0D)THEN GOSUB '50(" "," ")
   : IF K$=HEX(0D)THEN 210
0210 REM % Find the number of platters on the tape
0220 P=VAL(STR(B$(1),67,1))
0230 GOSUB '50(" "," ")
0240 REM % Display the platters stored
0250 PRINT AT(21,51);"SPACE/BACKSPACE - Move Cursor";AT(22,60);"RETURN - Selec
     t item";AT(6,2);
0260 PRINT AT(6,1);"\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\A0\A0\A0\A0\A0\A0\A0\A0\A0\A0\A
     0 \A0\C6\F2\EF\ED\A0\D4\EF\A0 \A0\A0\C2\E5\E7\A0\A0\A0 \A0\A0\C5\EE\E4\A0
     \A0\A0 \A0\A0\CD\C2\A0"
0270 PRINT AT(5,46);" Surface";
0280 REM % R=Row, x=current item selected, k=item at top of the list
0290 GOSUB '60("Select item to restore")
0300 X,K=1
0310 REM % display section of directory
   : N=1
   : PRINT AT(7,0,1040);
   : IF P>12THEN PRINT HEX(060E);AT(20,0,71);AT(20,71);"--More--";HEX(0F);AT(7
     ,0);
   : FOR R=7TO 18
   : Y=K+R-7
   : IF Y>PTHEN 330
   : N$=STR(B$(Y),1,49)
   : A=VAL(STR(B$(Y),53,3),3)
   : B=VAL(STR(B$(Y),56,3),3)
0320 PRINT AT(R,0);"  ";STR(N$,,44);
   : PRINTUSING " /### ### ######## ######## ###.#",STR(B$(Y),50,3),D$(Y),A,B,
     ROUND(((B-A+1)/4096,1);
   : IF A>999THEN DO
   : PRINT AT(R,57);
   : PRINTUSING "#######",A
   : END DO
0330 N=N+1
   : NEXT R
   : PRINT AT(5,74);
   : REM P RINTUSING"###.#",ROUND((B-A-1)/4096,1)
   : PRINT AT(19,72);BOX(-0,-6);
   : IF N=KTHEN PRINT AT(20,71,8);
0340 KEYIN K$,340,340
   : O=0
0350 REM % Pick items to restore
   : PRINT AT(X-K+7,0);HEX(0E8B20);STR(B$(X),,44);HEX(0F);
0360 KEYIN K$,,370
   : ON POS(HEX(08200D82)=K$)GOTO 380,390,400,500
   : IF K$=HEX(0F)THEN GOSUB 6000
   : GOTO 360
0370 ON POS(HEX(465645557E7F)=K$)GOTO 380,380,390,390,50,50
   : IF K$=HEX(0F)THEN GOSUB 6000
   : GOTO 360
0380 REM prev item
   : IF X=1THEN 360
   : GOSUB 6010
   : X=X-1
   : IF X-K+17<1THEN X=1
   : IF X>=KTHEN 350
   : K=K-12
   : GOTO 310
0390 REM next item
   : IF X=PTHEN 360
   : GOSUB 6010
   : X=X+1
   : IF X-K+7<19THEN 350
   : K=K+12
   : GOTO 310
0400 PRINT AT(20,60,20)
   : D0$=D1$
   : GOSUB '50(" "," ")
0410 REM % get platter address to restore to
   : D1$=D0$
   : PRINT AT(3,20);"Address of Disk platter to restore to: ";HEX(0E);
   : LINPUT -D1$
0420 IF D1$="   "THEN 490
   : IF D1$="RUN"THEN GOTO 410
   : GOSUB '300(D1$)
   : D1$=D2$
   : IF D1$="340"THEN 430
   : GOSUB '50(" "," ")
   : IF POS("DB3"=STR(D1$,1,1))<>0AND POS("123567"=STR(D1$,2,1))<>0AND POS("01
     23456789ABCDE"=STR(D1$,3,1))<>0THEN 430
   : GOSUB '50(HEX(0E),"Invalid Address")
   : GOTO 410
0430 GOSUB '300(D1$)
   : D1$=D2$
   : IF D1$="340"THEN 450
   : IF STR(D1$,1,1)="B"AND STR(D1$,3,1)="1"THEN 410
   : IF POS("DB3"=STR(D1$,1,1))<>0AND POS("123567"=STR(D1$,2,1))<>0AND VER(STR
     (D1$,3,1),"H")<>0THEN 440
0440 IF STR(D1$,3,1)="F"THEN 410
   : IF POS("3B"=STR(D1$,1,1))=0AND POS("123"=STR(D1$,2,1))=0AND STR(D1$,3,1)<
     >"0"THEN 450
   : ELSE IF STR(D1$,1,1)="3"AND STR(D1$,3,1)="0"THEN DO
   : STR(D1$,1,1)="D"
   : STR(D1$,3,1)="1"
   : END DO
   : ELSE IF STR(D1$,1,1)="B"AND STR(D1$,3,1)="0"THEN DO
   : STR(D1$,1,1)="D"
   : STR(D1$,3,1)="0"
   : END DO
0450 SELECT #1<D1$>
   : ERRORGOSUB '50(HEX(060E),"Invalid address")
   : GOTO 410
0460 PRINT AT(20,63);"RUN - Proceed"
   : IF D1$="   "THEN 490
   : Z=0
0470 $IF ON #2,480
   : $BREAK
   : Z=Z+1
   : IF Z<999THEN 470
   : GOSUB '50(HEX(060E),"Drive unavailable")
   : D1$=" "
   : GOTO 490
0480 G=VAL(STR(B$(X),56,3),3)
   : VERIFY T#1,(G,G)G
   : IF G=0THEN 490
   : GOSUB '50(HEX(0E07),"Illegal destination sector")
   : D1$=" "
0490 D$(X)=D1$
   : O=O+1
   : PRINT AT(X-K+7,52,3);HEX(06);STR(D1$,,3);
   : GOTO 350
0500 IF O<1THEN GOSUB '50(HEX(06070E),"Minimum 1 platter is needed for restore
     ")
   : IF O<1THEN 360
0510 REM .RUN Keyed
   : GOSUB 6010
   : G=0
   : FOR X=1TO P
   : IF D$(X)=" "THEN 520
   : D1$=D$(X)
   : FOR J=X+1TO P
   : IF D1$=D$(J)THEN G=1
   : NEXT J
0520 NEXT X
   : X=1
   : IF G>0THEN GOSUB '50(HEX(0E),"Duplicate destination found")
   : IF G>0THEN 300
   : J=1
   : FOR X=JTO P
   : IF D$(X)=" "THEN 530
   : S0$(J)=B$(X)
   : STR(S0$(J),50,3)=STR(D$(X),,3)
   : STR(S0$(J),68,1)=BIN(X)
   : J=J+1
0530 NEXT X
   : STR(S0$(1),67,1)=BIN(J-1)
   : X=1
   : IF G=1THEN 300
   : FOR X=JTO P
   : S0$(X)=ALL(00)
   : NEXT X
   : X,K=1
   : PRINT AT(5,47,29);"Restore";AT(6,46);"   \A0\D4\EF\A0  "
0540 REM show picks
   : PRINT AT(7,0,);
   : FOR X=1TO P
   : N$=STR(S0$(X),,49)
   : A=VAL(STR(S0$(X),53,3),3)
   : B=VAL(STR(S0$(X),56,3),3)
   : IF B=0THEN 550
   : R=X+6
   : PRINT AT(R,0);" ";STR(N$,,44);
   : PRINTUSING "    /###   ######## ######## ###.#",STR(S0$(X),50,3),A,B,ROUN
     D(((B-A+1)/4096,1);
0550 NEXT X
   : PRINT AT(21,51,29);AT(22,51,29)
0560 PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed"
0570 KEYIN K$
   : ON POS(HEX(0D7E7F)=K$)GOTO 580,7090,7090
   : GOTO 570
0580 P0=VAL(STR(S0$(1),67,1))
0590 GOSUB '50(HEX(060E),"Retension Tape")
   : $SCSITAPE RETENSIONT#2,
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape error")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0600 REM % START RESTORE HERE
   : R=7
   : FOR X=1TO P0
   : P1=VAL(STR(S0$(X),68,1))
0610 D1$=STR(S0$(X),50,3)
   : SELECT #1<D1$>
0620 A,B,C,D,E=0
   : A=VAL(STR(S0$(X),53,3),3)
   : B=VAL(STR(S0$(X),56,3),3)
   : D=VAL(STR(S0$(X),59,3),3)
   : E=VAL(STR(S0$(X),62,3),3)
   : L=A
0630 GOSUB '50(HEX(060E),"Rewind Tape")
   : $SCSITAPE REWIND T#2,
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape error")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0640 GOSUB '50(HEX(060E),"Positioning the tape")
   : $SCSITAPE RMARKT#2,(P1)
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape error")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0650 GOSUB '302
0660 REM % IF BACKUP WAS EXT THEN RESTORE MUST BE EXT
   : IF F=1AND VAL(STR(S0$(X),66,1))=0THEN F=0
0670 REM % IF BACKUP WAS INT THEN RESTORE MUST BE INT  IF F=1AND VAL(STR(S0$(X
     ),66,1))=1THEN F=1  ELSE F=0
0680 IF F=0THEN GOSUB 750
   : IF F=1THEN GOSUB 2000
0690 PRINT AT(R,0);HEX(0202020E0E960202000E);
   : R=R+1
0700 NEXT X
0710 GOSUB '50(HEX(060E),"Rewind Tape")
   : $SCSITAPE REWIND T#2,
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape error")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0720 GOSUB '50(" "," ")
0730 GOSUB '50(HEX(06070E),"Restore Complete")
   : PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - RE-RUN"
0740 KEYIN K$
   : ON POS(HEX(0D7E7F)=K$)GOTO 50,7090,7090
   : GOTO 740
0750 REM % External Restore
   : GOSUB '50(" "," ")
   : GOSUB '70("External Restore in Progress...")
0760 FOR Y=1TO D
   : GOSUB '60("Restoring  Block No: ")
   : PRINT HEX(060E);Y;" of ";D;
0770 $SCSITAPE READ T#2,A$()
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape data error - Restore aborted")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0771 DATA SAVE BMT#1,(L,L)A$()
   : NEXT Y
0780 IF E<>0THEN DO
   : GOSUB '60("Restoring last block")
   : $SCSITAPE READ T#2,STR(A$(),1,E)
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape data error - Restore aborted")
   : GOSUB 8110
   : Z=0
   : GOTO 50
0781 DATA SAVE BMT#1,(L,L)STR(A$(),1,E)
   : END DO
0790 RETURN
2000 REM % Internal backup starts here!
2010 GOSUB '50(" "," ")
   : GOSUB '70("Internal Restore in Progress...")
2020 GOSUB '60("Restoring Platter ")
   : PRINT HEX(060E);" To ";D1$;
2030 $SCSITAPE RESTORE T#1,(A,B)
   : ERRORZ=ERR
   : IF Z<>0THEN GOSUB '50(HEX(06070E),"Tape data error - Restore aborted")
   : GOSUB 8110
   : Z=0
   : GOTO 50
2031 RETURN
2090 DEFFN'302
   : REM DECIDE INTERNAL OR EXTERNAL RESTORE
2100 E$=STR(D$,2,1)
   : IF E$=STR(D1$,2,1)THEN 2130
   : ELSE DO
   : E$=E$XOR HEX(04)
   : END DO
2110 REM % IF F=0 THEN EXTERNAL RESTORE
2120 REM % IF F=1 THEN INTERNAL RESTORE
2130 F=POS(STR(D1$,2,1)=E$)
2140 RETURN
2150 REM % Even/Odd Check for internal restore
2160 DEFFN'303
2170 IF MOD(A,2)<>0THEN A=A-1
   : IF MOD(B,2)<>1THEN B=B+1
   : RETURN
2180 REM % get platter address to restore to
   : PRINT AT(3,20);"Address of Disk platter to restore to: ";HEX(0E);
   : LINPUT -D1$
   : IF D1$="   "THEN RETURN
   : IF D1$="RUN"THEN 2180
2190 GOSUB '300
   : IF D1$="340"THEN 2200
   : 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 2195
   : ELSE GOSUB '50(HEX(060E),"Illegal platter address")
   : GOTO 2180
2195 IF POS("3B"=STR(D1$,1,1))=0OR POS("123"=STR(D1$,2,1))=0OR STR(D1$,3,1)<>"
     0"THEN 2200
   : IF STR(D1$,1,1)="3"THEN STR(D1$,1,1)="3"
   : STR(D1$,3,1)="1"
   : STR(D1$,1,1)="D"
2200 SELECT #1<D1$>
   : ERRORGOSUB '50(HEX(060E),"Invalid address")
   : RETURN
   : % GOTO 2180
2210 RETURN
6000 REM '6000
   : RETURN
6010 PRINT AT(X-K+7,0);HEX(2020);STR(B$(X),,44);
   : RETURN
7000 DEFFN'300(D2$)
7010 $TRAN(D2$,"AaBbCcDdEeFf")R
   : RETURN
7030 REM % Display Messages at Lower left Corner.
7040 DEFFN'50(M1$,M2$)
   : PRINT AT(22,0,60);STR(M1$,,LEN(M1$));AT(23,0,60);STR(M2$,,LEN(M2$));HEX(0
     F);
   : RETURN
7050 REM % display message at 23,0
7060 DEFFN'60(M$)
   : PRINT AT(23,0,60);HEX(060E);STR(M$,,LEN(M$));HEX(0F);
   : RETURN
7070 REM % deffn 126 & 127
7080 DEFFN'127
7090 DEFFN'126
   : SELECT 3OFF
   : LOAD RUN "@MENU"
7100 DEFFN'70(M$)
   : PRINT AT(22,0,79);HEX(060E);STR(M$,,LEN(M$));HEX(0F);
   : RETURN
8000 REM % Left Justify Subroutine
8010 DEFFN'603(L$)
   : L$=STR(L$,(POS(L$<>"0")-0))
   : RETURN
8100 GOSUB '50(HEX(06070E),"No data found on the tape")
8110 PRINT AT(23,61);"FN/TAB - Exit";AT(22,61);"RETURN - Proceed"
8120 KEYIN K$
   : IF POS(HEX(0D)=K$)<>0THEN 8130
   : GOTO 8120
8130 RETURN
9000 STOP #
9999 DEFFN'31
   : RESAVE T"@SCTAPER"