Listing of file='KFAM8003' on disk='vmedia/701-2049C.wvd.zip'
# Sector 456, program filename = 'KFAM8003'
0010 REM KFAM8003,VER.02/20/76
0200 DIM I$(32)8,X1$2,Z$8,H$2,X$64
: DIM M1$(12)20,Q6$64,N1$8,A$38,A1$(12)38,A2$(38)3
: DIM G$(4)64,G$2,L$2,F$1,Y$1,A2$2,P$(4)64,J$(1)2,C2$(1)1
: PRINT HEX(030A0A0A0A)
: PRINT "BUILD SUBROUTINE MODULE"
0585 LIMITS T#0,"KFAM0003",U,X,Y
: C2$(1)=HEX(FD)
: M1$(1)="230 OPEN"
: M1$(2)="OPEN FOR FINDNEW"
: M1$(3)="231 DELETE"
: M1$(4)="232 FINDOLD"
: M1$(5)="233 FINDNEW"
: M1$(6)="234 FINDNEW(HERE)"
0670 M1$(7)="235 FINDFIRST"
: M1$(8)="236 FINDLAST"
: M1$(9)="237 FINDNEXT"
: M1$(10)="239 CLOSE"
: M1$(11)="MULTIPLE FILES"
: M1$(12)="RECOVERY OPTION"
0740 A1$(1)="11210000100011000000000000121000001010"
: A1$(2)="00400000000000000000000000000000000010"
: A1$(3)="10001101010100100000000001000000011010"
0770 A1$(4)="10000101010100110000000000000000011010"
: A1$(5)="10401111010110100000011010000000101010"
: A1$(6)="10401111010110100000011110000000101010"
0800 A1$(7)="10000101010100101111000000000000011110"
: A1$(8)="10000101010100100010100000000000011010"
: A1$(9)="10000101010100100111000000000000011110"
0830 A1$(10)="10000000000011000000000000000121001010"
: A1$(11)="00000000101211000000000000000000001010"
: A1$(12)="00400000000000000000000000040040000000"
: A2$(1)=HEX(020001)
0880 A2$(2)=HEX(020509)
: A2$(3)=HEX(023501)
: A2$(4)=HEX(024002)
: A2$(5)=HEX(051003)
: A2$(6)=HEX(054503)
: A2$(7)=HEX(057003)
: A2$(8)=HEX(064515)
: A2$(9)=HEX(083003)
: A2$(10)=HEX(092002)
: A2$(11)=HEX(093504)
0980 A2$(12)=HEX(098801)
: A2$(13)=HEX(101505)
: A2$(14)=HEX(104505)
: A2$(15)=HEX(107005)
: A2$(16)=HEX(112005)
: A2$(17)=HEX(117503)
: A2$(18)=HEX(121510)
: A2$(19)=HEX(132505)
: A2$(20)=HEX(136512)
: A2$(21)=HEX(148002)
1140 A2$(22)=HEX(154507)
: A2$(23)=HEX(164008)
: A2$(24)=HEX(177005)
: A2$(25)=HEX(183050)
: A2$(26)=HEX(242015)
: A2$(27)=HEX(262007)
: A2$(28)=HEX(271502)
: A2$(29)=HEX(271815)
: A2$(30)=HEX(287504)
: A2$(31)=HEX(291405)
1240 A2$(32)=HEX(293503)
: A2$(33)=HEX(298001)
: A2$(34)=HEX(300002)
: A2$(35)=HEX(303502)
: A2$(36)=HEX(306002)
: A2$(37)=HEX(307201)
: A2$(38)=HEX(999900)
: GOSUB '243("ENTER NAME OF PROGRAM TO BE GENERATED",8)
1410 N1$=Q6$
: GOSUB '125("ENTER THE NO. OF THE OUTPUT PROGRAM DEVICE")
: D2=X
1440 GOSUB '248(5,0,10)
: PRINT "MODULES INCLUDED --"
: INIT(30)A$
: C=5
: D=0
: FOR N=1TO 12
1500 Q6$=M1$(N)
: E=LEN(Q6$)+2
: STR(Q6$,E)="? (Y OR N)"
: GOSUB '243(Q6$,1)
: IF Q6$="Y"THEN 1600
: IF Q6$="N"THEN 1680
: PRINT HEX(010A0A0A)
: PRINT "RE-ENTER"
: GOTO 1500
1600 C=C+1
: IF C<15THEN 1640
: C=6
: D=30
1640 GOSUB '248(C,D,0)
: PRINT M1$(N)
: OR (A$,A1$(N))
1680 NEXT N
: FOR N=1TO 38
: IF STR(A$,N,1)<"6"THEN 1688
: STR(A$,N,1)="1"
1688 NEXT N
1690 GOSUB '243("OK TO PROCEED? (Y OR N)",1)
: IF Q6$="Y"THEN 1770
: IF Q6$="N"THEN 1440
: PRINT HEX(010A0A0A)
: PRINT "RE-ENTER"
: GOTO 1690
1770 GOSUB '248(0,0,5)
: PRINT HEX(0A0A0A0A)
: PRINT "PHASE 2 -- BUILDING PROGRAM ";N1$
: B=0
: FOR N=1TO 38
: IF STR(A$,N,1)<>"1"THEN 1840
: UNPACK(##)STR(A2$(N),3,1)TO X
: B=B+X
1840 NEXT N
: B=INT(B/10)+4
: GOSUB 5820
: GOSUB '39(N1$,2,B)
: G$(1)=HEX(40)
: STR(G$(1),2,8)=N1$
: STR(G$(1),10,1)=HEX(FD)
: DATA SAVE BA T$#2,(G$,G$)G$()
: G$(1)=HEX(00FF0010A2)
: STR(G$(1),6)=N1$
: G=LEN(G$(1))+1
: STR(G$(1),G)=HEX(0D0000)
: G=G+3
2020 U=U+1
: N=1
: F$="0"
: A2$=HEX(0200)
: Y$=HEX(0D)
2080 DATA LOAD BA T#0,(U,U)P$()
: P=2
2100 Q=256-P
: MAT COPY P$()<P+1,2>TO J$()
2130 IF J$(1)<A2$THEN 2210
: F$=STR(A$,N,1)
: N=N+1
: A2$=A2$(N)
: GOTO 2130
2210 MAT SEARCHP$()<P+1,Q>,=Y$TO J$()
: Y=VAL(STR(J$(1),2))+3
: IF F$<>"1"THEN 2360
: IF G+Y<256THEN 2330
: MAT COPY C2$()TO G$()<G,1>
: IF G$>=L$THEN 2590
: DATA SAVE BA T$#2,(G$,G$)G$()
: G=2
2330 MAT COPY P$()<P,Y>TO G$()<G,Y>
: G=G+Y
2360 P=P+Y
: MAT COPY P$()<P,1>TO J$()
: IF J$(1)=HEX(FF)THEN 2100
: IF J$(1)=HEX(FD)THEN 2080
: STR(G$(1),1,1)=HEX(20)
: IF J$(1)=HEX(FE)THEN 2430
: GOSUB '101("INVALID DELIMITER")
2430 MAT COPY J$()TO G$()<G,1>
: IF G$>=L$THEN 2590
: DATA SAVE BA T$#2,(G$,G$)G$()
: LIMITS T#2,N1$,A,E,X
: X1$=G$
: GOSUB '41
: Z=X-A+1
: GOSUB '43(Z)
: G$(1)=HEX(202020FD)
: STR(G$(1),2,2)=X1$
: DATA SAVE BA T$#2,(E,X)G$()
: LOAD DC T#0,"START050"
2500 DEFFN'101(X$)
: GOSUB '248(0,0,4)
: PRINT X$
: STOP
2590 GOSUB '101("OUTPUT PROGRAM SPACE EXCEEDED")
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
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
6040 DEFFN'40(N1$,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$=N1$
: XOR (STR(Z$,2),Z$)
: Y$=STR(Z$,8,1)
: H$=HEX(0000)
: ADDC(H$,Y$)
: ADDC(H$,Y$)
6230 ADDC(H$,Y$)
: 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 6390
: IF Y=0THEN 6390
: H=0
6330 DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 6390
: H=H+1
: IF H<S9THEN 6330
6390 RETURN
6420 DEFFN'41
: AND (STR(X1$,1,1),7F)
: X=VAL(X1$)*256+VAL(STR(X1$,2))
: RETURN
6480 DEFFN'42
: Y=0
: X=2
: IF H>0THEN 6530
: X=4
6530 IF STR(I$(X-1),1,1)=HEX(10)THEN 6570
: IF STR(I$(X-1),1,1)=HEX(11)THEN 6570
: IF STR(I$(X-1),1,1)=HEX(00)THEN 6620
: GOTO 6580
6570 IF I$(X)=N1$THEN 6640
6580 X=X+2
: IF X<34THEN 6530
: Y=1
6620 X=0
6640 RETURN
6720 DEFFN'39(N1$,Z,B)
: GOSUB '40(N1$,Z)
: IF X=0THEN 6900
6760 STR(I$(X-1),2,1)=HEX(80)
: DATA SAVE BA T$#Z,(H,X)I$()
: LIMITS T#Z,N1$,A,E,G
: GOSUB '43(A)
: G$=X1$
: GOSUB '43(E)
: L$=X1$
: RETURN
6900 IF B>ATHEN 7000
: DATA SAVE DC OPEN T$#Z,B,N1$
: GOSUB '40(N1$,Z)
: IF X>0THEN 6760
: GOSUB '101("SYSTEM ERROR")
7000 GOSUB '101("NO ROOM ON DISK FOR OUTPUT PROGRAM")
7070 DEFFN'43(X)
: Y=INT(X/256)
: X=X-256*Y
: BIN(X1$)=Y
: BIN(STR(X1$,2))=X
: 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