Listing of file='TPUT040A' on disk='vmedia/733-1004.wvd.zip'
# Sector 184, program filename = 'TPUT040A'
0012 REM . TPUT040A, 00-00 (04/10/77), 10189A
: COM C$(33)64,Y$4,Y1$2,D$(4)64,N0$(2)8,L1,P9,B9,L2,A,A1,A9,V,J9,T0
0030 DIM N$8,A1$(16),Z2$1,Z0$64,Z1$64,L$1,H$2,N$8
: SELECT #107B
: O$="C"
: B9=0
: PRINT HEX(03);"2209A - TAPE TO DISK DATA TRANSFER UTILITY"
: GOSUB 970
: GOSUB '248(1,0,15)
0100 GOSUB '243("MOUNT THE PLATTER, KEY (EXEC) TO RESUME",0)
: Z=0
: GOSUB '243("ENTER DISK FILE STATUS (O=OLD, N=NEW)",1)
: Z2$=Q6$
: IF Q6$="O"THEN 180
: IF Q6$="N"THEN 180
: GOSUB 9854
: GOTO 100
0180 GOSUB '248(1,0,8)
: GOSUB '243("ENTER THE DATAFILE NAME (FOR DISK) IN 5 CHARS",5)
0200 STR(N0$(1),1,5)=Q6$
: STR(N0$(1),1,5)=Q6$
: STR(N0$(1),6,2)="00"
: STR(N0$(1),8,1)="0"
: STR(N0$(2),1,7)=STR(N0$(1),1,7)
: STR(N0$(2),8,1)="1"
: IF Z2$="N"THEN 380
: GOSUB '209(N0$(1),1)
: IF H0<>1THEN 350
0290 PRINT HEX(0A0A);" * FILE ALREADY CATALOGED *"
0300 GOSUB '243("ENTER 1 TO MOUNT PLATTER, 0 TO TRY FILE NAME",1)
: IF Q6$="1"THEN 100
: IF Q6$="0"THEN 180
: GOSUB 9854
: GOTO 300
0350 GOSUB '209(N0$(2),2)
: IF H0=1THEN 290
: GOTO 400
0380 GOSUB '245("ENTER THE SECTOR # OF 'END CAT. AREA'",4,0)
: SCRATCH DISK T#2,END =Q9
0400 GOSUB 790
: IF Z=1THEN 100
: GOSUB '243("MOUNT THE TAPE, KEY (EXEC) TO RESUME",0)
: GOSUB '31(13)
: GOSUB '248(1,0,7)
0430 GOSUB '43
: IF V0$="N"THEN 720
: GOSUB '31(6)
: GOSUB '31(3)
: GOSUB '31(3)
: GOSUB '31(12)
: GOSUB '204(0)
: CONVERT STR(C$(1),6,5)TO L1
: CONVERT STR(C$(1),11,5)TO L2
: P9=L1
: GOSUB 1270
: GOSUB '31(6)
: GOSUB '31(12)
: GOSUB '204(T0)
: D$(1)=C$(1)
: STR(D$(2),1,16)=STR(C$(2),1,16)
0590 GOSUB '31(12)
: GOSUB '204(T0)
: STR(D$(2),17,48)=STR(C$(1),1,48)
: STR(D$(3),1,16)=STR(C$(1),49,16)
: STR(D$(3),17,16)=STR(C$(2),1,16)
: GOSUB '31(12)
: GOSUB '204(T0)
: STR(D$(3),33,32)=STR(C$(1),1,32)
0670 STR(D$(4),1,32)=STR(C$(1),33,32)
: STR(D$(4),33,16)=STR(C$(2),1,16)
: DATA SAVE BA T#2,(A,A)D$()
: GOSUB '248(1,0,8)
: LOAD DC F"TPUT040B"12,9390
0720 GOSUB 1270
: GOSUB '31(6)
: GOSUB '248(1,0,8)
: GOSUB '245("ENTER THE BLOCK LENGTH",5,0)
: L1,P9,L2=Q9
: GOSUB '248(1,0,4)
: LOAD DC F"TPUT040B"12,9390
0790 DATA LOAD BA T#2,(0,M$)D$()
: AND (STR(D$(1),3,1),7F)
: A,A1=256*VAL(STR(D$(1),3,1))+VAL(STR(D$(1),4,1))
: AND (STR(D$(1),5,1),7F)
: A9=256*VAL(STR(D$(1),5,1))+VAL(STR(D$(1),6,1))
: IF A9>A1THEN 870
0850 PRINT " * REACH THE 'END OF CATALOG BOUNDARY' *"
: Z=1
0870 RETURN
0880 DATA LOAD BA T#2,(0,M$)D$()
: AND (STR(D$(1),3,1),80)
: A8=INT((A+1)/256)
: BIN(STR(V$,1,1))=A8
: BIN(STR(D$(1),4,1))=A-A8*256+1
: OR (STR(D$(1),3,1),STR(V$,1,1))
: CONVERT VTO STR(N0$(1),6,2),(##)
: V=V+1
: RETURN
0970 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"
1040 PRINT TAB(25);"3. 320 6. B50"
: PRINT HEX(010A0A);
1060 INPUT Q9
: IF Q9>7THEN 1090
: IF Q9>0THEN 1130
1090 PRINT "RE-ENTER"
: PRINT HEX(0C0C);TAB(20)
: PRINT HEX(0C)
: GOTO 1060
1130 ON Q9GOTO 1150,1170,1190,1210,1230,1250
: GOTO 1090
1150 SELECT #2310
: RETURN
1170 SELECT #2B10
: RETURN
1190 SELECT #2320
: RETURN
1210 SELECT #2B20
: RETURN
1230 SELECT #2350
: RETURN
1250 SELECT #2B50
: RETURN
1270 T0=0
: GOSUB '248(1,0,4)
1290 GOSUB '243("ENTER THE OBJECT CODE (E=EBCDIC/ A=ASCII)",1)
: IF Q6$="E"THEN 1340
: IF Q6$="A"THEN 1400
: GOSUB 9854
: GOTO 1290
1340 IF T=1THEN 1380
: T0=1
: T=1
: RETURN
1380 T=0
1390 RETURN
1400 IF T=0THEN 1390
: RETURN
9195 DEFFN'43
: GOSUB 9353
9199 O$="O"
: GOSUB '31(6)
: GOSUB '31(12)
: GOSUB '204(0)
: GOSUB 9365
: 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$(1),54,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,10)
: 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
9343 DEFFN'45
: GOSUB 9359
: O$="C"
: GOSUB '31(6)
: 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 S8=256*VAL(STR(B$,9,1))+VAL(STR(B$,10,1))
9367 IF V0$<>"N"THEN 9383
: IF S8<>80THEN 9381
: IF STR(C$(1),1,4)<>"VOL1"THEN 9381
9373 Z6=1
: Z7=0
: Z1$=" * LABEL TYPES ARE NOT IDENTICAL *"
: GOSUB 9263
9381 RETURN
9383 GOSUB '208(1,"VOL1",1,4," * LABEL TYPES ARE NOT IDENTICAL *",0,1)
: IF S8<>80THEN 9373
: RETURN
9391 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$)A1$()
: S=VAL(STR(A1$(1),2,1))
: H=H-INT(H/S)*S
: H0=0
9419 DATA LOAD BA T#2,(H,H)A1$()
: FOR I=1TO 16
: IF I+H=1THEN 9437
: IF STR(A1$(I),1,2)<>HEX(0000)THEN 9435
: I=16
: O9=1
: GOTO 9437
9433 IF STR(A1$(I),1,1)=HEX(11)THEN 9437
9435 IF STR(A1$(I),9,8)=N0$(J9)THEN 9457
9437 NEXT I
: IF O9=1THEN 9453
: H0=H0+1
: IF H0>STHEN 9453
: H=H-2
: IF H>=0THEN 9419
: H=S-1
: GOTO 9419
9453 H0=-1
: RETURN
9457 H0=1
: RETURN