image of READY prompt

Wang2200.org

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

# Sector 369, program filename = 'KFAM1004'
0010 REM KFAM1004,VER.03/04/76
0012 COM Q6$64
0750 DIM K0$3,K1$8,U0$3,U1$8,D8$21
   : DIM X$64,X1$2,I$(32)8,Z$8,N$8,H$2,L$1,A(7),R(7)
   : DIM Q2$2,Q3$2,V5$(4)1,V8$1,V1$8,V2$2,V3$2,V6$1,T2$2
   : DIM T8$(4)1,Q0$4,V4$(4)2,V2$(4)2,Q9$2,Q0$(4)60
0820 PRINT HEX(03)
   : D8$="310320330350B10B20B30"
0890 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
   : U1$=Q6$
   : IF STR(U1$,5,1)="F"THEN 950
   : GOSUB '43("FILE NAME MUST HAVE F IN POSITION 5")
   : GOTO 890
0950 IF STR(U1$,6,1)<"0"THEN 980
   : IF STR(U1$,6,1)>"9"THEN 980
   : GOTO 1010
0980 GOSUB '43("FILE NAME MUST HAVE NUMBER IN POSITION 6")
   : GOTO 890
1010 GOSUB '125("ENTER THE NO. OF THE DATA FILE DEVICE ADDRESS")
   : D2=X
   : U0$=STR(D8$,X*3-2,3)
   : GOSUB '127(2)
   : FOR X=1TO 7
   : A(X),R(X)=0
   : NEXT X
   : GOSUB '40(U1$,2)
   : GOSUB '44("IS DATA FILE CATALOGUED? (Y OR N)")
1140 IF Q6$="N"THEN 1180
   : IF X>0THEN 1220
   : GOSUB '43("FILE NOT FOUND")
   : GOTO 890
1180 IF X=0THEN 1220
   : GOSUB '43("FILE ALREADY CATALOGUED")
   : GOTO 890
1220 A(D2)=A
   : C2=X
1250 GOSUB '245("ENTER KEY FILE NUMBER",1,0)
   : IF Q9>0THEN 1300
   : GOSUB '43("ZERO INVALID")
   : GOTO 1250
1300 K1$=U1$
   : STR(K1$,5,1)="K"
   : CONVERT Q9TO STR(K1$,6,1),(#)
   : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS")
   : D1=X
   : K0$=STR(D8$,X*3-2,3)
   : GOSUB '210(1)
   : GOSUB '40(K1$,1)
1420 GOSUB '44("IS KEY FILE CATALOGUED? (Y OR N)")
   : IF Q6$="N"THEN 1470
   : IF X>0THEN 1510
   : GOSUB '43("FILE NOT FOUND")
   : GOTO 1250
1470 IF X=0THEN 1510
   : GOSUB '43("FILE ALREADY CATALOGUED")
   : GOTO 1250
1510 A(D1)=A
   : C1=X
1540 GOSUB '243("ENTER RECORD TYPE (A,C,N,M)",1)
   : V1$=Q6$
   : U,U1,U2=1
   : K3=0
   : IF V1$="A"THEN 1650
   : IF V1$="C"THEN 1650
   : IF V1$="N"THEN 1860
   : IF V1$="M"THEN 1770
   : GOSUB '43("INVALID RECORD TYPE")
   : GOTO 1540
1650 GOSUB '245("ENTER LOGICAL RECORD LENGTH",3,0)
   : U1=Q9
   : GOSUB '245("ENTER BLOCKING FACTOR",2,0)
   : U2=Q9
   : X=U1*U2
   : IF X<2THEN 1730
   : IF V1$="C"THEN 1710
   : X=X+3
1710 IF X>256THEN 1730
   : GOTO 1860
1730 GOSUB '43("BLOCKING FACTOR OR RECORD LENGTH INCORRECT")
   : GOTO 1650
1770 GOSUB '245("ENTER NUMBER OF SECTORS PER RECORD",3,0)
   : U=Q9
   : IF U<2THEN 1820
   : IF U>255THEN 1820
   : GOTO 1860
1820 GOSUB '43("INVALID - MUST BE 2 TO 255")
   : GOTO 1770
1860 GOSUB '245("ENTER KEY LENGTH",2,0)
   : U3=Q9
   : IF U3<1THEN 1910
   : IF U3>30THEN 1910
   : GOTO 1940
1910 GOSUB '43("INVALID -- KEY MUST BE 1 TO 30")
   : GOTO 1860
1940 T5=U3+3
   : V6=INT(240/T5)
1970 GOSUB '245("ENTER STARTING POSITION OF KEY",5,0)
   : U4=Q9
   : IF V1$>"C"THEN 2060
   : IF V1$="C"THEN 2030
   : IF U4<3THEN 2110
2030 IF U3+U4>U1+2THEN 2110
   : GOTO 2150
2060 IF U3+U4>256*UTHEN 2110
   : IF INT(U4/256)=INT((U3+U4)/256)THEN 2150
   : GOSUB '43("KEY MAY NOT SPAN SECTORS")
   : GOTO 1970
2110 GOSUB '43("KEY OVERLAPS END OF RECORD")
   : GOTO 1970
2150 IF C2=0THEN 2190
   : GOSUB '45(U1$,2)
2190 GOSUB '245("ENTER ESTIMATED NUMBER OF RECORDS",5,0)
   : GOSUB '248(4,0,1)
   : U6=Q9
   : U8=INT(U6/U2+.999)
   : IF U<2THEN 2260
   : U8=U8*U
2260 U8=U8+2
   : IF C2=0THEN 2340
   : IF U8>A+2THEN 2320
   : U8=A+2
   : GOTO 2360
2320 GOSUB '43("USER FILE TOO SMALL")
   : GOTO 2190
2340 R(D2)=U8
2360 IF C1=0THEN 2530
   : GOSUB '45(K1$,1)
   : K2=A+2
   : X=INT(V6*.75)-1
   : K1=INT(U6/X)+5
   : IF K2>=K1THEN 2570
   : K3=1
   : GOTO 2570
2530 X=INT(V6*.6)-1
   : K2=INT(U6/X)+5
   : R(D1)=R(D1)+K2
2570 IF R(D1)>A(D1)THEN 2610
   : IF R(D2)>A(D2)THEN 2610
   : GOTO 2860
2610 IF C2=0THEN 2650
   : GOSUB '248(0,0,4)
   : STOP "NO ROOM FOR KEY FILE"
2650 GOSUB '248(3,0,2)
   : PRINT "SECTORS AVAILABLE,  ";
   : IF R(D1)=0THEN 2690
   : PRINT "DEVICE ";K0$;" = ";A(D1);TAB(43);
2690 IF R(D2)=0THEN 2720
   : IF D1=D2THEN 2720
   : PRINT "DEVICE ";U0$;" = ";A(D2);
2720 PRINT " "
   : PRINT "SECTORS REQUESTED,  ";
   : IF R(D1)=0THEN 2760
   : PRINT "DEVICE ";K0$;" = ";R(D1);TAB(43);
2760 IF R(D2)=0THEN 2790
   : IF D1=D2THEN 2790
   : PRINT "DEVICE ";U0$;" = ";R(D2);
2790 PRINT " "
   : FOR X=1TO 7
   : R(X)=0
   : NEXT X
   : GOTO 2190
2860 GOSUB '248(4,0,0)
   : GOSUB '46
   : GOSUB '44("ARE FILE SPECIFICATIONS OK? (Y OR N)")
   : IF Q6$="N"THEN 820
   : GOSUB '44("DO YOU WANT A HARD COPY PRINTOUT OF FILE DESCRIPTION? (Y OR N)
     ")
   : IF Q6$="N"THEN 2970
   : SELECT PRINT 215
   : GOSUB '46
2940 SELECT PRINT 005
2970 IF C1>0THEN 3040
   : DATA SAVE DC OPEN T$#1,K2,K1$
   : DSKIP #1,K2-2S
   : DATA SAVE DC $#1,END
   : DATA SAVE DC CLOSE#1
3040 IF C2>0THEN 3120
   : DATA SAVE DC OPEN T$#2,U8,U1$
   : DSKIP #2,U8-2S
   : DATA SAVE DC $#2,END
   : DATA SAVE DC CLOSE#2
3120 Q2$=HEX(0000)
   : BIN(STR(Q2$,2))=U-1
   : XOR (Q2$,FF)
   : INIT(FF)V2$()
   : Y=U8-3
   : X=INT(Y/256)
   : BIN(Q3$)=X
   : BIN(STR(Q3$,2))=Y-256*X
   : BIN(V8$)=U2
   : FOR X=1TO 4
   : V5$(X)=V8$
   : NEXT X
   : BIN(STR(V1$,2))=U1
   : X=INT(U4/256)
   : BIN(STR(V1$,3))=X
3280 BIN(STR(V1$,4))=U4-256*X
   : BIN(STR(V1$,5))=U3
   : BIN(STR(V1$,6))=V6
   : V2$=HEX(0001)
   : Y=K2-3
   : X=INT(Y/256)
   : BIN(V3$)=X
   : BIN(STR(V3$,2))=Y-256*X
   : BIN(V6$)=U
   : T2$=HEX(0001)
   : T0=1
   : Q0$=" "
   : INIT(FF)V4$()
   : INIT(5A)T8$()
   : DATA LOAD DC OPEN T#1,K1$
3460 DATA SAVE DC $#1,Q2$,Q3$,V5$(),V8$,V1$,V2$,V3$,V6$,T2$,T0,T8$(),Q0$,V4$()
     ,V2$()
   : INIT(FF)Q0$()
   : INIT(00)STR(Q0$(1),1,U3)
   : Q9$=HEX(0001)
   : GOSUB '211(1)
   : DATA SAVE DC $#1,Q9$,Q0$()
   : LIMITS T#2,U1$,X,Y,Z
   : Y=Y-1
   : X1$=HEX(A0FD)
3530 X$=HEX(A002A002A001A001A008A001A002)
   : $PACK(F=X$)Q0$()FROMX1$,Q2$,V5$(),V8$,V1$,V6$,V2$()
   : GOSUB '128(2)
   : DATA SAVE BA T$#2,(Y,Y)Q0$()
   : GOSUB '44("DO YOU WISH TO DO ANOTHER FILE? (Y OR N)")
3600 IF Q6$="Y"THEN 820
   : COM CLEAR Q6$
   : LOAD DC T#0,"START065"
3690 DEFFN'40(N$,Z)
   : DATA LOAD BA T#Z,(0,X)I$()
   : X1$=STR(I$(1),1,2)
   : GOSUB '41
   : S9=X
   : X1$=STR(I$(1),3,2)
   : GOSUB '41
   : Y=X
   : X1$=STR(I$(1),5,2)
   : GOSUB '41
   : A=X-Y
   : Z$=N$
   : XOR (STR(Z$,2),Z$)
   : L$=STR(Z$,8,1)
   : H$=HEX(0000)
   : ADDC(H$,L$)
   : ADDC(H$,L$)
3880 ADDC(H$,L$)
   : ADD(STR(H$,1,1),STR(H$,2,1))
   : H=VAL(H$)
   : H=H-INT(H/S9)*S9
   : DATA LOAD BA T#Z,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 4040
   : IF Y=0THEN 4040
   : H=0
3980 DATA LOAD BA T#Z,(H,X)I$()
   : GOSUB '42
   : IF X>0THEN 4040
   : H=H+1
   : IF H<S9THEN 3980
4040 RETURN
4070 DEFFN'41
   : AND (STR(X1$,1,1),7F)
   : X=VAL(X1$)*256+VAL(STR(X1$,2))
   : RETURN
4130 DEFFN'42
   : Y=0
   : X=2
   : IF H>0THEN 4180
   : X=4
4180 IF STR(I$(X-1),1,1)=HEX(10)THEN 4210
   : IF STR(I$(X-1),1,1)=HEX(00)THEN 4260
   : GOTO 4220
4210 IF I$(X)=N$THEN 4280
4220 X=X+2
   : IF X<34THEN 4180
   : Y=1
4260 X=0
4280 RETURN
4310 DEFFN'43(Q6$)
   : PRINT HEX(010A0A0A)
   : PRINT Q6$
   : RETURN
4370 DEFFN'44(X$)
4380 GOSUB '243(X$,1)
   : IF Q6$=" "THEN 4450
   : IF Q6$="Y"THEN 4470
   : IF Q6$="N"THEN 4470
   : GOSUB '43("RE-ENTER")
   : GOTO 4380
4450 Q6$="Y"
4470 RETURN
4530 DEFFN'45(N$,Z)
   : LIMITS T#Z,N$,X,Y,H
   : H=H-2
   : A=Y-X-1
   : IF A=HTHEN 4670
   : DATA LOAD DC OPEN T#Z,N$
   : IF H<0THEN 4640
   : DSKIP #Z,END
   : DATA SAVE DC $#Z,N$
4640 DSKIP #Z,A-H-1S
   : DATA SAVE DC $#Z,END
   : DATA SAVE DC CLOSE#Z
4670 RETURN
4700 DEFFN'46
   : IF K3=0THEN 4730
   : PRINT "WARNING -- KEY FILE TOO SMALL"
4730 PRINTUSING 4770,U1$,K1$
   : PRINTUSING 4780,U0$;
   : PRINT TAB(32);
   : PRINTUSING 4780,K0$
4770 %DATA FILE NAME  ########        KEY FILE NAME   ########
4780 % DEVICE ADDRESS      ###
4790 PRINT " RECORD TYPE";TAB(23);STR(V1$,1,1);TAB(33);"KEY FILE NUMBER";TAB(5
     5);STR(K1$,6,1)
   : IF V1$>"C"THEN 4840
   : PRINTUSING 4830,U1;
   : GOTO 4850
4830 % RECORD LENGTH       ###
4840 PRINTUSING 4830,U;
4850 PRINT TAB(32);
   : PRINTUSING 4870,U3
4870 % KEY LENGTH           ##
4880 IF V1$>"C"THEN 4920
   : PRINTUSING 4910,U2;
   : GOTO 4930
4910 % BLOCKING FACTOR     ###
4920 PRINT "  (SECTORS)";
4930 PRINT TAB(32);
   : PRINTUSING 4950,U4
4950 % KEY POSITION      #####
4960 PRINTUSING 4990,U8;
   : PRINT TAB(32);
   : PRINTUSING 4990,K2
4990 % NO. OF SECTORS    #####
5000 PRINT HEX(0A)
   : RETURN
5060 DEFFN'125(X$)
   : GOSUB '248(5,0,5)
   : PRINT ,"1.  310     5.  B10"
   : PRINT ,"2.  320     6.  B20"
   : PRINT ,"3.  330     7.  B30"
   : PRINT ,"4.  350"
5120 GOSUB '245(X$,1,0)
   : X=Q9
   : IF X<1THEN 5180
   : IF X>7THEN 5180
   : GOSUB '248(5,0,5)
   : RETURN
5180 PRINT HEX(010A0A0A)
   : PRINT "INVALID DEVICE ADDRESS"
   : GOTO 5120
5250 DEFFN'210(T6)
   : IF M$="X"THEN 5450
   : ON D1GOTO 5280,5300,5320,5340,5360,5380,5400
5280 SELECT #1390
   : RETURN
5300 SELECT #13A0
   : RETURN
5320 SELECT #13B0
   : RETURN
5340 SELECT #13D0
   : RETURN
5360 SELECT #1B90
   : RETURN
5380 SELECT #1BA0
   : RETURN
5400 SELECT #1BB0
   : RETURN
5440 DEFFN'211(T6)
5450 ON D1GOTO 5460,5480,5500,5520,5540,5560,5580
5460 SELECT #1310
   : RETURN
5480 SELECT #1320
   : RETURN
5500 SELECT #1330
   : RETURN
5520 SELECT #1350
   : RETURN
5540 SELECT #1B10
   : RETURN
5560 SELECT #1B20
   : RETURN
5580 SELECT #1B30
   : RETURN
5620 DEFFN'127(T6)
   : IF M$="X"THEN 5820
   : ON D2GOTO 5650,5670,5690,5710,5730,5750,5770
5650 SELECT #2390
   : RETURN
5670 SELECT #23A0
   : RETURN
5690 SELECT #23B0
   : RETURN
5710 SELECT #23D0
   : RETURN
5730 SELECT #2B90
   : RETURN
5750 SELECT #2BA0
   : RETURN
5770 SELECT #2BB0
   : RETURN
5810 DEFFN'128(T6)
5820 ON D2GOTO 5830,5850,5870,5890,5910,5930,5950
5830 SELECT #2310
   : RETURN
5850 SELECT #2320
   : RETURN
5870 SELECT #2330
   : RETURN
5890 SELECT #2350
   : RETURN
5910 SELECT #2B10
   : RETURN
5930 SELECT #2B20
   : RETURN
5950 SELECT #2B30
   : RETURN
8710 Q6=3
   : GOTO 9289
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)
   : GOSUB 9200
9022 SELECT CO 205
   : Q6$=" "
   : INPUT Q6$
   : IF Q0=0THEN 9231
   : IF LEN(Q6$)<=Q0THEN 9231
   : GOSUB 9150
9032 DEFFN'244(Q0)
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
   : PRINT "/"
   : GOSUB 9220
   : SELECT CO 205
   : Q9,W0=-1E-99
   : INPUT Q9
   : IF W0=Q9THEN 9058
   : IF Q9>=0THEN 9070
   : IF Q2<=0THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 9220
   : GOSUB 9210
   : GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058
   : W0=ABS(Q9*10^Q3)
   : IF INT(W0)<>W0THEN 9058
   : GOTO 8710
9150 GOSUB 8710
   : 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
   : Q6=0
9289 Q7=0
   : Q8=1
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