fig-forth-auto6809halfopt.asm

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