image of READY prompt

Wang2200.org

Listing of file='TPUT070A' on disk='vmedia/733-1004.wvd.zip'

# Sector 274, program filename = 'TPUT070A'
0012 REM .     TPUT070A,     00-00 (04/10/77),     10189A
0029 DIM C$(42)50,D1$17,D$8,M$6,A1$50,Q6$64,Z1$64,Z0$64,M1$2
   : SELECT #107B
   : O$="C"
   : SELECT PRINT 005
   : PRINT HEX(03);"2209A - TAPE (CONTENTS) DUMP UTILITY"
0070 GOTO 1410
0080 GOSUB '243("ENTER THE OUTPUT DATASET NAME",17)
   : D1$=Q6$
0100 GOSUB '243("ENTER THE TODAY'S DATE IN (MM/DD/YY) FORMAT",8)
   : GOSUB '211(STR(Q6$,1,2))
   : IF T1=1THEN 190
   : IF STR(Q6$,3,1)<>"/"THEN 190
   : GOSUB '211(STR(Q6$,4,2))
   : IF T1=1THEN 190
   : IF STR(Q6$,6,1)<>"/"THEN 190
   : GOSUB '211(STR(Q6$,7,2))
0180 IF T1=0THEN 210
0190 GOSUB 9854
   : GOTO 100
0210 D$=Q6$
   : P3=0
   : R0=1
   : M$="ASCII"
   : O$="O"
   : GOSUB '243("TURN ON THE PRINTER, KEY (EXEC) TO RESUME",0)
   : GOSUB '248(1,0,4)
   : PRINT " DUMPING THE TAPE"
   : SELECT PRINT 215(132)
   : IF T=0THEN 320
   : M$="EBCDIC"
0320 GOSUB '31(6)
   : GOSUB 880
   : FOR I=1TO 999999
   : GOSUB '31(12)
   : K8,K9=256*VAL(STR(B$,9,1))+VAL(STR(B$,10,1))
   : IF STR(B$,7,1)<>HEX(04)THEN 430
   : IF K4=1THEN 410
   : K4=1
   : GOTO 810
0410 I=999999
   : GOTO 700
0430 K4=0
   : K6=INT((K9-1)/50)+1
   : GOSUB 1360
   : FOR J=1TO K6
   : B9=(J-1)*50+1
   : A1$=C$(J)
   : IF T=0THEN 510
   : $TRAN(A1$,T$())
0510 GOSUB '205(B9,1)
   : GOSUB '205(B9+25,26)
   : P0=P0+1
   : IF P0<2THEN 600
   : PRINT
   : P0=0
   : P2=P2+1
   : IF P2<10THEN 600
   : GOSUB 1380
0600 NEXT J
   : IF P0>=2THEN 690
   : IF P0=0THEN 690
   : FOR J0=1TO 2-P0
   : PRINT
   : PRINT
   : NEXT J0
   : P2=P2+1
   : P0=0
0690 IF P2<10THEN 760
0700 IF I<999999THEN 750
   : PRINT HEX(0A);"END OF DUMP"
   : PRINT HEX(0C)
   : PRINT HEX(0C)
   : GOTO 810
0750 GOSUB 1380
0760 R0=R0+1
   : IF I<999999THEN 810
   : PRINT HEX(0A);"END OF DUMP"
   : PRINT HEX(0C)
   : PRINT HEX(0C)
0810 NEXT I
   : GOSUB '31(6)
   : O$="C"
   : SELECT PRINT 005
   : GOSUB '248(1,0,4)
   : PRINT HEX(010A);"     END OF THE PROGRAM"
   : STOP
0880 P3=P3+1
   : IF P3>1THEN 910
   : PRINT HEX(0D);
0910 PRINT HEX(0C0A0A);TAB(9);"DATASET NAME";TAB(61);"TAPE DUMP";TAB(109);"DAT
     E";TAB(121);"PAGE"
   : PRINT TAB(9);D1$;TAB(107);D$;TAB(121);
   : PRINTUSING 940,P3
0940 %####
0950 PRINT
   : PRINT TAB(26);"BYTES";TAB(45);"TAPE CONTENTS <";M$;" HEXIDECIMAL>";TAB(10
     0);"2200 CORRESPONDING CHARS."
   : PRINT
   : P2,P0=0
   : RETURN
1000 %BLOCK ####   SIZE  ####
1010 %#####
1020 DEFFN'205(B0,I1)
   : IF K8>0THEN 1060
   : PRINT
   : RETURN
1060 K0=0
   : IF K8<25THEN 1110
   : K7=25
   : K0=1
   : GOTO 1120
1110 K7=K8
1120 K1=INT((K7-1)/5)
   : K5=K7-K1*5
   : PRINT TAB(26);
   : PRINTUSING 1010,B0;
   : PRINT " ";
   : IF K1<>0THEN 1200
   : I0=0
   : GOTO 1240
1200 FOR I0=1TO K1
   : PRINT " ";
   : HEXPRINT STR(C$(J),(I0-1)*5+I1,5);
   : NEXT I0
1240 PRINT " ";
   : HEXPRINT STR(C$(J),I0*5+I1,K5);
   : PRINT TAB(98);
   : IF K1<>0THEN 1300
   : I0=0
   : GOTO 1330
1300 FOR I0=1TO K1
   : PRINT STR(A1$,(I0-1)*5+I1,5);
   : NEXT I0
1330 PRINT STR(A1$,I0*5+I1,K5)
   : K8=K8-25
   : RETURN
1360 PRINTUSING 1000,R0,K9;
   : RETURN
1380 GOSUB 880
   : RETURN
1400 STOP
1410 GOSUB '243("MOUNT THE TAPE ON 2209, KEY (EXEC) TO RESUME",0)
   : GOSUB '31(13)
   : GOSUB '248(1,0,9)
   : GOSUB '43
   : GOSUB '31(6)
   : GOSUB '248(1,0,4)
   : GOTO 80
1470 DEFFN'211(M1$)
   : T1=1
   : IF STR(M1$,1,1)>HEX(39)THEN 1520
   : IF STR(M1$,2,1)<HEX(30)THEN 1520
   : T1=0
1520 RETURN
9195 DEFFN'43
   : GOSUB 9353
9199 O$="O"
   : GOSUB '31(6)
   : GOSUB '31(12)
   : GOSUB '204(0)
   : GOSUB 9391
   : IF T9=1THEN 9199
   : IF V0$<>"N"THEN 9219
   : GOSUB '31(6)
   : U1=0
   : RETURN
9219 GOSUB '248(1,0,8)
   : GOSUB '243("ENTER THE VOLUME SERIAL NO.",6)
   : STR(L$(1),5,6)=Q6$
   : GOSUB 9301
   : IF T8=1THEN 9199
   : GOSUB '31(12)
   : GOSUB '204(0)
   : IF STR(C$(2),4,1)<>"1"THEN 9243
   : GOSUB '248(1,0,8)
   : GOSUB '243("ENTER THE DATASET NAME",17)
9239 GOSUB '208(1,Q6$,5,17," * THE DATASET NAMES DO NOT MATCH *",0,1)
   : IF T8=1THEN 9199
9243 GOSUB '31(12)
   : GOSUB '204(0)
   : GOSUB '208(1,"F",5,1," * ILLEGAL RECORD FORMAT *",0,1)
   : IF T8=1THEN 9199
   : GOSUB '31(3)
   : U1=0
   : RETURN
9257 DEFFN'208(Z0,Z0$,Z8,Z9,Z1$,Z7,Z6)
   : T8,T9=0
   : IF STR(C$(Z0),Z8,Z9)=Z0$THEN 9271
9263 GOSUB '248(1,0,8)
   : PRINT HEX(0A0A);Z1$
   : T8=1
   : IF Z7=0THEN 9273
9271 RETURN
9273 IF Z6=1THEN 9287
   : PRINT HEX(010A);"KEY 'C' TO CONTINUE, 'S' TO STOP"
   : T9=0
9279 KEYIN Z$,9283,9283
   : GOTO 9279
9283 IF Z$="C"THEN 9297
   : IF Z$<>"S"THEN 9279
9287 GOSUB '243("REMOVE THE TAPE, KEY (EXEC) TO RESUME",0)
   : GOSUB '31(6)
   : T9=1
   : O$="C"
   : GOSUB '243("MOUNT THE TAPE, KEY (EXEC) TO RESUME",0)
   : GOSUB '31(13)
9297 GOSUB '248(1,0,8)
   : RETURN
9301 GOSUB '208(1,STR(L$(1),5,6),5,6," * THE VSN. DO NOT MATCH *",1,0)
   : IF T8=0THEN 9313
   : PRINT "     ---------------------"
   : PRINT "     THE INTERNAL VSN. = ";STR(C$(1),5,6)
9309 PRINT "     THE EXTERNAL VSN. = ";STR(L$(1),5,6)
   : GOSUB 9287
9313 RETURN
9353 IF O$="C"THEN 9357
   : STOP "   * ATTEMPT TO OPEN A NON-CLOSED FILE *"
9357 RETURN
9359 IF O$="O"THEN 9363
   : STOP "   * ATTEMPT TO CLOSE A CLOSED FILE *"
9363 RETURN
9391 GOSUB 9415
   : IF V0$<>"N"THEN 9409
   : IF S8<>80THEN 9407
   : IF STR(C$(1),1,4)<>"VOL1"THEN 9407
9399 Z6=1
   : Z7=0
   : Z1$=" * LABEL TYPES ARE NOT IDENTICAL *"
   : GOSUB 9263
9407 RETURN
9409 GOSUB '208(1,"VOL1",1,4," * LABEL TYPES ARE NOT IDENTICAL *",0,1)
   : IF S8<>80THEN 9399
   : RETURN
9415 S8=256*VAL(STR(B$,9,1))+VAL(STR(B$,10,1))
   : RETURN