1 00010 * The Kernel of BIF: A Dialect of FORTH
\r00015 * with a Binary Tree Dictionary
\r00020 * Copyright 1989 by Joel Matthew Rees
\r00025 *
\r00030 * BIF is architecturally derived from
\r00035 * the public domain fig-FORTH model.
\r00040 *
\r00050 * TITLE BIF kernel 16 Feb 89
\r00070 OPT MEX
\r00080 INCLUDE BIFU.INC
\r00090 ORG $1200 DEBIF: $3F00
\r00100 INCLUDE BIF.M
\r00110 INCLUDE BIFDP.ASM
\r00110 INCLUDE BIFST.ASM
\r00120 SETDP VDP COLD loads DP
\r01000 *
\r01001 FCC '@' name
\r01002 FCB 1 name length, usage (NFA)
\r01003 FCB MFORE type/allocation MODES
\r01004 FDB WARM-CFAOFF previous link in allocation
\r01005 FDB BIF+2 owning vocabulary
\r01006 FDB EQ-CFAOFF left link in tree
\r01007 FDB AND-CFAOFF right link in tree
\r01010 FETCH LDD [,U] from [tos] to stack
\r01011 STD ,U
\r01012 NEXT
\r01013 *
\r01014 FCC '!'
\r01015 FCB 1
\r01016 FCB MFORE
\r01017 FDB FETCH-CFAOFF
\r01030 FDB BIF+2
\r01040 FDB NUBLK-CFAOFF
\r01050 FDB STOCSP-CFAOFF
\r01060 STORE LDD 2,U from stack to [top]
\r01070 STD [,U]
\r01080 LEAU 4,U
\r01090 NEXT
\r01095 *
\r01100 FCC 'LIT'
\r01110 FCB MCOMP.OR.3
\r01120 FCB MFORE
\r01130 FDB STORE-CFAOFF
\r01140 FDB BIF+2
\r01150 FDB 0 * LIST-CFAOFF
\r01160 FDB 0
\r01170 LIT LDD ,Y++ push literal from code
\r01180 PSHU D
\r01190 NEXT
\r01200 *
\r01210 FCC 'DLIT'
\r01220 FCB MCOMP.OR.4
\r01230 FCB MFORE
\r01240 FDB LIT-CFAOFF
\r01250 FDB BIF+2
\r01260 FDB 0
\r01270 FDB 0
\r01280 * push double literal from code
\r01290 DLIT LDD ,Y++
\r01300 LDX ,Y++
\r01310 PSHU D,X
\r01320 NEXT
\r01330 *
\r01340 FCC 'EXECUTE'
\r01350 FCB MCOMP.OR.7
\r01360 FCB MFORE
\r01370 FDB DLIT-CFAOFF
\r01380 FDB BIF+2
\r01390 FDB 0
\r01400 FDB 0
\r01410 * EXECUTE cfa on stack
\r01420 EXEC LDX ,U++
\r01430 BEQ *+4
\r01440 JMP ,X
\r01450 LDD #9
\r01460 PSHU D
\r01462 JMP ERROR
\r01464 *
\r01466 FCC '1BRANCH'
\r01468 FCB MCOMP.OR.7
\r01470 FCB MFORE
\r01472 FDB EXEC-CFAOFF
\r01474 FDB BIF+2
\r01476 FDB 0
\r01478 FDB 0
\r01480 TBR LDD ,U++
\r01482 BNE BRANCH
\r01484 LEAY 2,Y
\r01486 NEXT
\r01488 *
\r01490 FCC 'BRANCH'
\r01500 FCB MCOMP.OR.6
\r01510 FCB MFORE
\r01520 FDB TBR-CFAOFF
\r01530 FDB BIF+2
\r01540 FDB 0
\r01550 FDB 0
\r01560 BRANCH LDD ,Y++
\r01570 LEAY D,Y
\r01580 NEXT
\r01590 *
\r01600 FCC '0BRANCH'
\r01610 FCB MCOMP.OR.7
\r01620 FCB MFORE
\r01630 FDB BRANCH-CFAOFF
\r01640 FDB BIF+2
\r01650 FDB 0
\r01660 FDB 0
\r01670 ZBR LDD ,U++
\r01680 BEQ BRANCH
\r01690 LEAY 2,Y
\r01700 NEXT
\r01710 *
\r01720 FCC '(LOOP)'
\r01730 FCB MCOMP.OR.6
\r01740 FCB MFORE
\r01750 FDB ZBR-CFAOFF
\r01760 FDB BIF+2
\r01770 FDB 0
\r01780 FDB 0
\r01790 XLOOP LDD #1
\r01800 ADDD ,S
\r01810 STD ,S
\r01820 SUBD 2,S
\r01830 BLT BRANCH
\r01840 XLOOPN LEAY 2,Y
\r01850 LEAS 4,S
\r01860 NEXT
\r01870 *
\r01880 FCC '(+LOOP)'
\r01890 FCB MCOMP.OR.7
\r01900 FCB MFORE
\r01910 FDB XLOOP-CFAOFF
\r01920 FDB BIF+2
\r01930 FDB 0
\r01940 FDB 0
\r01950 XPLOOP LDD ,U++ inc val
\r01960 BPL XLOOP+3
\r01970 ADDD ,S
\r01980 STD ,S
\r01990 SUBD 2,S
\r02000 BGT BRANCH
\r02010 BRA XLOOPN
\r02020 *
\r02030 FCC '(DO)'
\r02040 FCB 4
\r02050 FCB MFORE
\r02060 FDB XPLOOP-CFAOFF
\r02070 FDB BIF+2
\r02080 FDB 0
\r02090 FDB 0
\r02100 XDO PULU D,X
\r02110 PSHS D,X
\r02120 NEXT
\r02130 *
\r02140 FCC 'I'
\r02150 FCB 1
\r02160 FCB MFORE
\r02170 FDB XDO-CFAOFF
\r02180 FDB BIF+2
\r02190 FDB HLD-CFAOFF
\r02200 FDB IDDOT-CFAOFF
\r02210 I LDD ,S
\r02220 PSHU D
\r02222 NEXT
\r02224 *
\r02226 FCC 'J'
\r02228 FCB 1
\r02230 FCB MFORE
\r02232 FDB I-CFAOFF
\r02234 FDB BIF+2
\r02236 FDB IPCOM-CFAOFF
\r02238 FDB 0
\r02240 J LDD 4,S
\r02242 PSHU D
\r02244 NEXT
\r02246 *
\r02250 FCC 'DIGIT'
\r02260 FCB 5
\r02270 FCB MFORE
\r02280 FDB J-CFAOFF
\r02290 FDB BIF+2
\r02300 FDB DEC-CFAOFF
\r02310 FDB DLITER-CFAOFF
\r02320 DIGIT LDB 3,U
\r02330 CMPB #'9
\r02340 BLS DIGITX+4
\r02350 CMPB #'A
\r02360 BLO DIGITN
\r02370 CMPB #'Z
\r02380 BLS DIGITX+2
\r02390 CMPB #'a
\r02400 BLO DIGITN
\r02410 CMPB #'z
\r02420 BHI DIGITN
\r02430 DIGITX SUBB #'a-'Z-1
\r02440 SUBB #'A-'9-1
\r02450 SUBB #'0
\r02460 CMPB 1,U
\r02470 BHS DIGITN
\r02480 CLRA
\r02490 STD 2,U
\r02500 LDD #-1
\r02510 DIGITL STD ,U
\r02520 NEXT
\r02530 DIGITN LEAU 2,U
\r02540 LDD #0
\r02550 BRA DIGITL
\r02560 *
\r02570 FCC '(FIND)'
\r02580 FCB 6
\r02590 FCB MFORE
\r02600 FDB DIGIT-CFAOFF
\r02610 FDB BIF+2
\r02620 FDB IABORT-CFAOFF
\r02630 FDB XMACH-CFAOFF
\r02640 * search vocabulary adr2 for (adr1)
\r02650 PFIND LDD ,U valid?
\r02660 BEQ PFINDX
\r02670 PFINDL DOCOL
\r02680 FDB PREF
\r02690 FDB XMACH
\r02700 LEAU 2,U
\r02710 LDX [,U] NULL link?
\r02720 BEQ PFINDN
\r02730 LDB ,X
\r02740 ANDB #MHID smudged?
\r02750 BEQ PFINDY
\r02760 LEAX RTOFF,X deeper
\r02770 STX ,U
\r02780 BRA PFINDL
\r02790 PFINDY LDX #-1
\r02800 PFINDN LDD ,U
\r02810 STX ,U
\r02820 PFINDX STD 2,U
\r02830 NEXT
\r02990 *
\r03000 FCC 'ENCLOSE'
\r03010 FCB 7
\r03020 FCB MFORE
\r03030 FDB PFIND-CFAOFF
\r03040 FDB BIF+2
\r03050 FDB EMTBUF-CFAOFF
\r03060 FDB 0
\r03070 * adr1 c --- adr2 len
\r03080 ENCLOS LDX 2,U
\r03100 ENCLLD LDB ,X+ delimiter
\r03110 BEQ ENCL0
\r03120 CMPB 1,U
\r03130 BEQ ENCLLD
\r03133 ENCL0 LEAX -1,X
\r03140 STX 2,U
\r03150 ENCLLW LDB ,X+ scan word
\r03160 BEQ ENCLCA
\r03170 CMPB 1,U
\r03180 BNE ENCLLW
\r03190 ENCLCA TFR X,D length
\r03195 SUBD #1
\r03200 SUBD 2,U
\r03220 STD ,U
\r03230 NEXT
\r03240 *
\r03250 FCC 'LITERAL'
\r03260 FCB MIMM.OR.7
\r03270 FCB MFORE
\r03280 FDB ENCLOS-CFAOFF
\r03290 FDB BIF+2
\r03300 FDB LIT-CFAOFF
\r03310 FDB LOAD-CFAOFF
\r03320 * compile a literal
\r03330 LITER BSR LITERS
\r03340 LDD #LIT
\r03350 LITERB STD ,Y++
\r03360 PULU D
\r03370 STD ,Y++
\r03380 STY UDP,X
\r03390 PULS Y
\r03400 JMP HERERR
\r03405 *
\r03410 LITERS LDX <UP
\r03412 LDB USTATE+1,X
\r03414 ANDB #SCOMP
\r03416 PULS D no CC
\r03418 BNE *+4 compiling?
\r03420 NEXT no
\r03422 PSHS Y
\r03424 LDY UDP,X
\r03426 EXG D,PC return
\r03430 *
\r03435 FCC 'DLITERAL'
\r03440 FCB MIMM.OR.8
\r03450 FCB MFORE
\r03460 FDB LITER-CFAOFF
\r03470 FDB BIF+2
\r03480 FDB DLIT-CFAOFF
\r03490 FDB DMINUS-CFAOFF
\r03500 * compile a 32 bit constant
\r03510 DLITER BSR LITERS
\r03540 LDD #DLIT
\r03550 STD ,Y++
\r03560 PULU D
\r03570 BRA LITERB
\r03630 *
\r08210 INCLUDE BIFB.ASM
\r08220 INCLUDE BIF1.ASM
\r08230 INCLUDE BIF1B.ASM
\r08240 INCLUDE BIF2.ASM
\r08250 INCLUDE BIF2B.ASM
\r08260 INCLUDE BIF3.ASM
\r08270 INCLUDE BIF3B.ASM
\r08280 INCLUDE BIF4.ASM
\r08285 INCLUDE BIF4B.ASM
\r08290 INCLUDE BIF5.ASM
\r08295 INCLUDE BIF5B.ASM
\r08300 INCLUDE BIF6.ASM
\r08310 INCLUDE BIF6B.ASM
\r08320 INCLUDE BIF7.ASM
\r08330 INCLUDE BIF7B.ASM
\r09000 END
\r
OSDN Git Service
