fig-forth_6809.asm

   1 *       OPT PRT
   2
   3 * fig-FORTH FOR 6800 -- converted mechanically to 6809
   4 * ASSEMBLY SOURCE LISTING
   5
   6 * RELEASE 1
   7 * MAY 1979
   8 * WITH COMPILER SECURITY
   9 * AND VARIABLE LENGTH NAMES
  10
  11 * RELEASE 1.00.01
  12 * April 2018
  13 * Modified for TRS-80/Tandy Color Computer, Dragon, etc., JMR
  14
  15 * This public domain publication is provided
  16 * through the courtesy of:
  17 * FORTH
  18 * INTEREST
  19 * GROUP
  20 * fig
  21
  22 * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
  23 * Further distribution must include this notice.
  24         PAGE
  25         NAM     Copyright:FORTH Interest Group
  26         OPT     GEN,PAG
  27 * filename FTH7.21
  28 * === FORTH-6800 06-06-79 21:OO
  29
  30
  31 * The following constitutes the original license:
  32 *=====================LICENSE====================
  33 * This listing is in the PUBLIC DOMAIN and
  34 * may be freely copied or published with the
  35 * restriction that a credit line is printed
  36 * with the material, crediting the
  37 * authors and the FORTH INTEREST GROUP.
  38
  39 * === by Dave Lion,
  40 * ===  with help from
  41 * === Bob Smith,
  42 * === LaFarr Stuart,
  43 * === The Forth Interest Group
  44 * === PO Box 1105
  45 * === San Carlos, CA 94070
  46 * ===  and
  47 * === Unbounded Computing
  48 * === 1134-K Aster Ave.
  49 * === Sunnyvale, CA 94086
  50 *===================END-LICENSE==================
  51 * Note that the assertion of attribution terms contradicts with a
  52 * pure assignment to the public domain.
  53 * Because of the terms, copyright should be understood
  54 * to be asserted by the authors.
  55 * Attribution, according to the above, should be understood
  56 * to be required.
  57 *
  58 * === Conversion to 6809
  59 * === and modifications for Color Computer, etc., by Joel Rees, Reiisi Kenkyuu
  60 * Conversions and modifications copyright Joel Rees, 2018.
  61 * Permission to use, modify, distribute, and publish the modifications
  62 * is extended under the attribution terms given above,
  63 * with the explicitly affirmed obligation to retain intact
  64 * all authorship and copyright notices, and license notices.
  65 *
  66 * Note that, under my (Joel Rees) recollection and understanding of the
  67 * legal/political context of the original context of publication,
  68 * right to use source code in one's possession was not considered
  69 * deniable in any practical or meaningful sense.
  70 * (Laws such as the DMCA had been proposed by certain advocates for
  71 * the concept of intellectual property under other names,
  72 * but were considered unenforceable and impracticable,
  73 * thus contrary to the purpose of law,
  74 * a waste of resources, and the height of discourtesy
  75 * by the general community of software practicioners at the time,
  76 * to the best of my understanding and recollection.)
  77 * Thus, the lack of explicit mention of a right to use in the terms of
  78 * the effective license should in no wise be considered to imply a
  79 * witholding thereof.
  80 * ===
  81 *
  82 *  This version was developed on an AMI EVK 300 PROTO
  83 *  system using an ACIA for the I/O. All terminal 1/0
  84 *  is done in three subroutines:
  85 *   PEMIT  ( word # 182 )
  86 *   PKEY   (        183 )
  87 *   PQTERM (        184 )
  88 * =6809= See the above routines for Color Computer calls. JMR
  89 *
  90 *  The FORTH words for disc related I/O follow the model
  91 *  of the FORTH Interest Group, but have not been
  92 *  tested using a real disc.
  93 * === True disk I/O not implemented in v. 1.00.01. JMR
  94 *
  95 *  Addresses in this implementation reflect the fact that,
  96 *  on the development system, it was convenient to
  97 *  write-protect memory at hex 1000, and leave the first
  98 *  4K bytes write-enabled. As a consequence, code from
  99 *  location $1000 to lable ZZZZ could be put in ROM.
 100 *  Minor deviations from the model were made in the
 101 *  initialization and words ?STACK and FORGET
 102 *  in order to do this.
 103 * =6809= Note that there is no write-protect on stock Color Computer,
 104 * =6809= and other addresses will be adjusted, rather, for the Color Computer hardware.
 105 *
 106
 107
 108 *
 109 NBLK    EQU     4       # of disc buffer blocks for virtual memory
 110 * MEMEND        EQU     132*NBLK+$3000 end of ram
 111 MEMEND  EQU     132*NBLK+$4000+132 end of ram with some breathing room
 112 *  each block is 132 bytes in size,
 113 *  holding 128 characters
 114 *
 115 * MEMTOP        EQU     $3FFF   absolute end of all ram
 116 MEMTOP  EQU     $7FFF   putative absolute end of all ram
 117 * ACIAC EQU     $FBCE   the ACIA control address and
 118 ACIAC   EQU     $FCF4   the ACIA control address and
 119 ACIAD   EQU     ACIAC+1 data address for PROTO
 120 * =6809= There is no ACIA (darn it!), but we need the addresses until we redefine the I/O routines.
 121         PAGE
 122 *  MEMORY MAP for this (not) 16K system:
 123 *  ( (*not*) positioned so that systems with 4k byte write-
 124 *   protected segments can write protect FORTH )
 125 *
 126 * addr.         contents                pointer init by
 127 * ****  ******************************* ******* ******
 128 * 3FFF  (6FFF)                                  HI
 129 *       substitute for disc mass memory
 130 * 3210  (5294)                                  LO,MEMEND
 131 * 320F  (5293)
 132 *       4 buffer sectors of VIRTUAL MEMORY
 133 * 3000  (5084)                                  FIRST
 134 * >>>>>> memory from here up must be RAM <<<<<<
 135 *
 136 * 27FF  (37FF, but 38XX, with debugging code included the the "ROMable" image.)
 137 *       6k of romable "FORTH"           <== IP  ABORT
 138 *                                       <== W
 139 *       the VIRTUAL FORTH MACHINE
 140 *
 141 * 1004 <<< WARM START ENTRY >>> (4004)
 142 * 1000 <<< COLD START ENTRY >>> (4000)
 143 *
 144 * >>>>>> memory from here down must be RAM <<<<<<
 145 *  FFE  (3FF0) RETURN STACK base                <== RP  RINIT
 146 *
 147 *  FB4  (less than 3EB4)
 148 *       INPUT LINE BUFFER
 149 *       holds up to 132 characters
 150 *       and is scanned upward by IN
 151 *       starting at TIB
 152 *  F30  (3E00)                          <== IN  TIB
 153 *  F2F  (3DF0) DATA STACK                       <== SP  SP0,SINIT
 154 *    |  grows downward from F2F
 155 *    v
 156 *  - -
 157 *    |
 158 *    I  DICTIONARY grows upward
 159 *
 160 *  183  (1483) end of ram-dictionary.           <== DP  DPINIT
 161 *       "TASK"
 162 *
 163 *  150  (1450) "FORTH" ( a word )               <=, <== CONTEXT
 164 *                                       `==== CURRENT
 165 *  148  (1448) start of ram-dictionary.
 166 *
 167 *  100  (1400) user #l table of variables       <= UP   DPINIT
 168 *   F0  (13B0) registers & pointers for the virtual machine
 169 *       scratch area used by various words
 170 *   E0  (13A0) lowest address used by FORTH
 171 *
 172 * 0000
 173         PAGE
 174 ***
 175 *
 176 * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
 177 *
 178 * IP points to the current instruction ( pre-increment mode )
 179 * RP points to second free byte (first free word) in return stack
 180 * =6809= S stack will be the return/flow-of-control stack.
 181 * SP (hardware SP) points to first free byte in data stack
 182 = =6809= U stack will be the parameter stack.
 183 *
 184 *       when A and B hold one 16 bit FORTH data word,
 185 *       A contains the high byte, B, the low byte.
 186 ***
 187
 188
 189
 190
 191 *       ORG     $E0     variables
 192         ORG     $13A0   variables
 193
 194
 195 * N     RMB     10      used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
 196 *                               SP@,SWAP,DOES>,COLD
 197 * =6809= All these will use scratch space on stack, to the extent they need it.
 198
 199
 200 *       These locations are used by the TRACE routine :
 201
 202 TRLIM   RMB     1       the count for tracing without user intervention
 203 TRACEM  RMB     1       non-zero = trace mode
 204 BRKPT   RMB     2       the breakpoint address at which
 205 *                       the program will go into trace mode
 206 VECT    RMB     2       vector to machine code
 207 *       (only needed if the TRACE routine is resident)
 208
 209
 210 *       Registers used by the FORTH virtual machine:
 211 *       Starting at $OOFO ($00B0):
 212
 213
 214 W       RMB     2       the instruction register points to 6800 code
 215 IP      RMB     2       the instruction pointer points to pointer to 6800 code
 216 * =6809= after NEXT, Y will retain IP, and X will retain W until overwritten
 217 * RP    RMB     2       the return stack pointer
 218 * =6809= S stack is fine for the flow of control stack.
 219 * =6809= SP will be U
 220 UP      RMB     2       the pointer to base of current user's 'USER' table
 221 *               ( altered during multi-tasking )
 222 * UP will be early in the DP variables.
 223 *
 224 * For the tracer:
 225 * =6809= Trace variables will also be in the direct page.
 226         RMB 4
 227 TRASP   RMB 2
 228 TRAVEC  RMB 2
 229 TRAA    RMB 1
 230 TRAB    RMB 1
 231 *
 232         PAGE
 233 *       This system is shown with one user, but additional users
 234 *       may be added by allocating additional user tables:
 235 *       UORIG2 RMB 64 data table for user #2
 236 *
 237 *
 238 * =6809= Should the TASK record be in the DP or not?
 239 *       Some of this stuff gets initialized during
 240 *       COLD start and WARM start:
 241 *       [ names correspond to FORTH words of similar (no X) name ]
 242 *
 243         ORG     $100
 244 *       ORG     $1100
 245 UORIG   RMB     6       3 reserved variables
 246 XSPZER  RMB     2       initial top of data stack for this user
 247 XRZERO  RMB     2       initial top of return stack
 248 XTIB    RMB     2       start of terminal input buffer
 249 XWIDTH  RMB     2       name field width
 250 XWARN   RMB     2       warning message mode (0 = no disc)
 251 XFENCE  RMB     2       fence for FORGET
 252 XDP     RMB     2       dictionary pointer
 253 XVOCL   RMB     2       vocabulary linking
 254 XBLK    RMB     2       disc block being accessed
 255 XIN     RMB     2       scan pointer into the block
 256 XOUT    RMB     2       cursor position
 257 XSCR    RMB     2       disc screen being accessed ( O=terminal )
 258 XOFSET  RMB     2       disc sector offset for multi-disc
 259 XCONT   RMB     2       last word in primary search vocabulary
 260 XCURR   RMB     2       last word in extensible vocabulary
 261 XSTATE  RMB     2       flag for 'interpret' or 'compile' modes
 262 XBASE   RMB     2       number base for I/O numeric conversion
 263 XDPL    RMB     2       decimal point place
 264 XFLD    RMB     2
 265 XCSP    RMB     2       current stack position, for compile checks
 266 XRNUM   RMB     2
 267 XHLD    RMB     2
 268 XDELAY  RMB     2       carriage return delay count
 269 XCOLUM  RMB     2       carriage width
 270 IOSTAT  RMB     2       last acia status from write/read
 271         RMB     2       ( 4 spares! )
 272         RMB     2
 273         RMB     2
 274         RMB     2
 275
 276
 277
 278
 279 *
 280 *
 281 *   end of user table, start of common system variables
 282 *
 283 *
 284 *
 285 XUSE    RMB     2
 286 XPREV   RMB     2
 287         RMB     4       ( spares )
 288
 289         PAGE
 290 *  These things, up through the lable 'REND', are overwritten
 291 *  at time of cold load and should have the same contents
 292 *  as shown here:
 293 *
 294         FCB     $C5     immediate
 295         FCC     4,FORTH
 296         FCB     $C8
 297         FDB     NOOP-7
 298 FORTH   FDB     DODOES,DOVOC,$81A0,TASK-7
 299         FDB     0
 300 *
 301         FCC     "(C) Forth Interest Group, 1979"
 302
 303         FCB     $84
 304         FCC     3,TASK
 305         FCB     $CB
 306         FDB     FORTH-8
 307 TASK    FDB     DOCOL,SEMIS
 308 *
 309 REND    EQU     *       ( first empty location in dictionary )
 310
 311         PAGE
 312 *    The FORTH program ( address $1000 ($2000) to $27FF (37FF?) ) is written
 313 *    so that it can be in a ROM, or write-protected if desired
 314         ORG     $2000
 315
 316 * ######>> screen 3 <<
 317 *
 318 ***************************
 319 **  C O L D   E N T R Y  **
 320 ***************************
 321 ORIG    NOP
 322         JMP     CENT
 323 ***************************
 324 **  W A R M   E N T R Y  **
 325 ***************************
 326         NOP
 327         JMP     WENT    warm-start code, keeps current dictionary intact
 328
 329 *
 330 ******* startup parmeters **************************
 331 *
 332         FDB     $6800,0000      cpu & revision
 333         FDB     0       topmost word in FORTH vocabulary
 334 BACKSP  FDB     $7F     backspace character for editing
 335 UPINIT  FDB     UORIG   initial user area
 336 *SINIT  FDB     ORIG-$D0        initial top of data stack
 337 SINIT   FDB     ORIG-$210       initial top of data stack
 338 *RINIT  FDB     ORIG-2  initial top of return stack
 339 RINIT   FDB     ORIG-$10        initial top of return stack
 340 *       FDB     ORIG-$D0        terminal input buffer
 341         FDB     ORIG-$200       terminal input buffer
 342         FDB     31      initial name field width
 343         FDB     0       initial warning mode (0 = no disc)
 344 FENCIN  FDB     REND    initial fence
 345 DPINIT  FDB     REND    cold start value for DP
 346 VOCINT  FDB     FORTH+8
 347 COLINT  FDB     132     initial terminal carriage width
 348 DELINT  FDB     4       initial carriage return delay
 349 ****************************************************
 350 *
 351         PAGE
 352 *
 353 * ######>> screen 13 <<
 354 * PULABX        PUL A           24 cycles until 'NEXT'
 355 *       PUL B
 356 * STABX STA A   0,X     16 cycles until 'NEXT'
 357 *       STA B   1,X
 358 *       BRA     NEXT
 359 * GETX  LDA A   0,X     18 cycles until 'NEXT'
 360 *       LDA B   1,X
 361 * PUSHBA        PSH B           8 cycles until 'NEXT'
 362 *       PSH A
 363 * PULABX        PUL A           24 cycles until 'NEXT'
 364 *       PUL B
 365 * STABX STA A   0,X     16 cycles until 'NEXT'
 366 *       STA B   1,X
 367 *       BRA     NEXT
 368 * GETX  LDA A   0,X     18 cycles until 'NEXT'
 369 *       LDA B   1,X
 370 *
 371 * =6809= These really aren't all that useful.
 372 PULABX  PULU D
 373 STABX   STD     ,X
 374         BRA     NEXT    ; Used less than seven times.
 375 GETX    LDD     ,X
 376 PUSHBA  PSHU D          ; Used only seven times, saves only 14 bytes.
 377  * Must fall through to NEXT
 378
 379
 380 *
 381 * "NEXT" takes 38 cycles if TRACE is removed,
 382 *
 383 * and 95 cycles if NOT tracing.
 384 *
 385 * = = = = = = =   t h e   v i r t u a l   m a c h i n e   = = = = =
 386 *                                                                 =
 387 * NEXT  LDX     IP
 388 *       INX             pre-increment mode
 389 *       INX
 390 *       STX     IP
 391 * NEXT2 LDX     0,X     get W which points to CFA of word to be done
 392 * NEXT3 STX     W
 393 *       LDX     0,X     get VECT which points to executable code
 394 NEXT    LDX     <IP
 395 NEXTIC  LDY     ,X++
 396         STX     <IP
 397 NEXTSW  STY     <W
 398         JMP     [,Y++]  ; Or use the tracing routine below.
 399 *                                                                 =
 400 * The next instruction could be patched to JMP TRACE              =
 401 * if a TRACE routine is available:                                =
 402 *                                                                 =
 403 * Or add the TRACE routine in-line, since we are assembling it.
 404 *       TST TRACEM
 405         tst     <TRACEM
 406         BEQ NEXTGO
 407 *       STX TRAVEC
 408         sty <TRACEV
 409 *       TSX ; So the funn 6800 stack doesn't beach us.
 410 *       STX TRASP
 411         stu <TRASP
 412 * =JMR= Check these!
 413         LDA A #':'
 414         JSR PEMIT
 415         LDA A #' '
 416         JSR PEMIT
 417 *
 418 *       LDX W
 419 *       DEX
 420 *       DEX ; allocation link
 421 *       DEX ; last char
 422         ldy <W
 423         leay -3,y ; last char
 424         LDA A #31
 425 NAMTST  DEX ; length byte?
 426         LDA B 0,X
 427         BMI NAMTDN
 428         DEC A
 429         BNE NAMTST
 430 NAMTDN  AND B #31 ; It's the length byte whether it wants to be or not.
 431 NAMSHW  INX
 432         LDA A 0,X
 433         JSR PEMIT
 434         DEC B
 435         BNE NAMSHW
 436 * show the virtual registers
 437         LDA A #' '
 438         JSR PEMIT
 439         LDA A #'@'
 440         LDX #TRAVEC
 441         JSR PHEX4F
 442         LDA A #'W'
 443         LDX #W
 444         JSR PHEX4F
 445         LDA A #'I'
 446         JSR PHEX4F
 447         LDA A #'R'
 448         JSR PHEX4F
 449         LDA A #'U'
 450         JSR PHEX4F
 451         LDA A #'S'
 452         LDX #TRASP
 453         BSR PHEX4F
 454         LDA A #'>'
 455         TSX
 456         BSR PHEX4F
 457         LDA A #' '
 458         BSR PHEX4F
 459 *
 460         JSR PCR
 461         LDX TRAVEC
 462 *
 463 * NEXTGO        JMP     0,X
 464 NEXTGO  JMP     [,Y++]
 465 *       NOP
 466 *       JMP     TRACE   ( an alternate for the above )
 467 *                                                                 =
 468 *DBG
 469 PHEX4F  JSR PEMIT
 470         BSR PHEXX2
 471         BSR PHEXX2
 472         LDA A #' '
 473         JSR PEMIT
 474         RTS
 475 PHEXX2  LDA A 0,X
 476         LSR A
 477         LSR A
 478         LSR A
 479         LSR A
 480         JSR PHEXD
 481         LDA A 0,X
 482         JSR PHEXD
 483         INX
 484         RTS
 485 PHEXD   AND A #$0F
 486         CMP A #10
 487         BLO PHEXDH
 488         ADD A #7        ; 'A'-'9'+1
 489 PHEXDH  ADD A #'0'
 490         JSR PEMIT
 491         RTS
 492 *DBG
 493 * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
 494
 495
 496         PAGE
 497 *
 498 * ======>>  1  <<
 499         FCB     $83
 500         FCC     2,LIT   NOTE: this is different from LITERAL
 501         FCB     $D4
 502         FDB     0       link of zero to terminate dictionary scan
 503 LIT     FDB     *+2
 504 *       LDX     IP
 505 *       INX
 506 *       INX
 507 *       STX     IP
 508 *       LDA A   0,X
 509 *       LDA B   1,X
 510 *       JMP     PUSHBA
 511         LDD     ,X++
 512         STX     <IP
 513         JMP     PUSHBA
 514
 515
 516 *
 517 * ######>> screen 14 <<
 518 * ======>>  2  <<
 519 *DBG
 520         FCB     $85
 521         FCC     4,XCLIT ; for debugging
 522         FCB     $D4
 523         FDB     LIT-6   ; should never link
 524 *DBG
 525 CLITER  FDB     *+2      (this is an invisible word, with no header)
 526 *       LDX     IP
 527 *       INX
 528 *       STX     IP
 529 *       CLR A
 530 *       LDA B   1,X
 531 *       JMP     PUSHBA
 532         LDB     ,X+
 533         CLR A
 534         STX     <IP
 535         JMP     PUSHBA
 536 *
 537 * ======>>  3  <<
 538         FCB     $87
 539         FCC     6,EXECUTE
 540         FCB     $C5
 541         FDB     LIT-6
 542 EXEC    FDB     *+2
 543 *       TSX
 544 *       LDX     0,X     get code field address (CFA)
 545 *       INS             pop stack
 546 *       INS
 547 *       JMP     NEXT3
 548         PULU Y
 549         JMP     NEXTSW
 550 *
 551 * ######>> screen 15 <<
 552 * ======>>  4  <<
 553         FCB     $86
 554         FCC     5,BRANCH
 555         FCB     $C8
 556         FDB     EXEC-10
 557 BRAN    FDB     ZBYES   Go steal code in ZBRANCH
 558
 559 *
 560 * ======>>  5  <<
 561         FCB     $87
 562         FCC     6,0BRANCH
 563         FCB     $C8
 564         FDB     BRAN-9
 565 ZBRAN   FDB     *+2
 566 *       PULA
 567 *       PULB
 568 *       ABA
 569 *       BNE     ZBNO
 570 *       BCS     ZBNO
 571         LDD     ,U++    ; set flags
 572         BNE     ZBNO
 573 * ZBYES LDX     <IP     Note: code is shared with BRANCH, (+LOOP), (LOOP)
 574 *       LDA B   3,X
 575 *       LDA A   2,X
 576 *       ADD B   IP+1
 577 *       ADC A   IP
 578 *       STA B   IP+1
 579 *       STA A   IP
 580 *       JMP     NEXT
 581 ZBYES   LDD     ,X      ; X still has IP
 582         LEAX    D,X
 583         JMP     NEXTIC
 584 * ZBNO  LDX     IP      no branch. This code is shared with (+LOOP), (LOOP).
 585 *       INX             jump over branch delta
 586 *       INX
 587 *       STX     IP
 588 *       JMP     NEXT
 589 ZBNO    LEAX    2,X
 590         JMP     NEXTIC
 591 *
 592 * ######>> screen 16 <<
 593 * ======>>  6  <<
 594         FCB     $86
 595         FCC     5,(LOOP)
 596         FCB     $A9
 597         FDB     ZBRAN-10
 598 XLOOP   FDB     *+2
 599 *       CLR A
 600 *       LDA B   #1      get set to increment counter by 1
 601 *       BRA     XPLOP2  go steal other guy's code!
 602         LDD     #1
 603         BRA     XPLOPP
 604 *
 605 * ======>>  7  <<
 606         FCB     $87
 607         FCC     6,(+LOOP)
 608         FCB     $A9
 609         FDB     XLOOP-9
 610 XPLOOP  FDB *+2 Note: +LOOP has an un-signed loop counter
 611 *       PUL A   get increment
 612 *       PUL B
 613 * XPLOP2        TST A
 614 *       BPL     XPLOF   forward looping
 615 *       BSR     XPLOPS
 616 *       SEC
 617 *       SBC B   5,X
 618 *       SBC A   4,X
 619 *       BPL     ZBYES
 620 *       BRA     XPLONO  fall through
 621         LDD     ,U++
 622         BPL     XPLOF
 623         ADDD    ,S
 624         STD     ,S
 625         SUBD    2,S
 626         **** Have to think about this.
 627 *
 628 * the subroutine :
 629 * XPLOPS        LDX     RP
 630 *       ADD B   3,X     add it to counter
 631 *       ADC A   2,X
 632 *       STA B   3,X     store new counter value
 633 *       STA A   2,X
 634 *       RTS
 635 *
 636 XPLOF   BSR     XPLOPS
 637         SUB B   5,X
 638         SBC A   4,X
 639         BMI     ZBYES
 640 *
 641 XPLONO  INX             done, don't branch back
 642         INX
 643         INX
 644         INX
 645         STX     RP
 646         BRA     ZBNO    use ZBRAN to skip over unused delta
 647 *
 648 * ######>> screen 17 <<
 649 * ======>>  8  <<
 650         FCB     $84
 651         FCC     3,(DO)
 652         FCB     $A9
 653         FDB     XPLOOP-10
 654 XDO     FDB     *+2     This is the RUNTIME DO, not the COMPILING DO
 655         LDX     RP
 656         DEX
 657         DEX
 658         DEX
 659         DEX
 660         STX     RP
 661         PUL A
 662         PUL B
 663         STA A   2,X
 664         STA B   3,X
 665         PUL A
 666         PUL B
 667         STA A   4,X
 668         STA B   5,X
 669         JMP     NEXT
 670 *
 671 * ======>>  9  <<
 672         FCB     $81     I
 673         FCB     $C9
 674         FDB     XDO-7
 675 I       FDB     *+2
 676         LDX     RP
 677         INX
 678         INX
 679         JMP     GETX
 680 *
 681 * ######>> screen 18 <<
 682 * ======>>  10  <<
 683         FCB     $85
 684         FCC     4,DIGIT
 685         FCB     $D4
 686         FDB     I-4
 687 DIGIT   FDB     *+2     NOTE: legal input range is 0-9, A-Z
 688         TSX
 689         LDA A   3,X
 690         SUB A   #$30    ascii zero
 691         BMI     DIGIT2  IF LESS THAN '0', ILLEGAL
 692         CMP A   #$A
 693         BMI     DIGIT0  IF '9' OR LESS
 694         CMP A   #$11
 695         BMI     DIGIT2  if less than 'A'
 696         CMP A   #$2B
 697         BPL     DIGIT2  if greater than 'Z'
 698         SUB A   #7      translate 'A' thru 'F'
 699 DIGIT0  CMP A   1,X
 700         BPL     DIGIT2  if not less than the base
 701         LDA B   #1      set flag
 702         STA A   3,X     store digit
 703 DIGIT1  STA B   1,X     store the flag
 704         JMP     NEXT
 705 DIGIT2  CLR B
 706         INS
 707         INS     pop bottom number
 708         TSX
 709         STA B   0,X     make sure both bytes are 00
 710         BRA     DIGIT1
 711 *
 712 * ######>> screen 19 <<
 713 *
 714 * The word format in the dictionary is:
 715 *
 716 * char-count + $80      lowest address
 717 * char 1
 718 * char 2
 719 *
 720 * char n  + $80
 721 * link high byte \___point to previous word
 722 * link low  byte /
 723 * CFA  high byte \___pnt to 6800 code
 724 * CFA  low  byte /
 725 * parameter fields
 726 *    "
 727 *    "
 728 *    "
 729 *
 730 * ======>>  11  <<
 731         FCB     $86
 732         FCC     5,(FIND)
 733         FCB     $A9
 734         FDB     DIGIT-8
 735 PFIND   FDB     *+2
 736         NOP
 737         NOP
 738 PD      EQU     N       ptr to dict word being checked
 739 PA0     EQU     N+2
 740 PA      EQU     N+4
 741 PC      EQU     N+6
 742         LDX     #PD
 743         LDA B   #4
 744 PFIND0  PUL A           loop to get arguments
 745         STA A   0,X
 746         INX
 747         DEC B
 748         BNE     PFIND0
 749 *
 750         LDX     PD
 751 PFIND1  LDA B   0,X     get count dict count
 752         STA B   PC
 753         AND B   #$3F
 754         INX
 755         STX     PD      update PD
 756         LDX     PA0
 757         LDA A   0,X     get count from arg
 758         INX
 759         STX     PA      intialize PA
 760         CBA             compare lengths
 761         BNE     PFIND4
 762 PFIND2  LDX     PA
 763         LDA A   0,X
 764         INX
 765         STX     PA
 766         LDX     PD
 767         LDA B   0,X
 768         INX
 769         STX     PD
 770         TST B           is dict entry neg. ?
 771         BPL     PFIND8
 772         AND B   #$7F    clear sign
 773         CBA
 774         BEQ     FOUND
 775 PFIND3  LDX     0,X     get new link
 776         BNE     PFIND1  continue if link not=0
 777 *
 778 *       not found :
 779 *
 780         CLR A
 781         CLR B
 782         JMP     PUSHBA
 783 PFIND8  CBA
 784         BEQ     PFIND2
 785 PFIND4  LDX     PD
 786 PFIND9  LDA B   0,X     scan forward to end of this name
 787         INX
 788         BPL     PFIND9
 789         BRA     PFIND3
 790 *
 791 *       found :
 792 *
 793 FOUND   LDA A   PD      compute CFA
 794         LDA B   PD+1
 795         ADD B   #4
 796         ADC A   #0
 797         PSH B
 798         PSH A
 799         LDA A   PC
 800         PSH A
 801         CLR A
 802         PSH A
 803         LDA B   #1
 804         JMP     PUSHBA
 805 *
 806         PSH A
 807         CLR A
 808         PSH A
 809         LDA B   #1
 810         JMP     PUSHBA
 811 *
 812 * ######>> screen 20 <<
 813 * ======>>  12  <<
 814         FCB     $87
 815         FCC     6,ENCLOSE
 816         FCB     $C5
 817         FDB     PFIND-9
 818 * NOTE :
 819 * FC means offset (bytes) to First Character of next word
 820 * EW  "     "   to End of Word
 821 * NC  "     "   to Next Character to start next enclose at
 822 ENCLOS  FDB     *+2
 823         INS
 824         PUL B           now, get the low byte, for an 8-bit delimiter
 825         TSX
 826         LDX     0,X
 827         CLR     N
 828 *       wait for a non-delimiter or a NUL
 829 ENCL2   LDA A   0,X
 830         BEQ     ENCL6
 831         CBA             CHECK FOR DELIM
 832         BNE     ENCL3
 833         INX
 834         INC     N
 835         BRA     ENCL2
 836 *       found first character. Push FC
 837 ENCL3   LDA A   N       found first char.
 838         PSH A
 839         CLR A
 840         PSH A
 841 *       wait for a delimiter or a NUL
 842 ENCL4   LDA A   0,X
 843         BEQ     ENCL7
 844         CBA             ckech for delim.
 845         BEQ     ENCL5
 846         INX
 847         INC     N
 848         BRA     ENCL4
 849 *       found EW. Push it
 850 ENCL5   LDA B   N
 851         CLR A
 852         PSH B
 853         PSH A
 854 *       advance and push NC
 855         INC B
 856         JMP     PUSHBA
 857 *       found NUL before non-delimiter, therefore there is no word
 858 ENCL6   LDA B   N       found NUL
 859         PSH B
 860         PSH A
 861         INC B
 862         BRA     ENCL7+2
 863 *       found NUL following the word instead of SPACE
 864 ENCL7   LDA B   N
 865         PSH B           save EW
 866         PSH A
 867 ENCL8   LDA B   N       save NC
 868         JMP     PUSHBA
 869
 870         PAGE
 871 *
 872 * ######>> screen 21 <<
 873 * The next 4 words call system dependant I/O routines
 874 * which are listed after word "-->" ( lable: "arrow" )
 875 * in the dictionary.
 876 *
 877 * ======>>  13  <<
 878         FCB     $84
 879         FCC     3,EMIT
 880         FCB     $D4
 881         FDB     ENCLOS-10
 882 EMIT    FDB     *+2
 883         PUL A
 884         PUL A
 885         JSR     PEMIT
 886         LDX     UP
 887         INC     XOUT+1-UORIG,X
 888         BNE     *+4
 889         INC     XOUT-UORIG,X
 890         JMP     NEXT
 891 *
 892 * ======>>  14  <<
 893         FCB     $83
 894         FCC     2,KEY
 895         FCB     $D9
 896         FDB     EMIT-7
 897 KEY     FDB     *+2
 898         JSR     PKEY
 899         PSH A
 900         CLR A
 901         PSH A
 902         JMP     NEXT
 903 *
 904 * ======>>  15  <<
 905         FCB     $89
 906         FCC     8,?TERMINAL
 907         FCB     $CC
 908         FDB     KEY-6
 909 QTERM   FDB     *+2
 910         JSR     PQTER
 911         CLR B
 912         JMP     PUSHBA  stack the flag
 913 *
 914 * ======>>  16  <<
 915         FCB     $82
 916         FCC     1,CR
 917         FCB     $D2
 918         FDB     QTERM-12
 919 CR      FDB     *+2
 920         JSR     PCR
 921         JMP     NEXT
 922 *
 923 * ######>> screen 22 <<
 924 * ======>>  17  <<
 925         FCB     $85
 926         FCC     4,CMOVE source, destination, count
 927         FCB     $C5
 928         FDB     CR-5
 929 CMOVE   FDB     *+2     takes ( 43+47*count cycles )
 930         LDX     #N
 931         LDA B   #6
 932 CMOV1   PUL A
 933         STA A   0,X     move parameters to scratch area
 934         INX
 935         DEC B
 936         BNE     CMOV1
 937 CMOV2   LDA A   N
 938         LDA B   N+1
 939         SUB B   #1
 940         SBC A   #0
 941         STA A   N
 942         STA B   N+1
 943         BCS     CMOV3
 944         LDX     N+4
 945         LDA A   0,X
 946         INX
 947         STX     N+4
 948         LDX     N+2
 949         STA A   0,X
 950         INX
 951         STX     N+2
 952         BRA     CMOV2
 953 CMOV3   JMP     NEXT
 954 *
 955 * ######>> screen 23 <<
 956 * ======>>  18  <<
 957         FCB     $82
 958         FCC     1,U*
 959         FCB     $AA
 960         FDB     CMOVE-8
 961 USTAR   FDB     *+2
 962         BSR     USTARS
 963         INS
 964         INS
 965         JMP     PUSHBA
 966 *
 967 * The following is a subroutine which
 968 * multiplies top 2 words on stack,
 969 * leaving 32-bit result:  high order word in A,B
 970 * low order word in 2nd word of stack.
 971 *
 972 USTARS  LDA A   #16     bits/word counter
 973         PSH A
 974         CLR A
 975         CLR B
 976         TSX
 977 USTAR2  ROR     5,X     shift multiplier
 978         ROR     6,X
 979         DEC     0,X     done?
 980         BMI     USTAR4
 981         BCC     USTAR3
 982         ADD B   4,X
 983         ADC A   3,X
 984 USTAR3  ROR A
 985         ROR B           shift result
 986         BRA     USTAR2
 987 USTAR4  INS             dump counter
 988         RTS
 989 *
 990 * ######>> screen 24 <<
 991 * ======>>  19  <<
 992         FCB     $82
 993         FCC     1,U/
 994         FCB     $AF
 995         FDB     USTAR-5
 996 USLASH  FDB     *+2
 997         LDA A   #17
 998         PSH A
 999         TSX
1000         LDA A   3,X
1001         LDA B   4,X
1002 USL1    CMP A   1,X
1003         BHI     USL3
1004         BCS     USL2
1005         CMP B   2,X
1006         BCC     USL3
1007 USL2    CLC
1008         BRA     USL4
1009 USL3    SUB B   2,X
1010         SBC A   1,X
1011         SEC
1012 USL4    ROL     6,X
1013         ROL     5,X
1014         DEC     0,X
1015         BEQ     USL5
1016         ROL B
1017         ROL A
1018         BCC     USL1
1019         BRA     USL3
1020 USL5    INS
1021         INS
1022         INS
1023         INS
1024         INS
1025         JMP     SWAP+4  reverse quotient & remainder
1026 *
1027 * ######>> screen 25 <<
1028 * ======>>  20  <<
1029         FCB     $83
1030         FCC     2,AND
1031         FCB     $C4
1032         FDB     USLASH-5
1033 AND     FDB     *+2
1034         PUL A
1035         PUL B
1036         TSX
1037         AND B   1,X
1038         AND A   0,X
1039         JMP     STABX
1040 *
1041 * ======>>  21  <<
1042         FCB     $82
1043         FCC     1,OR
1044         FCB     $D2
1045         FDB     AND-6
1046 OR      FDB     *+2
1047         PUL A
1048         PUL B
1049         TSX
1050         ORA B   1,X
1051         ORA A   0,X
1052         JMP     STABX
1053 *
1054 * ======>>  22  <<
1055         FCB     $83
1056         FCC     2,XOR
1057         FCB     $D2
1058         FDB     OR-5
1059 XOR     FDB     *+2
1060         PUL A
1061         PUL B
1062         TSX
1063         EOR B   1,X
1064         EOR A   0,X
1065         JMP     STABX
1066 *
1067 * ######>> screen 26 <<
1068 * ======>>  23  <<
1069         FCB     $83
1070         FCC     2,SP@
1071         FCB     $C0
1072         FDB     XOR-6
1073 SPAT    FDB     *+2
1074         TSX
1075         STX     N       scratch area
1076         LDX     #N
1077         JMP     GETX
1078 *
1079 * ======>>  24  <<
1080         FCB     $83
1081         FCC     2,SP!
1082         FCB     $A1
1083         FDB     SPAT-6
1084 SPSTOR  FDB     *+2
1085         LDX     UP
1086         LDX     XSPZER-UORIG,X
1087         TXS             watch it ! X and S are not equal.
1088         JMP     NEXT
1089 * ======>>  25  <<
1090         FCB     $83
1091         FCC     2,RP!
1092         FCB     $A1
1093         FDB     SPSTOR-6
1094 RPSTOR  FDB     *+2
1095         LDX     RINIT   initialize from rom constant
1096         STX     RP
1097         JMP     NEXT
1098 *
1099 * ======>>  26  <<
1100         FCB     $82
1101         FCC     1,;S
1102         FCB     $D3
1103         FDB     RPSTOR-6
1104 SEMIS   FDB     *+2
1105         LDX     RP
1106         INX
1107         INX
1108         STX     RP
1109         LDX     0,X     get address we have just finished.
1110         JMP     NEXT+2  increment the return address & do next word
1111 *
1112 * ######>> screen 27 <<
1113 * ======>>  27  <<
1114         FCB     $85
1115         FCC     4,LEAVE
1116         FCB     $C5
1117         FDB     SEMIS-5
1118 LEAVE   FDB     *+2
1119         LDX     RP
1120         LDA A   2,X
1121         LDA B   3,X
1122         STA A   4,X
1123         STA B   5,X
1124         JMP     NEXT
1125 *
1126 * ======>>  28  <<
1127         FCB     $82
1128         FCC     1,>R
1129         FCB     $D2
1130         FDB     LEAVE-8
1131 TOR     FDB     *+2
1132         LDX     RP
1133         DEX
1134         DEX
1135         STX     RP
1136         PUL A
1137         PUL B
1138         STA A   2,X
1139         STA B   3,X
1140         JMP     NEXT
1141 *
1142 * ======>>  29  <<
1143         FCB     $82
1144         FCC     1,R>
1145         FCB     $BE
1146         FDB     TOR-5
1147 FROMR   FDB     *+2
1148         LDX     RP
1149         LDA A   2,X
1150         LDA B   3,X
1151         INX
1152         INX
1153         STX     RP
1154         JMP     PUSHBA
1155 *
1156 * ======>>  30  <<
1157         FCB     $81     R
1158         FCB     $D2
1159         FDB     FROMR-5
1160 R       FDB     *+2
1161         LDX     RP
1162         INX
1163         INX
1164         JMP     GETX
1165 *
1166 * ######>> screen 28 <<
1167 * ======>>  31  <<
1168         FCB     $82
1169         FCC     1,0=
1170         FCB     $BD
1171         FDB     R-4
1172 ZEQU    FDB     *+2
1173         TSX
1174         CLR A
1175         CLR B
1176         LDX     0,X
1177         BNE     ZEQU2
1178         INC B
1179 ZEQU2   TSX
1180         JMP     STABX
1181 *
1182 * ======>>  32  <<
1183         FCB     $82
1184         FCC     1,0<
1185         FCB     $BC
1186         FDB     ZEQU-5
1187 ZLESS   FDB     *+2
1188         TSX
1189         LDA A   #$80    check the sign bit
1190         AND A   0,X
1191         BEQ     ZLESS2
1192         CLR A           if neg.
1193         LDA B #1
1194         JMP     STABX
1195 ZLESS2  CLR B
1196         JMP     STABX
1197 *
1198 * ######>> screen 29 <<
1199 * ======>>  33  <<
1200         FCB     $81     '+'
1201         FCB     $AB
1202         FDB     ZLESS-5
1203 PLUS    FDB     *+2
1204         PUL A
1205         PUL B
1206         TSX
1207         ADD B   1,X
1208         ADC A   0,X
1209         JMP     STABX
1210 *
1211 * ======>>  34  <<
1212         FCB     $82
1213         FCC     1,D+
1214         FCB     $AB
1215         FDB     PLUS-4
1216 DPLUS   FDB     *+2
1217         TSX
1218         CLC
1219         LDA B   #4
1220 DPLUS2  LDA A   3,X
1221         ADC A   7,X
1222         STA A   7,X
1223         DEX
1224         DEC B
1225         BNE     DPLUS2
1226         INS
1227         INS
1228         INS
1229         INS
1230         JMP     NEXT
1231 *
1232 * ======>>  35  <<
1233         FCB     $85
1234         FCC     4,MINUS
1235         FCB     $D3
1236         FDB     DPLUS-5
1237 MINUS   FDB     *+2
1238         TSX
1239         NEG     1,X
1240         BCC     MINUS2
1241         NEG     0,X
1242         BRA     MINUS3
1243 MINUS2  COM     0,X
1244 MINUS3  JMP     NEXT
1245 *
1246 * ======>>  36  <<
1247         FCB     $86
1248         FCC     5,DMINUS
1249         FCB     $D3
1250         FDB     MINUS-8
1251 DMINUS  FDB     *+2
1252         TSX
1253         COM     0,X
1254         COM     1,X
1255         COM     2,X
1256         NEG     3,X
1257         BNE     DMINX
1258         INC     2,X
1259         BNE     DMINX
1260         INC     1,X
1261         BNE     DMINX
1262         INC     0,X
1263 DMINX   JMP     NEXT
1264 *
1265 * ######>> screen 30 <<
1266 * ======>>  37  <<
1267         FCB     $84
1268         FCC     3,OVER
1269         FCB     $D2
1270         FDB     DMINUS-9
1271 OVER    FDB     *+2
1272         TSX
1273         LDA A   2,X
1274         LDA B   3,X
1275         JMP     PUSHBA
1276 *
1277 * ======>>  38  <<
1278         FCB     $84
1279         FCC     3,DROP
1280         FCB     $D0
1281         FDB     OVER-7
1282 DROP    FDB     *+2
1283         INS
1284         INS
1285         JMP     NEXT
1286 *
1287 * ======>>  39  <<
1288         FCB     $84
1289         FCC     3,SWAP
1290         FCB     $D0
1291         FDB     DROP-7
1292 SWAP    FDB     *+2
1293         PUL A
1294         PUL B
1295         TSX
1296         LDX     0,X
1297         INS
1298         INS
1299         PSH B
1300         PSH A
1301         STX     N
1302         LDX     #N
1303         JMP     GETX
1304 *
1305 * ======>>  40  <<
1306         FCB     $83
1307         FCC     2,DUP
1308         FCB     $D0
1309         FDB     SWAP-7
1310 DUP     FDB     *+2
1311         PUL A
1312         PUL B
1313         PSH B
1314         PSH A
1315         JMP PUSHBA
1316 *
1317 * ######>> screen 31 <<
1318 * ======>>  41  <<
1319         FCB     $82
1320         FCC     1,+!
1321         FCB     $A1
1322         FDB     DUP-6
1323 PSTORE  FDB     *+2
1324         TSX
1325         LDX     0,X
1326         INS
1327         INS
1328         PUL A           get stack data
1329         PUL B
1330         ADD B   1,X     add & store low byte
1331         STA B   1,X
1332         ADC A   0,X     add & store hi byte
1333         STA A   0,X
1334         JMP     NEXT
1335 *
1336 * ======>>  42  <<
1337         FCB     $86
1338         FCC     5,TOGGLE
1339         FCB     $C5
1340         FDB     PSTORE-5
1341 TOGGLE  FDB     DOCOL,OVER,CAT,XOR,SWAP,CSTORE
1342         FDB     SEMIS
1343 *
1344 * ######>> screen 32 <<
1345 * ======>>  43  <<
1346         FCB     $81     @
1347         FCB     $C0
1348         FDB     TOGGLE-9
1349 AT      FDB     *+2
1350         TSX
1351         LDX     0,X     get address
1352         INS
1353         INS
1354         JMP     GETX
1355 *
1356 * ======>>  44  <<
1357         FCB     $82
1358         FCC     1,C@
1359         FCB     $C0
1360         FDB     AT-4
1361 CAT     FDB     *+2
1362         TSX
1363         LDX     0,X
1364         CLR A
1365         LDA B   0,X
1366         INS
1367         INS
1368         JMP     PUSHBA
1369 *
1370 * ======>>  45  <<
1371         FCB     $81
1372         FCB     $A1
1373         FDB     CAT-5
1374 STORE   FDB     *+2
1375         TSX
1376         LDX     0,X     get address
1377         INS
1378         INS
1379         JMP     PULABX
1380 *
1381 * ======>>  46  <<
1382         FCB     $82
1383         FCC     1,C!
1384         FCB     $A1
1385         FDB     STORE-4
1386 CSTORE  FDB     *+2
1387         TSX
1388         LDX     0,X     get address
1389         INS
1390         INS
1391         INS
1392         PUL B
1393         STA B   0,X
1394         JMP     NEXT
1395         PAGE
1396 *
1397 * ######>> screen 33 <<
1398 * ======>>  47  <<
1399         FCB     $C1     : immediate
1400         FCB     $BA
1401         FDB     CSTORE-5
1402 COLON   FDB     DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
1403         FDB     CREATE,RBRAK
1404         FDB     PSCODE
1405
1406 * Here is the IP pusher for allowing
1407 * nested words in the virtual machine:
1408 * ( ;S is the equivalent un-nester )
1409
1410 DOCOL   LDX     RP      make room in the stack
1411         DEX
1412         DEX
1413         STX     RP
1414         LDA A   IP
1415         LDA B   IP+1
1416         STA A   2,X     Store address of the high level word
1417         STA B   3,X     that we are starting to execute
1418         LDX     W       Get first sub-word of that definition
1419         JMP     NEXT+2  and execute it
1420 *
1421 * ======>>  48  <<
1422         FCB     $C1     ;   imnediate code
1423         FCB     $BB
1424         FDB     COLON-4
1425 SEMI    FDB     DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
1426         FDB     SEMIS
1427 *
1428 * ######>> screen 34 <<
1429 * ======>>  49  <<
1430         FCB     $88
1431         FCC     7,CONSTANT
1432         FCB     $D4
1433         FDB     SEMI-4
1434 CON     FDB     DOCOL,CREATE,SMUDGE,COMMA,PSCODE
1435 DOCON   LDX     W
1436         LDA A   2,X
1437         LDA B   3,X     A & B now contain the constant
1438         JMP     PUSHBA
1439 *
1440 * ======>>  50  <<
1441         FCB     $88
1442         FCC     7,VARIABLE
1443         FCB     $C5
1444         FDB     CON-11
1445 VAR     FDB     DOCOL,CON,PSCODE
1446 DOVAR   LDA A   W
1447         LDA B   W+1
1448         ADD B   #2
1449         ADC A   #0      A,B now contain the address of the variable
1450         JMP     PUSHBA
1451 *
1452 * ======>>  51  <<
1453         FCB     $84
1454         FCC     3,USER
1455         FCB     $D2
1456         FDB     VAR-11
1457 USER    FDB     DOCOL,CON,PSCODE
1458 DOUSER  LDX     W       get offset  into user's table
1459         LDA A   2,X
1460         LDA B   3,X
1461         ADD B   UP+1    add to users base address
1462         ADC A   UP
1463         JMP     PUSHBA  push address of user's variable
1464 *
1465 * ######>> screen 35 <<
1466 * ======>>  52  <<
1467         FCB     $81
1468         FCB     $B0     0
1469         FDB     USER-7
1470 ZERO    FDB     DOCON
1471         FDB     0000
1472 *
1473 * ======>>  53  <<
1474         FCB     $81
1475         FCB     $B1     1
1476         FDB     ZERO-4
1477 ONE     FDB     DOCON
1478         FDB     1
1479 *
1480 * ======>>  54  <<
1481         FCB     $81
1482         FCB     $B2     2
1483         FDB     ONE-4
1484 TWO     FDB     DOCON
1485         FDB     2
1486 *
1487 * ======>>  55  <<
1488         FCB     $81
1489         FCB     $B3     3
1490         FDB     TWO-4
1491 THREE   FDB     DOCON
1492         FDB     3
1493 *
1494 * ======>>  56  <<
1495         FCB     $82
1496         FCC     1,BL
1497         FCB     $CC
1498         FDB     THREE-4
1499 BL      FDB     DOCON   ascii blank
1500         FDB     $20
1501 *
1502 * ======>>  57  <<
1503         FCB     $85
1504         FCC     4,FIRST
1505         FCB     $D4
1506         FDB     BL-5
1507 FIRST   FDB     DOCON
1508         FDB     MEMEND-528      (132 * NBLK)
1509 *
1510 * ======>>  58  <<
1511         FCB     $85
1512         FCC     4,LIMIT ( the end of memory +1 )
1513         FCB     $D4
1514         FDB     FIRST-8
1515 LIMIT   FDB     DOCON
1516         FDB     MEMEND
1517 *
1518 * ======>>  59  <<
1519         FCB     $85
1520         FCC     4,B/BUF (bytes/buffer)
1521         FCB     $C6
1522         FDB     LIMIT-8
1523 BBUF    FDB     DOCON
1524         FDB     128
1525 *
1526 * ======>>  60  <<
1527         FCB     $85
1528         FCC     4,B/SCR (blocks/screen)
1529         FCB     $D2
1530         FDB     BBUF-8
1531 BSCR    FDB     DOCON
1532         FDB     8
1533 *       blocks/screen = 1024 / "B/BUF" = 8
1534 *
1535 * ======>>  61  <<
1536         FCB     $87
1537         FCC     6,+ORIGIN
1538         FCB     $CE
1539         FDB     BSCR-8
1540 PORIG   FDB     DOCOL,LIT,ORIG,PLUS
1541         FDB     SEMIS
1542 *
1543 * ######>> screen 36 <<
1544 * ======>>  62  <<
1545         FCB     $82
1546         FCC     1,S0
1547         FCB     $B0
1548         FDB     PORIG-10
1549 SZERO   FDB     DOUSER
1550         FDB     XSPZER-UORIG
1551 *
1552 * ======>>  63  <<
1553         FCB     $82
1554         FCC     1,R0
1555         FCB     $B0
1556         FDB     SZERO-5
1557 RZERO   FDB     DOUSER
1558         FDB     XRZERO-UORIG
1559 *
1560 * ======>>  64  <<
1561         FCB     $83
1562         FCC     2,TIB
1563         FCB     $C2
1564         FDB     RZERO-5
1565 TIB     FDB     DOUSER
1566         FDB     XTIB-UORIG
1567 *
1568 * ======>>  65  <<
1569         FCB     $85
1570         FCC     4,WIDTH
1571         FCB     $C8
1572         FDB     TIB-6
1573 WIDTH   FDB     DOUSER
1574         FDB     XWIDTH-UORIG
1575 *
1576 * ======>>  66  <<
1577         FCB     $87
1578         FCC     6,WARNING
1579         FCB     $C7
1580         FDB     WIDTH-8
1581 WARN    FDB     DOUSER
1582         FDB     XWARN-UORIG
1583 *
1584 * ======>>  67  <<
1585         FCB     $85
1586         FCC     4,FENCE
1587         FCB     $C5
1588         FDB     WARN-10
1589 FENCE   FDB     DOUSER
1590         FDB     XFENCE-UORIG
1591 *
1592 * ======>>  68  <<
1593         FCB     $82
1594         FCC     1,DP    points to first free byte at end of dictionary
1595         FCB     $D0
1596         FDB     FENCE-8
1597 DP      FDB     DOUSER
1598         FDB     XDP-UORIG
1599 *
1600 * ======>>  68.5  <<
1601         FCB     $88
1602         FCC     7,VOC-LINK
1603         FCB     $CB
1604         FDB     DP-5
1605 VOCLIN  FDB     DOUSER
1606         FDB     XVOCL-UORIG
1607 *
1608 * ======>>  69  <<
1609         FCB     $83
1610         FCC     2,BLK
1611         FCB     $CB
1612         FDB     VOCLIN-11
1613 BLK     FDB     DOUSER
1614         FDB     XBLK-UORIG
1615 *
1616 * ======>>  70  <<
1617         FCB     $82
1618         FCC     1,IN    scan pointer for input line buffer
1619         FCB     $CE
1620         FDB     BLK-6
1621 IN      FDB     DOUSER
1622         FDB     XIN-UORIG
1623 *
1624 * ======>>  71  <<
1625         FCB     $83
1626         FCC     2,OUT
1627         FCB     $D4
1628         FDB     IN-5
1629 OUT     FDB     DOUSER
1630         FDB     XOUT-UORIG
1631 *
1632 * ======>>  72  <<
1633         FCB     $83
1634         FCC     2,SCR
1635         FCB     $D2
1636         FDB     OUT-6
1637 SCR     FDB     DOUSER
1638         FDB     XSCR-UORIG
1639 * ######>> screen 37 <<
1640 *
1641 * ======>>  73  <<
1642         FCB     $86
1643         FCC     5,OFFSET
1644         FCB     $D4
1645         FDB     SCR-6
1646 OFSET   FDB     DOUSER
1647         FDB     XOFSET-UORIG
1648 *
1649 * ======>>  74  <<
1650         FCB     $87
1651         FCC     6,CONTEXT       points to pointer to vocab to search first
1652         FCB     $D4
1653         FDB     OFSET-9
1654 CONTXT  FDB     DOUSER
1655         FDB     XCONT-UORIG
1656 *
1657 * ======>>  75  <<
1658         FCB     $87
1659         FCC     6,CURRENT       points to ptr. to vocab being extended
1660         FCB     $D4
1661         FDB     CONTXT-10
1662 CURENT  FDB     DOUSER
1663         FDB     XCURR-UORIG
1664 *
1665 * ======>>  76  <<
1666         FCB     $85
1667         FCC     4,STATE 1 if compiling, 0 if not
1668         FCB     $C5
1669         FDB     CURENT-10
1670 STATE   FDB     DOUSER
1671         FDB     XSTATE-UORIG
1672 *
1673 * ======>>  77  <<
1674         FCB     $84
1675         FCC     3,BASE  number base for all input & output
1676         FCB     $C5
1677         FDB     STATE-8
1678 BASE    FDB     DOUSER
1679         FDB     XBASE-UORIG
1680 *
1681 * ======>>  78  <<
1682         FCB     $83
1683         FCC     2,DPL
1684         FCB     $CC
1685         FDB     BASE-7
1686 DPL     FDB     DOUSER
1687         FDB     XDPL-UORIG
1688 *
1689 * ======>>  79  <<
1690         FCB     $83
1691         FCC     2,FLD
1692         FCB     $C4
1693         FDB     DPL-6
1694 FLD     FDB     DOUSER
1695         FDB     XFLD-UORIG
1696 *
1697 * ======>>  80  <<
1698         FCB     $83
1699         FCC     2,CSP
1700         FCB     $D0
1701         FDB     FLD-6
1702 CSP     FDB     DOUSER
1703         FDB     XCSP-UORIG
1704 *
1705 * ======>>  81  <<
1706         FCB     $82
1707         FCC     1,R#
1708         FCB     $A3
1709         FDB     CSP-6
1710 RNUM    FDB     DOUSER
1711         FDB     XRNUM-UORIG
1712 *
1713 * ======>>  82  <<
1714         FCB     $83
1715         FCC     2,HLD
1716         FCB     $C4
1717         FDB     RNUM-5
1718 HLD     FDB     DOCON
1719         FDB     XHLD
1720 *
1721 * ======>>  82.5  <<== SPECIAL
1722         FCB     $87
1723         FCC     6,COLUMNS       line width of terminal
1724         FCB     $D3
1725         FDB     HLD-6
1726 COLUMS  FDB     DOUSER
1727         FDB     XCOLUM-UORIG
1728 *
1729 * ######>> screen 38 <<
1730 * ======>>  83  <<
1731         FCB     $82
1732         FCC     1,1+
1733         FCB     $AB
1734         FDB     COLUMS-10
1735 ONEP    FDB     DOCOL,ONE,PLUS
1736         FDB     SEMIS
1737 *
1738 * ======>>  84  <<
1739         FCB     $82
1740         FCC     1,2+
1741         FCB     $AB
1742         FDB     ONEP-5
1743 TWOP    FDB     DOCOL,TWO,PLUS
1744         FDB     SEMIS
1745 *
1746 * ======>>  85  <<
1747         FCB     $84
1748         FCC     3,HERE
1749         FCB     $C5
1750         FDB     TWOP-5
1751 HERE    FDB     DOCOL,DP,AT
1752         FDB     SEMIS
1753 *
1754 * ======>>  86  <<
1755         FCB     $85
1756         FCC     4,ALLOT
1757         FCB     $D4
1758         FDB     HERE-7
1759 ALLOT   FDB     DOCOL,DP,PSTORE
1760         FDB     SEMIS
1761 *
1762 * ======>>  87  <<
1763         FCB     $81     ; , (COMMA)
1764         FCB     $AC
1765         FDB     ALLOT-8
1766 COMMA   FDB     DOCOL,HERE,STORE,TWO,ALLOT
1767         FDB     SEMIS
1768 *
1769 * ======>>  88  <<
1770         FCB     $82
1771         FCC     1,C,
1772         FCB     $AC
1773         FDB     COMMA-4
1774 CCOMM   FDB     DOCOL,HERE,CSTORE,ONE,ALLOT
1775         FDB     SEMIS
1776 *
1777 * ======>>  89  <<
1778         FCB     $81     ; -
1779         FCB     $AD
1780         FDB     CCOMM-5
1781 SUB     FDB     DOCOL,MINUS,PLUS
1782         FDB     SEMIS
1783 *
1784 * ======>>  90  <<
1785         FCB     $81     =
1786         FCB     $BD
1787         FDB     SUB-4
1788 EQUAL   FDB     DOCOL,SUB,ZEQU
1789         FDB     SEMIS
1790 *
1791 * ======>>  91  <<
1792         FCB     $81     <
1793         FCB     $BC
1794         FDB     EQUAL-4
1795 LESS    FDB     *+2
1796         PUL A
1797         PUL B
1798         TSX
1799         CMP A   0,X
1800         INS
1801         BGT     LESST
1802         BNE     LESSF
1803         CMP B   1,X
1804         BHI     LESST
1805 LESSF   CLR B
1806         BRA     LESSX
1807 LESST   LDA B   #1
1808 LESSX   CLR A
1809         INS
1810         JMP     PUSHBA
1811 *
1812 * ======>>  92  <<
1813         FCB     $81     >
1814         FCB     $BE
1815         FDB     LESS-4
1816 GREAT   FDB     DOCOL,SWAP,LESS
1817         FDB     SEMIS
1818 *
1819 * ======>>  93  <<
1820         FCB     $83
1821         FCC     2,ROT
1822         FCB     $D4
1823         FDB     GREAT-4
1824 ROT     FDB     DOCOL,TOR,SWAP,FROMR,SWAP
1825         FDB     SEMIS
1826 *
1827 * ======>>  94  <<
1828         FCB     $85
1829         FCC     4,SPACE
1830         FCB     $C5
1831         FDB     ROT-6
1832 SPACE   FDB     DOCOL,BL,EMIT
1833         FDB     SEMIS
1834 *
1835 * ======>>  95  <<
1836         FCB     $83
1837         FCC     2,MIN
1838         FCB     $CE
1839         FDB     SPACE-8
1840 MIN     FDB     DOCOL,OVER,OVER,GREAT,ZBRAN
1841         FDB     MIN2-*
1842         FDB     SWAP
1843 MIN2    FDB     DROP
1844         FDB     SEMIS
1845 *
1846 * ======>>  96  <<
1847         FCB     $83
1848         FCC     2,MAX
1849         FCB     $D8
1850         FDB     MIN-6
1851 MAX     FDB     DOCOL,OVER,OVER,LESS,ZBRAN
1852         FDB     MAX2-*
1853         FDB     SWAP
1854 MAX2    FDB     DROP
1855         FDB     SEMIS
1856 *
1857 * ======>>  97  <<
1858         FCB     $84
1859         FCC     3,-DUP
1860         FCB     $D0
1861         FDB     MAX-6
1862 DDUP    FDB     DOCOL,DUP,ZBRAN
1863         FDB     DDUP2-*
1864         FDB     DUP
1865 DDUP2   FDB     SEMIS
1866 *
1867 * ######>> screen 39 <<
1868 * ======>>  98  <<
1869         FCB     $88
1870         FCC     7,TRAVERSE
1871         FCB     $C5
1872         FDB     DDUP-7
1873 TRAV    FDB     DOCOL,SWAP
1874 TRAV2   FDB     OVER,PLUS,CLITER
1875         FCB     $7F
1876         FDB     OVER,CAT,LESS,ZBRAN
1877         FDB     TRAV2-*
1878         FDB     SWAP,DROP
1879         FDB     SEMIS
1880 *
1881 * ======>>  99  <<
1882         FCB     $86
1883         FCC     5,LATEST
1884         FCB     $D4
1885         FDB     TRAV-11
1886 LATEST  FDB     DOCOL,CURENT,AT,AT
1887         FDB     SEMIS
1888 *
1889 * ======>>  100  <<
1890         FCB     $83
1891         FCC     2,LFA
1892         FCB     $C1
1893         FDB     LATEST-9
1894 LFA     FDB     DOCOL,CLITER
1895         FCB     4
1896         FDB     SUB
1897         FDB     SEMIS
1898 *
1899 * ======>>  101  <<
1900         FCB     $83
1901         FCC     2,CFA
1902         FCB     $C1
1903         FDB     LFA-6
1904 CFA     FDB     DOCOL,TWO,SUB
1905         FDB     SEMIS
1906 *
1907 * ======>>  102  <<
1908         FCB     $83
1909         FCC     2,NFA
1910         FCB     $C1
1911         FDB     CFA-6
1912 NFA     FDB     DOCOL,CLITER
1913         FCB     5
1914         FDB     SUB,ONE,MINUS,TRAV
1915         FDB     SEMIS
1916 *
1917 * ======>>  103  <<
1918         FCB     $83
1919         FCC     2,PFA
1920         FCB     $C1
1921         FDB     NFA-6
1922 PFA     FDB     DOCOL,ONE,TRAV,CLITER
1923         FCB     5
1924         FDB     PLUS
1925         FDB     SEMIS
1926 *
1927 * ######>> screen 40 <<
1928 * ======>>  104  <<
1929         FCB     $84
1930         FCC     3,!CSP
1931         FCB     $D0
1932         FDB     PFA-6
1933 SCSP    FDB     DOCOL,SPAT,CSP,STORE
1934         FDB     SEMIS
1935 *
1936 * ======>>  105  <<
1937         FCB     $86
1938         FCC     5,?ERROR
1939         FCB     $D2
1940         FDB     SCSP-7
1941 QERR    FDB     DOCOL,SWAP,ZBRAN
1942         FDB     QERR2-*
1943         FDB     ERROR,BRAN
1944         FDB     QERR3-*
1945 QERR2   FDB     DROP
1946 QERR3   FDB     SEMIS
1947 *
1948 * ======>>  106  <<
1949         FCB     $85
1950         FCC     4,?COMP
1951         FCB     $D0
1952         FDB     QERR-9
1953 QCOMP   FDB     DOCOL,STATE,AT,ZEQU,CLITER
1954         FCB     $11
1955         FDB     QERR
1956         FDB     SEMIS
1957 *
1958 * ======>>  107  <<
1959         FCB     $85
1960         FCC     4,?EXEC
1961         FCB     $C3
1962         FDB     QCOMP-8
1963 QEXEC   FDB     DOCOL,STATE,AT,CLITER
1964         FCB     $12
1965         FDB     QERR
1966         FDB     SEMIS
1967 *
1968 * ======>>  108  <<
1969         FCB     $86
1970         FCC     5,?PAIRS
1971         FCB     $D3
1972         FDB     QEXEC-8
1973 QPAIRS  FDB     DOCOL,SUB,CLITER
1974         FCB     $13
1975         FDB     QERR
1976         FDB     SEMIS
1977 *
1978 * ======>>  109  <<
1979         FCB     $84
1980         FCC     3,?CSP
1981         FCB     $D0
1982         FDB     QPAIRS-9
1983 QCSP    FDB     DOCOL,SPAT,CSP,AT,SUB,CLITER
1984         FCB     $14
1985         FDB     QERR
1986         FDB     SEMIS
1987 *
1988 * ======>>  110  <<
1989         FCB     $88
1990         FCC     7,?LOADING
1991         FCB     $C7
1992         FDB     QCSP-7
1993 QLOAD   FDB     DOCOL,BLK,AT,ZEQU,CLITER
1994         FCB     $16
1995         FDB     QERR
1996         FDB     SEMIS
1997 *
1998 * ######>> screen 41 <<
1999 * ======>>  111  <<
2000         FCB     $87
2001         FCC     6,COMPILE
2002         FCB     $C5
2003         FDB     QLOAD-11
2004 COMPIL  FDB     DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
2005         FDB     SEMIS
2006 *
2007 * ======>>  112  <<
2008         FCB     $C1     [       immediate
2009         FCB     $DB
2010         FDB     COMPIL-10
2011 LBRAK   FDB     DOCOL,ZERO,STATE,STORE
2012         FDB     SEMIS
2013 *
2014 * ======>>  113  <<
2015         FCB     $81     ]
2016         FCB     $DD
2017         FDB     LBRAK-4
2018 RBRAK   FDB     DOCOL,CLITER
2019         FCB     $C0
2020         FDB     STATE,STORE
2021         FDB     SEMIS
2022 *
2023 * ======>>  114  <<
2024         FCB     $86
2025         FCC     5,SMUDGE
2026         FCB     $C5
2027         FDB     RBRAK-4
2028 SMUDGE  FDB     DOCOL,LATEST,CLITER
2029         FCB     $20
2030         FDB     TOGGLE
2031         FDB     SEMIS
2032 *
2033 * ======>>  115  <<
2034         FCB     $83
2035         FCC     2,HEX
2036         FCB     $D8
2037         FDB     SMUDGE-9
2038 HEX     FDB     DOCOL
2039         FDB     CLITER
2040         FCB     16
2041         FDB     BASE,STORE
2042         FDB     SEMIS
2043 *
2044 * ======>>  116  <<
2045         FCB     $87
2046         FCC     6,DECIMAL
2047         FCB     $CC
2048         FDB     HEX-6
2049 DEC     FDB     DOCOL
2050         FDB     CLITER
2051         FCB     10      note: hex "A"
2052         FDB     BASE,STORE
2053         FDB     SEMIS
2054 *
2055 * ######>> screen 42 <<
2056 * ======>>  117  <<
2057         FCB     $87
2058         FCC     6,(;CODE)
2059         FCB     $A9
2060         FDB     DEC-10
2061 PSCODE  FDB     DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
2062         FDB     SEMIS
2063 *
2064 * ======>>  118  <<
2065         FCB     $C5     immediate
2066         FCC     4,;CODE
2067         FCB     $C5
2068         FDB     PSCODE-10
2069 SEMIC   FDB     DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
2070         FDB     SEMIS
2071 * note: "QSTACK" will be replaced by "ASSEMBLER" later
2072 *
2073 * ######>> screen 43 <<
2074 * ======>>  119  <<
2075         FCB     $87
2076         FCC     6,<BUILDS
2077         FCB     $D3
2078         FDB     SEMIC-8
2079 BUILDS  FDB     DOCOL,ZERO,CON
2080         FDB     SEMIS
2081 *
2082 * ======>>  120  <<
2083         FCB     $85
2084         FCC     4,DOES>
2085         FCB     $BE
2086         FDB     BUILDS-10
2087 DOES    FDB     DOCOL,FROMR,TWOP,LATEST,PFA,STORE
2088         FDB     PSCODE
2089 DODOES  LDA A   IP
2090         LDA B   IP+1
2091         LDX     RP      make room on return stack
2092         DEX
2093         DEX
2094         STX     RP
2095         STA A   2,X     push return address
2096         STA B   3,X
2097         LDX     W       get addr of pointer to run-time code
2098         INX
2099         INX
2100         STX     N       stash it in scratch area
2101         LDX     0,X     get new IP
2102         STX     IP
2103         CLR A           get address of parameter
2104         LDA B   #2
2105         ADD B   N+1
2106         ADC A   N
2107         PSH B           and push it on data stack
2108         PSH A
2109         JMP     NEXT2
2110 *
2111 * ######>> screen 44 <<
2112 * ======>>  121  <<
2113         FCB     $85
2114         FCC     4,COUNT
2115         FCB     $D4
2116         FDB     DOES-8
2117 COUNT   FDB     DOCOL,DUP,ONEP,SWAP,CAT
2118         FDB     SEMIS
2119 *
2120 * ======>>  122  <<
2121         FCB     $84
2122         FCC     3,TYPE
2123         FCB     $C5
2124         FDB     COUNT-8
2125 TYPE    FDB     DOCOL,DDUP,ZBRAN
2126         FDB     TYPE3-*
2127         FDB     OVER,PLUS,SWAP,XDO
2128 TYPE2   FDB     I,CAT,EMIT,XLOOP
2129         FDB     TYPE2-*
2130         FDB     BRAN
2131         FDB     TYPE4-*
2132 TYPE3   FDB     DROP
2133 TYPE4   FDB     SEMIS
2134 *
2135 * ======>>  123  <<
2136         FCB     $89
2137         FCC     8,-TRAILING
2138         FCB     $C7
2139         FDB     TYPE-7
2140 DTRAIL  FDB     DOCOL,DUP,ZERO,XDO
2141 DTRAL2  FDB     OVER,OVER,PLUS,ONE,SUB,CAT,BL
2142         FDB     SUB,ZBRAN
2143         FDB     DTRAL3-*
2144         FDB     LEAVE,BRAN
2145         FDB     DTRAL4-*
2146 DTRAL3  FDB     ONE,SUB
2147 DTRAL4  FDB     XLOOP
2148         FDB     DTRAL2-*
2149         FDB     SEMIS
2150 *
2151 * ======>>  124  <<
2152         FCB     $84
2153         FCC     3,(.")
2154         FCB     $A9
2155         FDB     DTRAIL-12
2156 PDOTQ   FDB     DOCOL,R,TWOP,COUNT,DUP,ONEP
2157         FDB     FROMR,PLUS,TOR,TYPE
2158         FDB     SEMIS
2159 *
2160 * ======>>  125  <<
2161         FCB     $C2     immediate
2162         FCC     1,."
2163         FCB     $A2
2164         FDB     PDOTQ-7
2165 DOTQ    FDB     DOCOL
2166         FDB     CLITER
2167         FCB     $22     ascii quote
2168         FDB     STATE,AT,ZBRAN
2169         FDB     DOTQ1-*
2170         FDB     COMPIL,PDOTQ,WORD
2171         FDB     HERE,CAT,ONEP,ALLOT,BRAN
2172         FDB     DOTQ2-*
2173 DOTQ1   FDB     WORD,HERE,COUNT,TYPE
2174 DOTQ2   FDB     SEMIS
2175 *
2176 * ######>> screen 45 <<
2177 * ======>>  126  <<== MACHINE DEPENDENT
2178         FCB     $86
2179         FCC     5,?STACK
2180         FCB     $CB
2181         FDB     DOTQ-5
2182 QSTACK  FDB     DOCOL,CLITER
2183         FCB     $12
2184         FDB     PORIG,AT,TWO,SUB,SPAT,LESS,ONE
2185         FDB     QERR
2186 * prints 'empty stack'
2187 *
2188 QSTAC2  FDB     SPAT
2189 * Here, we compare with a value at least 128
2190 * higher than dict. ptr. (DP)
2191         FDB     HERE,CLITER
2192         FCB     $80
2193         FDB     PLUS,LESS,ZBRAN
2194         FDB     QSTAC3-*
2195         FDB     TWO
2196         FDB     QERR
2197 * prints 'full stack'
2198 *
2199 QSTAC3  FDB     SEMIS
2200 *
2201 * ======>>  127  <<     this word's function
2202 *           is done by ?STACK in this version
2203 *       FCB     $85
2204 *       FCC     4,?FREE
2205 *       FCB     $C5
2206 *       FDB     QSTACK-9
2207 *QFREE  FDB     DOCOL,SPAT,HERE,CLITER
2208 *       FCB     $80
2209 *       FDB     PLUS,LESS,TWO,QERR,SEMIS
2210 *
2211 * ######>> screen 46 <<
2212 * ======>>  128  <<
2213         FCB     $86
2214         FCC     5,EXPECT
2215         FCB     $D4
2216         FDB     QSTACK-9
2217 EXPECT  FDB     DOCOL,OVER,PLUS,OVER,XDO
2218 EXPEC2  FDB     KEY,DUP,CLITER
2219         FCB     $0E
2220         FDB     PORIG,AT,EQUAL,ZBRAN
2221         FDB     EXPEC3-*
2222         FDB     DROP,CLITER
2223         FCB     8       ( backspace character to emit )
2224         FDB     OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS
2225         FDB     TOR,SUB,BRAN
2226         FDB     EXPEC6-*
2227 EXPEC3  FDB     DUP,CLITER
2228         FCB     $D      ( carriage return )
2229         FDB     EQUAL,ZBRAN
2230         FDB     EXPEC4-*
2231         FDB     LEAVE,DROP,BL,ZERO,BRAN
2232         FDB     EXPEC5-*
2233 EXPEC4  FDB     DUP
2234 EXPEC5  FDB     I,CSTORE,ZERO,I,ONEP,STORE
2235 EXPEC6  FDB     EMIT,XLOOP
2236         FDB     EXPEC2-*
2237         FDB     DROP
2238         FDB     SEMIS
2239 *
2240 * ======>>  129  <<
2241         FCB     $85
2242         FCC     4,QUERY
2243         FCB     $D9
2244         FDB     EXPECT-9
2245 QUERY   FDB     DOCOL,TIB,AT,COLUMS
2246         FDB     AT,EXPECT,ZERO,IN,STORE
2247 *DBG
2248 *       FDB     MNOP
2249 *DBG
2250         FDB     SEMIS
2251 *
2252 * ======>>  130  <<
2253         FCB     $C1     immediate       < carriage return >
2254         FCB     $80
2255         FDB     QUERY-8
2256 NULL    FDB     DOCOL,BLK,AT,ZBRAN
2257         FDB     NULL2-*
2258         FDB     ONE,BLK,PSTORE
2259         FDB     ZERO,IN,STORE,BLK,AT,BSCR,MOD
2260         FDB     ZEQU
2261 *     check for end of screen
2262         FDB     ZBRAN
2263         FDB     NULL1-*
2264         FDB     QEXEC,FROMR,DROP
2265 NULL1   FDB     BRAN
2266         FDB     NULL3-*
2267 NULL2   FDB     FROMR,DROP
2268 NULL3   FDB     SEMIS
2269 *
2270 * ######>> screen 47 <<
2271 * ======>>  133  <<
2272         FCB     $84
2273         FCC     3,FILL
2274         FCB     $CC
2275         FDB     NULL-4
2276 FILL    FDB     DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
2277         FDB     FROMR,ONE,SUB,CMOVE
2278         FDB     SEMIS
2279 *
2280 * ======>>  134  <<
2281         FCB     $85
2282         FCC     4,ERASE
2283         FCB     $C5
2284         FDB     FILL-7
2285 ERASE   FDB     DOCOL,ZERO,FILL
2286         FDB     SEMIS
2287 *
2288 * ======>>  135  <<
2289         FCB     $86
2290         FCC     5,BLANKS
2291         FCB     $D3
2292         FDB     ERASE-8
2293 BLANKS  FDB     DOCOL,BL,FILL
2294         FDB     SEMIS
2295 *
2296 * ======>>  136  <<
2297         FCB     $84
2298         FCC     3,HOLD
2299         FCB     $C4
2300         FDB     BLANKS-9
2301 HOLD    FDB     DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
2302         FDB     SEMIS
2303 *
2304 * ======>>  137  <<
2305         FCB     $83
2306         FCC     2,PAD
2307         FCB     $C4
2308         FDB     HOLD-7
2309 PAD     FDB     DOCOL,HERE,CLITER
2310         FCB     $44
2311         FDB     PLUS
2312         FDB     SEMIS
2313 *
2314 * ######>> screen 48 <<
2315 * ======>>  138  <<
2316         FCB     $84
2317         FCC     3,WORD
2318         FCB     $C4
2319         FDB     PAD-6
2320 WORD    FDB     DOCOL,BLK,AT,ZBRAN
2321         FDB     WORD2-*
2322         FDB     BLK,AT,BLOCK,BRAN
2323         FDB     WORD3-*
2324 WORD2   FDB     TIB,AT
2325 WORD3   FDB     IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER
2326         FCB     34
2327         FDB     BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
2328         FDB     CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
2329         FDB     SEMIS
2330 *
2331 * ######>> screen 49 <<
2332 * ======>>  139  <<
2333         FCB     $88
2334         FCC     7,(NUMBER)
2335         FCB     $A9
2336         FDB     WORD-7
2337 PNUMB   FDB     DOCOL
2338 PNUMB2  FDB     ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
2339         FDB     PNUMB4-*
2340         FDB     SWAP,BASE,AT,USTAR,DROP,ROT,BASE
2341         FDB     AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
2342         FDB     PNUMB3-*
2343         FDB     ONE,DPL,PSTORE
2344 PNUMB3  FDB     FROMR,BRAN
2345         FDB     PNUMB2-*
2346 PNUMB4  FDB     FROMR
2347         FDB     SEMIS
2348 *
2349 * ======>>  140  <<
2350         FCB     $86
2351         FCC     5,NUMBER
2352         FCB     $D2
2353         FDB     PNUMB-11
2354 NUMB    FDB     DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
2355         FCC     "-"     minus sign
2356         FDB     EQUAL,DUP,TOR,PLUS,LIT,$FFFF
2357 NUMB1   FDB     DPL,STORE,PNUMB,DUP,CAT,BL,SUB
2358         FDB     ZBRAN
2359         FDB     NUMB2-*
2360         FDB     DUP,CAT,CLITER
2361         FCC     "."
2362         FDB     SUB,ZERO,QERR,ZERO,BRAN
2363         FDB     NUMB1-*
2364 NUMB2   FDB     DROP,FROMR,ZBRAN
2365         FDB     NUMB3-*
2366         FDB     DMINUS
2367 NUMB3   FDB     SEMIS
2368 *
2369 * ======>>  141  <<
2370         FCB     $85
2371         FCC     4,-FIND
2372         FCB     $C4
2373         FDB     NUMB-9
2374 DFIND   FDB     DOCOL,BL,WORD,HERE,CONTXT,AT,AT
2375 *DBG
2376         FDB     MNOP
2377 *DBG
2378         FDB     PFIND
2379 *DBG
2380         FDB MNOP
2381 *DBG
2382         FDB DUP,ZEQU,ZBRAN
2383         FDB     DFIND2-*
2384         FDB     DROP,HERE,LATEST,PFIND
2385 DFIND2  FDB     SEMIS
2386 *
2387 * ######>> screen 50 <<
2388 * ======>>  142  <<
2389         FCB     $87
2390         FCC     6,(ABORT)
2391         FCB     $A9
2392         FDB     DFIND-8
2393 PABORT  FDB     DOCOL,ABORT
2394         FDB     SEMIS
2395 *
2396 * ======>>  143  <<
2397         FCB     $85
2398         FCC     4,ERROR
2399         FCB     $D2
2400         FDB     PABORT-10
2401 ERROR   FDB     DOCOL,WARN,AT,ZLESS
2402         FDB     ZBRAN
2403 * note: WARNING is -1 to abort, 0 to print error #
2404 * and 1 to print error message from disc
2405         FDB     ERROR2-*
2406         FDB     PABORT
2407 ERROR2  FDB     HERE,COUNT,TYPE,PDOTQ
2408         FCB     4,7     ( bell )
2409         FCC     " ? "
2410         FDB     MESS,SPSTOR,IN,AT,BLK,AT,QUIT
2411         FDB     SEMIS
2412 *
2413 * ======>>  144  <<
2414         FCB     $83
2415         FCC     2,ID.
2416         FCB     $AE
2417         FDB     ERROR-8
2418 IDDOT   FDB     DOCOL,PAD,CLITER
2419         FCB     32
2420         FDB     CLITER
2421         FCB     $5F     ( underline )
2422         FDB     FILL,DUP,PFA,LFA,OVER,SUB,PAD
2423         FDB     SWAP,CMOVE,PAD,COUNT,CLITER
2424         FCB     31
2425         FDB     AND,TYPE,SPACE
2426         FDB     SEMIS
2427 *
2428 * ######>> screen 51 <<
2429 * ======>>  145  <<
2430         FCB     $86
2431         FCC     5,CREATE
2432         FCB     $C5
2433         FDB     IDDOT-6
2434 CREATE  FDB     DOCOL,DFIND,ZBRAN
2435         FDB     CREAT2-*
2436         FDB     DROP,PDOTQ
2437         FCB     8
2438         FCB     7       ( bel )
2439         FCC     "redef: "
2440         FDB     NFA,IDDOT,CLITER
2441         FCB     4
2442         FDB     MESS,SPACE
2443 CREAT2  FDB     HERE,DUP,CAT,WIDTH,AT,MIN
2444         FDB     ONEP,ALLOT,DUP,CLITER
2445         FCB     $A0
2446         FDB     TOGGLE,HERE,ONE,SUB,CLITER
2447         FCB     $80
2448         FDB     TOGGLE,LATEST,COMMA,CURENT,AT,STORE
2449         FDB     HERE,TWOP,COMMA
2450         FDB     SEMIS
2451 *
2452 * ######>> screen 52 <<
2453 * ======>>  146  <<
2454         FCB     $C9     immediate
2455         FCC     8,[COMPILE]
2456         FCB     $DD
2457         FDB     CREATE-9
2458 BCOMP   FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
2459         FDB     SEMIS
2460 *
2461 * ======>>  147  <<
2462         FCB     $C7     immediate
2463         FCC     6,LITERAL
2464         FCB     $CC
2465         FDB     BCOMP-12
2466 LITER   FDB     DOCOL,STATE,AT,ZBRAN
2467         FDB     LITER2-*
2468         FDB     COMPIL,LIT,COMMA
2469 LITER2  FDB     SEMIS
2470 *
2471 * ======>>  148  <<
2472         FCB     $C8     immediate
2473         FCC     7,DLITERAL
2474         FCB     $CC
2475         FDB     LITER-10
2476 DLITER  FDB     DOCOL,STATE,AT,ZBRAN
2477         FDB     DLITE2-*
2478         FDB     SWAP,LITER,LITER
2479 DLITE2  FDB     SEMIS
2480 *
2481 * ######>> screen 53 <<
2482 * ======>>  149  <<
2483         FCB     $89
2484         FCC     8,INTERPRET
2485         FCB     $D4
2486         FDB     DLITER-11
2487 INTERP  FDB     DOCOL
2488 INTER2  FDB     DFIND
2489 *DBG
2490 *       FDB MNOP
2491 *       FDB OVER,OVER,HEX,DOT,DOT,DEC
2492 *DBG
2493         FDB ZBRAN
2494         FDB     INTER5-*
2495         FDB     STATE,AT,LESS
2496         FDB     ZBRAN
2497         FDB     INTER3-*
2498         FDB     CFA,COMMA,BRAN
2499         FDB     INTER4-*
2500 INTER3  FDB     CFA,EXEC
2501 INTER4  FDB     BRAN
2502         FDB     INTER7-*
2503 INTER5  FDB     HERE,NUMB,DPL,AT,ONEP,ZBRAN
2504         FDB     INTER6-*
2505         FDB     DLITER,BRAN
2506         FDB     INTER7-*
2507 INTER6  FDB     DROP,LITER
2508 INTER7  FDB     QSTACK,BRAN
2509         FDB     INTER2-*
2510 *       FDB     SEMIS   never executed
2511
2512 *
2513 * ######>> screen 54 <<
2514 * ======>>  150  <<
2515         FCB     $89
2516         FCC     8,IMMEDIATE
2517         FCB     $C5
2518         FDB     INTERP-12
2519 IMMED   FDB     DOCOL,LATEST,CLITER
2520         FCB     $40
2521         FDB     TOGGLE
2522         FDB     SEMIS
2523 *
2524 * ======>>  151  <<
2525         FCB     $8A
2526         FCC     9,VOCABULARY
2527         FCB     $D9
2528         FDB     IMMED-12
2529 VOCAB   FDB     DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
2530         FDB     COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
2531 DOVOC   FDB     TWOP,CONTXT,STORE
2532         FDB     SEMIS
2533 *
2534 * ======>>  152  <<
2535 *
2536 * Note: FORTH does not go here in the rom-able dictionary,
2537 *    since FORTH is a type of variable.
2538 *
2539 *
2540 * ======>>  153  <<
2541         FCB     $8B
2542         FCC     10,DEFINITIONS
2543         FCB     $D3
2544         FDB     VOCAB-13
2545 DEFIN   FDB     DOCOL,CONTXT,AT,CURENT,STORE
2546         FDB     SEMIS
2547 *
2548 * ======>>  154  <<
2549         FCB     $C1     immediate       (
2550         FCB     $A8
2551         FDB     DEFIN-14
2552 PAREN   FDB     DOCOL,CLITER
2553         FCC     ")"
2554         FDB     WORD
2555         FDB     SEMIS
2556 *
2557 * ######>> screen 55 <<
2558 * ======>>  155  <<
2559         FCB     $84
2560         FCC     3,QUIT
2561         FCB     $D4
2562         FDB     PAREN-4
2563 QUIT    FDB     DOCOL,ZERO,BLK,STORE
2564         FDB     LBRAK
2565 *
2566 *  Here is the outer interpretter
2567 *  which gets a line of input, does it, prints " OK"
2568 *  then repeats :
2569 QUIT2   FDB     RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
2570         FDB     ZBRAN
2571         FDB     QUIT3-*
2572         FDB     PDOTQ
2573         FCB     3
2574         FCC     3, OK
2575 QUIT3   FDB     BRAN
2576         FDB     QUIT2-*
2577 *       FDB     SEMIS   ( never executed )
2578 *
2579 * ======>>  156  <<
2580         FCB     $85
2581         FCC     4,ABORT
2582         FCB     $D4
2583         FDB     QUIT-7
2584 ABORT   FDB     DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
2585         FCB     8
2586         FCC     "Forth-68"
2587         FDB     FORTH,DEFIN
2588 *DBG
2589 *       FDB TRCON
2590 *       FDB LIT
2591 *       FDB ABORT-8
2592 *       FDB IDDOT
2593 *       FDB LIT
2594 *       FDB NULL-4
2595 *       FDB IDDOT
2596 *       FDB LIT
2597 *       FDB MNOP-7
2598 *       FDB IDDOT
2599 *       FDB LIT
2600 *       FDB TRCON-10
2601 *       FDB IDDOT
2602 *       FDB LIT
2603 *       FDB TRCOFF-11
2604 *       FDB IDDOT
2605 *DBG
2606         FDB     QUIT
2607 *       FDB     SEMIS   never executed
2608         PAGE
2609 *
2610 * ######>> screen 56 <<
2611 * bootstrap code... moves rom contents to ram :
2612 * ======>>  157  <<
2613         FCB     $84
2614         FCC     3,COLD
2615         FCB     $C4
2616         FDB     ABORT-8
2617 COLD    FDB     *+2
2618 CENT    LDS     #REND-1 top of destination
2619         LDX     #ERAM   top of stuff to move
2620 COLD2   DEX
2621         LDA A   0,X
2622         PSH A           move TASK & FORTH to ram
2623         CPX     #RAM
2624         BNE     COLD2
2625 *
2626         LDS     #XFENCE-1       put stack at a safe place for now
2627         LDX     COLINT
2628         STX     XCOLUM
2629         LDX     DELINT
2630         STX     XDELAY
2631         LDX     VOCINT
2632         STX     XVOCL
2633         LDX     DPINIT
2634         STX     XDP
2635         LDX     FENCIN
2636         STX     XFENCE
2637
2638
2639 WENT    LDS     #XFENCE-1       top of destination
2640         LDX     #FENCIN         top of stuff to move
2641 WARM2   DEX
2642         LDA A   0,X
2643         PSH A
2644         CPX     #SINIT
2645         BNE     WARM2
2646 *
2647         LDS     SINIT
2648         LDX     UPINIT
2649         STX     UP              init user ram pointer
2650         LDX     #ABORT
2651         STX     IP
2652         NOP             Here is a place to jump to special user
2653         NOP             initializations such as I/0 interrups
2654         NOP
2655 *
2656 * For systems with TRACE:
2657         LDX     #00
2658         STX     TRLIM   clear trace mode
2659         LDX     #0
2660         STX     BRKPT   clear breakpoint address
2661         JMP     RPSTOR+2 start the virtual machine running !
2662 *
2663 * Here is the stuff that gets copied to ram :
2664 * at address $140:
2665 *
2666 * Thus, MAGIC numbers that initialize USE and PREV, magically! (JMR)
2667 * RAM   FDB     $3000,$3000,0,0
2668 RAM     FDB     $4000+132,$4000+132,0,0
2669
2670 * ======>>  (152)  <<
2671         FCB     $C5     immediate
2672         FCC     4,FORTH
2673         FCB     $C8
2674         FDB     MNOP-7
2675 RFORTH  FDB     DODOES,DOVOC,$81A0,TASK-7
2676         FDB     0
2677         FCC     "(C) Forth Interest Group, 1979"
2678         FCB     $84
2679         FCC     3,TASK
2680         FCB     $CB
2681         FDB     FORTH-8
2682 RTASK   FDB     DOCOL,SEMIS
2683 ERAM    FCC     "David Lion"
2684         PAGE
2685 *
2686 * ######>> screen 57 <<
2687 * ======>>  158  <<
2688         FCB     $84
2689         FCC     3,S->D
2690         FCB     $C4
2691         FDB     COLD-7
2692 STOD    FDB     DOCOL,DUP,ZLESS,MINUS
2693         FDB     SEMIS
2694
2695
2696 *
2697 * ======>>  159  <<
2698         FCB     $81     ; *
2699         FCB     $AA
2700         FDB     STOD-7
2701 STAR    FDB     *+2
2702         JSR     USTARS
2703         INS
2704         INS
2705         JMP     NEXT
2706 *
2707 * ======>>  160  <<
2708         FCB     $84
2709         FCC     3,/MOD
2710         FCB     $C4
2711         FDB     STAR-4
2712 SLMOD   FDB     DOCOL,TOR,STOD,FROMR,USLASH
2713         FDB     SEMIS
2714 *
2715 * ======>>  161  <<
2716         FCB     $81     ; /
2717         FCB     $AF
2718         FDB     SLMOD-7
2719 SLASH   FDB     DOCOL,SLMOD,SWAP,DROP
2720         FDB     SEMIS
2721 *
2722 * ======>>  162  <<
2723         FCB     $83
2724         FCC     2,MOD
2725         FCB     $C4
2726         FDB     SLASH-4
2727 MOD     FDB     DOCOL,SLMOD,DROP
2728         FDB     SEMIS
2729 *
2730 * ======>>  163  <<
2731         FCB     $85
2732         FCC     4,*/MOD
2733         FCB     $C4
2734         FDB     MOD-6
2735 SSMOD   FDB     DOCOL,TOR,USTAR,FROMR,USLASH
2736         FDB     SEMIS
2737 *
2738 * ======>>  164  <<
2739         FCB     $82
2740         FCC     1,*/
2741         FCB     $AF
2742         FDB     SSMOD-8
2743 SSLASH  FDB     DOCOL,SSMOD,SWAP,DROP
2744         FDB     SEMIS
2745 *
2746 * ======>>  165  <<
2747         FCB     $85
2748         FCC     4,M/MOD
2749         FCB     $C4
2750         FDB     SSLASH-5
2751 MSMOD   FDB     DOCOL,TOR,ZERO,R,USLASH
2752         FDB     FROMR,SWAP,TOR,USLASH,FROMR
2753         FDB     SEMIS
2754 *
2755 * ======>>  166  <<
2756         FCB     $83
2757         FCC     2,ABS
2758         FCB     $D3
2759         FDB     MSMOD-8
2760 ABS     FDB     DOCOL,DUP,ZLESS,ZBRAN
2761         FDB     ABS2-*
2762         FDB     MINUS
2763 ABS2    FDB     SEMIS
2764 *
2765 * ======>>  167  <<
2766         FCB     $84
2767         FCC     3,DABS
2768         FCB     $D3
2769         FDB     ABS-6
2770 DABS    FDB     DOCOL,DUP,ZLESS,ZBRAN
2771         FDB     DABS2-*
2772         FDB     DMINUS
2773 DABS2   FDB     SEMIS
2774 *
2775 * ######>> screen 58 <<
2776 * Disc primatives :
2777 * ======>>  168  <<
2778         FCB     $83
2779         FCC     2,USE
2780         FCB     $C5
2781         FDB     DABS-7
2782 USE     FDB     DOCON
2783         FDB     XUSE
2784 * ======>>  169  <<
2785         FCB     $84
2786         FCC     3,PREV
2787         FCB     $D6
2788         FDB     USE-6
2789 PREV    FDB     DOCON
2790         FDB     XPREV
2791 * ======>>  170  <<
2792         FCB     $84
2793         FCC     3,+BUF
2794         FCB     $C6
2795         FDB     PREV-7
2796 PBUF    FDB     DOCOL,CLITER
2797         FCB     $84
2798         FDB     PLUS,DUP,LIMIT,EQUAL,ZBRAN
2799         FDB     PBUF2-*
2800         FDB     DROP,FIRST
2801 PBUF2   FDB     DUP,PREV,AT,SUB
2802         FDB     SEMIS
2803 *
2804 * ======>>  171  <<
2805         FCB     $86
2806         FCC     5,UPDATE
2807         FCB     $C5
2808         FDB     PBUF-7
2809 UPDATE  FDB     DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
2810         FDB     SEMIS
2811 *
2812 * ======>>  172  <<
2813         FCB     $8D
2814         FCC     12,EMPTY-BUFFERS
2815         FCB     $D3
2816         FDB     UPDATE-9
2817 MTBUF   FDB     DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
2818         FDB     SEMIS
2819 *
2820 * ======>>  173  <<
2821         FCB     $83
2822         FCC     2,DR0
2823         FCB     $B0
2824         FDB     MTBUF-16
2825 DRZERO  FDB     DOCOL,ZERO,OFSET,STORE
2826         FDB     SEMIS
2827 *
2828 * ======>>  174  <<== system dependant word
2829         FCB     $83
2830         FCC     2,DR1
2831         FCB     $B1
2832         FDB     DRZERO-6
2833 *DRONE  FDB     DOCOL,LIT,$07D0,OFSET,STORE
2834 DRONE   FDB     DOCOL,LIT,RAMDSZ,OFSET,STORE
2835         FDB     SEMIS
2836 *
2837 * ######>> screen 59 <<
2838 * ======>>  175  <<
2839         FCB     $86
2840         FCC     5,BUFFER
2841         FCB     $D2
2842         FDB     DRONE-6
2843 BUFFER  FDB     DOCOL,USE,AT,DUP,TOR
2844 BUFFR2  FDB     PBUF,ZBRAN
2845         FDB     BUFFR2-*
2846         FDB     USE,STORE,R,AT,ZLESS
2847         FDB     ZBRAN
2848         FDB     BUFFR3-*
2849         FDB     R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
2850 BUFFR3  FDB     R,STORE,R,PREV,STORE,FROMR,TWOP
2851         FDB     SEMIS
2852 *
2853 * ######>> screen 60 <<
2854 * ======>>  176  <<
2855         FCB     $85
2856         FCC     4,BLOCK
2857         FCB     $CB
2858         FDB     BUFFER-9
2859 BLOCK   FDB     DOCOL,OFSET,AT,PLUS,TOR
2860         FDB     PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
2861         FDB     BLOCK5-*
2862 BLOCK3  FDB     PBUF,ZEQU,ZBRAN
2863         FDB     BLOCK4-*
2864         FDB     DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
2865 BLOCK4  FDB     DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
2866         FDB     BLOCK3-*
2867         FDB     DUP,PREV,STORE
2868 BLOCK5  FDB     FROMR,DROP,TWOP
2869         FDB     SEMIS
2870 *
2871 * ######>> screen 61 <<
2872 * ======>>  177  <<
2873         FCB     $86
2874         FCC     5,(LINE)
2875         FCB     $A9
2876         FDB     BLOCK-8
2877 PLINE   FDB     DOCOL,TOR,CLITER
2878         FCB     $40
2879         FDB     BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER
2880         FCB     $40
2881         FDB     SEMIS
2882 *
2883 * ======>>  178  <<
2884         FCB     $85
2885         FCC     4,.LINE
2886         FCB     $C5
2887         FDB     PLINE-9
2888 DLINE   FDB     DOCOL,PLINE,DTRAIL,TYPE
2889         FDB     SEMIS
2890 *
2891 * ======>>  179  <<
2892         FCB     $87
2893         FCC     6,MESSAGE
2894         FCB     $C5
2895         FDB     DLINE-8
2896 MESS    FDB     DOCOL,WARN,AT,ZBRAN
2897         FDB     MESS3-*
2898         FDB     DDUP,ZBRAN
2899         FDB     MESS3-*
2900         FDB     CLITER
2901         FCB     4
2902         FDB     OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
2903         FDB     MESS4-*
2904 MESS3   FDB     PDOTQ
2905         FCB     6
2906         FCC     6,err # ; Make sure there's a space there at the end.
2907         FDB     DOT
2908 MESS4   FDB     SEMIS
2909 *
2910 * ======>>  180  <<
2911         FCB     $84
2912         FCC     3,LOAD  input:scr #
2913         FCB     $C4
2914         FDB     MESS-10
2915 LOAD    FDB     DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
2916         FDB     BSCR,STAR,BLK,STORE
2917         FDB     INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
2918         FDB     SEMIS
2919 *
2920 * ======>>  181  <<
2921         FCB     $C3
2922         FCC     2,-->
2923         FCB     $BE
2924         FDB     LOAD-7
2925 ARROW   FDB     DOCOL,QLOAD,ZERO,IN,STORE,BSCR
2926         FDB     BLK,AT,OVER,MOD,SUB,BLK,PSTORE
2927         FDB     SEMIS
2928         PAGE
2929 *
2930 *
2931 * ######>> screen 63 <<
2932 *    The next 4 subroutines are machine dependent, and are
2933 *    called by words 13 through 16 in the dictionary.
2934 *
2935 * ======>>  182  << code for EMIT
2936 * PEMIT JMP     $F018   ; EXBUG outch, rob the RTS.
2937 PEMIT   STA B   N+1     save B
2938         STX     N+2     save X
2939         LDA B   ACIAC
2940         BIT B   #2      check ready bit
2941         BEQ     PEMIT+4 if not ready for more data
2942         STA A   N
2943         AND A   #$7F
2944         STA A   ACIAD
2945         LDX     UP
2946         STA B   IOSTAT-UORIG,X
2947         LDA A   N
2948         LDA B   N+1     recover B & X
2949         LDX     N+2
2950         RTS             only A register may change
2951 *  PEMIT        JMP     $E1D1   for MIKBUG
2952 *  PEMIT        FCB     $3F,$11,$39     for PROTO
2953 *  PEMIT        JMP     $D286 for Smoke Signal DOS
2954 *
2955 * ======>>  183  << code for KEY
2956 PKEY    CLR     $FF53
2957         INC     $FF53   ; shut off echo
2958         JMP     $F015   ; EXBUG inch, rob the RTS.
2959 * PKEY  STA B   N
2960 *       STX     N+1
2961 *       LDA B   ACIAC
2962 *       ASR B
2963 *       BCC     PKEY+4  no incoming data yet
2964 *       LDA A   ACIAD
2965 *       AND A   #$7F    strip parity bit
2966 *       LDX     UP
2967 *       STA B   IOSTAT+1-UORIG,X
2968 *       LDA B   N
2969 *       LDX     N+1
2970 *       RTS
2971 *  PKEY JMP     $E1AC   for MIKBUG
2972 *  PKEY FCB     $3F,$14,$39     for PROTO
2973 *  PKEY JMP     $D289 for Smoke Signal DOS
2974 *
2975 * ######>> screen 64 <<
2976 * ======>>  184  << code for ?TERMINAL
2977 PQTER   LDA A   ACIAC   Test for 'break'  condition
2978         AND A   #$11    mask framing error bit and
2979 *                       input buffer full
2980         BEQ     PQTER2
2981         LDA A   ACIAD   clear input buffer
2982         LDA A   #01
2983 PQTER2  RTS
2984
2985
2986         PAGE
2987 *
2988 * ======>>  185  << code for CR
2989 PCR     JMP     $F021   ; EXBUG pcrlf, rob the RTS.
2990 * PCR   LDA A   #$D     carriage return
2991 *       BSR     PEMIT
2992 *       LDA A   #$A     line feed
2993 *       BSR     PEMIT
2994 *       LDA A   #$7F    rubout
2995 *       LDX     UP
2996 *       LDA B   XDELAY+1-UORIG,X
2997 * PCR2  DEC B
2998 *       BMI     PQTER2  return if minus
2999 *       PSH B           save counter
3000 *       BSR     PEMIT   print RUBOUTs to delay.....
3001 *       PUL B
3002 *       BRA     PCR2    repeat
3003
3004
3005         PAGE
3006 *
3007 * ######>> screen 66 <<
3008 * ======>>  187  <<
3009         FCB     $85
3010         FCC     4,?DISC
3011         FCB     $C3
3012         FDB     ARROW-6
3013 QDISC   FDB     *+2
3014         JMP     NEXT
3015 *
3016 * ######>> screen 67 <<
3017 * ======>>  189  <<
3018         FCB     $8B
3019         FCC     10,BLOCK-WRITE
3020         FCB     $C5
3021         FDB     QDISC-8
3022 BWRITE  FDB     *+2
3023         JMP     NEXT
3024 *
3025 * ######>> screen 68 <<
3026 * ======>>  190  <<
3027         FCB     $8A
3028         FCC     9,BLOCK-READ
3029         FCB     $C4
3030         FDB     BWRITE-14
3031 BREAD   FDB     *+2
3032         JMP     NEXT
3033 *
3034 *The next 3 words are written to create a substitute for disc
3035 * mass memory,located between $3210 & $3FFF in ram.
3036 * ======>>  190.1  <<
3037         FCB     $82
3038         FCC     1,LO
3039         FCB     $CF
3040         FDB     BREAD-13
3041 LO      FDB     DOCON
3042         FDB     MEMEND  a system dependent equate at front
3043 *
3044 * ======>>  190.2  <<
3045         FCB     $82
3046         FCC     1,HI
3047         FCB     $C9
3048         FDB     LO-5
3049 HI      FDB     DOCON
3050 *       FDB     MEMTOP  ( $3FFF ($7FFF) in this version )
3051         FDB     RAMDEN
3052 *
3053 * ######>> screen 69 <<
3054 * ======>>  191  <<
3055         FCB     $83
3056         FCC     2,R/W
3057         FCB     $D7
3058         FDB     HI-5
3059 RW      FDB     DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
3060         FDB     RW2-*
3061         FDB     PDOTQ
3062         FCB     8
3063         FCC     8, Range ?
3064         FDB     QUIT
3065 RW2     FDB     FROMR,ZBRAN
3066         FDB     RW3-*
3067         FDB     SWAP
3068 RW3     FDB     BBUF,CMOVE
3069         FDB     SEMIS
3070 *
3071 * ######>> screen 72 <<
3072 * ======>>  192  <<
3073         FCB     $C1     immediate
3074         FCB     $A7     '       ( tick )
3075         FDB     RW-6
3076 TICK    FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
3077         FDB     SEMIS
3078 *
3079 * ======>>  193  <<
3080         FCB     $86
3081         FCC     5,FORGET
3082         FCB     $D4
3083         FDB     TICK-4
3084 FORGET  FDB     DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
3085         FCB     $18
3086         FDB     QERR,TICK,DUP,FENCE,AT,LESS,CLITER
3087         FCB     $15
3088         FDB     QERR,DUP,ZERO,PORIG,GREAT,CLITER
3089         FCB     $15
3090         FDB     QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE
3091         FDB     SEMIS
3092 *
3093 * ######>> screen 73 <<
3094 * ======>>  194  <<
3095         FCB     $84
3096         FCC     3,BACK
3097         FCB     $CB
3098         FDB     FORGET-9
3099 BACK    FDB     DOCOL,HERE,SUB,COMMA
3100         FDB     SEMIS
3101 *
3102 * ======>>  195  <<
3103         FCB     $C5
3104         FCC     4,BEGIN
3105         FCB     $CE
3106         FDB     BACK-7
3107 BEGIN   FDB     DOCOL,QCOMP,HERE,ONE
3108         FDB     SEMIS
3109 *
3110 * ======>>  196  <<
3111         FCB     $C5
3112         FCC     4,ENDIF
3113         FCB     $C6
3114         FDB     BEGIN-8
3115 ENDIF   FDB     DOCOL,QCOMP,TWO,QPAIRS,HERE
3116         FDB     OVER,SUB,SWAP,STORE
3117         FDB     SEMIS
3118 *
3119 * ======>>  197  <<
3120         FCB     $C4
3121         FCC     3,THEN
3122         FCB     $CE
3123         FDB     ENDIF-8
3124 THEN    FDB     DOCOL,ENDIF
3125         FDB     SEMIS
3126 *
3127 * ======>>  198  <<
3128         FCB     $C2
3129         FCC     1,DO
3130         FCB     $CF
3131         FDB     THEN-7
3132 DO      FDB     DOCOL,COMPIL,XDO,HERE,THREE
3133         FDB     SEMIS
3134 *
3135 * ======>>  199  <<
3136         FCB     $C4
3137         FCC     3,LOOP
3138         FCB     $D0
3139         FDB     DO-5
3140 LOOP    FDB     DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
3141         FDB     SEMIS
3142 *
3143 * ======>>  200  <<
3144         FCB     $C5
3145         FCC     4,+LOOP
3146         FCB     $D0
3147         FDB     LOOP-7
3148 PLOOP   FDB     DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
3149         FDB     SEMIS
3150 *
3151 * ======>>  201  <<
3152         FCB     $C5
3153         FCC     4,UNTIL ( same as END )
3154         FCB     $CC
3155         FDB     PLOOP-8
3156 UNTIL   FDB     DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
3157         FDB     SEMIS
3158 *
3159 * ######>> screen 74 <<
3160 * ======>>  202  <<
3161         FCB     $C3
3162         FCC     2,END
3163         FCB     $C4
3164         FDB     UNTIL-8
3165 END     FDB     DOCOL,UNTIL
3166         FDB     SEMIS
3167 *
3168 * ======>>  203  <<
3169         FCB     $C5
3170         FCC     4,AGAIN
3171         FCB     $CE
3172         FDB     END-6
3173 AGAIN   FDB     DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
3174         FDB     SEMIS
3175 *
3176 * ======>>  204  <<
3177         FCB     $C6
3178         FCC     5,REPEAT
3179         FCB     $D4
3180         FDB     AGAIN-8
3181 REPEAT  FDB     DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
3182         FDB     TWO,SUB,ENDIF
3183         FDB     SEMIS
3184 *
3185 * ======>>  205  <<
3186         FCB     $C2
3187         FCC     1,IF
3188         FCB     $C6
3189         FDB     REPEAT-9
3190 IF      FDB     DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
3191         FDB     SEMIS
3192 *
3193 * ======>>  206  <<
3194         FCB     $C4
3195         FCC     3,ELSE
3196         FCB     $C5
3197         FDB     IF-5
3198 ELSE    FDB     DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
3199         FDB     ZERO,COMMA,SWAP,TWO,ENDIF,TWO
3200         FDB     SEMIS
3201 *
3202 * ======>>  207  <<
3203         FCB     $C5
3204         FCC     4,WHILE
3205         FCB     $C5
3206         FDB     ELSE-7
3207 WHILE   FDB     DOCOL,IF,TWOP
3208         FDB     SEMIS
3209 *
3210 * ######>> screen 75 <<
3211 * ======>>  208  <<
3212         FCB     $86
3213         FCC     5,SPACES
3214         FCB     $D3
3215         FDB     WHILE-8
3216 SPACES  FDB     DOCOL,ZERO,MAX,DDUP,ZBRAN
3217         FDB     SPACE3-*
3218         FDB     ZERO,XDO
3219 SPACE2  FDB     SPACE,XLOOP
3220         FDB     SPACE2-*
3221 SPACE3  FDB     SEMIS
3222 *
3223 * ======>>  209  <<
3224         FCB     $82
3225         FCC     1,<#
3226         FCB     $A3
3227         FDB     SPACES-9
3228 BDIGS   FDB     DOCOL,PAD,HLD,STORE
3229         FDB     SEMIS
3230 *
3231 * ======>>  210  <<
3232         FCB     $82
3233         FCC     1,#>
3234         FCB     $BE
3235         FDB     BDIGS-5
3236 EDIGS   FDB     DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
3237         FDB     SEMIS
3238 *
3239 * ======>>  211  <<
3240         FCB     $84
3241         FCC     3,SIGN
3242         FCB     $CE
3243         FDB     EDIGS-5
3244 SIGN    FDB     DOCOL,ROT,ZLESS,ZBRAN
3245         FDB     SIGN2-*
3246         FDB     CLITER
3247         FCC     "-"
3248         FDB     HOLD
3249 SIGN2   FDB     SEMIS
3250 *
3251 * ======>>  212  <<
3252         FCB     $81     #
3253         FCB     $A3
3254         FDB     SIGN-7
3255 DIG     FDB     DOCOL,BASE,AT,MSMOD,ROT,CLITER
3256         FCB     9
3257         FDB     OVER,LESS,ZBRAN
3258         FDB     DIG2-*
3259         FDB     CLITER
3260         FCB     7
3261         FDB     PLUS
3262 DIG2    FDB     CLITER
3263         FCC     "0"     ascii zero
3264         FDB     PLUS,HOLD
3265         FDB     SEMIS
3266 *
3267 * ======>>  213  <<
3268         FCB     $82
3269         FCC     1,#S
3270         FCB     $D3
3271         FDB     DIG-4
3272 DIGS    FDB     DOCOL
3273 DIGS2   FDB     DIG,OVER,OVER,OR,ZEQU,ZBRAN
3274         FDB     DIGS2-*
3275         FDB     SEMIS
3276 *
3277 * ######>> screen 76 <<
3278 * ======>>  214  <<
3279         FCB     $82
3280         FCC     1,.R
3281         FCB     $D2
3282         FDB     DIGS-5
3283 DOTR    FDB     DOCOL,TOR,STOD,FROMR,DDOTR
3284         FDB     SEMIS
3285 *
3286 * ======>>  215  <<
3287         FCB     $83
3288         FCC     2,D.R
3289         FCB     $D2
3290         FDB     DOTR-5
3291 DDOTR   FDB     DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
3292         FDB     EDIGS,FROMR,OVER,SUB,SPACES,TYPE
3293         FDB     SEMIS
3294 *
3295 * ======>>  216  <<
3296         FCB     $82
3297         FCC     1,D.
3298         FCB     $AE
3299         FDB     DDOTR-6
3300 DDOT    FDB     DOCOL,ZERO,DDOTR,SPACE
3301         FDB     SEMIS
3302 *
3303 * ======>>  217  <<
3304         FCB     $81     .
3305         FCB     $AE
3306         FDB     DDOT-5
3307 DOT     FDB     DOCOL,STOD,DDOT
3308         FDB     SEMIS
3309 *
3310 * ======>>  218  <<
3311         FCB     $81     ?
3312         FCB     $BF
3313         FDB     DOT-4
3314 QUEST   FDB     DOCOL,AT,DOT
3315         FDB     SEMIS
3316 *
3317 * ######>> screen 77 <<
3318 * ======>>  219  <<
3319         FCB     $84
3320         FCC     3,LIST
3321         FCB     $D4
3322         FDB     QUEST-4
3323 LIST    FDB     DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
3324         FCB     6
3325         FCC     "SCR # "
3326         FDB     DOT,CLITER
3327         FCB     $10
3328         FDB     ZERO,XDO
3329 LIST2   FDB     CR,I,THREE
3330         FDB     DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
3331         FDB     LIST2-*
3332         FDB     CR
3333         FDB     SEMIS
3334 *
3335 * ======>>  220  <<
3336         FCB     $85
3337         FCC     4,INDEX
3338         FCB     $D8
3339         FDB     LIST-7
3340 INDEX   FDB     DOCOL,CR,ONEP,SWAP,XDO
3341 INDEX2  FDB     CR,I,THREE
3342         FDB     DOTR,SPACE,ZERO,I,DLINE
3343         FDB     QTERM,ZBRAN
3344         FDB     INDEX3-*
3345         FDB     LEAVE
3346 INDEX3  FDB     XLOOP
3347         FDB     INDEX2-*
3348         FDB     SEMIS
3349 *
3350 * ======>>  221  <<
3351         FCB     $85
3352         FCC     4,TRIAD
3353         FCB     $C4
3354         FDB     INDEX-8
3355 TRIAD   FDB     DOCOL,THREE,SLASH,THREE,STAR
3356         FDB     THREE,OVER,PLUS,SWAP,XDO
3357 TRIAD2  FDB     CR,I
3358         FDB     LIST,QTERM,ZBRAN
3359         FDB     TRIAD3-*
3360         FDB     LEAVE
3361 TRIAD3  FDB     XLOOP
3362         FDB     TRIAD2-*
3363         FDB     CR,CLITER
3364         FCB     $0F
3365         FDB     MESS,CR
3366         FDB     SEMIS
3367 *
3368 * ######>> screen 78 <<
3369 * ======>>  222  <<
3370         FCB     $85
3371         FCC     4,VLIST
3372         FCB     $D4
3373         FDB     TRIAD-8
3374 VLIST   FDB     DOCOL,CLITER
3375         FCB     $80
3376         FDB     OUT,STORE,CONTXT,AT,AT
3377 VLIST1  FDB     OUT,AT,COLUMS,AT,CLITER
3378         FCB     32
3379         FDB     SUB,GREAT,ZBRAN
3380         FDB     VLIST2-*
3381         FDB     CR,ZERO,OUT,STORE
3382 VLIST2  FDB     DUP
3383 *       FDB TRCON
3384         FDB IDDOT,SPACE,SPACE,PFA,LFA,AT
3385         FDB     DUP,ZEQU,QTERM,OR
3386 *       FDB TRCOFF
3387         FDB ZBRAN
3388         FDB     VLIST1-*
3389         FDB     DROP
3390         FDB     SEMIS
3391 *
3392 * ======>>  XX  <<
3393         FCB     $84
3394         FCC     3,NOOP
3395         FCB     $D0
3396         FDB     VLIST-8
3397 NOOP    FDB     NEXT    a useful no-op
3398 *
3399 * ======>>  XX1  <<
3400         FDB     $87
3401         FCC     6,TRACEON
3402         FCB     $CE
3403         FDB     NOOP-7
3404 TRCON   FDB     *+2
3405         CLR     TRACEM
3406         INC     TRACEM
3407         JMP     NEXT
3408 *
3409 * ======>>  XX2  <<
3410         FDB     $88
3411         FCC     7,TRACEOFF
3412         FCB     $C6
3413         FDB     TRCON-10
3414 TRCOFF  FDB     *+2
3415         CLR     TRACEM
3416         JMP     NEXT
3417 *
3418 * ======>>  XXX  <<
3419         FDB     $84
3420         FCC     3,MNOP
3421         FCB     $D0
3422         FDB     TRCOFF-11
3423 MNOP    FDB     *+2
3424         NOP             a place to insert a machine-level breakpoint.
3425         JMP     NEXT
3426 *
3427 ZZZZ    FDB     0,0,0,0,0,0,0,0 end of rom program
3428 *
3429         ORG     MEMEND  simulating disc on-line
3430 * SCREEN 0
3431         FCC     "0) Index to BIF HI-LEVEL disk                                   "
3432         FCC     "1)                                                              "
3433         FCC     "2) Title page, Copr. notice                                     "
3434         FCC     "3) MONITOR CALL TO DEBUG                                        "
3435         FCC     "4) ERROR MESSAGES                                               "
3436         FCC     "5)                                                              "
3437         FCC     "6)                                                              "
3438         FCC     "7)                                                              "
3439         FCC     "8)                                                              "
3440         FCC     "9)                                                              "
3441         FCC     "10)                                                             "
3442         FCC     "11)                                                             "
3443         FCC     "12)                                                             "
3444         FCC     "13)                                                             "
3445         FCC     "14)                                                             "
3446         FCC     "15)                                                             "
3447 * SCREEN 1
3448         FCC     "16)                                                             "
3449         FCC     "17)                                                             "
3450         FCC     "18)                                                             "
3451         FCC     "19)                                                             "
3452         FCC     "20)                                                             "
3453         FCC     "21)                                                             "
3454         FCC     "22)                                                             "
3455         FCC     "23)                                                             "
3456         FCC     "24)                                                             "
3457         FCC     "25)                                                             "
3458         FCC     "26)                                                             "
3459         FCC     "27)                                                             "
3460         FCC     "28)                                                             "
3461         FCC     "29)                                                             "
3462         FCC     "30)                                                             "
3463         FCC     "31)                                                             "
3464 * SCREEN 2
3465         FCC     " ( FORTH 68 RAM resident utilities and testing stuff )          " 0
3466         FCC     " ( Copyright 2013 Joel Rees )                                   " 1
3467         FCC     "                                                                " 2
3468         FCC     "                                                                " 3
3469         FCC     "                                                                " 4
3470         FCC     "                                                                " 5
3471         FCC     "                                                                " 6
3472         FCC     "                                                                " 7
3473         FCC     "                                                                " 8
3474         FCC     "                                                                " 9
3475         FCC     "                                                                " 10
3476         FCC     "                                                                " 11
3477         FCC     "                                                                " 12
3478         FCC     "                                                                " 13
3479         FCC     "                                                                " 14
3480         FCC     "                                                                " 15
3481 * SCREEN 3
3482         FCC     " ( No need to call the monitor in exorsim, just ctrl-c. )       " 0
3483         FCC     " ( But maybe we can put some other useful stuff here. )         " 1
3484         FCC     "                                                                " 2
3485         FCC     " 1 WARNING !                                                    " 3
3486         FCC     "                                                                " 4
3487         FCC     " VOCABULARY DEBUG DEFINITIONS                                   " 5
3488         FCC     " ( addr n -- )                                                  " 6
3489         FCC     " : DUMPHEX BASE @ >R HEX                                        " 7
3490         FCC     "           0 DO DUP I + C@ 0 <# # # #> TYPE SPACE LOOP          " 8
3491         FCC     "           DROP R> BASE ! ;                                     " 9
3492         FCC     "                                                                " 10
3493         FCC     "                                                                " 11
3494         FCC     "                                                                " 12
3495         FCC     "                                                                " 13
3496         FCC     "                                                                " 14
3497         FCC     " FORTH DEFINITIONS                                              " 15
3498 * SCREEN 4
3499         FCC     "( ERROR MESSAGES )                                              " 0
3500         FCC     "DATA STACK UNDERFLOW                                            " 1
3501         FCC     "DICTIONARY FULL                                                 " 2
3502         FCC     "ADDRESS RESOLUTION ERROR                                        " 3
3503         FCC     "HIDES DEFINITION IN                                             " 4
3504         FCC     "NULL VECTOR WRITTEN                                             " 5
3505         FCC     "DISC RANGE?                                                     " 6
3506         FCC     "DATA STACK OVERFLOW                                             " 7
3507         FCC     "DISC ERROR!                                                     " 8
3508         FCC     "CAN'T EXECUTE A NULL!                                           " 9
3509         FCC     "CONTROL STACK UNDERFLOW                                         " 10
3510         FCC     "CONTROL STACK OVERFLOW                                          " 11
3511         FCC     "ARRAY REFERENCE OUT OF BOUNDS                                   " 12
3512         FCC     "ARRAY DIMENSION NOT VALID                                       " 13
3513         FCC     "NO PROCEDURE TO ENTER                                           " 14
3514         FCC     "               ( WAS REGISTER )                                 " 15
3515 * SCREEN 5
3516         FCC     "                                                                " 0
3517         FCC     "COMPILATION ONLY, USE IN DEF                                    " 1
3518         FCC     "EXECUTION ONLY                                                  " 2
3519         FCC     "CONDITIONALS NOT PAIRED                                         " 3
3520         FCC     "DEFINITION INCOMPLETE                                           " 4
3521         FCC     "IN PROTECTED DICTIONARY                                         " 5
3522         FCC     "USE ONLY WHEN LOADING                                           " 6
3523         FCC     "OFF CURRENT EDITING SCREEN                                      " 7
3524         FCC     "DECLARE VOCABULARY                                              " 8
3525         FCC     "DEFINITION NOT IN VOCABULARY                                    " 9
3526         FCC     "IN FORWARD BLOCK                                                " 10
3527         FCC     "ALLOCATION LIST CORRUPTED: LOST                                 " 11
3528         FCC     "CAN'T REDEFINE nul!                                             " 12
3529         FCC     "NOT FORWARD REFERENCE                                           " 13
3530         FCC     "              ( WAS IMMEDIATE )                                 " 14
3531         FCC     "                                                                " 15
3532 * SCREEN 6
3533         FCC     "( MORE ERROR MESSAGES asm6809 )                                 " 0
3534         FCC     "HAS INCORRECT ADDRESS MODE                                      " 1
3535         FCC     "HAS INCORRECT INDEX MODE                                        " 2
3536         FCC     "OPERAND NOT REGISTER                                            " 3
3537         FCC     "HAS ILLEGAL IMMEDIATE                                           " 4
3538         FCC     "PC OFFSET MUST BE ABSOLUTE                                      " 5
3539         FCC     "ACCUMULATOR OFFSET REQUIRED                                     " 6
3540         FCC     "ILLEGAL MEMORY INDIRECTION  (6809)                              " 7
3541         FCC     "ILLEGAL INDEX BASE (6809)                                       " 8
3542         FCC     "ILLEGAL TARGET SPECIFIED                                        " 9
3543         FCC     "CAN'T STACK ON SELF (6809)                                      " 10
3544         FCC     "DUPLICATE IN LIST                                               " 11
3545         FCC     "REGISTER NOT STACK (6809)                                       " 12
3546         FCC     "EMPTY REGISTER LIST (6809)                                      " 13
3547         FCC     "IMMEDIATE OPERAND REQUIRED                                      " 14
3548         FCC     "REQUIRES CONDITION                                              " 15
3549 *
3550 * SCREEN 7
3551         FCC     "                                                                " 0
3552         FCC     "COMPILE-TIME STACK UNDERFLOW                                    " 1
3553         FCC     "COMPILE-TIME STACK OVERFLOW                                     " 2
3554         FCC     "                                                                " 3
3555         FCC     "                                                                " 4
3556         FCC     "                                                                " 5
3557         FCC     "                                                                " 6
3558         FCC     "                                                                " 7
3559         FCC     "                                                                " 8
3560         FCC     "                                                                " 9
3561         FCC     "                                                                " 10
3562         FCC     "                                                                " 11
3563         FCC     "                                                                " 12
3564         FCC     "                                                                " 13
3565         FCC     "                                                                " 14
3566         FCC     "                                                                " 15
3567 *
3568 * SCREEN 8
3569         FCC     " ( Crude editing facilities. -- one byte characters )           " 0
3570         FCC     "                                                                " 1
3571         FCC     " VOCABULARY EDITOR DEFINITIONS                                  " 2
3572         FCC     "                                                                " 3
3573         FCC     " ( n -- nb nc )  ( convert line number to block, count offset ) " 4
3574         FCC     " : L2BLOCK 64 * B/BUF /MOD ; ( 64 characters per line magic # ) " 5
3575         FCC     "                                                                " 6
3576         FCC     " ( n -- n )           ( convert screen number to block number ) " 7
3577         FCC     " : S2BLOCK B/SCR * ;          ( magic numbers hidden in B/SCR ) " 8
3578         FCC     "                                                                " 9
3579         FCC     " ( ns nl -- addr )         ( screen, line to address in block ) " 10
3580         FCC     " : SL2BB SWAP S2BLOCK SWAP L2BLOCK SWAP >R + BLOCK R> + ;       " 11
3581         FCC     "                                                                " 12
3582         FCC     " ( ns nl -- )                   ( show one line of the screen ) " 13
3583         FCC     " : SHOWLINE SL2BB CR 64 TYPE ;           ( list just one line ) " 14
3584         FCC     " -->                                                            " 15
3585 *
3586 * SCREEN 9
3587         FCC     " ( More crude editing facilities. -- one byte characters )      " 0
3588         FCC     "                                                                " 1
3589         FCC     " 0 VARIABLE LNEDBUF 62 ALLOT        ( buffer for line editing ) " 2
3590         FCC     "                                                                " 3
3591         FCC     " ( ns nl -- )              ( overwrite one line of the screen ) " 4
3592         FCC     " : PUTLINE LNEDBUF 64 BLANKS   ( just enough to write to disc ) " 5
3593         FCC     "           CR LNEDBUF 64 EXPECT CR     ( just enough to write ) " 6
3594         FCC     "           SL2BB LNEDBUF SWAP 64 CMOVE UPDATE ;                 " 7
3595         FCC     "       ( Full screen editing requires keyboard control codes. ) " 8
3596         FCC     "                                                                " 9
3597         FCC     "                                                                " 10
3598         FCC     "                                                                " 11
3599         FCC     "                                                                " 12
3600         FCC     "                                                                " 13
3601         FCC     "                                                                " 14
3602         FCC     "                                                                " 15
3603 *
3604 * I don't know enough about the EXORciser, and don't want to take the time
3605 * to try to work through the disk simulation in exorsim to get real simulated
3606 * disk access running.
3607 * This gives me enough to check my understanding of forth, to help me figure
3608 * out my bif-c project or whatever my next step is.
3609 *
3610 * Going farther with the exorsim version of the fig-FORTH 6800 model would be
3611 * a good student exercise, maybe? (For what coursework?)
3612 * But I think I need to move on.
3613 *
3614 * SCREEN 10
3615         FCC     "                                                                " 0
3616         FCC     "                                                                " 1
3617         FCC     "                                                                " 2
3618         FCC     "                                                                " 3
3619         FCC     "                                                                " 4
3620         FCC     "                                                                " 5
3621         FCC     "                                                                " 6
3622         FCC     "                                                                " 7
3623         FCC     "                                                                " 8
3624         FCC     "                                                                " 9
3625         FCC     "                                                                " 10
3626         FCC     "                                                                " 11
3627         FCC     "                                                                " 12
3628         FCC     "                                                                " 13
3629         FCC     "                                                                " 14
3630         FCC     "                                                                " 15
3631 *
3632 * SCREEN 11
3633         FCC     "                                                                " 0
3634         FCC     "                                                                " 1
3635         FCC     "                                                                " 2
3636         FCC     "                                                                " 3
3637         FCC     "                                                                " 4
3638         FCC     "                                                                " 5
3639         FCC     "                                                                " 6
3640         FCC     "                                                                " 7
3641         FCC     "                                                                " 8
3642         FCC     "                                                                " 9
3643         FCC     "                                                                " 10
3644         FCC     "                                                                " 11
3645         FCC     "                                                                " 12
3646         FCC     "                                                                " 13
3647         FCC     "                                                                " 14
3648         FCC     "                                                                " 15
3649 *
3650 * SCREEN 12
3651         FCC     "                                                                " 0
3652         FCC     "                                                                " 1
3653         FCC     "                                                                " 2
3654         FCC     "                                                                " 3
3655         FCC     "                                                                " 4
3656         FCC     "                                                                " 5
3657         FCC     "                                                                " 6
3658         FCC     "                                                                " 7
3659         FCC     "                                                                " 8
3660         FCC     "                                                                " 9
3661         FCC     "                                                                " 10
3662         FCC     "                                                                " 11
3663         FCC     "                                                                " 12
3664         FCC     "                                                                " 13
3665         FCC     "                                                                " 14
3666         FCC     "                                                                " 15
3667 *
3668 RAMDEN  EQU     *
3669 RAMDSZ  EQU     RAMDEN-MEMEND
3670 *
3671         ORG     ORIG    ; set the COLD entry address
3672
3673
3674
3675
3676
3677         PAGE
3678         OPT     L
3679         END