cross_v/BIF6.ASM

   1 00010 * Include file for BIF
   2 00020 * BIF Copyright 1989 Joel Matthew Rees (see BIF/ASM)
   3 00030 *
   4 01000   FCC '(NUMBER)'
   5 01010   FCB 8
   6 01020   FCB MFORE
   7 01030   FDB QARROW-CFAOFF
   8 01040   FDB BIF+2
   9 01050   FDB 0
  10 01060   FDB PREF-CFAOFF
  11 01070 INUMB     PSHS Y  see fig-FORTH model
  12 01080   PULU Y adr
  13 01085   LDX <UP
  14 01090 INUMBL    LDB ,Y+ ch
  15 01092   CLRA
  16 01094   PSHU D
  17 01096   LDD UBASE,X
  18 01100   PSHU D
  19 01110   DOCOL
  20 01120   FDB DIGIT
  21 01130   FDB ZBR
  22 01140   FDB INUMBE-*-2
  23 01150   FDB SWAP accm ms word
  24 01160   FDB BASE
  25 01180   FDB FETCH
  26 01190   FDB USTAR shift in base
  27 01200   FDB DROP ls word is digit
  28 01210   FDB ROT accm ls word
  29 01220   FDB BASE
  30 01230   FDB FETCH
  31 01240   FDB USTAR shift in base
  32 01250   FDB DADD accumulate
  33 01260   FDB XMACH adjust dpl
  34 01270   LDX <UP
  35 01280   LDD UDPL,X
  36 01290   BMI INUMBL
  37 01300   ADDD #1
  38 01310   STD UDPL,X
  39 01320   BRA INUMBL
  40 01330 INUMBE    FDB XMACH
  41 01340   LEAY -1,Y back up
  42 01350   PSHU Y adr
  43 01355   PULS Y
  44 01360   NEXT
  45 01390 *
  46 01400   FCC 'NUMBER'
  47 01410   FCB 6
  48 01420   FCB MFORE
  49 01430   FDB INUMB-CFAOFF
  50 01440   FDB BIF+2
  51 01450   FDB MIN-CFAOFF
  52 01460   FDB OVER-CFAOFF
  53 01470 NUMBER PULU X
  54 01475   LEAX 1,X skip ct
  55 01480   LDB ,X <0?
  56 01490   SUBB #'-
  57 01500   BNE *+4
  58 01510   LEAX 1,X
  59 01520   CLRA
  60 01530   PSHU D
  61 01540   CLRB
  62 01550   PSHU D double 0
  63 01560   PSHU D
  64 01570   PSHU X adr
  65 01580   LDD #-1 clear DPL
  66 01590 NUMBA     LDX <UP
  67 01600   STD UDPL,X
  68 01610   DOCOL
  69 01620   FDB INUMB
  70 01630   FDB XMACH
  71 01640   LDX ,U end ch
  72 01650   LDB ,X ascii NUL?
  73 01660   BEQ NUMBQ
  74 01670   CMPB #': double?
  75 01680   BEQ NUMBD
  76 01690   CMPB #'-
  77 01700   BLO NUMBE
  78 01710   CMPB #'/
  79 01720   BHI NUMBE
  80 01730 NUMBD     LEAX 1,X past dec pt
  81 01740   STX ,U
  82 01750   LDD #0 set DPL
  83 01760   BRA NUMBA
  84 01770 NUMBE     LDD #0
  85 01780   PSHU D
  86 01790   JMP ERROR
  87 01800 NUMBQ     LEAU 2,U valid, drop
  88 01810   DOCOL
  89 01830   FDB ROT <0?
  90 01840   FDB TBR
  91 01850   FDB 2
  92 01860   FDB DMINUS
  93 01870   FDB SEMIS
  94 01890 *
  95 01900   FCC 'WORDPAD'
  96 01910   FCB 7
  97 01920   FCB MFORE
  98 01930   FDB NUMBER-CFAOFF
  99 01940   FDB BIF+2
 100 01950   FDB 0
 101 01960   FDB 0
 102 01970 WORDPD    DOUCON
 103 01980   FCB UWP
 104 01990 *
 105 02000   FCC 'WORD'
 106 02010   FCB 4
 107 02020   FCB MFORE
 108 02030   FDB WORDPD-CFAOFF
 109 02040   FDB BIF+2
 110 02050   FDB WHILE-CFAOFF
 111 02060   FDB BCOMP-CFAOFF
 112 02070 WORD      PSHS Y
 113 02075   LDY <UP
 114 02080   LDD UBLK,Y terminal?
 115 02090   BEQ WORDK buffer
 116 02100   PSHU D
 117 02110   DOCOL
 118 02120   FDB BLOCK
 119 02130   FDB XMACH
 120 02140   PULU D
 121 02150   BRA *+4 UTIB < 16!
 122 02160 WORDK     LDD UTIB,Y
 123 02170   ADDD UIN,Y parse at
 124 02180   PULU X ch
 125 02190   TFR D,Y save
 126 02200   PSHU X,Y (swap)
 127 02205   DOCOL
 128 02210   FDB ENCLOS
 129 02215   FDB XMACH
 130 02220   PSHS Y start at
 131 02221   LDD 2,U symbol at
 132 02222   SUBD ,S++ delimiter count
 133 02223   ADDD ,U length
 134 02225   LDX <UP
 135 02226   ADDD UIN,X
 136 02227   STD UIN,X update
 137 02230   PULU D length
 138 02240   CMPD #NLMASK
 139 02250   BLS *+5 clip
 140 02260   LDD #NLMASK
 141 02270   LDY UWP,X
 142 02280   STB ,Y+ count
 143 02290   CLR B,Y trailing NUL
 144 02300   PSHU D,Y dest & ct
 145 02330   PULS Y
 146 02340   DOCOL
 147 02350   FDB CMOVE copy
 148 02360   FDB SEMIS
 149 02490 *
 150 02500   FCC 'BS'
 151 02510   FCB 2
 152 02520   FCB MFORE
 153 02530   FDB WORD-CFAOFF
 154 02540   FDB BIF+2
 155 02550   FDB BRANCH-CFAOFF
 156 02560   FDB 0
 157 02570 BS        DOUCON
 158 02580   FCB UBS
 159 02590 *
 160 02600   FCC 'EXPECT'
 161 02610   FCB 6
 162 02620   FCB MFORE
 163 02630   FDB BS-CFAOFF
 164 02640   FDB BIF+2
 165 02650   FDB ERROR-CFAOFF
 166 02660   FDB FILL-CFAOFF
 167 02670 EXPECT    PSHS Y
 168 02680   LDD ,U count
 169 02690   LDY 2,U buffer
 170 02700   SUBD #1 for NUL
 171 02710   BLT EXPE0+2
 172 02720   BEQ EXPE0
 173 02730   LEAX D,Y
 174 02740   STX ,U limit
 175 02750 EXPEL     DOCOL
 176 02760   FDB KEY
 177 02770   FDB XMACH
 178 02780   LDB 1,U
 179 02790   LDX <UP
 180 02800   CMPB UBS+1,X
 181 02810   BNE EXPECR
 182 02820   CMPY 4,U beginning?
 183 02830   BLS EXPEM0
 184 02840   LEAY -1,Y
 185 02850   BRA EXPEM
 186 02860 EXPEM0    CLR 1,U to emit
 187 02870   BRA EXPEM
 188 02880 EXPECR    CMPB #$0D
 189 02890   BNE EXPEPT
 190 02900   STY 2,U terminate
 191 02910   BRA EXPEM
 192 02913 EXPEPT    CMPB #$20 printable?
 193 02916   BLO EXPEM0
 194 02920   STB ,Y+ store ch
 195 02930 EXPEM     DOCOL
 196 02940   FDB EMIT
 197 02950   FDB XMACH
 198 02960   CMPY ,U
 199 02970   BLO EXPEL
 200 02980 EXPE0     CLR ,Y NUL term
 201 02990   LEAU 4,U
 202 03000   PULS Y
 203 03010   NEXT
 204 03090 *
 205 03600 TWID      EQU 128 width of a terminal line
 206 03605   FCC 'QUERY'
 207 03610   FCB 5
 208 03620   FCB MFORE
 209 03630   FDB EXPECT-CFAOFF
 210 03640   FDB BIF+2
 211 03650   FDB LOOP-CFAOFF
 212 03660   FDB SWAP-CFAOFF
 213 03670 QUERY     LDX <UP
 214 03680   LDD #0
 215 03690   STD UIN,X
 216 03700   LDD #TWID
 217 03710   LDX UTIB,X
 218 03720   PSHU D,X
 219 03730   DOCOL
 220 03740   FDB EXPECT
 221 03750   FDB SEMIS
 222 03790 *
 223 03795   FCB 0 ; NEEDED
 224 03800   FCB MIMM|0
 225 03810   FCB MFORE
 226 03820   FDB QUERY-CFAOFF
 227 03830   FDB BIF+2
 228 03840   FDB 0
 229 03850   FDB 0
 230 03860 NUBLK     LDX <UP
 231 03870   LDD UBLK,X
 232 03880   BEQ NUBLT
 233 03890   ADDD #1
 234 03900   STD UBLK,X
 235 03910   LDD #0
 236 03920   STD UIN,X
 237 03930   LDD BPSCR+2 2^n
 238 03940   DECB
 239 03950   ANDB UBLK+1,X end of screen?
 240 03960   BNE NUBLT+2
 241 03970   DOCOL
 242 03980   FDB QEXEC
 243 03990   FDB XMACH
 244 04000 NUBLT     PULS Y end interp
 245 04010   NEXT
 246 04090 *
 247 04100   FCC 'FIND'
 248 04110   FCB 4
 249 04120   FCB MFORE
 250 04130   FDB NUBLK-CFAOFF
 251 04140   FDB BIF+2
 252 04150   FDB EXPECT-CFAOFF
 253 04160   FDB HERE-CFAOFF
 254 04170 FIND      LDD 2,U
 255 04180   ADDD #1 past ct
 256 04190   STD 2,U
 257 04200   LDD ,U
 258 04210 FINDL     LDX 2,U
 259 04220   PSHU D,X
 260 04230   DOCOL
 261 04240   FDB PFIND
 262 04250   FDB XMACH
 263 04260   LDD ,U flag
 264 04270   BNE FINDF
 265 04290   LDX 4,U vocabulary
 266 04300   LDD GFAOFF-PFAOFF,X parent
 267 04305   CMPD 4,U root voc?
 268 04310   BEQ FINDF
 269 04315   LEAU 4,U
 270 04320   STD ,U
 271 04330   BRA FINDL
 272 04360 FINDF     LDD [2,U]
 273 04365   LEAU 4,U entry
 274 04370   STD 2,U
 275 04380   NEXT
 276 04390 *
 277 04400   FCC '-DFIND'
 278 04410   FCB 6
 279 04420   FCB MFORE
 280 04430   FDB FIND-CFAOFF
 281 04440   FDB BIF+2
 282 04450   FDB 0
 283 04460   FDB 0
 284 04470 DDFIND    DOCOL
 285 04480   FDB DROOT defs first
 286 04490   FDB ROOT context next
 287 04500 DFIND1    FDB BL
 288 04510   FDB WORD name in buf
 289 04520   FDB FETCH vocab2
 290 04530   FDB SWAP
 291 04540   FDB FETCH vocab1
 292 04550   FDB OVER
 293 04560   FDB OVER
 294 04570   FDB EQ same?
 295 04580   FDB ZBR
 296 04590   FDB 6
 297 04600   FDB DROP
 298 04610   FDB BRANCH
 299 04620   FDB DFIND2-*-2
 300 04630   FDB WORDPD buf
 301 04640   FDB SWAP
 302 04650   FDB FIND 1st
 303 04660   FDB OVER
 304 04670   FDB ZBR
 305 04680   FDB 6
 306 04690   FDB ROT
 307 04700   FDB DROP
 308 04710   FDB SEMIS
 309 04720   FDB DROP
 310 04730   FDB DROP
 311 04740 DFIND2    FDB WORDPD
 312 04750   FDB SWAP
 313 04760   FDB FIND 2nd
 314 04770   FDB SEMIS
 315 04790 *
 316 04800   FCC '-IFIND'
 317 04810   FCB 6
 318 04820   FCB MFORE
 319 04830   FDB DDFIND-CFAOFF
 320 04840   FDB BIF+2
 321 04850   FDB 0
 322 04860   FDB 0
 323 04870 DIFIND    DOCOL
 324 04880   FDB ROOT context first
 325 04890   FDB DROOT defs next
 326 04900   FDB BRANCH
 327 04910   FDB DFIND1-*-2
 328 05190 *