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