image of READY prompt

Wang2200.org

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