cross_v/BIF.ASM

   1 00010 * The Kernel of BIF: A Dialect of FORTH
   2 00015 * with a Binary Tree Dictionary
   3 00020 * Copyright   1989 by Joel Matthew Rees
   4 00025 *
   5 00030 * BIF is architecturally derived from
   6 00035 * the public domain fig-FORTH model.
   7 00040 *
   8 00050 * TITLE BIF kernel 16 Feb 89
   9 00070   OPT MEX
  10 00080   INCLUDE BIFU.INC
  11 00090   ORG $1200       DEBIF: $3F00
  12 00100   INCLUDE BIF.M
  13 00110   INCLUDE BIFDP.ASM
  14 00110   INCLUDE BIFST.ASM
  15 00120   SETDP VDP COLD loads DP
  16 01000 *
  17 01001   FCC '@' name
  18 01002   FCB 1 name length, usage (NFA)
  19 01003   FCB MFORE type/allocation MODES
  20 01004   FDB WARM-CFAOFF previous link in allocation
  21 01005   FDB BIF+2 owning vocabulary
  22 01006   FDB EQ-CFAOFF left link in tree
  23 01007   FDB AND-CFAOFF right link in tree
  24 01010 FETCH     LDD [,U] from [tos] to stack
  25 01011   STD ,U
  26 01012   NEXT
  27 01013 *
  28 01014   FCC '!'
  29 01015   FCB 1
  30 01016   FCB MFORE
  31 01017   FDB FETCH-CFAOFF
  32 01030   FDB BIF+2
  33 01040   FDB NUBLK-CFAOFF
  34 01050   FDB STOCSP-CFAOFF
  35 01060 STORE     LDD 2,U from stack to [top]
  36 01070   STD [,U]
  37 01080   LEAU 4,U
  38 01090   NEXT
  39 01095 *
  40 01100   FCC 'LIT'
  41 01110   FCB MCOMP|3
  42 01120   FCB MFORE
  43 01130   FDB STORE-CFAOFF
  44 01140   FDB BIF+2
  45 01150   FDB 0 * LIST-CFAOFF
  46 01160   FDB 0
  47 01170 LIT       LDD ,Y++ push literal from code
  48 01180   PSHU D
  49 01190   NEXT
  50 01200 *
  51 01210   FCC 'DLIT'
  52 01220   FCB MCOMP|4
  53 01230   FCB MFORE
  54 01240   FDB LIT-CFAOFF
  55 01250   FDB BIF+2
  56 01260   FDB 0
  57 01270   FDB 0
  58 01280 * push double literal from code
  59 01290 DLIT      LDD ,Y++
  60 01300   LDX ,Y++
  61 01310   PSHU D,X
  62 01320   NEXT
  63 01330 *
  64 01340   FCC 'EXECUTE'
  65 01350   FCB MCOMP|7
  66 01360   FCB MFORE
  67 01370   FDB DLIT-CFAOFF
  68 01380   FDB BIF+2
  69 01390   FDB 0
  70 01400   FDB 0
  71 01410 * EXECUTE cfa on stack
  72 01420 EXEC      LDX ,U++
  73 01430   BEQ *+4
  74 01440   JMP ,X
  75 01450   LDD #9
  76 01460   PSHU D
  77 01462   JMP ERROR
  78 01464 *
  79 01466   FCC '1BRANCH'
  80 01468   FCB MCOMP|7
  81 01470   FCB MFORE
  82 01472   FDB EXEC-CFAOFF
  83 01474   FDB BIF+2
  84 01476   FDB 0
  85 01478   FDB 0
  86 01480 TBR       LDD ,U++
  87 01482   BNE BRANCH
  88 01484   LEAY 2,Y
  89 01486   NEXT
  90 01488 *
  91 01490   FCC 'BRANCH'
  92 01500   FCB MCOMP|6
  93 01510   FCB MFORE
  94 01520   FDB TBR-CFAOFF
  95 01530   FDB BIF+2
  96 01540   FDB 0
  97 01550   FDB 0
  98 01560 BRANCH    LDD ,Y++
  99 01570   LEAY D,Y
 100 01580   NEXT
 101 01590 *
 102 01600   FCC '0BRANCH'
 103 01610   FCB MCOMP|7
 104 01620   FCB MFORE
 105 01630   FDB BRANCH-CFAOFF
 106 01640   FDB BIF+2
 107 01650   FDB 0
 108 01660   FDB 0
 109 01670 ZBR       LDD ,U++
 110 01680   BEQ BRANCH
 111 01690   LEAY 2,Y
 112 01700   NEXT
 113 01710 *
 114 01720   FCC '(LOOP)'
 115 01730   FCB MCOMP|6
 116 01740   FCB MFORE
 117 01750   FDB ZBR-CFAOFF
 118 01760   FDB BIF+2
 119 01770   FDB 0
 120 01780   FDB 0
 121 01790 XLOOP     LDD #1
 122 01800   ADDD ,S
 123 01810   STD ,S
 124 01820   SUBD 2,S
 125 01830   BLT BRANCH
 126 01840 XLOOPN    LEAY 2,Y
 127 01850   LEAS 4,S
 128 01860   NEXT
 129 01870 *
 130 01880   FCC '(+LOOP)'
 131 01890   FCB MCOMP|7
 132 01900   FCB MFORE
 133 01910   FDB XLOOP-CFAOFF
 134 01920   FDB BIF+2
 135 01930   FDB 0
 136 01940   FDB 0
 137 01950 XPLOOP    LDD ,U++ inc val
 138 01960   BPL XLOOP+3
 139 01970   ADDD ,S
 140 01980   STD ,S
 141 01990   SUBD 2,S
 142 02000   BGT BRANCH
 143 02010   BRA XLOOPN
 144 02020 *
 145 02030   FCC '(DO)'
 146 02040   FCB 4
 147 02050   FCB MFORE
 148 02060   FDB XPLOOP-CFAOFF
 149 02070   FDB BIF+2
 150 02080   FDB 0
 151 02090   FDB 0
 152 02100 XDO       PULU D,X
 153 02110   PSHS D,X
 154 02120   NEXT
 155 02130 *
 156 02140   FCC 'I'
 157 02150   FCB 1
 158 02160   FCB MFORE
 159 02170   FDB XDO-CFAOFF
 160 02180   FDB BIF+2
 161 02190   FDB HLD-CFAOFF
 162 02200   FDB IDDOT-CFAOFF
 163 02210 I LDD ,S
 164 02220   PSHU D
 165 02222   NEXT
 166 02224 *
 167 02226   FCC 'J'
 168 02228   FCB 1
 169 02230   FCB MFORE
 170 02232   FDB I-CFAOFF
 171 02234   FDB BIF+2
 172 02236   FDB IPCOM-CFAOFF
 173 02238   FDB 0
 174 02240 J LDD 4,S
 175 02242   PSHU D
 176 02244   NEXT
 177 02246 *
 178 02250   FCC 'DIGIT'
 179 02260   FCB 5
 180 02270   FCB MFORE
 181 02280   FDB J-CFAOFF
 182 02290   FDB BIF+2
 183 02300   FDB DEC-CFAOFF
 184 02310   FDB DLITER-CFAOFF
 185 02320 DIGIT     LDB 3,U
 186 02330   CMPB #'9
 187 02340   BLS DIGITX+4
 188 02350   CMPB #'A
 189 02360   BLO DIGITN
 190 02370   CMPB #'Z
 191 02380   BLS DIGITX+2
 192 02390   CMPB #'a
 193 02400   BLO DIGITN
 194 02410   CMPB #'z
 195 02420   BHI DIGITN
 196 02430 DIGITX    SUBB #'a-'Z-1
 197 02440   SUBB #'A-'9-1
 198 02450   SUBB #'0
 199 02460   CMPB 1,U
 200 02470   BHS DIGITN
 201 02480   CLRA
 202 02490   STD 2,U
 203 02500   LDD #-1
 204 02510 DIGITL    STD ,U
 205 02520   NEXT
 206 02530 DIGITN    LEAU 2,U
 207 02540   LDD #0
 208 02550   BRA DIGITL
 209 02560 *
 210 02570   FCC '(FIND)'
 211 02580   FCB 6
 212 02590   FCB MFORE
 213 02600   FDB DIGIT-CFAOFF
 214 02610   FDB BIF+2
 215 02620   FDB IABORT-CFAOFF
 216 02630   FDB XMACH-CFAOFF
 217 02640 * search vocabulary adr2 for (adr1)
 218 02650 PFIND     LDD ,U valid?
 219 02660   BEQ PFINDX
 220 02670 PFINDL    DOCOL
 221 02680   FDB PREF
 222 02690   FDB XMACH
 223 02700   LEAU 2,U
 224 02710   LDX [,U] NULL link?
 225 02720   BEQ PFINDN
 226 02730   LDB ,X
 227 02740   ANDB #MHID smudged?
 228 02750   BEQ PFINDY
 229 02760   LEAX RTOFF,X deeper
 230 02770   STX ,U
 231 02780   BRA PFINDL
 232 02790 PFINDY    LDX #-1
 233 02800 PFINDN    LDD ,U
 234 02810   STX ,U
 235 02820 PFINDX    STD 2,U
 236 02830   NEXT
 237 02990 *
 238 03000   FCC 'ENCLOSE'
 239 03010   FCB 7
 240 03020   FCB MFORE
 241 03030   FDB PFIND-CFAOFF
 242 03040   FDB BIF+2
 243 03050   FDB EMTBUF-CFAOFF
 244 03060   FDB 0
 245 03070 * adr1 c --- adr2 len
 246 03080 ENCLOS    LDX 2,U
 247 03100 ENCLLD    LDB ,X+ delimiter
 248 03110   BEQ ENCL0
 249 03120   CMPB 1,U
 250 03130   BEQ ENCLLD
 251 03133 ENCL0     LEAX -1,X
 252 03140   STX 2,U
 253 03150 ENCLLW    LDB ,X+ scan word
 254 03160   BEQ ENCLCA
 255 03170   CMPB 1,U
 256 03180   BNE ENCLLW
 257 03190 ENCLCA    TFR X,D length
 258 03195   SUBD #1
 259 03200   SUBD 2,U
 260 03220   STD ,U
 261 03230   NEXT
 262 03240 *
 263 03250   FCC 'LITERAL'
 264 03260   FCB MIMM|7
 265 03270   FCB MFORE
 266 03280   FDB ENCLOS-CFAOFF
 267 03290   FDB BIF+2
 268 03300   FDB LIT-CFAOFF
 269 03310   FDB LOAD-CFAOFF
 270 03320 * compile a literal
 271 03330 LITER     BSR LITERS
 272 03340   LDD #LIT
 273 03350 LITERB    STD ,Y++
 274 03360   PULU D
 275 03370   STD ,Y++
 276 03380   STY UDP,X
 277 03390   PULS Y
 278 03400   JMP HERERR
 279 03405 *
 280 03410 LITERS    LDX <UP
 281 03412   LDB USTATE+1,X
 282 03414   ANDB #SCOMP
 283 03416   PULS D no CC
 284 03418   BNE *+4 compiling?
 285 03420   NEXT no
 286 03422   PSHS Y
 287 03424   LDY UDP,X
 288 03426   EXG D,PC return
 289 03430 *
 290 03435   FCC 'DLITERAL'
 291 03440   FCB MIMM|8
 292 03450   FCB MFORE
 293 03460   FDB LITER-CFAOFF
 294 03470   FDB BIF+2
 295 03480   FDB DLIT-CFAOFF
 296 03490   FDB DMINUS-CFAOFF
 297 03500 * compile a 32 bit constant
 298 03510 DLITER    BSR LITERS
 299 03540   LDD #DLIT
 300 03550   STD ,Y++
 301 03560   PULU D
 302 03570   BRA LITERB
 303 03630 *
 304 08210   INCLUDE BIFB.ASM
 305 08220   INCLUDE BIF1.ASM
 306 08230   INCLUDE BIF1B.ASM
 307 08240   INCLUDE BIF2.ASM
 308 08250   INCLUDE BIF2B.ASM
 309 08260   INCLUDE BIF3.ASM
 310 08270   INCLUDE BIF3B.ASM
 311 08280   INCLUDE BIF4.ASM
 312 08285   INCLUDE BIF4B.ASM
 313 08290   INCLUDE BIF5.ASM
 314 08295   INCLUDE BIF5B.ASM
 315 08300   INCLUDE BIF6.ASM
 316 08310   INCLUDE BIF6B.ASM
 317 08320   INCLUDE BIF7.ASM
 318 08330   INCLUDE BIF7B.ASM
 319 09000   END