image of READY prompt

Wang2200.org

Listing of file='KFAM9004' on disk='vmedia/701-2086B.wvd.zip'

# Sector 423, program filename = 'KFAM9004'
0001 REM KFAM9004,VER.03/02/76
0002 GOTO 3072
0012 COM Q6$64
0240 DIM T3$(1)33,V9(3),Q0$(4)60,V5$(4)1,V2$(4)2,T8$(4)1,V4$(4)2,T1$(1)2
0570 STOP
1015 STOP
3072 LOAD DC T#0,"KFAM0004"3072,3072
4800 DIM D8$21,U2$2
   : DIM C$40,Y$1,U1$8,U0$3,K1$8,K0$3,E1$6,E4$3,X1$2
   : DIM B$1,D$(4)64,K$30,V5$1
   : D8$="310320330350B10B20B30"
   : GOTO 6000
4900 P1=P1+I
   : ADDC(V5$,01)
   : IF V5$<=V8$THEN 4970
4920 ADDC(Q2$,V6$)
   : V9$=U2$
   : ADDC(V9$,Q2$)
   : ADDC(V9$,STR(V1$,3,1))
4950 DATA LOAD BA T#2,(V9$,V9$)D$()
   : V5$=HEX(01)
   : P1=K0
4970 T4$=Q2$
   : STR(T4$,3)=V5$
   : MAT COPY D$()<P1,K>TO T3$()
   : Y$,K$=T3$(1)
   : IF Y$<HEX(FF)THEN 5095
   : K$="DELETED"
   : GOSUB 5035
   : GOTO 7245
5035 PRINT HEX(010A0A0A0A)
   : GOSUB '41(Q2$)
   : Y=VAL(V5$)
   : PRINTUSING 7120,X,Y
   : PRINTUSING 7125,K$
   : RETURN
5095 GOSUB '234(1,0,K$,Q)
   : IF Q$="X"THEN 7300
   : IF Q$="S"THEN 7305
   : GOSUB 5035
   : IF Q$<>"D"THEN 7245
   : GOSUB '44(0)
   : GOTO 7245
6000 PRINT HEX(03)
6005 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8,1)
   : U1$=Q6$
   : IF STR(U1$,5,1)<>"F"THEN 6030
   : IF STR(U1$,6,1)<"0"THEN 6030
   : IF STR(U1$,6,1)<="9"THEN 6042
6030 GOSUB '50("NOT KFAM FILE NAME")
   : GOTO 6005
6042 GOSUB '126("USER")
   : U0$=STR(D8$,X*3-2,3)
   : ON X-1GOTO 6054,6058,6062,6066,6070,6074
   : SELECT #2310
   : GOTO 6095
6054 SELECT #2320
   : GOTO 6095
6058 SELECT #2330
   : GOTO 6095
6062 SELECT #2350
   : GOTO 6095
6066 SELECT #2B10
   : GOTO 6095
6070 SELECT #2B20
   : GOTO 6095
6074 SELECT #2B30
6095 GOSUB '243("ENTER KEY FILE NUMBER (NORMAL=1)",1,2)
   : K9=Q9
   : IF K9>0THEN 6120
   : GOSUB '50("INVALID")
   : GOTO 6095
6120 K1$=U1$
   : STR(K1$,5,1)="K"
   : CONVERT K9TO STR(K1$,6,1),(#)
   : GOSUB '126("KEY")
   : K0$=STR(D8$,X*3-2,3)
   : D1=X
   : LIMITS T#2,U1$,A,E,U
   : GOSUB '43(A)
   : U2$=X1$
   : E=E-1
   : U=E-A
   : DATA LOAD BA T#2,(E,Y)D$()
   : T1$=HEX(A002A002A001A001A008A001A002)
6225 $UNPACK(F=T1$)D$()TO V9$,E4$,V5$(),V8$,V1$,V6$,V2$()
   : V5$,STR(E4$,3)=V8$
   : B=VAL(V8$)
   : S9=VAL(V6$)
   : K=VAL(STR(V1$,5))
   : V6=VAL(STR(V1$,6))
   : B$=V1$
   : GOSUB '210(T6)
   : GOSUB '243("IS KEY FILE CATALOGUED? (Y OR N)",1,0)
6275 IF Q6$<>"N"THEN 6335
   : Y=INT((U*B)/S9)
   : X=INT(V6*.6)-1
   : Z=INT(Y/X)+5
6310 DATA SAVE DC OPEN T$#1,Z,K1$
   : DSKIP #1,Z-2S
   : DATA SAVE DC $#1,END
   : DATA SAVE DC CLOSE#1
6335 LIMITS T#1,K1$,P,Z,X
   : GOSUB '43(U-1)
   : Q3$=X1$
   : GOSUB '43(S9-1)
   : Q2$=X1$
   : XOR (Q2$,FF)
   : V2$=HEX(0001)
   : GOSUB '43(Z-P-2)
   : V3$=X1$
   : T2$=HEX(0001)
   : T0=1
   : INIT(5A)T8$()
   : Q0$=" "
   : INIT(FF)V4$
   : GOSUB '43(P)
   : V0$=X1$
   : T1=1
   : GOSUB 1015
6450 INIT(FF)Q0$()
   : INIT(00)STR(Q0$(1),1,K)
   : Q9$=HEX(0001)
   : GOSUB 570
7010 GOSUB '248(0,0,4)
   : PRINT "TURN ON PRINTER"
   : GOSUB '243("KEY RETURN(EXEC) TO RESUME",1,1)
7030 GOSUB '248(0,0,4)
   : D=0
   : GOSUB '230(1,1,2,K9,U1$,"X")
   : IF Q$=" "THEN 7090
   : STOP "ERROR OPENING FILES"
   : GOTO 7282
7090 PRINT HEX(03)
   : GOSUB '248(7,0,0)
   : PRINT "KFAM9004 KEY FILE RECOVERY"
   : PRINT HEX(0A)
   : PRINT "USER FILE  ";U1$;TAB(30);"DEVICE = ";U0$
   : PRINT "KEY FILE   ";K1$;TAB(30);"DEVICE = ";K0$
7120 %SECTOR #####     RECORD NUMBER ######
7125 %KEY ################################
7160 R,I=VAL(STR(V1$,2))
   : K0=VAL(STR(V1$,4))+1
   : T5$,K$=" "
   : IF E4$>HEX(FF)THEN 7250
   : IF B$="A"THEN 7380
7206 INIT(FF)T1$()
   : FOR X=1TO 4
   : Y=VAL(V5$(X))+1
   : IF Y>BTHEN 7232
   : V9$=U2$
   : ADDC(V9$,V2$(X))
   : DATA LOAD BA T#2,(V9$,X1$)D$()
   : FOR Y=YTO B
   : P1=K0+(Y-1)*I
   : MAT COPY T1$()TO D$()<P1,1>
   : NEXT Y
   : DATA SAVE BA T$#2,(V9$,X1$)D$()
7232 NEXT X
   : GOTO 4900
7245 IF T4$<E4$THEN 4900
7250 GOSUB '44(2)
   : V8=.5
   : GOSUB '239(1)
7282 PRINT HEX(03)
   : COM CLEAR Q6$
   : LOAD DC T#0,"START065"
7300 GOSUB '51("INVALID POINTER")
7305 GOSUB '51("NO SPACE")
7320 DEFFN'50(Q6$)
   : PRINT HEX(010A0A0A)
   : PRINT Q6$
   : RETURN
7350 DEFFN'51(Q6$)
   : RETURN CLEAR
7355 PRINT HEX(01)
   : PRINT Q6$
7365 STOP
   : GOTO 7282
7380 DATA LOAD BA T#2,(U2$,X1$)D$()
   : IF STR(D$(1),1,2)=HEX(8101)THEN 7395
7390 GOSUB '51("INVALID RECORD FORMAT")
7395 N=0
   : P=3
   : C=0
7415 X=INT((P-1)/64)
   : Y=P-64*X
   : X=X+1
   : Y$=STR(D$(X),Y,1)
   : IF Y$=HEX(FD)THEN 7520
   : IF Y$=HEX(08)THEN 7455
   : IF Y$<HEX(81)THEN 7390
   : IF Y$>HEX(C0)THEN 7390
7455 IF C=0THEN 7470
   : IF Y$=STR(C$,N,1)THEN 7485
7465 GOSUB '51("NOT BLOCKED AS SPECIFIED")
7470 N=N+1
   : IF N>38THEN 7390
   : STR(C$,N,1)=Y$
7485 C=C+1
   : AND (Y$,7F)
   : P=P+1+VAL(Y$)
   : IF C<BTHEN 7415
   : C=0
   : GOTO 7415
7520 IF C>0THEN 7465
   : X=(P-3)/B
   : IF X=RTHEN 7545
   : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY")
7545 IF N=0THEN 7390
   : P=3
   : N1=0
7575 N1=N1+1
   : IF N1>NTHEN 7630
   : Y$=STR(C$,N1,1)
   : AND (Y$,7F)
   : Y=VAL(Y$)+1
   : IF P+Y>=K0THEN 7625
   : P=P+Y
   : GOTO 7575
7625 IF K0+K<=P+YTHEN 7635
7630 GOSUB '51("KEY FIELD OUT OF BOUNDS")
7635 IF STR(C$,N1,1)>HEX(80)THEN 7650
   : GOSUB '51("NUMERIC KEY INVALID")
7650 K0=(P-3)*B+3+K0-P
   : I=Y
   : GOTO 7206
7810 ON ERRORE1$,STR(E1$,3)GOTO 7820
7820 IF E1$<>"724950"THEN 7900
   : GOSUB '44(1)
   : IF Q2$<STR(E4$,1,2)THEN 4920
   : GOTO 7250
7900 IF E1$<>"796310"THEN 7920
   : GOSUB '50("FILE ALREADY CATALOGUED")
   : GOTO 6095
7920 IF E1$<>"626310"THEN 7940
   : GOSUB '248(0,0,4)
   : GOSUB '51("NO SPACE ON DISK FOR KEY FILE")
7940 IF E1$<>"806335"THEN 7960
   : GOSUB '50("FILE NOT FOUND")
   : GOTO 6095
7960 GOSUB '248(0,0,4)
   : PRINTUSING 7970,STR(E1$,1,2),STR(E1$,3)
7970 %ERROR ##, LINE ####
7975 GOTO 7365
7985 DEFFN'41(X1$)
   : X=VAL(X1$)*256+VAL(STR(X1$,2))
   : RETURN
8120 DEFFN'43(X)
   : Y=INT(X/256)
   : BIN(X1$)=Y
   : BIN(STR(X1$,2))=X-256*Y
   : RETURN
8170 DEFFN'126(E1$)
   : GOSUB '248(5,0,5)
   : PRINT ,"1.  310     5.  B10"
   : PRINT ,"2.  320     6.  B20"
   : PRINT ,"3.  330     7.  B30"
   : PRINT ,"4.  350"
   : Q6$="ENTER THE NO. OF THE **** FILE DEVICE ADDRESS"
8197 STR(Q6$,22,4)=E1$
8200 GOSUB '243(Q6$,1,2)
   : X=Q9
   : IF X<1THEN 8230
   : IF X>7THEN 8230
   : GOSUB '248(5,0,5)
   : RETURN
8230 PRINT HEX(010A0A0A)
   : PRINT "INVALID DEVICE ADDRESS"
   : GOTO 8200
8275 DEFFN'44(Z)
8285 SELECT PRINT 215
8295 GOSUB '41(Q2$)
   : ON ZGOTO 8365,8385
   : PRINT "DUPLICATE KEY IGNORED"
   : PRINTUSING 7125,K$
   : PRINTUSING 7120,X,VAL(V5$)
   : PRINT "HEX POINTER (T4$) = ";
   : HEXPRINT T4$
   : D=D+1
8345 PRINT HEX(0A0A)
8350 SELECT PRINT 005
   : RETURN
8365 PRINTUSING 8370,X,B
8370 %UNREADABLE SECTOR #####, ### RECORDS LOST
8375 GOTO 8345
8385 IF D>0THEN 8395
   : PRINT "NO DUPLICATE KEYS"
8395 PRINT HEX(0C)
   : GOTO 8350
8430 DEFFN'210(T6)
   : IF M$="X"THEN 8530
   : ON D1GOTO 8445,8455,8465,8475,8485,8495,8505
8445 SELECT #1390
   : RETURN
8455 SELECT #13A0
   : RETURN
8465 SELECT #13B0
   : RETURN
8475 SELECT #13D0
   : RETURN
8485 SELECT #1B90
   : RETURN
8495 SELECT #1BA0
   : RETURN
8505 SELECT #1BB0
   : RETURN
8525 DEFFN'211(T6)
8530 ON D1GOTO 8535,8545,8555,8565,8575,8585,8595
8535 SELECT #1310
   : RETURN
8545 SELECT #1320
   : RETURN
8555 SELECT #1330
   : RETURN
8565 SELECT #1350
   : RETURN
8575 SELECT #1B10
   : RETURN
8585 SELECT #1B20
   : RETURN
8595 SELECT #1B30
   : RETURN
8975 DEFFN'242(W0,Q6$)
   : IF W0<=0THEN 9405
   : IF W0=1THEN 8990
   : STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
   : RETURN
9010 DEFFN'243(Q6$,Q0,Q2)
   : GOSUB 9200
9022 SELECT CO 205
   : Q6$=" "
   : INPUT Q6$
   : IF Q0=0THEN 9231
   : Q3=LEN(Q6$)
   : IF Q3>Q0THEN 9032
   : ON Q2GOTO 9231,9026
   : IF Q6$="Y"THEN 9231
   : IF Q6$="N"THEN 9231
   : GOTO 9032
9026 IF NUM(Q6$)<Q3THEN 9032
   : CONVERT Q6$TO Q9
   : IF Q9<0THEN 9032
   : IF Q9=INT(Q9)THEN 9231
9032 GOSUB 9150
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9022
9150 GOSUB '248(3,0,1)
   : PRINT "RE-ENTER"
   : RETURN
9200 GOSUB 9405
   : PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
   : GOSUB '242(Q0+2,"-")
   : PRINT TAB(64)
9220 PRINT HEX(010A0A)
   : RETURN
9231 PRINT HEX(0A);TAB(64)
   : GOTO 9405
9290 DEFFN'248(Q6,Q7,Q8)
   : GOSUB 9405
   : IF Q8<1THEN 9350
   : GOSUB 9350
   : SELECT PRINT 205
   : Q6$=" "
   : PRINT STR(Q6$,Q7+1)
   : IF Q8<2THEN 9350
   : FOR W0=2TO Q8
   : PRINT HEX(0A);STR(Q6$,1)
   : NEXT W0
9350 PRINT HEX(01)
   : GOSUB '242(Q7,HEX(09))
   : GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
   : RETURN