00010 * Include file for BIF
00020 * BIF Copyright 1989 Joel Matthew Rees (see BIF/ASM)
00030 *
01000 	FCC '(NUMBER)'
01010 	FCB 8
01020 	FCB MFORE
01030 	FDB QARROW-CFAOFF
01040 	FDB BIF+2
01050 	FDB 0
01060 	FDB PREF-CFAOFF
01070 INUMB	PSHS Y	see fig-FORTH model
01080 	PULU Y adr
01085 	LDX <UP
01090 INUMBL	LDB ,Y+ ch
01092 	CLRA
01094 	PSHU D
01096 	LDD UBASE,X
01100 	PSHU D
01110 	DOCOL
01120 	FDB DIGIT
01130 	FDB ZBR
01140 	FDB INUMBE-*-2
01150 	FDB SWAP accm ms word
01160 	FDB BASE
01180 	FDB FETCH
01190 	FDB USTAR shift in base
01200 	FDB DROP ls word is digit
01210 	FDB ROT accm ls word
01220 	FDB BASE
01230 	FDB FETCH
01240 	FDB USTAR shift in base
01250 	FDB DADD accumulate
01260 	FDB XMACH adjust dpl
01270 	LDX <UP
01280 	LDD UDPL,X
01290 	BMI INUMBL
01300 	ADDD #1
01310 	STD UDPL,X
01320 	BRA INUMBL
01330 INUMBE	FDB XMACH
01340 	LEAY -1,Y back up
01350 	PSHU Y adr
01355 	PULS Y
01360 	NEXT
01390 *
01400 	FCC 'NUMBER'
01410 	FCB 6
01420 	FCB MFORE
01430 	FDB INUMB-CFAOFF
01440 	FDB BIF+2
01450 	FDB MIN-CFAOFF
01460 	FDB OVER-CFAOFF
01470 NUMBER PULU X
01475 	LEAX 1,X skip ct
01480 	LDB ,X <0?
01490 	SUBB #'-
01500 	BNE *+4
01510 	LEAX 1,X
01520 	CLRA
01530 	PSHU D
01540 	CLRB
01550 	PSHU D double 0
01560 	PSHU D
01570 	PSHU X adr
01580 	LDD #-1 clear DPL
01590 NUMBA	LDX <UP
01600 	STD UDPL,X
01610 	DOCOL
01620 	FDB INUMB
01630 	FDB XMACH
01640 	LDX ,U end ch
01650 	LDB ,X ascii NUL?
01660 	BEQ NUMBQ
01670 	CMPB #': double?
01680 	BEQ NUMBD
01690 	CMPB #'-
01700 	BLO NUMBE
01710 	CMPB #'/
01720 	BHI NUMBE
01730 NUMBD	LEAX 1,X past dec pt
01740 	STX ,U
01750 	LDD #0 set DPL
01760 	BRA NUMBA
01770 NUMBE	LDD #0
01780 	PSHU D
01790 	JMP ERROR
01800 NUMBQ	LEAU 2,U valid, drop
01810 	DOCOL
01830 	FDB ROT <0?
01840 	FDB TBR
01850 	FDB 2
01860 	FDB DMINUS
01870 	FDB SEMIS
01890 *
01900 	FCC 'WORDPAD'
01910 	FCB 7
01920 	FCB MFORE
01930 	FDB NUMBER-CFAOFF
01940 	FDB BIF+2
01950 	FDB 0
01960 	FDB 0
01970 WORDPD	DOUCON
01980 	FCB UWP
01990 *
02000 	FCC 'WORD'
02010 	FCB 4
02020 	FCB MFORE
02030 	FDB WORDPD-CFAOFF
02040 	FDB BIF+2
02050 	FDB WHILE-CFAOFF
02060 	FDB BCOMP-CFAOFF
02070 WORD	PSHS Y
02075 	LDY <UP
02080 	LDD UBLK,Y terminal?
02090 	BEQ WORDK buffer
02100 	PSHU D
02110 	DOCOL
02120 	FDB BLOCK
02130 	FDB XMACH
02140 	PULU D
02150 	BRA *+4 UTIB < 16!
02160 WORDK	LDD UTIB,Y
02170 	ADDD UIN,Y parse at
02180 	PULU X ch
02190 	TFR D,Y save
02200 	PSHU X,Y (swap)
02205 	DOCOL
02210 	FDB ENCLOS
02215 	FDB XMACH
02220 	PSHS Y start at
02221 	LDD 2,U symbol at
02222 	SUBD ,S++ delimiter count
02223 	ADDD ,U length
02225 	LDX <UP
02226 	ADDD UIN,X
02227 	STD UIN,X update
02230 	PULU D length
02240 	CMPD #NLMASK
02250 	BLS *+5 clip
02260 	LDD #NLMASK
02270 	LDY UWP,X
02280 	STB ,Y+ count
02290 	CLR B,Y trailing NUL
02300 	PSHU D,Y dest & ct
02330 	PULS Y
02340 	DOCOL
02350 	FDB CMOVE copy
02360 	FDB SEMIS
02490 *
02500 	FCC 'BS'
02510 	FCB 2
02520 	FCB MFORE
02530 	FDB WORD-CFAOFF
02540 	FDB BIF+2
02550 	FDB BRANCH-CFAOFF
02560 	FDB 0
02570 BS	DOUCON
02580 	FCB UBS
02590 *
02600 	FCC 'EXPECT'
02610 	FCB 6
02620 	FCB MFORE
02630 	FDB BS-CFAOFF
02640 	FDB BIF+2
02650 	FDB ERROR-CFAOFF
02660 	FDB FILL-CFAOFF
02670 EXPECT	PSHS Y
02680 	LDD ,U count
02690 	LDY 2,U buffer
02700 	SUBD #1	for NUL
02710 	BLT EXPE0+2
02720 	BEQ EXPE0
02730 	LEAX D,Y
02740 	STX ,U limit
02750 EXPEL	DOCOL
02760 	FDB KEY
02770 	FDB XMACH
02780 	LDB 1,U
02790 	LDX <UP
02800 	CMPB UBS+1,X
02810 	BNE EXPECR
02820 	CMPY 4,U beginning?
02830 	BLS EXPEM0
02840 	LEAY -1,Y
02850 	BRA EXPEM
02860 EXPEM0	CLR 1,U to emit
02870 	BRA EXPEM
02880 EXPECR	CMPB #$0D
02890 	BNE EXPEPT
02900 	STY 2,U terminate
02910 	BRA EXPEM
02913 EXPEPT	CMPB #$20 printable?
02916 	BLO EXPEM0
02920 	STB ,Y+ store ch
02930 EXPEM	DOCOL
02940 	FDB EMIT
02950 	FDB XMACH
02960 	CMPY ,U
02970 	BLO EXPEL
02980 EXPE0	CLR ,Y NUL term
02990 	LEAU 4,U
03000 	PULS Y
03010 	NEXT
03090 *
03600 TWID	EQU 128 width of a terminal line
03605 	FCC 'QUERY'
03610 	FCB 5
03620 	FCB MFORE
03630 	FDB EXPECT-CFAOFF
03640 	FDB BIF+2
03650 	FDB LOOP-CFAOFF
03660 	FDB SWAP-CFAOFF
03670 QUERY	LDX <UP
03680 	LDD #0
03690 	STD UIN,X
03700 	LDD #TWID
03710 	LDX UTIB,X
03720 	PSHU D,X
03730 	DOCOL
03740 	FDB EXPECT
03750 	FDB SEMIS
03790 *
03795 	FCB 0 ; NEEDED
03800 	FCB MIMM|0
03810 	FCB MFORE
03820 	FDB QUERY-CFAOFF
03830 	FDB BIF+2
03840 	FDB 0
03850 	FDB 0
03860 NUBLK	LDX <UP
03870 	LDD UBLK,X
03880 	BEQ NUBLT
03890 	ADDD #1
03900 	STD UBLK,X
03910 	LDD #0
03920 	STD UIN,X
03930 	LDD BPSCR+2 2^n
03940 	DECB
03950 	ANDB UBLK+1,X end of screen?
03960 	BNE NUBLT+2
03970 	DOCOL
03980 	FDB QEXEC
03990 	FDB XMACH
04000 NUBLT	PULS Y end interp
04010 	NEXT
04090 *
04100 	FCC 'FIND'
04110 	FCB 4
04120 	FCB MFORE
04130 	FDB NUBLK-CFAOFF
04140 	FDB BIF+2
04150 	FDB EXPECT-CFAOFF
04160 	FDB HERE-CFAOFF
04170 FIND	LDD 2,U
04180 	ADDD #1 past ct
04190 	STD 2,U
04200 	LDD ,U
04210 FINDL	LDX 2,U
04220 	PSHU D,X
04230 	DOCOL
04240 	FDB PFIND
04250 	FDB XMACH
04260 	LDD ,U flag
04270 	BNE FINDF
04290 	LDX 4,U vocabulary
04300 	LDD GFAOFF-PFAOFF,X parent
04305 	CMPD 4,U root voc?
04310 	BEQ FINDF
04315 	LEAU 4,U
04320 	STD ,U
04330 	BRA FINDL
04360 FINDF	LDD [2,U]
04365 	LEAU 4,U entry
04370 	STD 2,U
04380 	NEXT
04390 *
04400 	FCC '-DFIND'
04410 	FCB 6
04420 	FCB MFORE
04430 	FDB FIND-CFAOFF
04440 	FDB BIF+2
04450 	FDB 0
04460 	FDB 0
04470 DDFIND	DOCOL
04480 	FDB DROOT defs first
04490 	FDB ROOT context next
04500 DFIND1	FDB BL
04510 	FDB WORD name in buf
04520 	FDB FETCH vocab2
04530 	FDB SWAP
04540 	FDB FETCH vocab1
04550 	FDB OVER
04560 	FDB OVER
04570 	FDB EQ same?
04580 	FDB ZBR
04590 	FDB 6
04600 	FDB DROP
04610 	FDB BRANCH
04620 	FDB DFIND2-*-2
04630 	FDB WORDPD buf
04640 	FDB SWAP
04650 	FDB FIND 1st
04660 	FDB OVER
04670 	FDB ZBR
04680 	FDB 6
04690 	FDB ROT
04700 	FDB DROP
04710 	FDB SEMIS
04720 	FDB DROP
04730 	FDB DROP
04740 DFIND2	FDB WORDPD
04750 	FDB SWAP
04760 	FDB FIND 2nd
04770 	FDB SEMIS
04790 *
04800 	FCC '-IFIND'
04810 	FCB 6
04820 	FCB MFORE
04830 	FDB DDFIND-CFAOFF
04840 	FDB BIF+2
04850 	FDB 0
04860 	FDB 0
04870 DIFIND	DOCOL
04880 	FDB ROOT context first
04890 	FDB DROOT defs next
04900 	FDB BRANCH
04910 	FDB DFIND1-*-2
05190 *