Listing of file='TPUT050A' on disk='vmedia/733-1004.wvd.zip'
# Sector 214, program filename = 'TPUT050A'
0012 REM . TPUT050A, 00-00 (04/10/77),10189A
: COM C$(33)64,D$(4)64,Y$4,Y1$2,N$(2)8,A,A9,L1,P9,V4,T0,J9
0030 DIM A$(16),N0$8,Z0$64,Z1$64,L$1,H$2,N$8
: SELECT #107B
: GOSUB '31(6)
: O$="C"
: P2=1
: B9,V4=0
: PRINT HEX(03);"2209A - DISK TO TAPE DATA TRANSFER UTILITY"
: GOSUB 1080
: GOSUB '248(1,0,15)
0120 GOSUB '243("MOUNT THE PLATTER, KEY (EXEC) TO RESUME",0)
: GOSUB '248(1,0,4)
: GOSUB '243("ENTER THE DISK DATA FILE NAME (1 TO 5 CHARS)",5)
0150 STR(N$(1),1,5)=Q6$
: STR(N$(1),6,2)="00"
: STR(N$(2),1,7)=STR(N$(1),1,7)
: STR(N$(1),8,1)="1"
: STR(N$(2),8,1)="0"
: GOSUB '209(N$(1),1)
: IF H0=1THEN 280
: GOSUB '209(N$(2),2)
: IF H0=1THEN 280
: GOSUB '248(1,0,8)
0250 GOSUB '243("DATA FILE IS NOT ON THE WORKING DISK, KEY (EXEC) TO RETRY",0)
: GOSUB '248(1,0,4)
: GOTO 120
0280 DATA LOAD DC OPEN T#2,N$(J9)
: LIMITS T#2,N$(J9),A7,A9,A8
: A=A7
0320 GOSUB '243("ENTER THE TAPE LABEL TYPE (I/A/N)",1)
: V0$=Q6$
: IF Q6$="I"THEN 460
: IF Q6$="A"THEN 480
: IF Q6$="N"THEN 390
: GOSUB 9854
: GOTO 320
0390 GOSUB '243("ENTER THE TAPE DATA TYPE (E=EBCDIC,A=ASCII)",1)
: T2,T=0
: IF Q6$="A"THEN 650
: T2,T=1
: IF Q6$="E"THEN 650
: GOSUB 9854
: GOTO 390
0460 T2,T=1
: GOTO 490
0480 T2,T=0
0490 GOSUB 1380
: T1=T
: DATA LOAD BA T#2,(A,A)C$()
: IF T3=0THEN 550
: T=1
: GOSUB '204(0)
0550 L$(1)=STR(C$(1),1,40)
: STR(L$(2),1,24)=STR(C$(1),41,24)
: STR(L$(2),25,16)=STR(C$(1),1,16)
: STR(L$(3),1,40)=STR(C$(2),17,40)
: STR(L$(4),1,8)=STR(C$(2),57,8)
: STR(L$(4),9,32)=STR(C$(3),1,32)
0610 STR(L$(5),1,32)=STR(C$(3),33,32)
: STR(L$(5),33,8)=STR(C$(4),1,8)
: STR(L$(6),1,40)=STR(C$(4),1,40)
: GOTO 670
0650 GOSUB 1380
: T1=T
0670 GOSUB '243("MOUNT THE TAPE ON 2209, KEY (EXEC) TO RESUME",0)
: GOSUB '31(13)
: GOSUB '248(1,0,9)
: GOSUB '42
: GOSUB '31(1)
: T=T1
0720 LOAD DC F"TPUT050B"12,9499
0730 DEFFN'209(N$,J9)
: O9=0
: XOR (STR(N$,2),N$)
: L$=STR(N$,8,1)
: H$=HEX(0000)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADD(STR(H$,1,1),STR(H$,2,1))
: H=VAL(H$)
: DATA LOAD BA T#2,(0,M$)A$()
: S=VAL(STR(A$(1),2,1))
: H=H-INT(H/S)*S
: H0=0
0870 DATA LOAD BA T#2,(H,H)A$()
: FOR I=1TO 16
: IF I+H=1THEN 960
: IF STR(A$(I),1,2)<>HEX(0000)THEN 940
: I=16
: O9=1
: GOTO 960
0940 IF STR(A$(I),1,1)=HEX(11)THEN 960
: IF STR(A$(I),9,8)=N$(J9)THEN 1060
0960 NEXT I
: IF O9=1THEN 1040
: H0=H0+1
: IF H0>STHEN 1040
: H=H-2
: IF H>=0THEN 870
: H=S-1
: GOTO 870
1040 H0=-1
: RETURN
1060 H0=1
: RETURN
1080 GOSUB '248(1,0,4)
: PRINT "SELECT DISK DEVICE ADDRESS"
: PRINT HEX(0A0A0A0A0A0A);
: PRINT TAB(28);"DEVICE ADDRESS"
: PRINT TAB(23);"-----------------------"
: PRINT TAB(25);"1. 310 4. B20"
: PRINT TAB(25);"2. B10 5. 350"
1150 PRINT TAB(25);"3. 320 6. B50"
: PRINT HEX(010A0A);
1170 INPUT Q9
: IF Q9>7THEN 1200
: IF Q9>0THEN 1240
1200 PRINT "RE-ENTER"
: PRINT HEX(0C0C);TAB(20)
: PRINT HEX(0C)
: GOTO 1170
1240 ON Q9GOTO 1260,1280,1300,1320,1340,1360
: GOTO 1200
1260 SELECT #2310
: RETURN
1280 SELECT #2B10
: RETURN
1300 SELECT #2320
: RETURN
1320 SELECT #2B20
: RETURN
1340 SELECT #2350
: RETURN
1360 SELECT #2B50
: RETURN
1380 T0=0
1390 GOSUB '243("ENTER THE DISK DATA TYPE (E=EBCDIC/ A=ASCII)",1)
: T3=0
: IF Q6$="A"THEN 1490
: T3=1
: IF Q6$="E"THEN 1460
: GOSUB 9854
: GOTO 1390
1460 IF T=1THEN 1520
: T=1
1480 RETURN
1490 IF T=0THEN 1480
: T0=1
: RETURN
1520 T=0
: RETURN
9121 DEFFN'42
: T=T2
9125 GOSUB 9353
: GOSUB '31(6)
: O$="O"
: GOSUB '31(12)
: GOSUB '204(0)
: GOSUB 9393
: IF T9=1THEN 9125
: IF V0$<>"N"THEN 9151
: GOSUB '245("ENTER THE BLOCK SIZE",5,0)
: S9=Q9
: GOSUB '31(6)
: U1=0
: RETURN
9151 GOSUB 9301
: IF T8=1THEN 9125
: GOSUB '248(1,0,8)
: GOSUB '31(12)
: GOSUB '204(0)
: GOSUB '245("ENTER TODAY'S DATE IN (YYDDD) FORMAT",5,0)
: CONVERT Q9TO W5$,(#####)
: IF STR(C$(1),49,5)<=W5$THEN 9181
9167 GOSUB '208(1,W5$,49,5," * ATTEMPT TO WRITE ON UNEXPIRED TAPE *",0,0)
: IF T9=1THEN 9125
: IF STR(C$(1),54,1)="0"THEN 9181
: GOSUB '248(1,0,8)
: GOSUB '243("ENTER THE DATASET NAME",17)
9177 GOSUB '208(1,Q6$,5,17," * THE DATASET NAMES DO NOT MATCH *",0,1)
: IF T8=1THEN 9125
9181 GOSUB '31(1)
: GOSUB '201(3,0)
: GOSUB '201(5,0)
: CONVERT STR(L$(5),6,5)TO S9
: GOSUB '31(10)
: 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)
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
9365 DEFFN'201(Z1,Z2)
: STR(C$(1),1,40)=L$(Z1)
: STR(C$(1),41,24)=STR(L$(Z1+1),1,24)
: STR(C$(2),1,16)=STR(L$(Z1+1),25,16)
: L0=80
: IF Z2=0THEN 9387
: IF Z2=2THEN 9385
: STR(C$(1),1,4)="EOF1"
: STR(C$(1),55,6)=W6$
: GOTO 9387
9385 STR(C$(1),1,4)="EOF2"
9387 GOSUB '204(1)
: GOSUB '31(11)
: RETURN
9393 GOSUB 9417
: IF V0$<>"N"THEN 9411
: IF S8<>80THEN 9409
: IF STR(C$(1),1,4)<>"VOL1"THEN 9409
9401 Z6=1
: Z7=0
: Z1$=" * LABEL TYPES ARE NOT IDENTICAL *"
: GOSUB 9263
9409 RETURN
9411 GOSUB '208(1,"VOL1",1,4," * LABEL TYPES ARE NOT IDENTICAL *",0,1)
: IF S8<>80THEN 9401
: RETURN
9417 S8=256*VAL(STR(B$,9,1))+VAL(STR(B$,10,1))
: RETURN