From: Joel Matthew Rees <joel.rees@gmail.com>
Date: Thu, 24 Jan 2019 13:45:30 +0000 (+0900)
Subject: not sure, but I lost some code along here
X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;ds=sidebyside;h=3174b32b5fa74d5fba3f0fedb0aa60d2e9836fb6;p=fig-forth-6809%2Ffig-forth-6809.git

not sure, but I lost some code along here
---

diff --git a/junkpile/fig-forth-auto6809opt.list~ b/junkpile/fig-forth-auto6809opt.list~
new file mode 100644
index 0000000..ab03636
--- /dev/null
+++ b/junkpile/fig-forth-auto6809opt.list~
@@ -0,0 +1,5527 @@
+                      (fig-forth-auto680):00001                 OPT PRT
+                      (fig-forth-auto680):00002         
+                      (fig-forth-auto680):00003         * fig-FORTH FOR 6809
+                      (fig-forth-auto680):00004         * ASSEMBLY SOURCE LISTING
+                      (fig-forth-auto680):00005         
+                      (fig-forth-auto680):00006         * RELEASE 0
+                      (fig-forth-auto680):00007         * JAN 2019
+                      (fig-forth-auto680):00008         * WITH COMPILER SECURITY
+                      (fig-forth-auto680):00009         * AND VARIABLE LENGTH NAMES
+                      (fig-forth-auto680):00010         *
+                      (fig-forth-auto680):00011         * Adapted by Joel Matthew Rees 
+                      (fig-forth-auto680):00012         * from fig-FORTH for 6800 by Dave Lion, et. al.
+                      (fig-forth-auto680):00013         
+                      (fig-forth-auto680):00014         * This free/libre/open source publication is provided
+                      (fig-forth-auto680):00015         * through the courtesy of:
+                      (fig-forth-auto680):00016         * FORTH
+                      (fig-forth-auto680):00017         * INTEREST
+                      (fig-forth-auto680):00018         * GROUP
+                      (fig-forth-auto680):00019         * fig
+                      (fig-forth-auto680):00020         * and other interested parties.
+                      (fig-forth-auto680):00021         
+                      (fig-forth-auto680):00022         * Ancient address:
+                      (fig-forth-auto680):00023         * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
+                      (fig-forth-auto680):00024         * URL: http://www.forth.org
+                      (fig-forth-auto680):00025         * Further distribution must include this notice.
+                      (fig-forth-auto680):00026                 PAGE
+                      (fig-forth-auto680):00027                 NAM     Copyright: FORTH Interest Group, original authors, and Joel Matthew Rees
+                      (fig-forth-auto680):00028                 OPT     NOG,PAG
+                      (fig-forth-auto680):00029         * filename fig-forth-auto6809opt.asm
+                      (fig-forth-auto680):00030         * === FORTH-6809 {date} {time}
+                      (fig-forth-auto680):00031         
+                      (fig-forth-auto680):00032         
+                      (fig-forth-auto680):00033         * Permission is hereby granted, free of charge, to any person obtaining a copy
+                      (fig-forth-auto680):00034         * of this software and associated documentation files (the "Software"), to deal
+                      (fig-forth-auto680):00035         * in the Software without restriction, including without limitation the rights
+                      (fig-forth-auto680):00036         * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+                      (fig-forth-auto680):00037         * copies of the Software, and to permit persons to whom the Software is
+                      (fig-forth-auto680):00038         * furnished to do so, subject to the following conditions:
+                      (fig-forth-auto680):00039         *
+                      (fig-forth-auto680):00040         * The above copyright notice and this permission notice shall be included in
+                      (fig-forth-auto680):00041         * all copies or substantial portions of the Software.
+                      (fig-forth-auto680):00042         
+                      (fig-forth-auto680):00043         * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+                      (fig-forth-auto680):00044         * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+                      (fig-forth-auto680):00045         * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+                      (fig-forth-auto680):00046         * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+                      (fig-forth-auto680):00047         * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+                      (fig-forth-auto680):00048         * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+                      (fig-forth-auto680):00049         * THE SOFTWARE.
+                      (fig-forth-auto680):00050         *
+                      (fig-forth-auto680):00051         * "Associated documentation" for this declaration of license
+                      (fig-forth-auto680):00052         * shall be interpreted to include only the comments in this file,
+                      (fig-forth-auto680):00053         * or, if the code is split into multiple files,
+                      (fig-forth-auto680):00054         * all files containing the complete source.
+                      (fig-forth-auto680):00055         * 
+                      (fig-forth-auto680):00056         * This is the MIT model license, as published by the Open Source Consortium,
+                      (fig-forth-auto680):00057         * with associated documentation defined.
+                      (fig-forth-auto680):00058         * It was chosen to reflect the spirit of the original 
+                      (fig-forth-auto680):00059         * terms of use, which used archaic legal terminology.
+                      (fig-forth-auto680):00060         *
+                      (fig-forth-auto680):00061         
+                      (fig-forth-auto680):00062         * Authors of the 6800 model:
+                      (fig-forth-auto680):00063         * === Primary: Dave Lion,
+                      (fig-forth-auto680):00064         * ===  with help from
+                      (fig-forth-auto680):00065         * === Bob Smith,
+                      (fig-forth-auto680):00066         * === LaFarr Stuart,
+                      (fig-forth-auto680):00067         * === The Forth Interest Group
+                      (fig-forth-auto680):00068         * === PO Box 1105
+                      (fig-forth-auto680):00069         * === San Carlos, CA 94070
+                      (fig-forth-auto680):00070         * ===  and
+                      (fig-forth-auto680):00071         * === Unbounded Computing
+                      (fig-forth-auto680):00072         * === 1134-K Aster Ave.
+                      (fig-forth-auto680):00073         * === Sunnyvale, CA 94086
+                      (fig-forth-auto680):00074         *
+     0002             (fig-forth-auto680):00075         NATWID  EQU     2       ; bytes per natural integer/pointer
+                      (fig-forth-auto680):00076         *  The original version was developed on an AMI EVK 300 PROTO
+                      (fig-forth-auto680):00077         *  system using an ACIA for the I/O.
+                      (fig-forth-auto680):00078         *  This version is developed targeting the Tandy Color Computer.
+                      (fig-forth-auto680):00079         
+                      (fig-forth-auto680):00080         *  All terminal 1/0
+                      (fig-forth-auto680):00081         *  is done in three subroutines:
+                      (fig-forth-auto680):00082         *   PEMIT  ( word # 182 )
+                      (fig-forth-auto680):00083         *   PKEY   (        183 )
+                      (fig-forth-auto680):00084         *   PQTERM (        184 )
+                      (fig-forth-auto680):00085         *
+                      (fig-forth-auto680):00086         *  The FORTH words for disc related I/O follow the model
+                      (fig-forth-auto680):00087         *  of the FORTH Interest Group, but have not yet been
+                      (fig-forth-auto680):00088         *  tested using a real disc.
+                      (fig-forth-auto680):00089         *
+                      (fig-forth-auto680):00090         *  Addresses in the 6800 implementation reflect the fact that,
+                      (fig-forth-auto680):00091         *  on the development system, it was convenient to
+                      (fig-forth-auto680):00092         *  write-protect memory at hex 1000, and leave the first
+                      (fig-forth-auto680):00093         *  4K bytes write-enabled. As a consequence, code from
+                      (fig-forth-auto680):00094         *  location $1000 to lable ZZZZ could be put in ROM.
+                      (fig-forth-auto680):00095         *  Minor deviations from the model were made in the
+                      (fig-forth-auto680):00096         *  initialization and words ?STACK and FORGET
+                      (fig-forth-auto680):00097         *  in order to do this.
+                      (fig-forth-auto680):00098         *  Those deviations will be altered in this 
+                      (fig-forth-auto680):00099         *  implementation for the 6809 -- Color Computer.
+                      (fig-forth-auto680):00100         *  
+                      (fig-forth-auto680):00101         
+                      (fig-forth-auto680):00102         *
+     7FFF             (fig-forth-auto680):00103         MEMT32  EQU     $7FFF   absolute end of all ram
+     3FFF             (fig-forth-auto680):00104         MEMT16  EQU     $3FFF
+     7FFF             (fig-forth-auto680):00105         MEMTOP  EQU     MEMT32  ; tentative guess
+     FBCE             (fig-forth-auto680):00106         ACIAC   EQU     $FBCE   the ACIA control address and
+     FBCF             (fig-forth-auto680):00107         ACIAD   EQU     ACIAC+1 data address for PROTO
+                      (fig-forth-auto680):00108                 PAGE
+                      (fig-forth-auto680):00109         *  MEMORY MAP for this 16K|32K system:
+                      (fig-forth-auto680):00110         *  ( delineated so that systems with 4k byte write-
+                      (fig-forth-auto680):00111         *   protected segments can write protect FORTH )
+                      (fig-forth-auto680):00112         *
+                      (fig-forth-auto680):00113         * addr.         contents                pointer init by
+                      (fig-forth-auto680):00114         * ****  ******************************* ******* ******
+                      (fig-forth-auto680):00115         *       2nd through 4th per-user tables
+                      (fig-forth-auto680):00116         * 4000|7D00
+     0100             (fig-forth-auto680):00117         USERSZ  EQU     256     ; (Addressable by DP)
+     0001             (fig-forth-auto680):00118         USER16  EQU     1       ; We can change these for ROMPACK or 64K.
+     0004             (fig-forth-auto680):00119         USER32  EQU     4
+     0004             (fig-forth-auto680):00120         USERCT  EQU     USER32
+     3F00             (fig-forth-auto680):00121         IUP16   EQU     MEMT16+1-USER16*USERSZ
+     7C00             (fig-forth-auto680):00122         IUP32   EQU     MEMT32+1-USER32*USERSZ
+     7C00             (fig-forth-auto680):00123         IUP     EQU     IUP32
+     007C             (fig-forth-auto680):00124         IUPDP   EQU     IUP/256
+                      (fig-forth-auto680):00125         *       user tables of variables
+                      (fig-forth-auto680):00126         *       registers & pointers for the virtual machine
+                      (fig-forth-auto680):00127         *       scratch area used by various words
+                      (fig-forth-auto680):00128         * 3F00|7C00                             <== UP (DICTPT)
+                      (fig-forth-auto680):00129         * 3EFF|7BFF                                     HI
+                      (fig-forth-auto680):00130         *       substitute for disc mass memory
+     0003             (fig-forth-auto680):00131         RAMSCR  EQU     3
+     0400             (fig-forth-auto680):00132         SCRSZ   EQU     1024
+                      (fig-forth-auto680):00133         * 3300|7000                                     LO,MEMEND
+     3300             (fig-forth-auto680):00134         RAMD16  EQU     IUP16-RAMSCR*SCRSZ
+     7000             (fig-forth-auto680):00135         RAMD32  EQU     IUP32-RAMSCR*SCRSZ
+     7000             (fig-forth-auto680):00136         RAMDSK  EQU     RAMD32
+     3300             (fig-forth-auto680):00137         MEME16  EQU     RAMD16
+     7000             (fig-forth-auto680):00138         MEME32  EQU     RAMD32
+     7000             (fig-forth-auto680):00139         MEMEND  EQU     MEME32
+                      (fig-forth-auto680):00140         * 32FF|6FFF
+                      (fig-forth-auto680):00141         *       4 buffer sectors of VIRTUAL MEMORY
+     0004             (fig-forth-auto680):00142         NBLK    EQU     4 ; # of disc buffer blocks for virtual memory
+                      (fig-forth-auto680):00143         * Should NBLK be SCRSZ/SECTSZ?
+                      (fig-forth-auto680):00144         *  each block is SECTSZ+SECTRL bytes in size,
+                      (fig-forth-auto680):00145         *  holding SECTSZ characters
+     0100             (fig-forth-auto680):00146         SECTSZ  EQU     256
+     0008             (fig-forth-auto680):00147         SECTRL  EQU     8
+     0420             (fig-forth-auto680):00148         BUFSZ   EQU     (SECTSZ+SECTRL)*NBLK
+                      (fig-forth-auto680):00149         * 2EE0|6BE0                                     FIRST
+     2EE0             (fig-forth-auto680):00150         BUFB16  EQU     MEME16-BUFSZ
+     6BE0             (fig-forth-auto680):00151         BUFB32  EQU     MEME32-BUFSZ
+     6BE0             (fig-forth-auto680):00152         BUFBAS  EQU     BUFB32
+                      (fig-forth-auto680):00153         * "end" of "usable ram" -- in 16K
+                      (fig-forth-auto680):00154         * 2EE0|6BE0                             <== RP  RINIT
+     2EE0             (fig-forth-auto680):00155         IRP16   EQU     BUFB16
+     6BE0             (fig-forth-auto680):00156         IRP32   EQU     BUFB32
+     6BE0             (fig-forth-auto680):00157         IRP     EQU     IRP32
+                      (fig-forth-auto680):00158         *       RETURN STACK
+                      (fig-forth-auto680):00159         *       (64|112 levels nesting)
+     0080             (fig-forth-auto680):00160         RSTK16  EQU     128
+     00E0             (fig-forth-auto680):00161         RSTK32  EQU     224
+                      (fig-forth-auto680):00162         * (2E60|6B00)
+     2E60             (fig-forth-auto680):00163         SFTB16  EQU     IRP16-RSTK16
+     6B00             (fig-forth-auto680):00164         SFTB32  EQU     IRP32-RSTK32
+     6B00             (fig-forth-auto680):00165         SFTBND  EQU     SFTB32
+                      (fig-forth-auto680):00166         *       INPUT LINE BUFFER
+                      (fig-forth-auto680):00167         *       holds up to 256 characters
+                      (fig-forth-auto680):00168         *       and is scanned upward by IN
+                      (fig-forth-auto680):00169         *       starting at TIB
+     0100             (fig-forth-auto680):00170         TIBSZ   EQU     256
+                      (fig-forth-auto680):00171         * 2D60|6A00
+     2D60             (fig-forth-auto680):00172         ITIB16  EQU     SFTB16-TIBSZ
+     6A00             (fig-forth-auto680):00173         ITIB32  EQU     SFTB32-TIBSZ
+     6A00             (fig-forth-auto680):00174         ITIB    EQU     ITIB32
+                      (fig-forth-auto680):00175         * 2D60|6A00                             <== IN  TIB
+     2D60             (fig-forth-auto680):00176         ISP16   EQU     ITIB16
+     6A00             (fig-forth-auto680):00177         ISP32   EQU     ITIB32
+     6A00             (fig-forth-auto680):00178         ISP     EQU     ISP32
+                      (fig-forth-auto680):00179         * 2D60|6A00                             <== SP  SP0,SINIT
+                      (fig-forth-auto680):00180         *       DATA STACK
+                      (fig-forth-auto680):00181         *    |  grows downward from 2A60|6A00
+                      (fig-forth-auto680):00182         *    v
+                      (fig-forth-auto680):00183         *  - -
+                      (fig-forth-auto680):00184         *    |
+                      (fig-forth-auto680):00185         *    I  DICTIONARY grows upward
+                      (fig-forth-auto680):00186         * 
+                      (fig-forth-auto680):00187         * ????  end of ram-dictionary.          <== DICTPT      DPINIT
+                      (fig-forth-auto680):00188         *       "TASK"
+                      (fig-forth-auto680):00189         *
+                      (fig-forth-auto680):00190         * ????  "FORTH" ( a word )              <=, <== CONTEXT
+                      (fig-forth-auto680):00191         *                                       `==== CURRENT
+                      (fig-forth-auto680):00192         *       start of ram-dictionary.
+                      (fig-forth-auto680):00193         *
+                      (fig-forth-auto680):00194         * >>>>>> memory from here up must be in RAM area <<<<<<
+                      (fig-forth-auto680):00195         *
+                      (fig-forth-auto680):00196         * ????
+                      (fig-forth-auto680):00197         *       6k of romable "FORTH"           <== IP  ABORT
+                      (fig-forth-auto680):00198         *                                       <== W
+                      (fig-forth-auto680):00199         *       the VIRTUAL FORTH MACHINE
+                      (fig-forth-auto680):00200         *
+                      (fig-forth-auto680):00201         * 1208  initialization tables
+                      (fig-forth-auto680):00202         * 1204 <<< WARM START ENTRY >>>
+                      (fig-forth-auto680):00203         * 1200 <<< COLD START ENTRY >>>
+                      (fig-forth-auto680):00204         * 1200  lowest address used by FORTH
+                      (fig-forth-auto680):00205         *
+     1200             (fig-forth-auto680):00206         CODEBG  EQU $1200
+                      (fig-forth-auto680):00207         * CODEBG        EQU $3000
+                      (fig-forth-auto680):00208         *
+                      (fig-forth-auto680):00209         * >>>>>> memory from here down left alone <<<<<<
+                      (fig-forth-auto680):00210         * >>>>>> so we can safely call ROM routines <<<<<<
+                      (fig-forth-auto680):00211         *
+                      (fig-forth-auto680):00212         * 0000
+                      (fig-forth-auto680):00213                 PAGE
+                      (fig-forth-auto680):00214         ***
+                      (fig-forth-auto680):00215         *
+                      (fig-forth-auto680):00216         * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
+                      (fig-forth-auto680):00217         *
+                      (fig-forth-auto680):00218         * IP (hardware Y) points to the current instruction ( pre-increment mode )
+                      (fig-forth-auto680):00219         * RP (hardware S) points to last return address pushedin return stack
+                      (fig-forth-auto680):00220         * SP (hardware U) points to last byte pushed in data stack
+                      (fig-forth-auto680):00221         *
+                      (fig-forth-auto680):00222         * Y must be IP when NEXT is entered (if using the inner loop).
+                      (fig-forth-auto680):00223         *
+                      (fig-forth-auto680):00224         *       When A and B hold one 16 bit FORTH data word,
+                      (fig-forth-auto680):00225         *       A contains the high byte, B, the low byte.
+                      (fig-forth-auto680):00226         *
+                      (fig-forth-auto680):00227         * UP (hardware DP) is the base of per-task ("user") variables.
+                      (fig-forth-auto680):00228         * (Be careful of the stray semantics of "user".)
+                      (fig-forth-auto680):00229         *
+                      (fig-forth-auto680):00230         * W (hardware X) is the pointer to the "code field" address of native CPU 
+                      (fig-forth-auto680):00231         * machine code to be executed for the definition of the dictionary word 
+                      (fig-forth-auto680):00232         * to be executed/currently executing.
+                      (fig-forth-auto680):00233         * The following natural integer (word) begins any "parameter section" 
+                      (fig-forth-auto680):00234         * (body) -- similar to a "this" pointer, but not the same.
+                      (fig-forth-auto680):00235         * It may be native CPU machine code, or it may be a global variable, 
+                      (fig-forth-auto680):00236         * or it may be a list of Forth definition words (addresses).
+                      (fig-forth-auto680):00237         *
+                      (fig-forth-auto680):00238         * ======
+                      (fig-forth-auto680):00239         * This implementation uses the native subroutine architecture 
+                      (fig-forth-auto680):00240         * rather than a postponed-push call that the 6800 model VM uses
+                      (fig-forth-auto680):00241         * to save code and time in leaf routines. 
+                      (fig-forth-auto680):00242         *
+                      (fig-forth-auto680):00243         * This should allow directly calling many of the Forth words 
+                      (fig-forth-auto680):00244         * from assembly language code. 
+                      (fig-forth-auto680):00245         * (Be aware of the need for a valid W in some cases.)
+                      (fig-forth-auto680):00246         * It won't allow mixing assembly language directly into Forth word lists.
+                      (fig-forth-auto680):00247         * ======
+                      (fig-forth-auto680):00248         *
+                      (fig-forth-auto680):00249         * boolean flags:
+                      (fig-forth-auto680):00250         * 0 is false, anything else is true.
+                      (fig-forth-auto680):00251         * Most places in this model that set a boolean flag set true as 1.
+                      (fig-forth-auto680):00252         * This is in contrast to many models that set a boolean flag as -1.
+                      (fig-forth-auto680):00253         *
+                      (fig-forth-auto680):00254         ***
+                      (fig-forth-auto680):00255         
+                      (fig-forth-auto680):00256                 PAGE
+                      (fig-forth-auto680):00257         *       This system is shown with one user (task), 
+                      (fig-forth-auto680):00258         *       but additional users (tasks) may be added
+                      (fig-forth-auto680):00259         *       by allocating additional user tables:
+                      (fig-forth-auto680):00260         *
+                      (fig-forth-auto680):00261                 ORG     IUP
+7C00                  (fig-forth-auto680):00262         UBASE   RMB     USERSZ
+7D00                  (fig-forth-auto680):00263         UBASEX  RMB     USERSZ data table for extra users
+                      (fig-forth-auto680):00264         *
+                      (fig-forth-auto680):00265         *       Some of this stuff gets initialized during
+                      (fig-forth-auto680):00266         *       COLD start and WARM start:
+                      (fig-forth-auto680):00267         *       [ names correspond to FORTH words of similar (no X) name ]
+                      (fig-forth-auto680):00268         *
+                      (fig-forth-auto680):00269                 ORG     IUP
+     7C00             (fig-forth-auto680):00270         UORIG   EQU     *
+                      (fig-forth-auto680):00271         *               A few useful VM variables
+                      (fig-forth-auto680):00272         * Will be removed when they are no longer needed.
+                      (fig-forth-auto680):00273         * All are replaced by 6809 registers.
+                      (fig-forth-auto680):00274         
+7C00                  (fig-forth-auto680):00275         N       RMB     10      used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
+                      (fig-forth-auto680):00276         *                               SP@,SWAP,DOES>,COLD
+                      (fig-forth-auto680):00277         
+                      (fig-forth-auto680):00278         
+                      (fig-forth-auto680):00279         *       These locations are used by the TRACE routine :
+                      (fig-forth-auto680):00280         
+7C0A                  (fig-forth-auto680):00281         TRLIM   RMB     1       the count for tracing without user intervention
+7C0B                  (fig-forth-auto680):00282         TRACEM  RMB     1       non-zero = trace mode
+7C0C                  (fig-forth-auto680):00283         BRKPT   RMB     2       the breakpoint address at which
+                      (fig-forth-auto680):00284         *                       the program will go into trace mode
+7C0E                  (fig-forth-auto680):00285         VECT    RMB     2       vector to machine code
+                      (fig-forth-auto680):00286         *       (only needed if the TRACE routine is resident)
+                      (fig-forth-auto680):00287         
+                      (fig-forth-auto680):00288         
+                      (fig-forth-auto680):00289         *       Registers used by the FORTH virtual machine:
+                      (fig-forth-auto680):00290         *       Starting at $OOFO:
+                      (fig-forth-auto680):00291         
+                      (fig-forth-auto680):00292         
+7C10                  (fig-forth-auto680):00293         W       RMB     2       the instruction register points to 6800 code
+                      (fig-forth-auto680):00294         * This is not exactly accurate. Points to the definiton body,
+                      (fig-forth-auto680):00295         * which is native CPU machine code when it is native CPU machine code.
+7C12                  (fig-forth-auto680):00296         IP      RMB     2       the instruction pointer points to pointer to 6800 code
+7C14                  (fig-forth-auto680):00297         RP      RMB     2       the return stack pointer
+7C16                  (fig-forth-auto680):00298         UP      RMB     2       the pointer to base of current user's 'USER' table
+                      (fig-forth-auto680):00299         *               ( altered during multi-tasking )
+                      (fig-forth-auto680):00300         *
+                      (fig-forth-auto680):00301         *UORIG  RMB     6       3 reserved variables
+7C18                  (fig-forth-auto680):00302                 RMB     6       3 reserved variables
+7C1E                  (fig-forth-auto680):00303         XSPZER  RMB     2       initial top of data stack for this user
+7C20                  (fig-forth-auto680):00304         XRZERO  RMB     2       initial top of return stack
+7C22                  (fig-forth-auto680):00305         XTIB    RMB     2       start of terminal input buffer
+7C24                  (fig-forth-auto680):00306         XWIDTH  RMB     2       name field width
+7C26                  (fig-forth-auto680):00307         XWARN   RMB     2       warning message mode (0 = no disc)
+7C28                  (fig-forth-auto680):00308         XFENCE  RMB     2       fence for FORGET
+7C2A                  (fig-forth-auto680):00309         XDICTP  RMB     2       dictionary pointer
+7C2C                  (fig-forth-auto680):00310         XVOCL   RMB     2       vocabulary linking
+7C2E                  (fig-forth-auto680):00311         XBLK    RMB     2       disc block being accessed
+7C30                  (fig-forth-auto680):00312         XIN     RMB     2       scan pointer into the block
+7C32                  (fig-forth-auto680):00313         XOUT    RMB     2       cursor position
+7C34                  (fig-forth-auto680):00314         XSCR    RMB     2       disc screen being accessed ( O=terminal )
+7C36                  (fig-forth-auto680):00315         XOFSET  RMB     2       disc sector offset for multi-disc
+7C38                  (fig-forth-auto680):00316         XCONT   RMB     2       last word in primary search vocabulary
+7C3A                  (fig-forth-auto680):00317         XCURR   RMB     2       last word in extensible vocabulary
+7C3C                  (fig-forth-auto680):00318         XSTATE  RMB     2       flag for 'interpret' or 'compile' modes
+7C3E                  (fig-forth-auto680):00319         XBASE   RMB     2       number base for I/O numeric conversion
+7C40                  (fig-forth-auto680):00320         XDPL    RMB     2       decimal point place
+7C42                  (fig-forth-auto680):00321         XFLD    RMB     2       
+7C44                  (fig-forth-auto680):00322         XCSP    RMB     2       current stack position, for compile checks
+7C46                  (fig-forth-auto680):00323         XRNUM   RMB     2       
+7C48                  (fig-forth-auto680):00324         XHLD    RMB     2       
+7C4A                  (fig-forth-auto680):00325         XDELAY  RMB     2       carriage return delay count
+7C4C                  (fig-forth-auto680):00326         XCOLUM  RMB     2       carriage width
+7C4E                  (fig-forth-auto680):00327         IOSTAT  RMB     2       last acia status from write/read
+7C50                  (fig-forth-auto680):00328                 RMB     2       ( 4 spares! )
+7C52                  (fig-forth-auto680):00329                 RMB     2       
+7C54                  (fig-forth-auto680):00330                 RMB     2       
+7C56                  (fig-forth-auto680):00331                 RMB     2       
+                      (fig-forth-auto680):00332         
+                      (fig-forth-auto680):00333         
+                      (fig-forth-auto680):00334         
+                      (fig-forth-auto680):00335         
+                      (fig-forth-auto680):00336         *
+                      (fig-forth-auto680):00337         *
+                      (fig-forth-auto680):00338         *   end of user table, start of common system variables
+                      (fig-forth-auto680):00339         *
+                      (fig-forth-auto680):00340         *
+                      (fig-forth-auto680):00341         *
+7C58                  (fig-forth-auto680):00342         XUSE    RMB     2
+7C5A                  (fig-forth-auto680):00343         XPREV   RMB     2
+7C5C                  (fig-forth-auto680):00344                 RMB     4       ( spares )
+                      (fig-forth-auto680):00345         
+                      (fig-forth-auto680):00346                 PAGE
+                      (fig-forth-auto680):00347         *    The FORTH program ( address $1200 to about $27FF ) will be written
+                      (fig-forth-auto680):00348         *    so that it can be in a ROM, or write-protected if desired,
+                      (fig-forth-auto680):00349         * but right now we're just getting it running.
+                      (fig-forth-auto680):00350                 ORG     CODEBG
+                      (fig-forth-auto680):00351         
+                      (fig-forth-auto680):00352         * ######>> screen 3 <<
+                      (fig-forth-auto680):00353         *
+                      (fig-forth-auto680):00354         ***************************
+                      (fig-forth-auto680):00355         **  C O L D   E N T R Y  **
+                      (fig-forth-auto680):00356         ***************************
+1200 12               (fig-forth-auto680):00357         ORIG    NOP
+                      (fig-forth-auto680):00358         *       JMP     CENT
+1201 171028           (fig-forth-auto680):00359                 LBSR    CENT
+                      (fig-forth-auto680):00360         ***************************
+                      (fig-forth-auto680):00361         **  W A R M   E N T R Y  **
+                      (fig-forth-auto680):00362         ***************************
+1204 12               (fig-forth-auto680):00363                 NOP
+                      (fig-forth-auto680):00364         *       JMP     WENT    warm-start code, keeps current dictionary intact
+1205 171061           (fig-forth-auto680):00365                 LBSR    WENT    warm-start code, keeps current dictionary intact
+     7C               (fig-forth-auto680):00366                 SETDP   IUPDP
+                      (fig-forth-auto680):00367         
+                      (fig-forth-auto680):00368         *
+                      (fig-forth-auto680):00369         ******* startup parmeters **************************
+                      (fig-forth-auto680):00370         *
+1208 68090000         (fig-forth-auto680):00371                 FDB     $6809,0000      cpu & revision
+120C 0000             (fig-forth-auto680):00372                 FDB     0       topmost word in FORTH vocabulary
+                      (fig-forth-auto680):00373         * BACKSP        FDB     $7F     backspace character for editing 
+120E 0008             (fig-forth-auto680):00374         BACKSP  FDB     $08     backspace character for editing 
+1210 7C00             (fig-forth-auto680):00375         UPINIT  FDB     UORIG   initial user area
+                      (fig-forth-auto680):00376         * UPINIT        FDB     UORIG   initial user area
+1212 6A00             (fig-forth-auto680):00377         SINIT   FDB     ISP     ; initial top of data stack
+                      (fig-forth-auto680):00378         * SINIT FDB     ORIG-$D0        initial top of data stack
+1214 6BE0             (fig-forth-auto680):00379         RINIT   FDB     IRP     ; initial top of return stack
+                      (fig-forth-auto680):00380         * RINIT FDB     ORIG-2  initial top of return stack
+1216 6A00             (fig-forth-auto680):00381                 FDB     ITIB    ; terminal input buffer
+                      (fig-forth-auto680):00382         *       FDB     ORIG-$D0        terminal input buffer
+1218 001F             (fig-forth-auto680):00383                 FDB     31      initial name field width
+121A 0000             (fig-forth-auto680):00384                 FDB     0       initial warning mode (0 = no disc)
+121C 2A31             (fig-forth-auto680):00385         FENCIN  FDB     REND    initial fence
+121E 2A31             (fig-forth-auto680):00386         DPINIT  FDB     REND    cold start value for DICTPT
+1220 2A06             (fig-forth-auto680):00387         VOCINT  FDB     FORTH+4*NATWID  
+1222 0084             (fig-forth-auto680):00388         COLINT  FDB     132     initial terminal carriage width
+1224 0004             (fig-forth-auto680):00389         DELINT  FDB     4       initial carriage return delay
+                      (fig-forth-auto680):00390         ****************************************************
+                      (fig-forth-auto680):00391         *
+                      (fig-forth-auto680):00392                 PAGE
+                      (fig-forth-auto680):00393         *
+                      (fig-forth-auto680):00394         * ######>> screen 13 <<
+                      (fig-forth-auto680):00395         * These were of questionable use anyway, 
+                      (fig-forth-auto680):00396         * kept here now to satisfy the assembler and show hints.
+                      (fig-forth-auto680):00397         * They're too much trouble to use with native subroutine call anyway.
+                      (fig-forth-auto680):00398         * PULABX        PULS A  ; 24 cycles until 'NEXT'
+                      (fig-forth-auto680):00399         *       PULS B  ; 
+                      (fig-forth-auto680):00400         * PULABX        PULU A,B        ; ?? cycles until 'NEXT'
+                      (fig-forth-auto680):00401         * STABX STA 0,X 16 cycles until 'NEXT'
+                      (fig-forth-auto680):00402         *       STB 1,X
+                      (fig-forth-auto680):00403         * STABX STD 0,X ; ?? cycles until 'NEXT'
+1226 2000             (fig-forth-auto680):00404                 BRA     NEXT
+                      (fig-forth-auto680):00405         * GETX  LDA 0,X 18 cycles until 'NEXT'
+                      (fig-forth-auto680):00406         *       LDB 1,X
+                      (fig-forth-auto680):00407         * GETX  LDD 0,X ?? cycles until 'NEXT'
+                      (fig-forth-auto680):00408         * PUSHBA        PSHS B  ; 8 cycles until 'NEXT'
+                      (fig-forth-auto680):00409         *       PSHS A  ; 
+                      (fig-forth-auto680):00410         * PUSHBA        PSHU A,B        ; ?? cycles until 'NEXT'
+                      (fig-forth-auto680):00411         
+                      (fig-forth-auto680):00412         
+                      (fig-forth-auto680):00413         *
+                      (fig-forth-auto680):00414         * "NEXT" takes ?? cycles if TRACE is removed,
+                      (fig-forth-auto680):00415         *
+                      (fig-forth-auto680):00416         * and ?? cycles if trace is present and NOT tracing.
+                      (fig-forth-auto680):00417         *
+                      (fig-forth-auto680):00418         * = = = = = = =   t h e   v i r t u a l   m a c h i n e   = = = = =
+                      (fig-forth-auto680):00419         *                                                                 =
+                      (fig-forth-auto680):00420         * NEXT itself might just completely go away.
+                      (fig-forth-auto680):00421         * About the only reason to keep it is to allowing executing a list
+                      (fig-forth-auto680):00422         * which allows a cheap TRACE routine.
+                      (fig-forth-auto680):00423         *
+                      (fig-forth-auto680):00424         * NEXT is a loop which implements the Forth VM.
+                      (fig-forth-auto680):00425         * It basically cycles through calling the code out of code lists,
+                      (fig-forth-auto680):00426         * one at a time.
+                      (fig-forth-auto680):00427         * Using a native CPU return for this uses a few extra cycles per call,
+                      (fig-forth-auto680):00428         * compared to simply jumping to each definition and jumping back 
+                      (fig-forth-auto680):00429         * to the known beginning of the loop,
+                      (fig-forth-auto680):00430         * but the loop itself is really only there for convenience.
+                      (fig-forth-auto680):00431         * 
+                      (fig-forth-auto680):00432         * This implementation uses the native subroutine call,
+                      (fig-forth-auto680):00433         * to break the wall between Forth code and non-Forth code.
+                      (fig-forth-auto680):00434         *
+                      (fig-forth-auto680):00435         * NEXT  LDX     IP
+                      (fig-forth-auto680):00436         *       LEAX 1,X        ;               pre-increment mode
+                      (fig-forth-auto680):00437         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00438         *       STX     IP
+1228                  (fig-forth-auto680):00439         NEXT    ; IP is Y, push before using, pull before you come back here.
+                      (fig-forth-auto680):00440         * 
+                      (fig-forth-auto680):00441         * NEXT2 LDX     0,X     get W which points to CFA of word to be done
+1228 AEA1             (fig-forth-auto680):00442         NEXT2   LDX     ,Y++    get W which points to CFA of word to be done
+122A 8D08             (fig-forth-auto680):00443                 BSR     DBGNAM
+122C 8D58             (fig-forth-auto680):00444                 BSR     DBGREG
+                      (fig-forth-auto680):00445         * But NEXT2 is too much trouble to use with subroutine threading anyway.
+                      (fig-forth-auto680):00446         * NEXT3 STX     W
+122E                  (fig-forth-auto680):00447         NEXT3   ; W is X until you use X for something else. (TOS points back here.)
+                      (fig-forth-auto680):00448         * But NEXT3 is too much trouble to use with subroutine threading anyway.
+                      (fig-forth-auto680):00449         *       LDX     0,X     get VECT which points to executable code
+                      (fig-forth-auto680):00450         *                                                                 =
+                      (fig-forth-auto680):00451         * The next instruction could be patched to JMP TRACE              =
+                      (fig-forth-auto680):00452         * if a TRACE routine is available:                                =
+                      (fig-forth-auto680):00453         *                                                                 =
+                      (fig-forth-auto680):00454         *       JMP     0,X
+                      (fig-forth-auto680):00455         
+122E AD94             (fig-forth-auto680):00456                 JSR     [,X]    ; Saving the postinc cycles,
+                      (fig-forth-auto680):00457         *                       ; but X must be bumped NATWID to the parameters.
+                      (fig-forth-auto680):00458         *       NOP
+                      (fig-forth-auto680):00459         *       JMP     TRACE   ( an alternate for the above )
+1230 8D54             (fig-forth-auto680):00460                 BSR     DBGREG  ( an alternate for the above )
+                      (fig-forth-auto680):00461         * In other words, with the call and the NOP,
+                      (fig-forth-auto680):00462         * there is room to patch the call with a JMP to your TRACE 
+                      (fig-forth-auto680):00463         * routine, which you have to provide.
+1232 20F4             (fig-forth-auto680):00464                 BRA     NEXT
+                      (fig-forth-auto680):00465         *
+1234 3437             (fig-forth-auto680):00466         DBGNAM  PSHS    CC,D,X,Y
+1236 0D0B             (fig-forth-auto680):00467                 TST     <TRACEM
+1238 2724             (fig-forth-auto680):00468                 BEQ     DBGNrt
+123A 301D             (fig-forth-auto680):00469                 LEAX    -3,X
+123C E682             (fig-forth-auto680):00470         DBGNlf  LDB     ,-X
+123E 2AFC             (fig-forth-auto680):00471                 BPL     DBGNlf
+1240 108E04C0         (fig-forth-auto680):00472                 LDY     #$4C0
+1244 E680             (fig-forth-auto680):00473                 LDB     ,X+
+1246 E680             (fig-forth-auto680):00474         DBGNlp  LDB     ,X+
+1248 2B04             (fig-forth-auto680):00475                 BMI     DBGNll
+124A E7A0             (fig-forth-auto680):00476                 STB     ,Y+
+124C 20F8             (fig-forth-auto680):00477                 BRA     DBGNlp
+124E C47F             (fig-forth-auto680):00478         DBGNll  ANDB    #$7F
+1250 E7A0             (fig-forth-auto680):00479                 STB     ,Y+
+1252 C660             (fig-forth-auto680):00480                 LDB     #$60
+1254 2002             (fig-forth-auto680):00481                 BRA     DBGNlt
+1256 E7A0             (fig-forth-auto680):00482         DBGNlc  STB     ,Y+     
+1258 108C04E0         (fig-forth-auto680):00483         DBGNlt  CMPY    #$4E0
+125C 25F8             (fig-forth-auto680):00484                 BLO     DBGNlc
+125E 35B7             (fig-forth-auto680):00485         DBGNrt  PULS    CC,D,X,Y,PC
+                      (fig-forth-auto680):00486         *
+                      (fig-forth-auto680):00487         *
+1260 54               (fig-forth-auto680):00488         MKhxBh  LSRB
+1261 54               (fig-forth-auto680):00489                 LSRB
+1262 54               (fig-forth-auto680):00490                 LSRB
+1263 54               (fig-forth-auto680):00491                 LSRB
+1264 C40F             (fig-forth-auto680):00492         MKhxBl  ANDB    #$0F
+1266 CB30             (fig-forth-auto680):00493                 ADDB    #$30
+1268 C139             (fig-forth-auto680):00494                 CMPB    #$39
+126A 2302             (fig-forth-auto680):00495                 BLS     MKhxBx
+126C CBC7             (fig-forth-auto680):00496                 ADDB    #$C7    ; ($40-$39)-$40
+126E 39               (fig-forth-auto680):00497         MKhxBx  RTS
+                      (fig-forth-auto680):00498         *
+126F 1E89             (fig-forth-auto680):00499         OUThxA  EXG     A,B
+1271 8D05             (fig-forth-auto680):00500                 BSR     OUThxB
+1273 1E89             (fig-forth-auto680):00501                 EXG     A,B
+1275 39               (fig-forth-auto680):00502                 RTS
+                      (fig-forth-auto680):00503         *
+1276 8DF7             (fig-forth-auto680):00504         OUThxD  BSR     OUThxA
+1278 3404             (fig-forth-auto680):00505         OUThxB  PSHS    B
+127A 8DE4             (fig-forth-auto680):00506                 BSR     MKhxBh
+127C E780             (fig-forth-auto680):00507                 STB     ,X+
+127E E6E4             (fig-forth-auto680):00508                 LDB     ,S
+1280 8DE2             (fig-forth-auto680):00509                 BSR     MKhxBl
+1282 E780             (fig-forth-auto680):00510                 STB     ,X+
+1284 3584             (fig-forth-auto680):00511                 PULS    B,PC
+                      (fig-forth-auto680):00512         *
+1286 347F             (fig-forth-auto680):00513         DBGREG  PSHS    U,Y,X,DP,B,A,CC
+1288 0D0B             (fig-forth-auto680):00514                 TST     <TRACEM
+128A 102700DF         (fig-forth-auto680):00515                 LBEQ    DBGRrt
+128E 318D00DD         (fig-forth-auto680):00516                 LEAY    DBGRLB,PCR
+1292 8E04E0           (fig-forth-auto680):00517                 LDX     #$4E0
+1295 ECA1             (fig-forth-auto680):00518         DBGRlp  LDD     ,Y++
+1297 2704             (fig-forth-auto680):00519                 BEQ     DBGRdn
+1299 ED81             (fig-forth-auto680):00520                 STD     ,X++
+129B 20F8             (fig-forth-auto680):00521                 BRA     DBGRlp
+129D 8E0500           (fig-forth-auto680):00522         DBGRdn  LDX     #$500
+12A0 A663             (fig-forth-auto680):00523                 LDA     3,S     ; DP
+12A2 E6E4             (fig-forth-auto680):00524                 LDB     ,S      ; CC
+12A4 8DD0             (fig-forth-auto680):00525                 BSR     OUThxD
+12A6 C660             (fig-forth-auto680):00526                 LDB     #$60
+12A8 E780             (fig-forth-auto680):00527                 STB     ,X+
+12AA EC6A             (fig-forth-auto680):00528                 LDD     3*NATWID+4,S    ; PC:505
+12AC 8DC8             (fig-forth-auto680):00529                 BSR     OUThxD
+12AE C660             (fig-forth-auto680):00530                 LDB     #$60
+12B0 E780             (fig-forth-auto680):00531                 STB     ,X+
+12B2 1F40             (fig-forth-auto680):00532                 TFR     S,D     ; 509
+12B4 C3000C           (fig-forth-auto680):00533                 ADDD    #4*NATWID+4
+12B7 8DBD             (fig-forth-auto680):00534                 BSR     OUThxD
+12B9 EC68             (fig-forth-auto680):00535                 LDD     2*NATWID+4,S    ; U:50E
+12BB 8DB9             (fig-forth-auto680):00536                 BSR     OUThxD
+12BD C660             (fig-forth-auto680):00537                 LDB     #$60
+12BF E780             (fig-forth-auto680):00538                 STB     ,X+
+12C1 EC66             (fig-forth-auto680):00539                 LDD     1*NATWID+4,S    ; Y:513
+12C3 8DB1             (fig-forth-auto680):00540                 BSR     OUThxD
+12C5 EC64             (fig-forth-auto680):00541                 LDD     0*NATWID+4,S    ; X at 517
+12C7 8DAD             (fig-forth-auto680):00542                 BSR     OUThxD
+12C9 C660             (fig-forth-auto680):00543                 LDB     #$60
+12CB E780             (fig-forth-auto680):00544                 STB     ,X+
+12CD EC61             (fig-forth-auto680):00545                 LDD     1,S     ; D at 51C
+12CF 8DA5             (fig-forth-auto680):00546                 BSR     OUThxD
+12D1 C660             (fig-forth-auto680):00547                 LDB     #$60
+12D3 E780             (fig-forth-auto680):00548                 STB     ,X+
+12D5 E780             (fig-forth-auto680):00549                 STB     ,X+
+12D7 E780             (fig-forth-auto680):00550                 STB     ,X+
+12D9 E780             (fig-forth-auto680):00551                 STB     ,X+
+12DB E780             (fig-forth-auto680):00552                 STB     ,X+
+12DD ECF80A           (fig-forth-auto680):00553                 LDD     [3*NATWID+4,S]  ; PC
+12E0 8D94             (fig-forth-auto680):00554                 BSR     OUThxD
+12E2 C660             (fig-forth-auto680):00555                 LDB     #$60
+12E4 E780             (fig-forth-auto680):00556                 STB     ,X+
+12E6 EC6C             (fig-forth-auto680):00557                 LDD     4*NATWID+4,S    ; S
+12E8 8D8C             (fig-forth-auto680):00558                 BSR     OUThxD
+12EA ECF808           (fig-forth-auto680):00559                 LDD     [2*NATWID+4,S]  ; U
+12ED 8D87             (fig-forth-auto680):00560                 BSR     OUThxD
+12EF C660             (fig-forth-auto680):00561                 LDB     #$60
+12F1 E780             (fig-forth-auto680):00562                 STB     ,X+
+12F3 ECF806           (fig-forth-auto680):00563                 LDD     [1*NATWID+4,S]  ; Y
+12F6 17FF7D           (fig-forth-auto680):00564                 LBSR    OUThxD
+12F9 ECF804           (fig-forth-auto680):00565                 LDD     [0*NATWID+4,S]  ; X
+12FC 17FF77           (fig-forth-auto680):00566                 LBSR    OUThxD
+12FF C660             (fig-forth-auto680):00567                 LDB     #$60
+1301 E780             (fig-forth-auto680):00568                 STB     ,X+
+1303 E780             (fig-forth-auto680):00569                 STB     ,X+
+1305 E780             (fig-forth-auto680):00570                 STB     ,X+
+1307 E780             (fig-forth-auto680):00571                 STB     ,X+
+1309 E780             (fig-forth-auto680):00572                 STB     ,X+
+130B C600             (fig-forth-auto680):00573                 LDB     #0
+130D 1E9B             (fig-forth-auto680):00574                 EXG     B,DP
+130F AD9FA000         (fig-forth-auto680):00575         DBGRkl  JSR     [$A000]
+1313 27FA             (fig-forth-auto680):00576                 BEQ     DBGRkl
+1315 FD043E           (fig-forth-auto680):00577                 STD     $43E
+1318 1EB9             (fig-forth-auto680):00578                 EXG     DP,B
+131A 8155             (fig-forth-auto680):00579                 CMPA    #$55    ; 'U'
+131C 273C             (fig-forth-auto680):00580                 BEQ     DBGRdU
+131E 8153             (fig-forth-auto680):00581                 CMPA    #$53    ; 'S'
+1320 271E             (fig-forth-auto680):00582                 BEQ     DBGRdS
+1322 8149             (fig-forth-auto680):00583                 CMPA    #$49    ; 'I'
+1324 2647             (fig-forth-auto680):00584                 BNE     DBGRrt
+1326 DC22             (fig-forth-auto680):00585         DBGRin  LDD     <XTIB
+1328 D330             (fig-forth-auto680):00586                 ADDD    <XIN
+132A 1F02             (fig-forth-auto680):00587                 TFR     D,Y
+132C 17FF47           (fig-forth-auto680):00588                 LBSR    OUThxD
+132F C63A             (fig-forth-auto680):00589                 LDB     #$3a    ; ':'
+1331 E780             (fig-forth-auto680):00590                 STB     ,X+
+1333 964C             (fig-forth-auto680):00591                 LDA     <XCOLUM
+1335 E6A0             (fig-forth-auto680):00592         DBGRip  LDB     ,Y+
+1337 E780             (fig-forth-auto680):00593                 STB     ,X+
+1339 2732             (fig-forth-auto680):00594                 BEQ     DBGRrt
+133B 4A               (fig-forth-auto680):00595         DBGRit  DECA
+133C 26F7             (fig-forth-auto680):00596                 BNE     DBGRip
+133E 202D             (fig-forth-auto680):00597                 BRA     DBGRrt
+1340 1F42             (fig-forth-auto680):00598         DBGRdS  TFR     S,Y
+1342 2009             (fig-forth-auto680):00599                 BRA     DBGRst
+1344 ECA1             (fig-forth-auto680):00600         DBGRsp  LDD     ,Y++
+1346 17FF2D           (fig-forth-auto680):00601                 LBSR    OUThxD
+1349 C660             (fig-forth-auto680):00602                 LDB     #$60
+134B E780             (fig-forth-auto680):00603                 STB     ,X+
+134D 109C20           (fig-forth-auto680):00604         DBGRst  CMPY    <XRZERO
+1350 25F2             (fig-forth-auto680):00605                 BLO     DBGRsp
+1352 C63A             (fig-forth-auto680):00606                 LDB     #$3a    ; ':'
+1354 E780             (fig-forth-auto680):00607                 STB     ,X+
+1356 C655             (fig-forth-auto680):00608                 LDB     #$55
+1358 E780             (fig-forth-auto680):00609                 STB     ,X+
+135A 10AE68           (fig-forth-auto680):00610         DBGRdU  LDY     2*NATWID+4,S
+135D 2009             (fig-forth-auto680):00611                 BRA     DBGRut
+135F ECA1             (fig-forth-auto680):00612         DBGRup  LDD     ,Y++
+1361 17FF12           (fig-forth-auto680):00613                 LBSR    OUThxD
+1364 C660             (fig-forth-auto680):00614                 LDB     #$60
+1366 E780             (fig-forth-auto680):00615                 STB     ,X+
+1368 109C1E           (fig-forth-auto680):00616         DBGRut  CMPY    <XSPZER
+136B 25F2             (fig-forth-auto680):00617                 BLO     DBGRup
+136D 35FF             (fig-forth-auto680):00618         DBGRrt  PULS    CC,A,B,DP,X,Y,U,PC
+136F 4450434320504320 (fig-forth-auto680):00619         DBGRLB  FCC     'DPCC PC   S   U    Y   X    A B '
+     2020532020205520
+     2020205920202058
+     2020202041204220
+138F 00000000         (fig-forth-auto680):00620                 FDB     0,0
+                      (fig-forth-auto680):00621         
+                      (fig-forth-auto680):00622         
+                      (fig-forth-auto680):00623         *
+                      (fig-forth-auto680):00624         *                                                                 =
+                      (fig-forth-auto680):00625         * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+                      (fig-forth-auto680):00626         
+                      (fig-forth-auto680):00627         
+                      (fig-forth-auto680):00628                 PAGE
+                      (fig-forth-auto680):00629         *
+                      (fig-forth-auto680):00630         * ======>>  1  <<
+                      (fig-forth-auto680):00631         * ( --- n )
+                      (fig-forth-auto680):00632         * Pushes the following natural width integer from the instruction stream
+                      (fig-forth-auto680):00633         * as a literal, or immediate value.
+                      (fig-forth-auto680):00634         *
+                      (fig-forth-auto680):00635         *       FDB {OP}
+                      (fig-forth-auto680):00636         *       FDB {OP}
+                      (fig-forth-auto680):00637         *       FDB LIT
+                      (fig-forth-auto680):00638         *       FDB LITERAL-TO-BE-PUSHED
+                      (fig-forth-auto680):00639         *       FDB {OP}
+                      (fig-forth-auto680):00640         *
+                      (fig-forth-auto680):00641         * In native processor code, there should be a better way, use that instead.
+                      (fig-forth-auto680):00642         * More specifically, DO NOT CALL THIS from assembly language code.
+                      (fig-forth-auto680):00643         * (Note that there is no compile-only flag in the fig model.)
+                      (fig-forth-auto680):00644         *
+                      (fig-forth-auto680):00645         * See (FIND), or PFIND , for layout of the header format.
+                      (fig-forth-auto680):00646         *
+1393 83               (fig-forth-auto680):00647                 FCB     $83
+1394 4C49             (fig-forth-auto680):00648                 FCC     'LI'    ; 'LIT' :       NOTE: this is different from LITERAL
+1396 D4               (fig-forth-auto680):00649                 FCB     $D4     ; 'T'|'\x80'    ; character code for T, with high bit set.
+1397 0000             (fig-forth-auto680):00650                 FDB     0       ; link of zero to terminate dictionary scan
+1399 139B             (fig-forth-auto680):00651         LIT     FDB     *+NATWID        ; Note also that LIT is meaningless in native code.
+139B ECA1             (fig-forth-auto680):00652                 LDD     ,Y++
+139D 3606             (fig-forth-auto680):00653                 PSHU    A,B
+139F 39               (fig-forth-auto680):00654                 RTS
+                      (fig-forth-auto680):00655         *       LDX     IP
+                      (fig-forth-auto680):00656         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00657         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00658         *       STX     IP
+                      (fig-forth-auto680):00659         *       LDA 0,X
+                      (fig-forth-auto680):00660         *       LDB 1,X
+                      (fig-forth-auto680):00661         *       JMP     PUSHBA
+                      (fig-forth-auto680):00662         *
+                      (fig-forth-auto680):00663         * ######>> screen 14 <<
+                      (fig-forth-auto680):00664         * ======>>  2  <<
+                      (fig-forth-auto680):00665         * ( --- n )
+                      (fig-forth-auto680):00666         * Pushes the following byte from the instruction stream
+                      (fig-forth-auto680):00667         * as a literal, or immediate value.
+                      (fig-forth-auto680):00668         *
+                      (fig-forth-auto680):00669         *       FDB {OP}
+                      (fig-forth-auto680):00670         *       FDB {OP}
+                      (fig-forth-auto680):00671         *       FDB LIT8
+                      (fig-forth-auto680):00672         *       FCB LITERAL-TO-BE-PUSHED
+                      (fig-forth-auto680):00673         *       FDB {OP}
+                      (fig-forth-auto680):00674         *
+                      (fig-forth-auto680):00675         * If this is kept, it should have a header for TRACE to read.
+                      (fig-forth-auto680):00676         * If the data bus is wider than a byte, you don't want to do this.
+                      (fig-forth-auto680):00677         * Byte shaving like this is often counter-productive anyway.
+                      (fig-forth-auto680):00678         * Changing the name to LIT8, hoping that will be more understandable.
+                      (fig-forth-auto680):00679         * Also, see comments for LIT.
+                      (fig-forth-auto680):00680         * (Note that there is no compile-only flag in the fig model.)
+13A0 84               (fig-forth-auto680):00681                 FCB     $84
+13A1 4C4954           (fig-forth-auto680):00682                 FCC     'LIT'   ; 'LIT8' :      NOTE: this is different from LITERAL
+13A4 B8               (fig-forth-auto680):00683                 FCB     $B8
+13A5 1393             (fig-forth-auto680):00684                 FDB     LIT-6
+13A7 13A9             (fig-forth-auto680):00685         LIT8    FDB     *+NATWID         (this was an invisible word, with no header)
+13A9 E6A0             (fig-forth-auto680):00686                 LDB     ,Y+     ; This also is meaningless in native code.
+13AB 4F               (fig-forth-auto680):00687                 CLRA
+13AC 3606             (fig-forth-auto680):00688                 PSHU    A,B
+13AE 39               (fig-forth-auto680):00689                 RTS
+                      (fig-forth-auto680):00690         *       LDX     IP
+                      (fig-forth-auto680):00691         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00692         *       STX     IP
+                      (fig-forth-auto680):00693         *       CLRA    ;
+                      (fig-forth-auto680):00694         *       LDB 1,X
+                      (fig-forth-auto680):00695         *       JMP     PUSHBA
+                      (fig-forth-auto680):00696         *
+                      (fig-forth-auto680):00697         * ( n off --- n )
+                      (fig-forth-auto680):00698         * off is offset in video buffer area.
+13AF 87               (fig-forth-auto680):00699                 FCB     $87
+13B0 53484F57544F     (fig-forth-auto680):00700                 FCC     'SHOWTO'        ; 'SHOWTOS'
+13B6 D3               (fig-forth-auto680):00701                 FCB     $D3     ; 'S'
+13B7 13A0             (fig-forth-auto680):00702                 FDB     LIT8-7
+13B9 13BB             (fig-forth-auto680):00703         SHOTOS  FDB     *+NATWID
+13BB 8E0400           (fig-forth-auto680):00704                 LDX     #$400
+13BE ECC1             (fig-forth-auto680):00705                 LDD     ,U++
+13C0 308B             (fig-forth-auto680):00706                 LEAX    D,X
+13C2 ECC4             (fig-forth-auto680):00707                 LDD     ,U
+13C4 17FEAF           (fig-forth-auto680):00708                 LBSR    OUThxD
+13C7 39               (fig-forth-auto680):00709                 RTS
+                      (fig-forth-auto680):00710         *
+13C8 85               (fig-forth-auto680):00711                 FCB     $85
+13C9 54524F46         (fig-forth-auto680):00712                 FCC     'TROF'  ; 'TROFF'
+13CD C6               (fig-forth-auto680):00713                 FCB     $C6     ; 'F'|$80
+13CE 13AF             (fig-forth-auto680):00714                 FDB     SHOTOS-10
+13D0 13D2             (fig-forth-auto680):00715         TROFF   FDB     *+NATWID
+13D2 0F0B             (fig-forth-auto680):00716                 CLR     <TRACEM
+13D4 39               (fig-forth-auto680):00717                 RTS
+                      (fig-forth-auto680):00718         *
+13D5 84               (fig-forth-auto680):00719                 FCB     $84
+13D6 54524F           (fig-forth-auto680):00720                 FCC     'TRO'   ; 'TRON'
+13D9 CE               (fig-forth-auto680):00721                 FCB     $CE     ; 'N'|$80
+13DA 13C8             (fig-forth-auto680):00722                 FDB     TROFF-8
+13DC 13DE             (fig-forth-auto680):00723         TRON    FDB     *+NATWID
+13DE 0C0B             (fig-forth-auto680):00724                 INC     <TRACEM
+13E0 39               (fig-forth-auto680):00725                 RTS
+                      (fig-forth-auto680):00726         *
+                      (fig-forth-auto680):00727         * ======>>  3  <<
+                      (fig-forth-auto680):00728         * ( adr --- )
+                      (fig-forth-auto680):00729         * Jump to address on stack.  Used by the "outer" interpreter to
+                      (fig-forth-auto680):00730         * interactively invoke routines.  
+                      (fig-forth-auto680):00731         * Might be useful to have EXECUTE test the pointer, as done in BIF-6809.
+13E1 87               (fig-forth-auto680):00732                 FCB     $87
+13E2 455845435554     (fig-forth-auto680):00733                 FCC     'EXECUT'        ; 'EXECUTE'
+13E8 C5               (fig-forth-auto680):00734                 FCB     $C5
+13E9 13D5             (fig-forth-auto680):00735                 FDB     TRON-7
+13EB 13ED             (fig-forth-auto680):00736         EXEC    FDB     *+NATWID
+13ED 3710             (fig-forth-auto680):00737                 PULU    X       ; Gotta have W anyway, just in case.
+13EF 6E94             (fig-forth-auto680):00738                 JMP     [,X]    ; Tail return.
+                      (fig-forth-auto680):00739         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):00740         *       LDX     0,X     get code field address (CFA)
+                      (fig-forth-auto680):00741         *       LEAS 1,S        ;               pop stack
+                      (fig-forth-auto680):00742         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):00743         *       JMP     NEXT3
+                      (fig-forth-auto680):00744         *
+                      (fig-forth-auto680):00745         * ######>> screen 15 <<
+                      (fig-forth-auto680):00746         * ======>>  4  <<
+                      (fig-forth-auto680):00747         * ( --- )                                                 C
+                      (fig-forth-auto680):00748         * Add the following word from the instruction stream to the
+                      (fig-forth-auto680):00749         * instruction pointer (Y++).  Causes a program branch in Forth code stream.
+                      (fig-forth-auto680):00750         *
+                      (fig-forth-auto680):00751         * In native processor code, there should be a better way, use that instead.
+                      (fig-forth-auto680):00752         * More specifically, DO NOT CALL THIS from assembly language code.
+                      (fig-forth-auto680):00753         * This is only for Forth code stream.
+                      (fig-forth-auto680):00754         * Also, see comments for LIT.
+13F1 86               (fig-forth-auto680):00755                 FCB     $86
+13F2 4252414E43       (fig-forth-auto680):00756                 FCC     'BRANC' ; 'BRANCH'
+13F7 C8               (fig-forth-auto680):00757                 FCB     $C8
+13F8 13E1             (fig-forth-auto680):00758                 FDB     EXEC-10
+13FA 140F             (fig-forth-auto680):00759         BRAN    FDB     ZBYES   ; Go steal code in ZBRANCH
+                      (fig-forth-auto680):00760         
+                      (fig-forth-auto680):00761         * Moving code around to optimize the branch taking case in 0BRANCH.
+13FC 3122             (fig-forth-auto680):00762         ZBNO    LEAY    NATWID,Y ;      No branch.
+13FE 39               (fig-forth-auto680):00763                 RTS
+                      (fig-forth-auto680):00764         * ======>>  5  <<
+                      (fig-forth-auto680):00765         * ( f --- )                                               C
+                      (fig-forth-auto680):00766         * BRANCH if flag is zero.
+                      (fig-forth-auto680):00767         *
+                      (fig-forth-auto680):00768         * In native processor code, there should be a better way, use that instead.
+                      (fig-forth-auto680):00769         * More specifically, DO NOT CALL THIS from assembly language code.
+                      (fig-forth-auto680):00770         * This is only for Forth code stream.
+                      (fig-forth-auto680):00771         * Also, see comments for LIT.
+13FF 87               (fig-forth-auto680):00772                 FCB     $87
+1400 304252414E43     (fig-forth-auto680):00773                 FCC     '0BRANC'        ; '0BRANCH'
+1406 C8               (fig-forth-auto680):00774                 FCB     $C8
+1407 13F1             (fig-forth-auto680):00775                 FDB     BRAN-9
+1409 140B             (fig-forth-auto680):00776         ZBRAN   FDB     *+NATWID
+140B ECC1             (fig-forth-auto680):00777                 LDD     ,U++
+140D 26ED             (fig-forth-auto680):00778                 BNE     ZBNO
+140F ECA1             (fig-forth-auto680):00779         ZBYES   LDD     ,Y++
+1411 31AB             (fig-forth-auto680):00780                 LEAY    D,Y     ; IP is postinc
+1413 39               (fig-forth-auto680):00781                 RTS
+                      (fig-forth-auto680):00782         *       PULS A  ; 
+                      (fig-forth-auto680):00783         *       PULS B  ; 
+                      (fig-forth-auto680):00784         *       PSHS B  ; ** emulating ABA:
+                      (fig-forth-auto680):00785         *       ADDA ,S+        ; 
+                      (fig-forth-auto680):00786         *       BNE     ZBNO
+                      (fig-forth-auto680):00787         *       BCS     ZBNO
+                      (fig-forth-auto680):00788         * ZBYES LDX     IP      Note: code is shared with BRANCH, (+LOOP), (LOOP)
+                      (fig-forth-auto680):00789         *       LDB 3,X
+                      (fig-forth-auto680):00790         *       LDA 2,X
+                      (fig-forth-auto680):00791         *       ADDB IP+1
+                      (fig-forth-auto680):00792         *       ADCA IP
+                      (fig-forth-auto680):00793         *       STB IP+1
+                      (fig-forth-auto680):00794         *       STA IP
+                      (fig-forth-auto680):00795         *       JMP     NEXT
+                      (fig-forth-auto680):00796         * ZBNO  LDX     IP      no branch. This code is shared with (+LOOP), (LOOP).
+                      (fig-forth-auto680):00797         *       LEAX 1,X        ;               jump over branch delta
+                      (fig-forth-auto680):00798         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00799         *       STX     IP
+                      (fig-forth-auto680):00800         *       JMP     NEXT
+                      (fig-forth-auto680):00801         *
+                      (fig-forth-auto680):00802         * ######>> screen 16 <<
+                      (fig-forth-auto680):00803         * ======>>  6  <<
+                      (fig-forth-auto680):00804         * ( --- )         ( limit index *** limit index+1)        C
+                      (fig-forth-auto680):00805         *                 ( limit index *** )
+                      (fig-forth-auto680):00806         * Counting loop primitive.  The counter and limit are the top two
+                      (fig-forth-auto680):00807         * words on the return stack.  If the updated index/counter does
+                      (fig-forth-auto680):00808         * not exceed the limit, a branch occurs.  If it does, the branch
+                      (fig-forth-auto680):00809         * does not occur, and the index and limit are dropped from the
+                      (fig-forth-auto680):00810         * return stack.
+                      (fig-forth-auto680):00811         *
+                      (fig-forth-auto680):00812         * In native processor code, there should be a better way, use that instead.
+                      (fig-forth-auto680):00813         * More specifically, DO NOT CALL THIS from assembly language code.
+                      (fig-forth-auto680):00814         * This is only for Forth code stream.
+                      (fig-forth-auto680):00815         * Also, see comments for LIT.
+1414 86               (fig-forth-auto680):00816                 FCB     $86
+1415 284C4F4F50       (fig-forth-auto680):00817                 FCC     '(LOOP' ; '(LOOP)'
+141A A9               (fig-forth-auto680):00818                 FCB     $A9
+141B 13FF             (fig-forth-auto680):00819                 FDB     ZBRAN-10
+141D 141F             (fig-forth-auto680):00820         XLOOP   FDB     *+NATWID
+141F CC0001           (fig-forth-auto680):00821                 LDD     #1      ; Borrowing from BIF-6809.
+1422 E362             (fig-forth-auto680):00822         XLOOPA  ADDD    NATWID,S        ; Dodge the return address.
+1424 ED62             (fig-forth-auto680):00823                 STD     NATWID,S
+1426 A364             (fig-forth-auto680):00824                 SUBD    2*NATWID,S
+1428 2DE5             (fig-forth-auto680):00825                 BLT     ZBYES   ; signed
+142A 3122             (fig-forth-auto680):00826         XLOOPN  LEAY    NATWID,Y
+142C AEE4             (fig-forth-auto680):00827                 LDX     ,S      ; synthetic return
+142E 3266             (fig-forth-auto680):00828                 LEAS    3*NATWID,S      ; Clean up the index and limit.
+1430 6E84             (fig-forth-auto680):00829                 JMP     ,X      
+                      (fig-forth-auto680):00830         *       CLRA    ;
+                      (fig-forth-auto680):00831         *       LDB #1  get set to increment counter by 1 (Clears N.)
+                      (fig-forth-auto680):00832         *       BRA     XPLOP2  go steal other guy's code!
+                      (fig-forth-auto680):00833         *
+                      (fig-forth-auto680):00834         * ======>>  7  <<
+                      (fig-forth-auto680):00835         * ( n --- )       ( limit index *** limit index+n )       C
+                      (fig-forth-auto680):00836         *                 ( limit index *** )
+                      (fig-forth-auto680):00837         * Loop with a variable increment.  Terminates when the index
+                      (fig-forth-auto680):00838         * crosses the boundary from one below the limit to the limit.  A
+                      (fig-forth-auto680):00839         * positive n will cause termination if the result index equals the
+                      (fig-forth-auto680):00840         * limit.  A negative n must cause the index to become less than
+                      (fig-forth-auto680):00841         * the limit to cause loop termination.
+                      (fig-forth-auto680):00842         *
+                      (fig-forth-auto680):00843         * Note that the end conditions are not symmetric around zero.
+                      (fig-forth-auto680):00844         *
+                      (fig-forth-auto680):00845         * In native processor code, there should be a better way, use that instead.
+                      (fig-forth-auto680):00846         * More specifically, DO NOT CALL THIS from assembly language code.
+                      (fig-forth-auto680):00847         * This is only for Forth code stream.
+                      (fig-forth-auto680):00848         * Also, see comments for LIT.
+1432 87               (fig-forth-auto680):00849                 FCB     $87
+1433 282B4C4F4F50     (fig-forth-auto680):00850                 FCC     '(+LOOP'        ; '(+LOOP)'
+1439 A9               (fig-forth-auto680):00851                 FCB     $A9
+143A 1414             (fig-forth-auto680):00852                 FDB     XLOOP-9
+143C 143E             (fig-forth-auto680):00853         XPLOOP  FDB     *+NATWID        ; Borrowing from BIF-6809.
+143E ECC1             (fig-forth-auto680):00854                 LDD     ,U++            ; inc val
+1440 2AE0             (fig-forth-auto680):00855                 BPL     XLOOPA          ; Steal plain loop code for forward count.
+1442 E362             (fig-forth-auto680):00856                 ADDD    NATWID,S                ; Dodge the return address
+1444 ED62             (fig-forth-auto680):00857                 STD     NATWID,S
+1446 A364             (fig-forth-auto680):00858                 SUBD    2*NATWID,S
+1448 2EC5             (fig-forth-auto680):00859                 BGT     ZBYES           ; signed
+144A 20DE             (fig-forth-auto680):00860                 BRA     XLOOPN          ; This path is less time-sensitive.
+                      (fig-forth-auto680):00861         *
+                      (fig-forth-auto680):00862         * This should work, but I want to use tested code.
+                      (fig-forth-auto680):00863         *       PULU    A,B     ; Get the increment.
+                      (fig-forth-auto680):00864         * XPLOP2        PULS    X       ; Pre-clear the return stack.
+                      (fig-forth-auto680):00865         *       PSHU    A       ; Save the direction in high bit.       
+                      (fig-forth-auto680):00866         *       ADDD    ,S      ; Count.
+                      (fig-forth-auto680):00867         *       STD     ,S      ; Update.
+                      (fig-forth-auto680):00868         *       SUBD    NATWID,S        ; Check limit.
+                      (fig-forth-auto680):00869         **
+                      (fig-forth-auto680):00870         ** I think this should work:
+                      (fig-forth-auto680):00871         *       EORA    ,U+     ; dir < 0 and (count - limit) >= 0
+                      (fig-forth-auto680):00872         *       BPL     XPLONO  ; or dir >= 0 and (count - limit) < 0
+                      (fig-forth-auto680):00873         *       LDD     ,Y++
+                      (fig-forth-auto680):00874         *       LEAY    D,Y     ; IP is postinc
+                      (fig-forth-auto680):00875         *       JMP     ,X
+                      (fig-forth-auto680):00876         * XPLONO        LEAS    2*NATWID,S
+                      (fig-forth-auto680):00877         *       JMP     ,X      ; synthetic return
+                      (fig-forth-auto680):00878         *
+                      (fig-forth-auto680):00879         * This definitely should work:
+                      (fig-forth-auto680):00880         *       TST     ,U+     ; Get the sign
+                      (fig-forth-auto680):00881         *       BPL     XPLOF   ; 
+                      (fig-forth-auto680):00882         *       CMPD    NATWID,S
+                      (fig-forth-auto680):00883         *       BMI     XPLONO
+                      (fig-forth-auto680):00884         * XPLOYE        LDD     ,Y++
+                      (fig-forth-auto680):00885         *       LEAY    D,Y     ; IP is postinc
+                      (fig-forth-auto680):00886         *       JMP     ,X
+                      (fig-forth-auto680):00887         * XPLOF CMPD    NATWID,S
+                      (fig-forth-auto680):00888         *       BMI     XPLOYE
+                      (fig-forth-auto680):00889         * XPLONO        LEAS    2*NATWID,S
+                      (fig-forth-auto680):00890         *       JMP     ,X      ; synthetic return
+                      (fig-forth-auto680):00891         *
+                      (fig-forth-auto680):00892         * 6800 Probably could have used the exclusive-or method, too.:
+                      (fig-forth-auto680):00893         *       PULS A  ; get increment
+                      (fig-forth-auto680):00894         *       PULS B  ; 
+                      (fig-forth-auto680):00895         * XPLOP2        TSTA    ;
+                      (fig-forth-auto680):00896         *       BPL     XPLOF   forward looping
+                      (fig-forth-auto680):00897         *       BSR     XPLOPS
+                      (fig-forth-auto680):00898         *       ORCC #$01       ; SEC : 
+                      (fig-forth-auto680):00899         *       SBCB 5,X
+                      (fig-forth-auto680):00900         *       SBCA 4,X
+                      (fig-forth-auto680):00901         *       BPL     ZBYES
+                      (fig-forth-auto680):00902         *       BRA     XPLONO  fall through
+                      (fig-forth-auto680):00903         *
+                      (fig-forth-auto680):00904         * the subroutine :
+                      (fig-forth-auto680):00905         * XPLOPS        LDX     RP
+                      (fig-forth-auto680):00906         *       ADDB 3,X        add it to counter
+                      (fig-forth-auto680):00907         *       ADCA 2,X
+                      (fig-forth-auto680):00908         *       STB 3,X store new counter value
+                      (fig-forth-auto680):00909         *       STA 2,X
+                      (fig-forth-auto680):00910         *       RTS
+                      (fig-forth-auto680):00911         *
+                      (fig-forth-auto680):00912         * XPLOF BSR     XPLOPS
+                      (fig-forth-auto680):00913         *       SUBB 5,X
+                      (fig-forth-auto680):00914         *       SBCA 4,X
+                      (fig-forth-auto680):00915         *       BMI     ZBYES
+                      (fig-forth-auto680):00916         *
+                      (fig-forth-auto680):00917         * XPLONO        LEAX 1,X        ;               done, don't branch back
+                      (fig-forth-auto680):00918         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00919         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00920         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00921         *       STX     RP
+                      (fig-forth-auto680):00922         *       BRA     ZBNO    use ZBRAN to skip over unused delta
+                      (fig-forth-auto680):00923         *
+                      (fig-forth-auto680):00924         * ######>> screen 17 <<
+                      (fig-forth-auto680):00925         * ======>>  8  <<
+                      (fig-forth-auto680):00926         * ( limit index --- )     ( *** limit index )
+                      (fig-forth-auto680):00927         * Move the loop parameters to the return stack.  Synonym for D>R.
+144C 84               (fig-forth-auto680):00928                 FCB     $84
+144D 28444F           (fig-forth-auto680):00929                 FCC     '(DO'   ; '(DO)'
+1450 A9               (fig-forth-auto680):00930                 FCB     $A9
+1451 1432             (fig-forth-auto680):00931                 FDB     XPLOOP-10
+1453 1455             (fig-forth-auto680):00932         XDO     FDB     *+NATWID        This is the RUNTIME DO, not the COMPILING DO
+1455 AEE4             (fig-forth-auto680):00933                 LDX     ,S      ; Save the return address.
+1457 3706             (fig-forth-auto680):00934                 PULU    A,B
+1459 3406             (fig-forth-auto680):00935                 PSHS    A,B
+145B 3706             (fig-forth-auto680):00936                 PULU    A,B     ; Maintain order.
+145D ED62             (fig-forth-auto680):00937                 STD     NATWID,S
+145F 6E84             (fig-forth-auto680):00938                 JMP     ,X      ; synthetic return
+                      (fig-forth-auto680):00939         *
+                      (fig-forth-auto680):00940         *       LDX     RP
+                      (fig-forth-auto680):00941         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):00942         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):00943         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):00944         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):00945         *       STX     RP
+                      (fig-forth-auto680):00946         *       PULS A  ; 
+                      (fig-forth-auto680):00947         *       PULS B  ; 
+                      (fig-forth-auto680):00948         *       STA 2,X
+                      (fig-forth-auto680):00949         *       STB 3,X
+                      (fig-forth-auto680):00950         *       PULS A  ; 
+                      (fig-forth-auto680):00951         *       PULS B  ; 
+                      (fig-forth-auto680):00952         *       STA 4,X
+                      (fig-forth-auto680):00953         *       STB 5,X
+                      (fig-forth-auto680):00954         *       JMP     NEXT
+                      (fig-forth-auto680):00955         *
+                      (fig-forth-auto680):00956         * ======>>  9  <<
+                      (fig-forth-auto680):00957         * ( --- index )           ( limit index *** limit index )
+                      (fig-forth-auto680):00958         * Copy the loop index from the return stack.  Synonym for R.
+1461 81               (fig-forth-auto680):00959                 FCB     $81     I
+1462 C9               (fig-forth-auto680):00960                 FCB     $C9
+1463 144C             (fig-forth-auto680):00961                 FDB     XDO-7   
+1465 1467             (fig-forth-auto680):00962         I       FDB     *+NATWID
+1467 EC62             (fig-forth-auto680):00963                 LDD     NATWID,S        ; Dodge return address.
+1469 3606             (fig-forth-auto680):00964                 PSHU    A,B
+146B 39               (fig-forth-auto680):00965                 RTS
+                      (fig-forth-auto680):00966         *       LDX     RP
+                      (fig-forth-auto680):00967         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00968         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):00969         *       JMP     GETX
+                      (fig-forth-auto680):00970         *
+                      (fig-forth-auto680):00971         * ######>> screen 18 <<
+                      (fig-forth-auto680):00972         * ======>>  10  <<
+                      (fig-forth-auto680):00973         * ( c base --- false )
+                      (fig-forth-auto680):00974         * ( c base --- n true )
+                      (fig-forth-auto680):00975         * Translate C in base, yielding a translation valid flag.  If the
+                      (fig-forth-auto680):00976         * translation is not valid in the specified base, only the false
+                      (fig-forth-auto680):00977         * flag is returned.
+146C 85               (fig-forth-auto680):00978                 FCB     $85
+146D 44494749         (fig-forth-auto680):00979                 FCC     'DIGI'  ; 'DIGIT'
+1471 D4               (fig-forth-auto680):00980                 FCB     $D4
+1472 1461             (fig-forth-auto680):00981                 FDB     I-4
+1474 1476             (fig-forth-auto680):00982         DIGIT   FDB     *+NATWID        NOTE: legal input range is 0-9, A-Z
+1476 EC42             (fig-forth-auto680):00983                 LDD     NATWID,U        ; Check the whole thing.
+1478 830030           (fig-forth-auto680):00984                 SUBD    #$30    ; ascii zero
+147B 2B22             (fig-forth-auto680):00985                 BMI     DIGIT2  IF LESS THAN '0', ILLEGAL
+147D 1083000A         (fig-forth-auto680):00986                 CMPD    #$A
+1481 2B0F             (fig-forth-auto680):00987                 BMI     DIGIT0  IF '9' OR LESS
+1483 10830011         (fig-forth-auto680):00988                 CMPD    #$11
+1487 2B16             (fig-forth-auto680):00989                 BMI     DIGIT2  if less than 'A'
+1489 1083002B         (fig-forth-auto680):00990                 CMPD    #$2B
+148D 2A10             (fig-forth-auto680):00991                 BPL     DIGIT2  if greater than 'Z'
+148F 830007           (fig-forth-auto680):00992                 SUBD    #7      translate 'A' thru 'F'
+1492 10A3C4           (fig-forth-auto680):00993         DIGIT0  CMPD    ,U      ; Check the base.
+1495 2A08             (fig-forth-auto680):00994                 BPL     DIGIT2  if not less than the base
+1497 ED42             (fig-forth-auto680):00995                 STD     NATWID,U        ; Store converted digit. (High byte known zero.)
+1499 CC0001           (fig-forth-auto680):00996                 LDD     #1      ; set valid flag 
+149C EDC4             (fig-forth-auto680):00997         DIGIT1  STD     ,U      ; store the flag
+149E 39               (fig-forth-auto680):00998                 RTS     NEXT
+149F CC0000           (fig-forth-auto680):00999         DIGIT2  LDD     #0      ; set not valid flag
+14A2 3342             (fig-forth-auto680):01000                 LEAU    NATWID,U        ; pop base
+14A4 20F6             (fig-forth-auto680):01001                 BRA     DIGIT1
+                      (fig-forth-auto680):01002         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01003         *       LDA 3,X
+                      (fig-forth-auto680):01004         *       SUBA #$30       ascii zero
+                      (fig-forth-auto680):01005         *       BMI     DIGIT2  IF LESS THAN '0', ILLEGAL
+                      (fig-forth-auto680):01006         *       CMPA #$A
+                      (fig-forth-auto680):01007         *       BMI     DIGIT0  IF '9' OR LESS
+                      (fig-forth-auto680):01008         *       CMPA #$11
+                      (fig-forth-auto680):01009         *       BMI     DIGIT2  if less than 'A'
+                      (fig-forth-auto680):01010         *       CMPA #$2B
+                      (fig-forth-auto680):01011         *       BPL     DIGIT2  if greater than 'Z'
+                      (fig-forth-auto680):01012         *       SUBA #7 translate 'A' thru 'F'
+                      (fig-forth-auto680):01013         * DIGIT0        CMPA 1,X
+                      (fig-forth-auto680):01014         *       BPL     DIGIT2  if not less than the base
+                      (fig-forth-auto680):01015         *       LDB #1  set flag
+                      (fig-forth-auto680):01016         *       STA 3,X store digit
+                      (fig-forth-auto680):01017         * DIGIT1        STB 1,X store the flag
+                      (fig-forth-auto680):01018         *       JMP     NEXT
+                      (fig-forth-auto680):01019         * DIGIT2        CLRB    ;
+                      (fig-forth-auto680):01020         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01021         *       LEAS 1,S        ;       pop bottom number
+                      (fig-forth-auto680):01022         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01023         *       STB 0,X make sure both bytes are 00
+                      (fig-forth-auto680):01024         *       BRA     DIGIT1
+                      (fig-forth-auto680):01025         *
+                      (fig-forth-auto680):01026         * ######>> screen 19 <<
+                      (fig-forth-auto680):01027         *
+                      (fig-forth-auto680):01028         * The word definition format in the dictionary:
+                      (fig-forth-auto680):01029         *
+                      (fig-forth-auto680):01030         * (Symbol names are bracketed by bytes with the high bit set, rather than linked.)
+                      (fig-forth-auto680):01031         *
+                      (fig-forth-auto680):01032         * NFA (name field address):
+                      (fig-forth-auto680):01033         * char-count + $80      Length of symbol name, flagged with high bit set.
+                      (fig-forth-auto680):01034         * char 1                Characters of symbol name.
+                      (fig-forth-auto680):01035         * char 2
+                      (fig-forth-auto680):01036         * ...
+                      (fig-forth-auto680):01037         * char n  + $80      symbol termination flag (char set < 128 code points)
+                      (fig-forth-auto680):01038         * LFA (link field address):
+                      (fig-forth-auto680):01039         * link high byte \___pointer to previous word in list
+                      (fig-forth-auto680):01040         * link low  byte /   -- Combined allocation/dictionary list. --
+                      (fig-forth-auto680):01041         * CFA (code field address):
+                      (fig-forth-auto680):01042         * CFA  high byte \___pointer to native CPU machine code
+                      (fig-forth-auto680):01043         * CFA  low  byte /   -- Consider this the characteristic code. --
+                      (fig-forth-auto680):01044         * PFA (parameter field address):
+                      (fig-forth-auto680):01045         * parameter fields   -- Machine code for low-level native machine CPU code,
+                      (fig-forth-auto680):01046         *    "                  instruction list for high-level Forth code,
+                      (fig-forth-auto680):01047         *    "                  constant data for constants, pointers to per task variables,
+                      (fig-forth-auto680):01048         *    "                  space for variables, for global variables, etc.
+                      (fig-forth-auto680):01049         *
+                      (fig-forth-auto680):01050         * In the case of native CPU machine code, the address at CFA will be PFA.
+                      (fig-forth-auto680):01051         
+                      (fig-forth-auto680):01052         * Definition attributes:
+     0040             (fig-forth-auto680):01053         FIMMED  EQU     $40     ; Immediate word flag.
+     0020             (fig-forth-auto680):01054         FSMUDG  EQU     $20     ; Smudged => definition not ready.
+     003F             (fig-forth-auto680):01055         CTMASK  EQU     ($FF&(^($80|FIMMED)))   ; For unmasking the length byte.
+                      (fig-forth-auto680):01056         * Note that the SMUDGE bit is not masked out.
+                      (fig-forth-auto680):01057         *
+                      (fig-forth-auto680):01058         * But we really want more (Thinking for a new model, need one more byte):
+                      (fig-forth-auto680):01059         * FCOMPI        EQU     $10     ; Compile-time-only.
+                      (fig-forth-auto680):01060         * FASSEM        EQU     $08     ; Assembly-language code only.
+                      (fig-forth-auto680):01061         * F4THLV        EQU     $04     ; Must not be called from assembly language code.
+                      (fig-forth-auto680):01062         * These would require some significant adjustments to the model.
+                      (fig-forth-auto680):01063         * We also want to put the low-level VM stuff in its own vocabulary.
+                      (fig-forth-auto680):01064         *
+                      (fig-forth-auto680):01065         * ======>>  11  <<
+                      (fig-forth-auto680):01066         * (FIND)  ( name vocptr --- locptr length true )
+                      (fig-forth-auto680):01067         *         ( name vocptr --- false )
+                      (fig-forth-auto680):01068         * Search vocabulary for a symbol called name. 
+                      (fig-forth-auto680):01069         * name is a pointer to a high-bit bracket string with length head.
+                      (fig-forth-auto680):01070         * vocptr is a pointer to the NFA of the tail-end (LATEST) definition 
+                      (fig-forth-auto680):01071         * in the vocabulary to be searched.
+                      (fig-forth-auto680):01072         * Hidden (SMUDGEd) definitions are lexically not equal to their name strings.
+14A6 86               (fig-forth-auto680):01073                 FCB     $86
+14A7 2846494E44       (fig-forth-auto680):01074                 FCC     '(FIND' ; '(FIND)'
+14AC A9               (fig-forth-auto680):01075                 FCB     $A9
+14AD 146C             (fig-forth-auto680):01076                 FDB     DIGIT-8
+14AF 14B1             (fig-forth-auto680):01077         PFIND   FDB     *+NATWID
+14B1 3420             (fig-forth-auto680):01078                 PSHS    Y       ; Have to track two pointers.
+                      (fig-forth-auto680):01079         * Use the stack and registers instead of temp area N.
+     0002             (fig-forth-auto680):01080         PA0     EQU     NATWID  ; pointer to the length byte of name being searched against
+     0000             (fig-forth-auto680):01081         PD      EQU     0       ; pointer to NFA of dict word being checked
+                      (fig-forth-auto680):01082         *
+14B3 AEC4             (fig-forth-auto680):01083                 LDX     PD,U    ; Start in on the vocabulary (NFA).
+14B5 10AE42           (fig-forth-auto680):01084         PFNDLP  LDY     PA0,U   ; Point to the name to check against.
+14B8 E680             (fig-forth-auto680):01085                 LDB     ,X+     ; get dict name length byte
+14BA 1F98             (fig-forth-auto680):01086                 TFR     B,A     ; Save it in case it matches.
+14BC C43F             (fig-forth-auto680):01087                 ANDB    #CTMASK 
+14BE E1A0             (fig-forth-auto680):01088                 CMPB    ,Y+     ; Compare lengths
+14C0 261C             (fig-forth-auto680):01089                 BNE     PFNDUN
+14C2 E680             (fig-forth-auto680):01090         PFNDBR  LDB     ,X+
+14C4 5D               (fig-forth-auto680):01091                 TSTB    ;       ; Is high bit of character in dictionary entry set?
+14C5 2A13             (fig-forth-auto680):01092                 BPL     PFNDCH
+14C7 C47F             (fig-forth-auto680):01093                 ANDB    #$7F    ; Clear high bit from dictionary.
+14C9 E1A0             (fig-forth-auto680):01094                 CMPB    ,Y+     ; Compare "last" characters.
+14CB 2717             (fig-forth-auto680):01095                 BEQ     FOUND   ; Matches even if dictionary actual length is shorter.
+14CD AE81             (fig-forth-auto680):01096         PFNDLN  LDX     ,X++    ; Get previous link in vocabulary.
+14CF 26E4             (fig-forth-auto680):01097                 BNE     PFNDLP  ; Continue if link not=0
+                      (fig-forth-auto680):01098         *
+                      (fig-forth-auto680):01099         *       not found :
+14D1 3342             (fig-forth-auto680):01100                 LEAU    NATWID,U        ; Return only false flag.
+14D3 CC0000           (fig-forth-auto680):01101                 LDD     #0
+14D6 EDC4             (fig-forth-auto680):01102                 STD     ,U
+14D8 35A0             (fig-forth-auto680):01103                 PULS    Y,PC
+                      (fig-forth-auto680):01104         *
+14DA E1A0             (fig-forth-auto680):01105         PFNDCH  CMPB    ,Y+     ; Compare characters.
+14DC 27E4             (fig-forth-auto680):01106                 BEQ     PFNDBR
+14DE                  (fig-forth-auto680):01107         PFNDUN  
+14DE E680             (fig-forth-auto680):01108         PFNDSC  LDB     ,X+     ; scan forward to end of this name in dictionary
+14E0 2AFC             (fig-forth-auto680):01109                 BPL     PFNDSC
+14E2 20E9             (fig-forth-auto680):01110                 BRA     PFNDLN
+                      (fig-forth-auto680):01111         *
+                      (fig-forth-auto680):01112         *       found :
+                      (fig-forth-auto680):01113         *
+14E4 3004             (fig-forth-auto680):01114         FOUND   LEAX    2*NATWID,X
+14E6 AF42             (fig-forth-auto680):01115                 STX     NATWID,U
+14E8 1F89             (fig-forth-auto680):01116                 TFR     A,B
+14EA 4F               (fig-forth-auto680):01117                 CLRA
+14EB EDC4             (fig-forth-auto680):01118                 STD     ,U
+14ED C601             (fig-forth-auto680):01119                 LDB     #1
+14EF 3606             (fig-forth-auto680):01120                 PSHU    A,B
+14F1 35A0             (fig-forth-auto680):01121                 PULS    Y,PC
+                      (fig-forth-auto680):01122         *
+                      (fig-forth-auto680):01123         * 6800 model:
+                      (fig-forth-auto680):01124         *       NOP     ; Probably leftovers from a debugging session.
+                      (fig-forth-auto680):01125         *       NOP
+                      (fig-forth-auto680):01126         * PD    EQU     N       ptr to dict word being checked
+                      (fig-forth-auto680):01127         * PA0   EQU     N+2
+                      (fig-forth-auto680):01128         * PA    EQU     N+4
+                      (fig-forth-auto680):01129         * PC    EQU     N+6
+                      (fig-forth-auto680):01130         *       LDX     #PD
+                      (fig-forth-auto680):01131         *       LDB #4
+                      (fig-forth-auto680):01132         * PFIND0        PULS A  ; loop to get arguments
+                      (fig-forth-auto680):01133         *       STA 0,X
+                      (fig-forth-auto680):01134         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01135         *       DECB    ;
+                      (fig-forth-auto680):01136         *       BNE     PFIND0
+                      (fig-forth-auto680):01137         *
+                      (fig-forth-auto680):01138         *       LDX     PD
+                      (fig-forth-auto680):01139         * PFNDLP        LDB 0,X get count dict count
+                      (fig-forth-auto680):01140         *       STB PC
+                      (fig-forth-auto680):01141         *       ANDB #$3F
+                      (fig-forth-auto680):01142         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01143         *       STX     PD      update PD
+                      (fig-forth-auto680):01144         *       LDX     PA0
+                      (fig-forth-auto680):01145         *       LDA 0,X get count from arg
+                      (fig-forth-auto680):01146         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01147         *       STX     PA      intialize PA
+                      (fig-forth-auto680):01148         *       PSHS B  ; ** emulating CBA:
+                      (fig-forth-auto680):01149         *       CMPA ,S+        ;               compare lengths
+                      (fig-forth-auto680):01150         *       BNE     PFNDUN
+                      (fig-forth-auto680):01151         * PFNDBR        LDX     PA
+                      (fig-forth-auto680):01152         *       LDA 0,X
+                      (fig-forth-auto680):01153         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01154         *       STX     PA
+                      (fig-forth-auto680):01155         *       LDX     PD
+                      (fig-forth-auto680):01156         *       LDB 0,X
+                      (fig-forth-auto680):01157         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01158         *       STX     PD
+                      (fig-forth-auto680):01159         *       TSTB    ;               is dict entry neg. ?
+                      (fig-forth-auto680):01160         *       BPL     PFNDCH
+                      (fig-forth-auto680):01161         *       ANDB #$7F       clear sign
+                      (fig-forth-auto680):01162         *       PSHS B  ; ** emulating CBA:
+                      (fig-forth-auto680):01163         *       CMPA ,S+        ; 
+                      (fig-forth-auto680):01164         *       BEQ     FOUND
+                      (fig-forth-auto680):01165         * PFNDLN        LDX     0,X     get new link
+                      (fig-forth-auto680):01166         *       BNE     PFNDLP  continue if link not=0
+                      (fig-forth-auto680):01167         *
+                      (fig-forth-auto680):01168         *       not found :
+                      (fig-forth-auto680):01169         *
+                      (fig-forth-auto680):01170         *       CLRA    ;
+                      (fig-forth-auto680):01171         *       CLRB    ;
+                      (fig-forth-auto680):01172         *       JMP     PUSHBA
+                      (fig-forth-auto680):01173         * PFNDCH        PSHS B  ; ** emulating CBA:
+                      (fig-forth-auto680):01174         *       CMPA ,S+        ; 
+                      (fig-forth-auto680):01175         *       BEQ     PFNDBR
+                      (fig-forth-auto680):01176         * PFNDUN        LDX     PD
+                      (fig-forth-auto680):01177         * PFNDSC        LDB 0,X scan forward to end of this name
+                      (fig-forth-auto680):01178         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01179         *       BPL     PFNDSC
+                      (fig-forth-auto680):01180         *       BRA     PFNDLN
+                      (fig-forth-auto680):01181         *
+                      (fig-forth-auto680):01182         *       found :
+                      (fig-forth-auto680):01183         *
+                      (fig-forth-auto680):01184         * FOUND LDA PD  compute CFA
+                      (fig-forth-auto680):01185         *       LDB PD+1
+                      (fig-forth-auto680):01186         *       ADDB #4
+                      (fig-forth-auto680):01187         *       ADCA #0
+                      (fig-forth-auto680):01188         *       PSHS B  ; 
+                      (fig-forth-auto680):01189         *       PSHS A  ; 
+                      (fig-forth-auto680):01190         *       LDA PC
+                      (fig-forth-auto680):01191         *       PSHS A  ; 
+                      (fig-forth-auto680):01192         *       CLRA    ;
+                      (fig-forth-auto680):01193         *       PSHS A  ; 
+                      (fig-forth-auto680):01194         *       LDB #1
+                      (fig-forth-auto680):01195         *       JMP     PUSHBA
+                      (fig-forth-auto680):01196         *
+                      (fig-forth-auto680):01197         *       PSHS A  ; Left over from a stray copy-paste, I guess.
+                      (fig-forth-auto680):01198         *       CLRA    ;
+                      (fig-forth-auto680):01199         *       PSHS A  ; 
+                      (fig-forth-auto680):01200         *       LDB #1
+                      (fig-forth-auto680):01201         *       JMP     PUSHBA
+                      (fig-forth-auto680):01202         *
+                      (fig-forth-auto680):01203         * ######>> screen 20 <<
+                      (fig-forth-auto680):01204         * ======>>  12  <<
+                      (fig-forth-auto680):01205         * ( buffer ch --- buffer symboloffset delimiteroffset scancount )
+                      (fig-forth-auto680):01206         * ( buffer ch --- buffer symboloffset nuloffset scancount ) ( Scan count == nuloffset )
+                      (fig-forth-auto680):01207         * ( buffer ch --- buffer nuloffset onepast scancount )
+                      (fig-forth-auto680):01208         * Scan buffer for a symbol delimited by ch or ASCII NUL, 
+                      (fig-forth-auto680):01209         * return the length of the buffer region scanned,
+                      (fig-forth-auto680):01210         * the offset to the trailing delimiter,
+                      (fig-forth-auto680):01211         * and the offset of the first character of the symbol. 
+                      (fig-forth-auto680):01212         * Leave the buffer on the stack.
+                      (fig-forth-auto680):01213         * Scancount is also offset to first character not yet looked at.
+                      (fig-forth-auto680):01214         * If no symbol in buffer, scancount and symboloffset point to NUL
+                      (fig-forth-auto680):01215         * and delimiteroffset points one beyond for some reason. 
+                      (fig-forth-auto680):01216         * On trailing NUL, delimiteroffset == scancount.
+                      (fig-forth-auto680):01217         * (Buffer is the address of the buffer array to scan.)
+                      (fig-forth-auto680):01218         * (This is a bit too tricky, really.)
+14F3 87               (fig-forth-auto680):01219                 FCB     $87
+14F4 454E434C4F53     (fig-forth-auto680):01220                 FCC     'ENCLOS'        ; 'ENCLOSE'
+14FA C5               (fig-forth-auto680):01221                 FCB     $C5
+14FB 14A6             (fig-forth-auto680):01222                 FDB     PFIND-9
+14FD 14FF             (fig-forth-auto680):01223         ENCLOS  FDB     *+NATWID
+14FF A641             (fig-forth-auto680):01224                 LDA     1,U     ; Delimiter character to match against in A.
+1501 AE42             (fig-forth-auto680):01225                 LDX     NATWID,U        ; Buffer to scan in.
+1503 5F               (fig-forth-auto680):01226                 CLRB            ; Initialize offset. (Buffer < 256 wide!)
+                      (fig-forth-auto680):01227         *       Scan to a non-delimiter or a NUL
+1504 6D85             (fig-forth-auto680):01228         ENCDEL  TST     B,X     ; NUL ?
+1506 271F             (fig-forth-auto680):01229                 BEQ     ENCNUL
+1508 A185             (fig-forth-auto680):01230                 CMPA    B,X     ; Delimiter?
+150A 2603             (fig-forth-auto680):01231                 BNE     ENC1ST
+150C 5C               (fig-forth-auto680):01232                 INCB            ; count character
+150D 20F5             (fig-forth-auto680):01233                 BRA     ENCDEL
+                      (fig-forth-auto680):01234         *       Found first character. Save the offset.
+150F E741             (fig-forth-auto680):01235         ENC1ST  STB     1,U     ; Found first non-delimiter character --
+1511 6FC4             (fig-forth-auto680):01236                 CLR     ,U      ; store the count, zero high byte.
+                      (fig-forth-auto680):01237         *       Scan to a delimiter or a NUL
+1513 6D85             (fig-forth-auto680):01238         ENCSYM  TST     B,X     ; NUL ?
+1515 271E             (fig-forth-auto680):01239                 BEQ     ENC0TR
+1517 A185             (fig-forth-auto680):01240                 CMPA    B,X     ; delimiter?
+1519 2703             (fig-forth-auto680):01241                 BEQ     ENCEND
+151B 5C               (fig-forth-auto680):01242                 INCB
+151C 20F5             (fig-forth-auto680):01243                 BRA     ENCSYM
+                      (fig-forth-auto680):01244         *       Found end of symbol. Push offset to delimiter found.
+151E 4F               (fig-forth-auto680):01245         ENCEND  CLRA            ; high byte -- buffer < 255 wide!
+151F 3606             (fig-forth-auto680):01246                 PSHU    A,B     ; Offset to seen delimiter.
+                      (fig-forth-auto680):01247         *       Advance and push address of next character to check.
+1521 C30001           (fig-forth-auto680):01248                 ADDD    #1      ; In case offset was 255.
+1524 3606             (fig-forth-auto680):01249                 PSHU    A,B
+1526 39               (fig-forth-auto680):01250                 RTS
+                      (fig-forth-auto680):01251         *       Found NUL before non-delimiter, therefore there is no word
+1527 4F               (fig-forth-auto680):01252         ENCNUL  CLRA            ; high byte -- buffer < 255 wide!
+1528 EDC4             (fig-forth-auto680):01253                 STD     ,U      ; offset to NUL.
+152A C30001           (fig-forth-auto680):01254                 ADDD    #1      ; For some reason, point after NUL.
+152D 3606             (fig-forth-auto680):01255                 PSHU    A,B     ;
+152F 830001           (fig-forth-auto680):01256                 SUBD    #1      ; Next is not passed NUL.
+1532 3606             (fig-forth-auto680):01257                 PSHU    A,B     ; Stealing code will save only one byte.
+1534 39               (fig-forth-auto680):01258                 RTS
+                      (fig-forth-auto680):01259         *       Found NUL following the word instead of delimiter.
+1535 3606             (fig-forth-auto680):01260         ENC0TR  PSHU    A,B     ; Save offset to first after symbol (NUL)
+1537 3606             (fig-forth-auto680):01261                 PSHU    A,B     ; and count scanned.
+1539 39               (fig-forth-auto680):01262                 RTS
+                      (fig-forth-auto680):01263         * NOTE :
+                      (fig-forth-auto680):01264         * FC means offset (bytes) to First Character of next word
+                      (fig-forth-auto680):01265         * EW  "     "   to End of Word
+                      (fig-forth-auto680):01266         * NC  "     "   to Next Character to start next enclose at
+                      (fig-forth-auto680):01267         * ENCLOS        FDB     *+NATWID
+                      (fig-forth-auto680):01268         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01269         *       PULS B  ; now, get the low byte, for an 8-bit delimiter
+                      (fig-forth-auto680):01270         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01271         *       LDX     0,X
+                      (fig-forth-auto680):01272         *       CLR N
+                      (fig-forth-auto680):01273         * *     wait for a non-delimiter or a NUL
+                      (fig-forth-auto680):01274         * ENCDEL        LDA 0,X
+                      (fig-forth-auto680):01275         *       BEQ     ENCNUL
+                      (fig-forth-auto680):01276         *       PSHS B  ; ** emulating CBA:
+                      (fig-forth-auto680):01277         *       CMPA ,S+        ;               CHECK FOR DELIM
+                      (fig-forth-auto680):01278         *       BNE     ENC1ST
+                      (fig-forth-auto680):01279         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01280         *       INC N
+                      (fig-forth-auto680):01281         *       BRA     ENCDEL
+                      (fig-forth-auto680):01282         * *     found first character. Push FC
+                      (fig-forth-auto680):01283         * ENC1ST        LDA N   found first char.
+                      (fig-forth-auto680):01284         *       PSHS A  ; 
+                      (fig-forth-auto680):01285         *       CLRA    ;
+                      (fig-forth-auto680):01286         *       PSHS A  ; 
+                      (fig-forth-auto680):01287         *       wait for a delimiter or a NUL
+                      (fig-forth-auto680):01288         * ENCSYM        LDA 0,X
+                      (fig-forth-auto680):01289         *       BEQ     ENC0TR
+                      (fig-forth-auto680):01290         *       PSHS B  ; ** emulating CBA:
+                      (fig-forth-auto680):01291         *       CMPA ,S+        ;               ckech for delim.
+                      (fig-forth-auto680):01292         *       BEQ     ENCEND
+                      (fig-forth-auto680):01293         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01294         *       INC N
+                      (fig-forth-auto680):01295         *       BRA     ENCSYM
+                      (fig-forth-auto680):01296         * *     found EW. Push it
+                      (fig-forth-auto680):01297         * ENCEND        LDB N
+                      (fig-forth-auto680):01298         *       CLRA    ;
+                      (fig-forth-auto680):01299         *       PSHS B  ; 
+                      (fig-forth-auto680):01300         *       PSHS A  ; 
+                      (fig-forth-auto680):01301         * *     advance and push NC
+                      (fig-forth-auto680):01302         *       INCB    ;
+                      (fig-forth-auto680):01303         *       JMP     PUSHBA
+                      (fig-forth-auto680):01304         *       found NUL before non-delimiter, therefore there is no word
+                      (fig-forth-auto680):01305         * ENCNUL        LDB N   found NUL
+                      (fig-forth-auto680):01306         *       PSHS B  ; 
+                      (fig-forth-auto680):01307         *       PSHS A  ; 
+                      (fig-forth-auto680):01308         *       INCB    ;
+                      (fig-forth-auto680):01309         *       BRA     ENC0TR+2        ; ********** POTENTIAL BUG HERE *******
+                      (fig-forth-auto680):01310         * ******** Should use labels in case opcodes change! ********
+                      (fig-forth-auto680):01311         *       found NUL following the word instead of SPACE
+                      (fig-forth-auto680):01312         * ENC0TR        LDB N
+                      (fig-forth-auto680):01313         *       PSHS B  ; save EW
+                      (fig-forth-auto680):01314         *       PSHS A  ; 
+                      (fig-forth-auto680):01315         * ENCL8 LDB N   save NC
+                      (fig-forth-auto680):01316         *       JMP     PUSHBA
+                      (fig-forth-auto680):01317         
+                      (fig-forth-auto680):01318                 PAGE
+                      (fig-forth-auto680):01319         *
+                      (fig-forth-auto680):01320         * ######>> screen 21 <<
+                      (fig-forth-auto680):01321         * The next 4 words call system dependant I/O routines
+                      (fig-forth-auto680):01322         * which are listed after word "-->" ( lable: "arrow" )
+                      (fig-forth-auto680):01323         * in the dictionary.
+                      (fig-forth-auto680):01324         *
+                      (fig-forth-auto680):01325         * ======>>  13  <<
+                      (fig-forth-auto680):01326         * ( c --- )
+                      (fig-forth-auto680):01327         * Write c to the output device (screen or printer).
+                      (fig-forth-auto680):01328         * ROM Uses the ECB device number at address $6F,
+                      (fig-forth-auto680):01329         * -2 is printer, 0 is screen.
+153A 84               (fig-forth-auto680):01330                 FCB     $84
+153B 454D49           (fig-forth-auto680):01331                 FCC     'EMI'   ; 'EMIT'
+153E D4               (fig-forth-auto680):01332                 FCB     $D4
+153F 14F3             (fig-forth-auto680):01333                 FDB     ENCLOS-10
+1541 1543             (fig-forth-auto680):01334         EMIT    FDB     *+NATWID
+1543 3706             (fig-forth-auto680):01335                 PULU    D
+1545 171067           (fig-forth-auto680):01336                 LBSR    PEMIT   ; PEMIT expects the character in D.
+1548 0C33             (fig-forth-auto680):01337                 INC     <XOUT+1
+154A 2602             (fig-forth-auto680):01338                 BNE     EMITDN
+154C 0C32             (fig-forth-auto680):01339                 INC     <XOUT
+154E 39               (fig-forth-auto680):01340         EMITDN  RTS
+                      (fig-forth-auto680):01341         *       PULS A  ; 
+                      (fig-forth-auto680):01342         *       PULS A  ; 
+                      (fig-forth-auto680):01343         *       JSR     PEMIT
+                      (fig-forth-auto680):01344         *       LDX     UP
+                      (fig-forth-auto680):01345         *       INC XOUT+1-UORIG,X
+                      (fig-forth-auto680):01346         *       BNE *+4 ; 
+                      (fig-forth-auto680):01347         *       ****WARNING**** HARD OFFSET: *+4 ****
+                      (fig-forth-auto680):01348         *       INC XOUT-UORIG,X
+                      (fig-forth-auto680):01349         *       JMP     NEXT
+                      (fig-forth-auto680):01350         *
+                      (fig-forth-auto680):01351         * ======>>  14  <<
+                      (fig-forth-auto680):01352         * ( --- c )
+                      (fig-forth-auto680):01353         * ( --- BREAK )
+                      (fig-forth-auto680):01354         * Wait for a key from the keyboard. 
+                      (fig-forth-auto680):01355         * If the key is BREAK, set the high byte (result $FF03).
+154F 83               (fig-forth-auto680):01356                 FCB     $83
+1550 4B45             (fig-forth-auto680):01357                 FCC     'KE'    ; 'KEY'
+1552 D9               (fig-forth-auto680):01358                 FCB     $D9
+1553 153A             (fig-forth-auto680):01359                 FDB     EMIT-7
+1555 1557             (fig-forth-auto680):01360         KEY     FDB     *+NATWID
+1557 171062           (fig-forth-auto680):01361                 LBSR    PKEY    ; PKEY leaves the key/break code in D.
+155A 3606             (fig-forth-auto680):01362                 PSHU    D
+155C 39               (fig-forth-auto680):01363                 RTS
+                      (fig-forth-auto680):01364         *       JSR     PKEY
+                      (fig-forth-auto680):01365         *       PSHS A  ; 
+                      (fig-forth-auto680):01366         *       CLRA    ;
+                      (fig-forth-auto680):01367         *       PSHS A  ; 
+                      (fig-forth-auto680):01368         *       JMP     NEXT
+                      (fig-forth-auto680):01369         *
+                      (fig-forth-auto680):01370         * ======>>  15  <<
+                      (fig-forth-auto680):01371         * ( --- f )
+                      (fig-forth-auto680):01372         * Scan keyboard, but do not wait.  
+                      (fig-forth-auto680):01373         * Return 0 if no key,
+                      (fig-forth-auto680):01374         * BREAK ($ff03) if BREAK is pressed,
+                      (fig-forth-auto680):01375         * or key currently pressed.     
+155D 89               (fig-forth-auto680):01376                 FCB     $89
+155E 3F5445524D494E41 (fig-forth-auto680):01377                 FCC     '?TERMINA'      ; '?TERMINAL'
+1566 CC               (fig-forth-auto680):01378                 FCB     $CC
+1567 154F             (fig-forth-auto680):01379                 FDB     KEY-6
+1569 156B             (fig-forth-auto680):01380         QTERM   FDB     *+NATWID
+156B 171073           (fig-forth-auto680):01381                 LBSR    PQTER   ; PQTER leaves the flag/key in D.
+156E 3606             (fig-forth-auto680):01382                 PSHU    D
+1570 39               (fig-forth-auto680):01383                 RTS
+                      (fig-forth-auto680):01384         *       JSR     PQTER
+                      (fig-forth-auto680):01385         *       CLRB    ;
+                      (fig-forth-auto680):01386         *       JMP     PUSHBA  stack the flag
+                      (fig-forth-auto680):01387         *
+                      (fig-forth-auto680):01388         * ======>>  16  <<
+                      (fig-forth-auto680):01389         * ( --- )
+                      (fig-forth-auto680):01390         * EMIT a Carriage Return (ASCII CR).
+1571 82               (fig-forth-auto680):01391                 FCB     $82
+1572 43               (fig-forth-auto680):01392                 FCC     'C'     ; 'CR'
+1573 D2               (fig-forth-auto680):01393                 FCB     $D2
+1574 155D             (fig-forth-auto680):01394                 FDB     QTERM-12
+1576 1578             (fig-forth-auto680):01395         CR      FDB     *+NATWID
+1578 161071           (fig-forth-auto680):01396                 LBRA    PCR     ; Nothing really to do here.
+                      (fig-forth-auto680):01397         *       JSR     PCR
+                      (fig-forth-auto680):01398         *       JMP     NEXT
+                      (fig-forth-auto680):01399         *
+                      (fig-forth-auto680):01400         * ######>> screen 22 <<
+                      (fig-forth-auto680):01401         * ======>>  17  <<
+                      (fig-forth-auto680):01402         * ( source target count --- )
+                      (fig-forth-auto680):01403         * Copy/move count bytes from source to target.  
+                      (fig-forth-auto680):01404         * Moves ascending addresses,
+                      (fig-forth-auto680):01405         * so that overlapping only works if the source is above the destination.
+157B 85               (fig-forth-auto680):01406                 FCB     $85
+157C 434D4F56         (fig-forth-auto680):01407                 FCC     'CMOV'  ; 'CMOVE' :     source, destination, count
+1580 C5               (fig-forth-auto680):01408                 FCB     $C5
+1581 1571             (fig-forth-auto680):01409                 FDB     CR-5
+1583 1585             (fig-forth-auto680):01410         CMOVE   FDB     *+NATWID
+                      (fig-forth-auto680):01411         * One way:              ; takes ( 37+17*count+9*(count/256) cycles )
+1585 3420             (fig-forth-auto680):01412                 PSHS    Y       ; #2~7 ; Gotta have our pointers.
+1587 3736             (fig-forth-auto680):01413                 PULU    D,X,Y   ; #2~11
+1589 3402             (fig-forth-auto680):01414                 PSHS    A       ; #2~6 ; Gotta have our pointers.
+158B 2004             (fig-forth-auto680):01415                 BRA     CMOVLE  ; #2~3
+158D                  (fig-forth-auto680):01416         CMOVLP
+158D A6A0             (fig-forth-auto680):01417                 LDA     ,Y+     ; #2~6
+158F A780             (fig-forth-auto680):01418                 STA     ,X+     ; #2~6
+1591                  (fig-forth-auto680):01419         CMOVLE
+1591 C001             (fig-forth-auto680):01420                 SUBB    #1      ; #2~2
+1593 24F8             (fig-forth-auto680):01421                 BCC     CMOVLP  ; #2~3
+1595 6AE4             (fig-forth-auto680):01422                 DEC     ,S      ; #2=6
+1597 2AF4             (fig-forth-auto680):01423                 BPL     CMOVLP  ; #2~3
+1599 35A2             (fig-forth-auto680):01424                 PULS    A,Y,PC  ; #2~10
+                      (fig-forth-auto680):01425         * Another way           ; takes ( 42+17*count+9*(count/256) cycles )
+                      (fig-forth-auto680):01426         *       LDD #0          ; #3~3
+                      (fig-forth-auto680):01427         *       SUBD ,U++       ; #2~9 ; invert the count
+                      (fig-forth-auto680):01428         *       PSHS A,Y        ; #2~8
+                      (fig-forth-auto680):01429         *       PULU X,Y        ; #2~9
+                      (fig-forth-auto680):01430         *       BEQ CMOVEX      ; #2~3
+                      (fig-forth-auto680):01431         * CMOVEL
+                      (fig-forth-auto680):01432         *       LDA ,Y+         ; #2~6
+                      (fig-forth-auto680):01433         *       STA ,X+         ; #2~6
+                      (fig-forth-auto680):01434         *       INCB            ; #1~2
+                      (fig-forth-auto680):01435         *       BNE CMOVEL      ; #2~3
+                      (fig-forth-auto680):01436         *       INC ,S          ; #2~6
+                      (fig-forth-auto680):01437         *       BNE CMOVEL      ; #2~3
+                      (fig-forth-auto680):01438         * CMOVEX
+                      (fig-forth-auto680):01439         *       PULS A,Y,PC     ; #2~10
+                      (fig-forth-auto680):01440         * Yet another way               ; takes ( 37+29*count cycles )
+                      (fig-forth-auto680):01441         *       PSHS    Y       ; #2~7
+                      (fig-forth-auto680):01442         *       LDX     NATWID,U        ; #2~6
+                      (fig-forth-auto680):01443         *       LDY     NATWID,U        ; #3~7
+                      (fig-forth-auto680):01444         *       BRA     CMOVLE  ; #2~3
+                      (fig-forth-auto680):01445         * CMOVLP
+                      (fig-forth-auto680):01446         *       LDA     ,Y+     ; #2~6
+                      (fig-forth-auto680):01447         *       STA     ,X+     ; #2~6
+                      (fig-forth-auto680):01448         * CMOVLE
+                      (fig-forth-auto680):01449         *       LDD     ,U      ; #2~5
+                      (fig-forth-auto680):01450         *       SUBD    #1      ; #3~4
+                      (fig-forth-auto680):01451         *       STD     ,U      ; #2~5
+                      (fig-forth-auto680):01452         *       BPL     CMOVLP  ; #2~3
+                      (fig-forth-auto680):01453         *       LEAU    3*NATWID,U      ; #2~5
+                      (fig-forth-auto680):01454         *       PULS    Y,PC    ; #2~9
+                      (fig-forth-auto680):01455         * Yet another way               ; takes ( 44+24*odd+33*count/2 cycles )
+                      (fig-forth-auto680):01456         *       PSHS    Y       ; #2~7
+                      (fig-forth-auto680):01457         *       LDX     NATWID,U        ; #2~6
+                      (fig-forth-auto680):01458         *       LDY     2*NATWID,U      ; #3~7
+                      (fig-forth-auto680):01459         *       LDD     ,U      ; #2~5
+                      (fig-forth-auto680):01460         *       BITB    #1      ; #2~2
+                      (fig-forth-auto680):01461         *       BEQ     CMOVLE  ; #2~3
+                      (fig-forth-auto680):01462         *       SUBD    #1      ; #3~4
+                      (fig-forth-auto680):01463         *       STD     ,U      ; #2~5
+                      (fig-forth-auto680):01464         *       LDA     ,Y+     ; #2~6
+                      (fig-forth-auto680):01465         *       STA     ,X+     ; #2~6
+                      (fig-forth-auto680):01466         *       BRA     CMOVLE  ; #2~3
+                      (fig-forth-auto680):01467         * CMOVLP
+                      (fig-forth-auto680):01468         *       LDD     ,Y++    ; #2~8
+                      (fig-forth-auto680):01469         *       STD     ,X++    ; #2~8
+                      (fig-forth-auto680):01470         * CMOVLI
+                      (fig-forth-auto680):01471         *       LDD     ,U      ; #2~5
+                      (fig-forth-auto680):01472         * CMOVLE
+                      (fig-forth-auto680):01473         *       SUBD    #2      ; #3~4
+                      (fig-forth-auto680):01474         *       STD     ,U      ; #2~5
+                      (fig-forth-auto680):01475         *       BPL     CMOVLP  ; #2~3
+                      (fig-forth-auto680):01476         *       LEAU    3*NATWID,U      ; #2~5
+                      (fig-forth-auto680):01477         *       PULS    Y,PC    ; #2~9
+                      (fig-forth-auto680):01478         * From the 6800 model:  
+                      (fig-forth-auto680):01479         * CMOVE FDB     *+2     takes ( 43+47*count cycles ) on 6800
+                      (fig-forth-auto680):01480         *       LDX     #N
+                      (fig-forth-auto680):01481         *       LDB #6
+                      (fig-forth-auto680):01482         * CMOV1 PULS A  ; 
+                      (fig-forth-auto680):01483         *       STA 0,X move parameters to scratch area
+                      (fig-forth-auto680):01484         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01485         *       DECB    ;
+                      (fig-forth-auto680):01486         *       BNE     CMOV1
+                      (fig-forth-auto680):01487         * CMOV2 LDA N
+                      (fig-forth-auto680):01488         *       LDB N+1
+                      (fig-forth-auto680):01489         *       SUBB #1
+                      (fig-forth-auto680):01490         *       SBCA #0
+                      (fig-forth-auto680):01491         *       STA N
+                      (fig-forth-auto680):01492         *       STB N+1
+                      (fig-forth-auto680):01493         *       BCS     CMOV3
+                      (fig-forth-auto680):01494         *       LDX     N+4
+                      (fig-forth-auto680):01495         *       LDA 0,X
+                      (fig-forth-auto680):01496         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01497         *       STX     N+4
+                      (fig-forth-auto680):01498         *       LDX     N+2
+                      (fig-forth-auto680):01499         *       STA 0,X
+                      (fig-forth-auto680):01500         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01501         *       STX     N+2
+                      (fig-forth-auto680):01502         *       BRA     CMOV2
+                      (fig-forth-auto680):01503         * CMOV3 JMP     NEXT
+                      (fig-forth-auto680):01504         *
+                      (fig-forth-auto680):01505         * ######>> screen 23 <<
+                      (fig-forth-auto680):01506         * ======>>  18  <<
+                      (fig-forth-auto680):01507         * ( u1 u2 --- ud )
+                      (fig-forth-auto680):01508         * Multiplies the top two unsigned integers,
+                      (fig-forth-auto680):01509         * yielding a double integer product.
+159B 82               (fig-forth-auto680):01510                 FCB     $82
+159C 55               (fig-forth-auto680):01511                 FCC     'U'     ; 'U*'
+159D AA               (fig-forth-auto680):01512                 FCB     $AA
+159E 157B             (fig-forth-auto680):01513                 FDB     CMOVE-8
+15A0 15A2             (fig-forth-auto680):01514         USTAR   FDB     *+NATWID
+15A2 335C             (fig-forth-auto680):01515                 LEAU    -2*NATWID,U
+15A4 A645             (fig-forth-auto680):01516                 LDA     2*NATWID+1,U    ; least
+15A6 E647             (fig-forth-auto680):01517                 LDB     3*NATWID+1,U
+15A8 3D               (fig-forth-auto680):01518                 MUL
+15A9 ED42             (fig-forth-auto680):01519                 STD     NATWID,U
+15AB A644             (fig-forth-auto680):01520                 LDA     2*NATWID,U      ; most
+15AD E646             (fig-forth-auto680):01521                 LDB     3*NATWID,U
+15AF 3D               (fig-forth-auto680):01522                 MUL
+15B0 EDC4             (fig-forth-auto680):01523                 STD     ,U
+15B2 EC45             (fig-forth-auto680):01524                 LDD     2*NATWID+1,U    ; first inner (u2 lo, u1 hi)
+15B4 3D               (fig-forth-auto680):01525                 MUL
+15B5 E341             (fig-forth-auto680):01526                 ADDD    1,U
+15B7 2402             (fig-forth-auto680):01527                 BCC     USTAR3
+15B9 6CC4             (fig-forth-auto680):01528                 INC     ,U
+15BB ED41             (fig-forth-auto680):01529         USTAR3  STD     1,U
+15BD A644             (fig-forth-auto680):01530                 LDA     2*NATWID,U      ; second inner (u2 hi)
+15BF E646             (fig-forth-auto680):01531                 LDB     3*NATWID,U      ; (u1 lo)
+15C1 3D               (fig-forth-auto680):01532                 MUL
+15C2 E341             (fig-forth-auto680):01533                 ADDD    1,U
+15C4 2402             (fig-forth-auto680):01534                 BCC     USTAR4
+15C6 6CC4             (fig-forth-auto680):01535                 INC     ,U
+15C8 ED41             (fig-forth-auto680):01536         USTAR4  STD     1,U
+15CA 3716             (fig-forth-auto680):01537                 PULU    D,X
+15CC EDC4             (fig-forth-auto680):01538                 STD     ,U
+15CE AF42             (fig-forth-auto680):01539                 STX     NATWID,U
+15D0 39               (fig-forth-auto680):01540                 RTS
+                      (fig-forth-auto680):01541         *
+                      (fig-forth-auto680):01542         * from 6800 model:
+                      (fig-forth-auto680):01543         *       BSR     USTARS
+                      (fig-forth-auto680):01544         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01545         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01546         *       JMP     PUSHBA
+                      (fig-forth-auto680):01547         *
+                      (fig-forth-auto680):01548         * The following is a subroutine which 
+                      (fig-forth-auto680):01549         * multiplies top 2 words on stack,
+                      (fig-forth-auto680):01550         * leaving 32-bit result:  high order word in A,B
+                      (fig-forth-auto680):01551         * low order word in 2nd word of stack.
+                      (fig-forth-auto680):01552         *
+                      (fig-forth-auto680):01553         * USTARS        LDA #16 bits/word counter
+                      (fig-forth-auto680):01554         *       PSHS A  ; 
+                      (fig-forth-auto680):01555         *       CLRA    ;
+                      (fig-forth-auto680):01556         *       CLRB    ;
+                      (fig-forth-auto680):01557         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01558         * USTAR2        ROR 5,X shift multiplier
+                      (fig-forth-auto680):01559         *       ROR 6,X
+                      (fig-forth-auto680):01560         *       DEC 0,X done?
+                      (fig-forth-auto680):01561         *       BMI     USTAR4
+                      (fig-forth-auto680):01562         *       BCC     USTAR3
+                      (fig-forth-auto680):01563         *       ADDB 4,X
+                      (fig-forth-auto680):01564         *       ADCA 3,X
+                      (fig-forth-auto680):01565         * USTAR3        RORA    ;
+                      (fig-forth-auto680):01566         *       RORB    ;               shift result
+                      (fig-forth-auto680):01567         *       BRA     USTAR2
+                      (fig-forth-auto680):01568         * USTAR4        LEAS 1,S        ;               dump counter
+                      (fig-forth-auto680):01569         *       RTS
+                      (fig-forth-auto680):01570         *
+                      (fig-forth-auto680):01571         * ######>> screen 24 <<
+                      (fig-forth-auto680):01572         * ======>>  19  <<
+                      (fig-forth-auto680):01573         * ( ud u --- uremainder uquotient )
+                      (fig-forth-auto680):01574         * Divides the top unsigned integer
+                      (fig-forth-auto680):01575         * into the second and third words on the stack
+                      (fig-forth-auto680):01576         * as a single unsigned double integer,
+                      (fig-forth-auto680):01577         * leaving the remainder and quotient (quotient on top)
+                      (fig-forth-auto680):01578         * as unsigned integers.
+                      (fig-forth-auto680):01579         *               
+                      (fig-forth-auto680):01580         *    The smaller the divisor, the more likely dropping the high word 
+                      (fig-forth-auto680):01581         *    of the quotient loses significant bits. See M/MOD .
+                      (fig-forth-auto680):01582         *
+15D1 82               (fig-forth-auto680):01583                 FCB     $82
+15D2 55               (fig-forth-auto680):01584                 FCC     'U'     ; 'U/'
+15D3 AF               (fig-forth-auto680):01585                 FCB     $AF
+15D4 159B             (fig-forth-auto680):01586                 FDB     USTAR-5
+15D6 15D8             (fig-forth-auto680):01587         USLASH  FDB     *+NATWID
+15D8 8611             (fig-forth-auto680):01588                 LDA     #17     ; bit ct
+15DA 3402             (fig-forth-auto680):01589                 PSHS    A
+15DC EC42             (fig-forth-auto680):01590                 LDD     NATWID,U        ; dividend
+15DE 10A3C4           (fig-forth-auto680):01591         USLDIV  CMPD    ,U      ; divisor
+15E1 2404             (fig-forth-auto680):01592                 BHS     USLSUB
+15E3 1CFE             (fig-forth-auto680):01593                 ANDCC   #~1     ; carry clear
+15E5 2004             (fig-forth-auto680):01594                 BRA     USLBIT
+15E7 A3C4             (fig-forth-auto680):01595         USLSUB  SUBD    ,U
+15E9 1A01             (fig-forth-auto680):01596                 ORCC    #1      ; quotient, (carry set)
+15EB 6945             (fig-forth-auto680):01597         USLBIT  ROL     2*NATWID+1,U    ; save it
+15ED 6944             (fig-forth-auto680):01598                 ROL     2*NATWID,U
+15EF 6AE4             (fig-forth-auto680):01599                 DEC     ,S      ; more bits?
+15F1 2706             (fig-forth-auto680):01600                 BEQ     USLR
+15F3 59               (fig-forth-auto680):01601                 ROLB            ; remainder
+15F4 49               (fig-forth-auto680):01602                 ROLA
+15F5 24E7             (fig-forth-auto680):01603                 BCC     USLDIV
+15F7 20EE             (fig-forth-auto680):01604                 BRA     USLSUB
+15F9 3342             (fig-forth-auto680):01605         USLR    LEAU    NATWID,U
+15FB AE42             (fig-forth-auto680):01606                 LDX     NATWID,U
+15FD ED42             (fig-forth-auto680):01607                 STD     NATWID,U
+15FF AFC4             (fig-forth-auto680):01608                 STX     ,U
+1601 3582             (fig-forth-auto680):01609                 PULS    A,PC    ; Avoiding a LEAS 1,S by discarding A.
+                      (fig-forth-auto680):01610         *
+                      (fig-forth-auto680):01611         * from 6800 model:
+                      (fig-forth-auto680):01612         *       LDA #17
+                      (fig-forth-auto680):01613         *       PSHS A  ; 
+                      (fig-forth-auto680):01614         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01615         *       LDA 3,X
+                      (fig-forth-auto680):01616         *       LDB 4,X
+                      (fig-forth-auto680):01617         * USL1  CMPA 1,X
+                      (fig-forth-auto680):01618         *       BHI     USL3
+                      (fig-forth-auto680):01619         *       BCS     USL2
+                      (fig-forth-auto680):01620         *       CMPB 2,X
+                      (fig-forth-auto680):01621         *       BCC     USL3
+                      (fig-forth-auto680):01622         * USL2  ANDCC #~$01     ; CLC : 
+                      (fig-forth-auto680):01623         *       BRA     USL4
+                      (fig-forth-auto680):01624         * USL3  SUBB 2,X
+                      (fig-forth-auto680):01625         *       SBCA 1,X
+                      (fig-forth-auto680):01626         *       ORCC #$01       ; SEC : 
+                      (fig-forth-auto680):01627         * USL4  ROL 6,X
+                      (fig-forth-auto680):01628         *       ROL 5,X
+                      (fig-forth-auto680):01629         *       DEC 0,X
+                      (fig-forth-auto680):01630         *       BEQ     USL5
+                      (fig-forth-auto680):01631         *       ROLB    ;
+                      (fig-forth-auto680):01632         *       ROLA    ;
+                      (fig-forth-auto680):01633         *       BCC     USL1
+                      (fig-forth-auto680):01634         *       BRA     USL3
+                      (fig-forth-auto680):01635         * USL5  LEAS 1,S        ; 
+                      (fig-forth-auto680):01636         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01637         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01638         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01639         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01640         *       JMP     SWAP+4  reverse quotient & remainder
+                      (fig-forth-auto680):01641         *
+                      (fig-forth-auto680):01642         * ######>> screen 25 <<
+                      (fig-forth-auto680):01643         * ======>>  20  <<
+                      (fig-forth-auto680):01644         * ( n1 n2 --- n )
+                      (fig-forth-auto680):01645         * Bitwise and the top two integers.
+1603 83               (fig-forth-auto680):01646                 FCB     $83
+1604 414E             (fig-forth-auto680):01647                 FCC     'AN'    ; 'AND'
+1606 C4               (fig-forth-auto680):01648                 FCB     $C4
+1607 15D1             (fig-forth-auto680):01649                 FDB     USLASH-5
+1609 160B             (fig-forth-auto680):01650         AND     FDB     *+NATWID
+160B 3706             (fig-forth-auto680):01651                 PULU    A,B
+160D E441             (fig-forth-auto680):01652                 ANDB    1,U
+160F A4C4             (fig-forth-auto680):01653                 ANDA    ,U
+1611 EDC4             (fig-forth-auto680):01654                 STD     ,U
+1613 39               (fig-forth-auto680):01655                 RTS
+                      (fig-forth-auto680):01656         *       PULS A  ; 
+                      (fig-forth-auto680):01657         *       PULS B  ; 
+                      (fig-forth-auto680):01658         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01659         *       ANDB 1,X
+                      (fig-forth-auto680):01660         *       ANDA 0,X
+                      (fig-forth-auto680):01661         *       JMP     STABX
+                      (fig-forth-auto680):01662         *
+                      (fig-forth-auto680):01663         * ======>>  21  <<
+                      (fig-forth-auto680):01664         * ( n1 n2 --- n )
+                      (fig-forth-auto680):01665         * Bitwise or the top two integers.
+1614 82               (fig-forth-auto680):01666                 FCB     $82
+1615 4F               (fig-forth-auto680):01667                 FCC     'O'     ; 'OR'
+1616 D2               (fig-forth-auto680):01668                 FCB     $D2
+1617 1603             (fig-forth-auto680):01669                 FDB     AND-6
+1619 161B             (fig-forth-auto680):01670         OR      FDB     *+NATWID
+161B 3706             (fig-forth-auto680):01671                 PULU    A,B
+161D EA41             (fig-forth-auto680):01672                 ORB     1,U
+161F AAC4             (fig-forth-auto680):01673                 ORA     ,U
+1621 EDC4             (fig-forth-auto680):01674                 STD     ,U
+1623 39               (fig-forth-auto680):01675                 RTS
+                      (fig-forth-auto680):01676         *       PULS A  ; 
+                      (fig-forth-auto680):01677         *       PULS B  ; 
+                      (fig-forth-auto680):01678         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01679         *       ORB 1,X
+                      (fig-forth-auto680):01680         *       ORA 0,X
+                      (fig-forth-auto680):01681         *       JMP     STABX
+                      (fig-forth-auto680):01682         *       
+                      (fig-forth-auto680):01683         * ======>>  22  <<
+                      (fig-forth-auto680):01684         * ( n1 n2 --- n )
+                      (fig-forth-auto680):01685         * Bitwise exclusive or the top two integers.
+1624 83               (fig-forth-auto680):01686                 FCB     $83
+1625 584F             (fig-forth-auto680):01687                 FCC     'XO'    ; 'XOR'
+1627 D2               (fig-forth-auto680):01688                 FCB     $D2
+1628 1614             (fig-forth-auto680):01689                 FDB     OR-5
+162A 162C             (fig-forth-auto680):01690         XOR     FDB     *+NATWID
+162C 3706             (fig-forth-auto680):01691                 PULU    A,B
+162E E841             (fig-forth-auto680):01692                 EORB    1,U
+1630 A8C4             (fig-forth-auto680):01693                 EORA    ,U
+1632 EDC4             (fig-forth-auto680):01694                 STD     ,U
+1634 39               (fig-forth-auto680):01695                 RTS
+                      (fig-forth-auto680):01696         *       PULS A  ; 
+                      (fig-forth-auto680):01697         *       PULS B  ; 
+                      (fig-forth-auto680):01698         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01699         *       EORB 1,X
+                      (fig-forth-auto680):01700         *       EORA 0,X
+                      (fig-forth-auto680):01701         *       JMP     STABX
+                      (fig-forth-auto680):01702         *
+                      (fig-forth-auto680):01703         * ######>> screen 26 <<
+                      (fig-forth-auto680):01704         * ======>>  23  <<
+                      (fig-forth-auto680):01705         * ( --- adr )
+                      (fig-forth-auto680):01706         * Fetch the parameter stack pointer (before it is pushed).
+                      (fig-forth-auto680):01707         * This points at whatever was on the top of stack before.
+1635 83               (fig-forth-auto680):01708                 FCB     $83
+1636 5350             (fig-forth-auto680):01709                 FCC     'SP'    ; 'SP@'
+1638 C0               (fig-forth-auto680):01710                 FCB     $C0
+1639 1624             (fig-forth-auto680):01711                 FDB     XOR-6
+163B 163D             (fig-forth-auto680):01712         SPAT    FDB     *+NATWID
+163D 1F31             (fig-forth-auto680):01713                 TFR     U,X
+163F 3610             (fig-forth-auto680):01714                 PSHU    X
+1641 39               (fig-forth-auto680):01715                 RTS
+                      (fig-forth-auto680):01716         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01717         *       STX     N       scratch area
+                      (fig-forth-auto680):01718         *       LDX     #N
+                      (fig-forth-auto680):01719         *       JMP     GETX
+                      (fig-forth-auto680):01720         *
+                      (fig-forth-auto680):01721         * ======>>  24  <<
+                      (fig-forth-auto680):01722         * ( whatever --- nothing )
+                      (fig-forth-auto680):01723         * Initialize the parameter stack pointer from the USER variable S0. 
+                      (fig-forth-auto680):01724         * Effectively clears the stack.
+1642 83               (fig-forth-auto680):01725                 FCB     $83
+1643 5350             (fig-forth-auto680):01726                 FCC     'SP'    ; 'SP!'
+1645 A1               (fig-forth-auto680):01727                 FCB     $A1
+1646 1635             (fig-forth-auto680):01728                 FDB     SPAT-6
+1648 164A             (fig-forth-auto680):01729         SPSTOR  FDB     *+NATWID
+164A DE1E             (fig-forth-auto680):01730                 LDU     <XSPZER
+164C 39               (fig-forth-auto680):01731                 RTS
+                      (fig-forth-auto680):01732         *       LDX     UP
+                      (fig-forth-auto680):01733         *       LDX     XSPZER-UORIG,X
+                      (fig-forth-auto680):01734         *       TFR X,S ; TXS :                 watch it ! X and S are not equal on 6800.
+                      (fig-forth-auto680):01735         *       JMP     NEXT
+                      (fig-forth-auto680):01736         * ======>>  25  <<
+                      (fig-forth-auto680):01737         * ( whatever *** nothing )
+                      (fig-forth-auto680):01738         * Initialize the return stack pointer from the initialization table
+                      (fig-forth-auto680):01739         * instead of the user variable R0, for some reason.
+                      (fig-forth-auto680):01740         * Quite possibly, this should be from R0.
+                      (fig-forth-auto680):01741         * Effectively aborts all in process definitions, except the active one. 
+                      (fig-forth-auto680):01742         * An emergency measure, to be sure.
+                      (fig-forth-auto680):01743         * The routine that calls this must never execute a return.
+                      (fig-forth-auto680):01744         * So this should never be executed from the terminal, I guess.
+                      (fig-forth-auto680):01745         * This is another that should be compile-time only, and in a separate vocabulary.
+164D 83               (fig-forth-auto680):01746                 FCB     $83
+164E 5250             (fig-forth-auto680):01747                 FCC     'RP'    ; 'RP!'
+1650 A1               (fig-forth-auto680):01748                 FCB     $A1
+1651 1642             (fig-forth-auto680):01749                 FDB     SPSTOR-6
+1653 1655             (fig-forth-auto680):01750         RPSTOR  FDB     *+NATWID
+1655 3510             (fig-forth-auto680):01751                 PULS    X       ; But this guy has to return to his caller.
+1657 10FE1214         (fig-forth-auto680):01752                 LDS     RINIT
+165B 6E84             (fig-forth-auto680):01753                 JMP     ,X
+                      (fig-forth-auto680):01754         *       LDX     RINIT   initialize from rom constant
+                      (fig-forth-auto680):01755         *       STX     RP
+                      (fig-forth-auto680):01756         *       JMP     NEXT
+                      (fig-forth-auto680):01757         *
+                      (fig-forth-auto680):01758         * ======>>  26  <<
+                      (fig-forth-auto680):01759         * ( ip *** )
+                      (fig-forth-auto680):01760         * Pop IP from return stack (return from high-level definition).
+                      (fig-forth-auto680):01761         * Can be used in a screen to force interpretion to terminate.
+                      (fig-forth-auto680):01762         * Must not be executed when temporaries are saved on top of the return stack.
+165D 82               (fig-forth-auto680):01763                 FCB     $82
+165E 3B               (fig-forth-auto680):01764                 FCC     ';'     ; ';S'
+165F D3               (fig-forth-auto680):01765                 FCB     $D3
+1660 164D             (fig-forth-auto680):01766                 FDB     RPSTOR-6
+1662 1664             (fig-forth-auto680):01767         SEMIS   FDB     *+NATWID
+1664 3526             (fig-forth-auto680):01768                 PULS    D,Y     ; return address in D, and saved IP in Y.
+1666 1F05             (fig-forth-auto680):01769                 TFR     D,PC    ; Synthetic return.
+                      (fig-forth-auto680):01770         *
+                      (fig-forth-auto680):01771         * Form 6800 model:
+                      (fig-forth-auto680):01772         *       LDX     RP
+                      (fig-forth-auto680):01773         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01774         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01775         *       STX     RP
+                      (fig-forth-auto680):01776         *       LDX     0,X     get address we have just finished.
+                      (fig-forth-auto680):01777         *       JMP     NEXT+2  increment the return address & do next word
+                      (fig-forth-auto680):01778         *
+                      (fig-forth-auto680):01779         * ######>> screen 27 <<
+                      (fig-forth-auto680):01780         * ======>>  27  <<
+                      (fig-forth-auto680):01781         * ( limit index *** index index )
+                      (fig-forth-auto680):01782         * Force the terminating condition for the innermost loop by
+                      (fig-forth-auto680):01783         * copying its index to its limit. 
+                      (fig-forth-auto680):01784         * Termination is postponed until the next
+                      (fig-forth-auto680):01785         * LOOP or +LOOP instruction is executed. 
+                      (fig-forth-auto680):01786         * The index remains available for use until
+                      (fig-forth-auto680):01787         * the LOOP or +LOOP instruction is encountered.
+                      (fig-forth-auto680):01788         * Note that the assumption is that the current count is the correct count 
+                      (fig-forth-auto680):01789         * to end at, rather than pushing the count to the final count.
+1668 85               (fig-forth-auto680):01790                 FCB     $85
+1669 4C454156         (fig-forth-auto680):01791                 FCC     'LEAV'  ; 'LEAVE'
+166D C5               (fig-forth-auto680):01792                 FCB     $C5
+166E 165D             (fig-forth-auto680):01793                 FDB     SEMIS-5
+1670 1672             (fig-forth-auto680):01794         LEAVE   FDB     *+NATWID
+1672 EC62             (fig-forth-auto680):01795                 LDD     NATWID,S        ; Dodge the return address.
+1674 ED64             (fig-forth-auto680):01796                 STD     2*NATWID,S
+1676 39               (fig-forth-auto680):01797                 RTS
+                      (fig-forth-auto680):01798         *       LDX     RP
+                      (fig-forth-auto680):01799         *       LDA 2,X
+                      (fig-forth-auto680):01800         *       LDB 3,X
+                      (fig-forth-auto680):01801         *       STA 4,X
+                      (fig-forth-auto680):01802         *       STB 5,X
+                      (fig-forth-auto680):01803         *       JMP     NEXT
+                      (fig-forth-auto680):01804         *
+                      (fig-forth-auto680):01805         * ======>>  28  <<
+                      (fig-forth-auto680):01806         * ( n --- )              
+                      (fig-forth-auto680):01807         * ( *** n ) 
+                      (fig-forth-auto680):01808         * Move top of parameter stack to top of return stack.
+1677 82               (fig-forth-auto680):01809                 FCB     $82
+1678 3E               (fig-forth-auto680):01810                 FCC     '>'     ; '>R'
+1679 D2               (fig-forth-auto680):01811                 FCB     $D2
+167A 1668             (fig-forth-auto680):01812                 FDB     LEAVE-8
+167C 167E             (fig-forth-auto680):01813         TOR     FDB     *+NATWID
+167E 3706             (fig-forth-auto680):01814                 PULU    A,B
+1680 AEE4             (fig-forth-auto680):01815                 LDX     ,S
+1682 EDE4             (fig-forth-auto680):01816                 STD     ,S      ; Put it where the return address was.
+1684 6E84             (fig-forth-auto680):01817                 JMP     ,X
+                      (fig-forth-auto680):01818         *       LDX     RP
+                      (fig-forth-auto680):01819         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):01820         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):01821         *       STX     RP
+                      (fig-forth-auto680):01822         *       PULS A  ; 
+                      (fig-forth-auto680):01823         *       PULS B  ; 
+                      (fig-forth-auto680):01824         *       STA 2,X
+                      (fig-forth-auto680):01825         *       STB 3,X
+                      (fig-forth-auto680):01826         *       JMP     NEXT
+                      (fig-forth-auto680):01827         *
+                      (fig-forth-auto680):01828         * ======>>  29  <<
+                      (fig-forth-auto680):01829         * ( --- n )              
+                      (fig-forth-auto680):01830         * ( n *** )  
+                      (fig-forth-auto680):01831         * Move top of return stack to top of parameter stack.
+1686 82               (fig-forth-auto680):01832                 FCB     $82
+1687 52               (fig-forth-auto680):01833                 FCC     'R'     ; 'R>'
+1688 BE               (fig-forth-auto680):01834                 FCB     $BE
+1689 1677             (fig-forth-auto680):01835                 FDB     TOR-5
+168B 168D             (fig-forth-auto680):01836         FROMR   FDB     *+NATWID
+168D 3516             (fig-forth-auto680):01837                 PULS    D,X
+168F 3610             (fig-forth-auto680):01838                 PSHU    X
+1691 1F05             (fig-forth-auto680):01839                 TFR     D,PC
+                      (fig-forth-auto680):01840         *       LDX     RP
+                      (fig-forth-auto680):01841         *       LDA 2,X
+                      (fig-forth-auto680):01842         *       LDB 3,X
+                      (fig-forth-auto680):01843         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01844         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01845         *       STX     RP
+                      (fig-forth-auto680):01846         *       JMP     PUSHBA
+                      (fig-forth-auto680):01847         *
+                      (fig-forth-auto680):01848         * ======>>  30  <<
+                      (fig-forth-auto680):01849         * ( --- n )             
+                      (fig-forth-auto680):01850         * ( n *** n )
+                      (fig-forth-auto680):01851         * Copy the top of return stack to top of parameter stack. 
+                      (fig-forth-auto680):01852         * A synonym for I.
+1693 81               (fig-forth-auto680):01853                 FCB     $81     R
+1694 D2               (fig-forth-auto680):01854                 FCB     $D2
+1695 1686             (fig-forth-auto680):01855                 FDB     FROMR-5
+1697 1467             (fig-forth-auto680):01856         R       FDB     I+NATWID
+                      (fig-forth-auto680):01857         
+                      (fig-forth-auto680):01858         *       LDX     RP
+                      (fig-forth-auto680):01859         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01860         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):01861         *       JMP     GETX
+                      (fig-forth-auto680):01862         *
+                      (fig-forth-auto680):01863         * ######>> screen 28 <<
+                      (fig-forth-auto680):01864         * ======>>  31  <<
+                      (fig-forth-auto680):01865         * ( n --- n=0 )
+                      (fig-forth-auto680):01866         * Logically invert top of stack;
+                      (fig-forth-auto680):01867         * or flag true if top is zero, otherwise false.
+1699 82               (fig-forth-auto680):01868                 FCB     $82
+169A 30               (fig-forth-auto680):01869                 FCC     '0'     ; '0='
+169B BD               (fig-forth-auto680):01870                 FCB     $BD
+169C 1693             (fig-forth-auto680):01871                 FDB     R-4
+169E 16A0             (fig-forth-auto680):01872         ZEQU    FDB     *+NATWID
+16A0 CC0000           (fig-forth-auto680):01873                 LDD     #0
+16A3 AEC4             (fig-forth-auto680):01874                 LDX     ,U
+16A5 2601             (fig-forth-auto680):01875                 BNE     ZEQUF
+16A7 5C               (fig-forth-auto680):01876                 INCB    ; 1 is true
+16A8 EDC4             (fig-forth-auto680):01877         ZEQUF   STD     ,U
+16AA 39               (fig-forth-auto680):01878                 RTS
+                      (fig-forth-auto680):01879         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01880         *       CLRA    ;
+                      (fig-forth-auto680):01881         *       CLRB    ;
+                      (fig-forth-auto680):01882         *       LDX     0,X
+                      (fig-forth-auto680):01883         *       BNE     ZEQU2
+                      (fig-forth-auto680):01884         *       INCB    ;
+                      (fig-forth-auto680):01885         *ZEQU2  TFR S,X ; TSX : 
+                      (fig-forth-auto680):01886         *       JMP     STABX
+                      (fig-forth-auto680):01887         *
+                      (fig-forth-auto680):01888         * ======>>  32  <<
+                      (fig-forth-auto680):01889         * ( n --- n<0 )
+                      (fig-forth-auto680):01890         * Flag true if top is negative (MSbit set), otherwise false.
+16AB 82               (fig-forth-auto680):01891                 FCB     $82
+16AC 30               (fig-forth-auto680):01892                 FCC     '0'     ; '0<'
+16AD BC               (fig-forth-auto680):01893                 FCB     $BC
+16AE 1699             (fig-forth-auto680):01894                 FDB     ZEQU-5
+16B0 16B2             (fig-forth-auto680):01895         ZLESS   FDB     *+NATWID
+16B2 CC0000           (fig-forth-auto680):01896                 LDD     #0
+16B5 6DC4             (fig-forth-auto680):01897                 TST     ,U
+16B7 2A01             (fig-forth-auto680):01898                 BPL     ZLESSF
+16B9 5C               (fig-forth-auto680):01899                 INCB
+16BA EDC4             (fig-forth-auto680):01900         ZLESSF  STD     ,U
+16BC 39               (fig-forth-auto680):01901                 RTS
+                      (fig-forth-auto680):01902         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01903         *       LDA #$80        check the sign bit
+                      (fig-forth-auto680):01904         *       ANDA 0,X
+                      (fig-forth-auto680):01905         *       BEQ     ZLESS2
+                      (fig-forth-auto680):01906         *       CLRA    ;               if neg.
+                      (fig-forth-auto680):01907         *       LDB #1
+                      (fig-forth-auto680):01908         *       JMP     STABX
+                      (fig-forth-auto680):01909         * ZLESS2        CLRB    ;
+                      (fig-forth-auto680):01910         *       JMP     STABX
+                      (fig-forth-auto680):01911         *
+                      (fig-forth-auto680):01912         * ######>> screen 29 <<
+                      (fig-forth-auto680):01913         * ======>>  33  <<
+                      (fig-forth-auto680):01914         * ( n1 n2 --- n1+n2 )
+                      (fig-forth-auto680):01915         * Add top two words.
+16BD 81               (fig-forth-auto680):01916                 FCB     $81     '+'
+16BE AB               (fig-forth-auto680):01917                 FCB     $AB
+16BF 16AB             (fig-forth-auto680):01918                 FDB     ZLESS-5
+16C1 16C3             (fig-forth-auto680):01919         PLUS    FDB     *+NATWID
+16C3 3706             (fig-forth-auto680):01920                 PULU    A,B     ; #2~7
+16C5 E3C4             (fig-forth-auto680):01921                 ADDD    ,U      ; #2~6
+16C7 EDC4             (fig-forth-auto680):01922                 STD     ,U      ; #2~5
+16C9 39               (fig-forth-auto680):01923                 RTS             ; #1~5  =#7~23
+                      (fig-forth-auto680):01924         *       PULS A  ; 
+                      (fig-forth-auto680):01925         *       PULS B  ; 
+                      (fig-forth-auto680):01926         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01927         *       ADDB 1,X
+                      (fig-forth-auto680):01928         *       ADCA 0,X
+                      (fig-forth-auto680):01929         *       JMP     STABX
+                      (fig-forth-auto680):01930         *
+                      (fig-forth-auto680):01931         * ======>>  34  <<
+                      (fig-forth-auto680):01932         * ( d1 d2 --- d1+d2 )
+                      (fig-forth-auto680):01933         * Add top two double integers.
+16CA 82               (fig-forth-auto680):01934                 FCB     $82
+16CB 44               (fig-forth-auto680):01935                 FCC     'D'     ; 'D+'
+16CC AB               (fig-forth-auto680):01936                 FCB     $AB
+16CD 16BD             (fig-forth-auto680):01937                 FDB     PLUS-4
+16CF 16D1             (fig-forth-auto680):01938         DPLUS   FDB     *+NATWID
+16D1 EC46             (fig-forth-auto680):01939                 LDD     3*NATWID,U
+16D3 E342             (fig-forth-auto680):01940                 ADDD    NATWID,U
+16D5 ED46             (fig-forth-auto680):01941                 STD     3*NATWID,U
+16D7 EC44             (fig-forth-auto680):01942                 LDD     2*NATWID,U
+16D9 E941             (fig-forth-auto680):01943                 ADCB    1,U
+16DB A9C4             (fig-forth-auto680):01944                 ADCA    ,U
+16DD 3344             (fig-forth-auto680):01945                 LEAU    2*NATWID,U
+16DF EDC4             (fig-forth-auto680):01946                 STD     ,U
+16E1 39               (fig-forth-auto680):01947                 RTS
+                      (fig-forth-auto680):01948         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01949         *       ANDCC #~$01     ; CLC : 
+                      (fig-forth-auto680):01950         *       LDB #4
+                      (fig-forth-auto680):01951         * DPLUS2        LDA 3,X
+                      (fig-forth-auto680):01952         *       ADCA 7,X
+                      (fig-forth-auto680):01953         *       STA 7,X
+                      (fig-forth-auto680):01954         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):01955         *       DECB    ;
+                      (fig-forth-auto680):01956         *       BNE     DPLUS2
+                      (fig-forth-auto680):01957         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01958         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01959         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01960         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):01961         *       JMP     NEXT
+                      (fig-forth-auto680):01962         *
+                      (fig-forth-auto680):01963         * ======>>  35  <<
+                      (fig-forth-auto680):01964         * ( n --- -n )
+                      (fig-forth-auto680):01965         * Negate (two's complement) top of stack.
+16E2 85               (fig-forth-auto680):01966                 FCB     $85
+16E3 4D494E55         (fig-forth-auto680):01967                 FCC     'MINU'  ; 'MINUS'
+16E7 D3               (fig-forth-auto680):01968                 FCB     $D3
+16E8 16CA             (fig-forth-auto680):01969                 FDB     DPLUS-5
+16EA 16EC             (fig-forth-auto680):01970         MINUS   FDB     *+NATWID
+16EC CC0000           (fig-forth-auto680):01971                 LDD     #0      ; #3~3
+16EF A3C4             (fig-forth-auto680):01972                 SUBD    ,U      ; #2~5
+16F1 EDC4             (fig-forth-auto680):01973                 STD     ,U      ; #2~5
+16F3 39               (fig-forth-auto680):01974                 RTS             ; #1~5  = #8~18
+                      (fig-forth-auto680):01975         * 
+                      (fig-forth-auto680):01976         * from 6800 model code:
+                      (fig-forth-auto680):01977         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):01978         *       NEG 1,X
+                      (fig-forth-auto680):01979         *       BCC     MINUS2
+                      (fig-forth-auto680):01980         *       NEG 0,X
+                      (fig-forth-auto680):01981         *       BRA     MINUS3
+                      (fig-forth-auto680):01982         * MINUS2        COM 0,X
+                      (fig-forth-auto680):01983         * MINUS3        JMP     NEXT
+                      (fig-forth-auto680):01984         *
+                      (fig-forth-auto680):01985         * ======>>  36  <<
+                      (fig-forth-auto680):01986         * ( d --- -d )
+                      (fig-forth-auto680):01987         * Negate (two's complement) top two words on stack as a double integer.
+16F4 86               (fig-forth-auto680):01988                 FCB     $86
+16F5 444D494E55       (fig-forth-auto680):01989                 FCC     'DMINU' ; 'DMINUS'
+16FA D3               (fig-forth-auto680):01990                 FCB     $D3
+16FB 16E2             (fig-forth-auto680):01991                 FDB     MINUS-8
+16FD 16FF             (fig-forth-auto680):01992         DMINUS  FDB     *+NATWID
+16FF CC0000           (fig-forth-auto680):01993                 LDD     #0      ; #3~3
+1702 A342             (fig-forth-auto680):01994                 SUBD    NATWID,U        ; #2~7
+1704 ED42             (fig-forth-auto680):01995                 STD     NATWID,U        ; #2~7
+1706 CC0000           (fig-forth-auto680):01996                 LDD     #0      ; #3~3
+1709 E241             (fig-forth-auto680):01997                 SBCB    1,U     ; #2~5
+170B A2C4             (fig-forth-auto680):01998                 SBCA    ,U      ; #2~4
+170D EDC4             (fig-forth-auto680):01999                 STD     ,U      ; #2~5
+170F 39               (fig-forth-auto680):02000                 RTS             ; #1~5  = #17~39
+                      (fig-forth-auto680):02001         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02002         *       COM 0,X
+                      (fig-forth-auto680):02003         *       COM 1,X
+                      (fig-forth-auto680):02004         *       COM 2,X
+                      (fig-forth-auto680):02005         *       NEG 3,X
+                      (fig-forth-auto680):02006         *       BNE     DMINX
+                      (fig-forth-auto680):02007         *       INC 2,X
+                      (fig-forth-auto680):02008         *       BNE     DMINX
+                      (fig-forth-auto680):02009         *       INC 1,X
+                      (fig-forth-auto680):02010         *       BNE     DMINX
+                      (fig-forth-auto680):02011         *       INC 0,X
+                      (fig-forth-auto680):02012         * DMINX JMP     NEXT
+                      (fig-forth-auto680):02013         *
+                      (fig-forth-auto680):02014         * ######>> screen 30 <<
+                      (fig-forth-auto680):02015         * ======>>  37  <<
+                      (fig-forth-auto680):02016         * ( n1 n2 --- n1 n2 n1 )
+                      (fig-forth-auto680):02017         * Push a copy of the second word on stack.
+1710 84               (fig-forth-auto680):02018                 FCB     $84
+1711 4F5645           (fig-forth-auto680):02019                 FCC     'OVE'   ; 'OVER'
+1714 D2               (fig-forth-auto680):02020                 FCB     $D2
+1715 16F4             (fig-forth-auto680):02021                 FDB     DMINUS-9
+1717 1719             (fig-forth-auto680):02022         OVER    FDB     *+NATWID
+1719 EC42             (fig-forth-auto680):02023                 LDD     NATWID,U
+171B 3606             (fig-forth-auto680):02024                 PSHU    D
+171D 39               (fig-forth-auto680):02025                 RTS
+                      (fig-forth-auto680):02026         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02027         *       LDA 2,X
+                      (fig-forth-auto680):02028         *       LDB 3,X
+                      (fig-forth-auto680):02029         *       JMP     PUSHBA
+                      (fig-forth-auto680):02030         *
+                      (fig-forth-auto680):02031         * ======>>  38  <<
+                      (fig-forth-auto680):02032         * ( n --- )
+                      (fig-forth-auto680):02033         * Discard the top word on stack.
+171E 84               (fig-forth-auto680):02034                 FCB     $84
+171F 44524F           (fig-forth-auto680):02035                 FCC     'DRO'   ; 'DROP'
+1722 D0               (fig-forth-auto680):02036                 FCB     $D0
+1723 1710             (fig-forth-auto680):02037                 FDB     OVER-7
+1725 1727             (fig-forth-auto680):02038         DROP    FDB     *+NATWID
+1727 3706             (fig-forth-auto680):02039                 PULU    D       ; Dodge the return address here, too, for heaven's sake!
+1729 EDC4             (fig-forth-auto680):02040                 STD     ,U
+172B 39               (fig-forth-auto680):02041                 RTS
+                      (fig-forth-auto680):02042         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02043         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02044         *       JMP     NEXT
+                      (fig-forth-auto680):02045         *
+                      (fig-forth-auto680):02046         * ======>>  39  <<
+                      (fig-forth-auto680):02047         * ( n1 n2 --- n2 n1 )
+                      (fig-forth-auto680):02048         * Swap the top two words on stack.
+172C 84               (fig-forth-auto680):02049                 FCB     $84
+172D 535741           (fig-forth-auto680):02050                 FCC     'SWA'   ; 'SWAP'
+1730 D0               (fig-forth-auto680):02051                 FCB     $D0
+1731 171E             (fig-forth-auto680):02052                 FDB     DROP-7
+1733 1735             (fig-forth-auto680):02053         SWAP    FDB     *+NATWID
+1735 3716             (fig-forth-auto680):02054                 PULU    D,X
+1737 3606             (fig-forth-auto680):02055                 PSHU    D
+1739 3610             (fig-forth-auto680):02056                 PSHU    X
+173B 39               (fig-forth-auto680):02057                 RTS
+                      (fig-forth-auto680):02058         *       PULS A  ; 
+                      (fig-forth-auto680):02059         *       PULS B  ; 
+                      (fig-forth-auto680):02060         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02061         *       LDX     0,X
+                      (fig-forth-auto680):02062         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02063         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02064         *       PSHS B  ; 
+                      (fig-forth-auto680):02065         *       PSHS A  ; 
+                      (fig-forth-auto680):02066         *       STX     N
+                      (fig-forth-auto680):02067         *       LDX     #N
+                      (fig-forth-auto680):02068         *       JMP     GETX
+                      (fig-forth-auto680):02069         *
+                      (fig-forth-auto680):02070         * ======>>  40  <<
+                      (fig-forth-auto680):02071         * ( n1 --- n1 n1 )
+                      (fig-forth-auto680):02072         * Push a copy of the top word on stack.
+173C 83               (fig-forth-auto680):02073                 FCB     $83
+173D 4455             (fig-forth-auto680):02074                 FCC     'DU'    ; 'DUP'
+173F D0               (fig-forth-auto680):02075                 FCB     $D0
+1740 172C             (fig-forth-auto680):02076                 FDB     SWAP-7
+1742 1744             (fig-forth-auto680):02077         DUP     FDB     *+NATWID
+1744 ECC4             (fig-forth-auto680):02078                 LDD     ,U
+1746 3606             (fig-forth-auto680):02079                 PSHU    D
+1748 39               (fig-forth-auto680):02080                 RTS
+                      (fig-forth-auto680):02081         *       PULS A  ; 
+                      (fig-forth-auto680):02082         *       PULS B  ; 
+                      (fig-forth-auto680):02083         *       PSHS B  ; 
+                      (fig-forth-auto680):02084         *       PSHS A  ; 
+                      (fig-forth-auto680):02085         *       JMP PUSHBA
+                      (fig-forth-auto680):02086         *
+                      (fig-forth-auto680):02087         * ######>> screen 31 <<
+                      (fig-forth-auto680):02088         * ======>>  41  <<
+                      (fig-forth-auto680):02089         * ( n adr --- )
+                      (fig-forth-auto680):02090         * Add the second word on stack to the word at the adr on top of stack.
+1749 82               (fig-forth-auto680):02091                 FCB     $82
+174A 2B               (fig-forth-auto680):02092                 FCC     '+'     ; '+!'
+174B A1               (fig-forth-auto680):02093                 FCB     $A1
+174C 173C             (fig-forth-auto680):02094                 FDB     DUP-6
+174E 1750             (fig-forth-auto680):02095         PSTORE  FDB     *+NATWID
+1750 3710             (fig-forth-auto680):02096                 PULU    X
+1752 EC84             (fig-forth-auto680):02097                 LDD     ,X
+1754 E3C1             (fig-forth-auto680):02098                 ADDD    ,U++
+1756 ED84             (fig-forth-auto680):02099                 STD     ,X
+1758 39               (fig-forth-auto680):02100                 RTS
+                      (fig-forth-auto680):02101         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02102         *       LDX     0,X
+                      (fig-forth-auto680):02103         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02104         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02105         *       PULS A  ; get stack data
+                      (fig-forth-auto680):02106         *       PULS B  ; 
+                      (fig-forth-auto680):02107         *       ADDB 1,X        add & store low byte
+                      (fig-forth-auto680):02108         *       STB 1,X
+                      (fig-forth-auto680):02109         *       ADCA 0,X        add & store hi byte
+                      (fig-forth-auto680):02110         *       STA 0,X
+                      (fig-forth-auto680):02111         *       JMP     NEXT
+                      (fig-forth-auto680):02112         *
+                      (fig-forth-auto680):02113         * ======>>  42  <<
+                      (fig-forth-auto680):02114         * ( adr b --- )
+                      (fig-forth-auto680):02115         * Exclusive or byte at adr with low byte of top word.
+1759 86               (fig-forth-auto680):02116                 FCB     $86
+175A 544F47474C       (fig-forth-auto680):02117                 FCC     'TOGGL' ; 'TOGGLE'
+175F C5               (fig-forth-auto680):02118                 FCB     $C5
+1760 1749             (fig-forth-auto680):02119                 FDB     PSTORE-5
+1762 1764             (fig-forth-auto680):02120         TOGGLE  FDB     *+NATWID
+1764 3716             (fig-forth-auto680):02121                 PULU    D,X
+1766 E884             (fig-forth-auto680):02122                 EORB    ,X
+1768 E784             (fig-forth-auto680):02123                 STB     ,X
+176A 39               (fig-forth-auto680):02124                 RTS
+                      (fig-forth-auto680):02125         * Using the model code would be less likely to introduce bugs, 
+                      (fig-forth-auto680):02126         * but that would sort-of defeat my purposes here.
+                      (fig-forth-auto680):02127         * Anyway, I can borrow from theoretically known good bif-6809 code
+                      (fig-forth-auto680):02128         * and it's fewer bytes and much faster code this way.
+                      (fig-forth-auto680):02129         * TOGGLE
+                      (fig-forth-auto680):02130         *       FDB     DOCOL,OVER,CAT,XOR,SWAP,CSTORE
+                      (fig-forth-auto680):02131         *       FDB     SEMIS
+                      (fig-forth-auto680):02132         *
+                      (fig-forth-auto680):02133         * ######>> screen 32 <<
+                      (fig-forth-auto680):02134         * ======>>  43  <<
+                      (fig-forth-auto680):02135         * ( adr --- n )
+                      (fig-forth-auto680):02136         * Replace address on stack with the word at the address.
+176B 81               (fig-forth-auto680):02137                 FCB     $81     @
+176C C0               (fig-forth-auto680):02138                 FCB     $C0
+176D 1759             (fig-forth-auto680):02139                 FDB     TOGGLE-9
+176F 1771             (fig-forth-auto680):02140         AT      FDB     *+NATWID
+1771 ECD4             (fig-forth-auto680):02141                 LDD     [,U]
+1773 EDC4             (fig-forth-auto680):02142                 STD     ,U
+1775 39               (fig-forth-auto680):02143                 RTS
+                      (fig-forth-auto680):02144         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02145         *       LDX     0,X     get address
+                      (fig-forth-auto680):02146         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02147         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02148         *       JMP     GETX
+                      (fig-forth-auto680):02149         *
+                      (fig-forth-auto680):02150         * ======>>  44  <<
+                      (fig-forth-auto680):02151         * ( adr --- b )
+                      (fig-forth-auto680):02152         * Replace address on top of stack with the byte at the address.
+                      (fig-forth-auto680):02153         * High byte of result is clear.
+1776 82               (fig-forth-auto680):02154                 FCB     $82
+1777 43               (fig-forth-auto680):02155                 FCC     'C'     ; 'C@'
+1778 C0               (fig-forth-auto680):02156                 FCB     $C0
+1779 176B             (fig-forth-auto680):02157                 FDB     AT-4
+177B 177D             (fig-forth-auto680):02158         CAT     FDB     *+NATWID
+177D E6D4             (fig-forth-auto680):02159                 LDB     [,U]
+177F 4F               (fig-forth-auto680):02160                 CLRA
+1780 EDC4             (fig-forth-auto680):02161                 STD     ,U
+1782 39               (fig-forth-auto680):02162                 RTS
+                      (fig-forth-auto680):02163         
+                      (fig-forth-auto680):02164         
+                      (fig-forth-auto680):02165         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02166         *       LDX     0,X
+                      (fig-forth-auto680):02167         *       CLRA    ;
+                      (fig-forth-auto680):02168         *       LDB 0,X
+                      (fig-forth-auto680):02169         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02170         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02171         *       JMP     PUSHBA
+                      (fig-forth-auto680):02172         *
+                      (fig-forth-auto680):02173         * ======>>  45  <<
+                      (fig-forth-auto680):02174         * ( n adr --- )
+                      (fig-forth-auto680):02175         * Store second word on stack at address on top of stack.
+1783 81               (fig-forth-auto680):02176                 FCB     $81
+1784 A1               (fig-forth-auto680):02177                 FCB     $A1
+1785 1776             (fig-forth-auto680):02178                 FDB     CAT-5
+1787 1789             (fig-forth-auto680):02179         STORE   FDB     *+NATWID
+1789 EC42             (fig-forth-auto680):02180                 LDD     NATWID,U
+178B EDD4             (fig-forth-auto680):02181                 STD     [,U]
+178D 3344             (fig-forth-auto680):02182                 LEAU    2*NATWID,U
+178F 39               (fig-forth-auto680):02183                 RTS
+                      (fig-forth-auto680):02184         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02185         *       LDX     0,X     get address
+                      (fig-forth-auto680):02186         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02187         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02188         *       JMP     PULABX
+                      (fig-forth-auto680):02189         *
+                      (fig-forth-auto680):02190         * ======>>  46  <<
+                      (fig-forth-auto680):02191         * ( b adr --- )
+                      (fig-forth-auto680):02192         * Store low byte of second word on stack at address on top of stack. 
+                      (fig-forth-auto680):02193         * High byte is ignored.
+1790 82               (fig-forth-auto680):02194                 FCB     $82
+1791 43               (fig-forth-auto680):02195                 FCC     'C'     ; 'C!'
+1792 A1               (fig-forth-auto680):02196                 FCB     $A1
+1793 1783             (fig-forth-auto680):02197                 FDB     STORE-4
+1795 1797             (fig-forth-auto680):02198         CSTORE  FDB     *+NATWID
+1797 E643             (fig-forth-auto680):02199                 LDB     3,U
+1799 E7D4             (fig-forth-auto680):02200                 STB     [,U]
+179B 3344             (fig-forth-auto680):02201                 LEAU    2*NATWID,U
+179D 39               (fig-forth-auto680):02202                 RTS
+                      (fig-forth-auto680):02203         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02204         *       LDX     0,X     get address
+                      (fig-forth-auto680):02205         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02206         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02207         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02208         *       PULS B  ; 
+                      (fig-forth-auto680):02209         *       STB 0,X
+                      (fig-forth-auto680):02210         *       JMP     NEXT
+                      (fig-forth-auto680):02211                 PAGE
+                      (fig-forth-auto680):02212         *
+                      (fig-forth-auto680):02213         * ######>> screen 33 <<
+                      (fig-forth-auto680):02214         * ======>>  47  <<
+                      (fig-forth-auto680):02215         * ( --- )                                                 P
+                      (fig-forth-auto680):02216         * { : name sundry-activities ; } typical input
+                      (fig-forth-auto680):02217         * If executing (not compiling), 
+                      (fig-forth-auto680):02218         * record the data stack mark in CSP,
+                      (fig-forth-auto680):02219         * Set the CONTEXT vocabulary to CURRENT,
+                      (fig-forth-auto680):02220         * CREATE a header,
+                      (fig-forth-auto680):02221         * set state to compile,
+                      (fig-forth-auto680):02222         * and compile the call to the trailing native CPU machine code DOCOL.
+                      (fig-forth-auto680):02223         *
+                      (fig-forth-auto680):02224         * This would not be hard to flatten to native code.
+                      (fig-forth-auto680):02225         * But that's not the purpose of a model.
+179E C1               (fig-forth-auto680):02226                 FCB     $C1     : immediate
+179F BA               (fig-forth-auto680):02227                 FCB     $BA
+17A0 1790             (fig-forth-auto680):02228                 FDB     CSTORE-5
+17A2 17B61B671B231949 (fig-forth-auto680):02229         COLON   FDB     DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
+     176F193B1787
+17B0 20651BE6         (fig-forth-auto680):02230                 FDB     CREATE,RBRAK
+17B4 1C35             (fig-forth-auto680):02231                 FDB     PSCODE
+                      (fig-forth-auto680):02232         
+                      (fig-forth-auto680):02233         * Here is the IP pusher for allowing
+                      (fig-forth-auto680):02234         * nested words in the virtual machine:
+                      (fig-forth-auto680):02235         * ( ;S is the equivalent un-nester )
+                      (fig-forth-auto680):02236         
+                      (fig-forth-auto680):02237         * ( *** oldIP ) 
+                      (fig-forth-auto680):02238         * Characteristic of a colon (:) definition.  
+                      (fig-forth-auto680):02239         * Begins execution of a high-level definition,
+                      (fig-forth-auto680):02240         * i. e., nests the definition and begins processing icodes. 
+                      (fig-forth-auto680):02241         * Mechanically, it pushes the IP (Y register)
+                      (fig-forth-auto680):02242         * and loads the Parameter Field Address of the definition which
+                      (fig-forth-auto680):02243         * called it into the IP.
+17B6 ECE4             (fig-forth-auto680):02244         DOCOL   LDD     ,S      ; Save the return address.
+17B8 10AFE4           (fig-forth-auto680):02245                 STY     ,S      ; Nest the old IP.
+17BB 3102             (fig-forth-auto680):02246                 LEAY    NATWID,X        ; W still in X, bump to parameters, load as new IP.
+17BD 1F05             (fig-forth-auto680):02247                 TFR     D,PC    ; synthetic return to interpret.
+                      (fig-forth-auto680):02248         
+                      (fig-forth-auto680):02249         * DOCOL LDX     RP      make room in the stack
+                      (fig-forth-auto680):02250         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):02251         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):02252         *       STX     RP
+                      (fig-forth-auto680):02253         *       LDA IP
+                      (fig-forth-auto680):02254         *       LDB IP+1        
+                      (fig-forth-auto680):02255         *       STA 2,X Store address of the high level word
+                      (fig-forth-auto680):02256         *       STB 3,X that we are starting to execute
+                      (fig-forth-auto680):02257         *       LDX     W       Get first sub-word of that definition
+                      (fig-forth-auto680):02258         *       JMP     NEXT+2  and execute it
+                      (fig-forth-auto680):02259         *
+                      (fig-forth-auto680):02260         * ======>>  48  <<
+                      (fig-forth-auto680):02261         * ( --- )                                                 P
+                      (fig-forth-auto680):02262         * { : name sundry-activities ; } typical input
+                      (fig-forth-auto680):02263         * ERROR check data stack against mark in CSP,
+                      (fig-forth-auto680):02264         * compile ;S,
+                      (fig-forth-auto680):02265         * unSMUDGE LATEST definition,
+                      (fig-forth-auto680):02266         * and set state to interpretation.
+17BF C1               (fig-forth-auto680):02267                 FCB     $C1     ;   imnediate code
+17C0 BB               (fig-forth-auto680):02268                 FCB     $BB
+17C1 179E             (fig-forth-auto680):02269                 FDB     COLON-4
+17C3 17B61B8F1BC41662 (fig-forth-auto680):02270         SEMI    FDB     DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
+     1BFA1BD8
+17CF 1662             (fig-forth-auto680):02271                 FDB     SEMIS
+                      (fig-forth-auto680):02272         *
+                      (fig-forth-auto680):02273         * ######>> screen 34 <<
+                      (fig-forth-auto680):02274         * ======>>  49  <<
+                      (fig-forth-auto680):02275         * ( n --- )
+                      (fig-forth-auto680):02276         * { value CONSTANT name } typical input
+                      (fig-forth-auto680):02277         * CREATE a header,
+                      (fig-forth-auto680):02278         * unSMUDGE it,
+                      (fig-forth-auto680):02279         * compile the constant value,
+                      (fig-forth-auto680):02280         * and compile the call to the trailing native CPU machine code DOCON.
+17D1 88               (fig-forth-auto680):02281                 FCB     $88
+17D2 434F4E5354414E   (fig-forth-auto680):02282                 FCC     'CONSTAN'       ; 'CONSTANT'
+17D9 D4               (fig-forth-auto680):02283                 FCB     $D4
+17DA 17BF             (fig-forth-auto680):02284                 FDB     SEMI-4
+17DC 17B620651BFA19E0 (fig-forth-auto680):02285         CON     FDB     DOCOL,CREATE,SMUDGE,COMMA,PSCODE
+     1C35
+                      (fig-forth-auto680):02286         * ( --- n ) 
+                      (fig-forth-auto680):02287         * Characteristic of a CONSTANT. 
+                      (fig-forth-auto680):02288         * A CONSTANT simply loads its value from its parameter field
+                      (fig-forth-auto680):02289         * and pushes it on the stack.
+17E6 EC02             (fig-forth-auto680):02290         DOCON   LDD     NATWID,X        ; Get the first natural width word of the parameter field.
+17E8 3606             (fig-forth-auto680):02291                 PSHU    D
+17EA 39               (fig-forth-auto680):02292                 RTS
+                      (fig-forth-auto680):02293         * DOCON LDX     W
+                      (fig-forth-auto680):02294         *       LDA 2,X 
+                      (fig-forth-auto680):02295         *       LDB 3,X A & B now contain the constant
+                      (fig-forth-auto680):02296         *       JMP     PUSHBA
+                      (fig-forth-auto680):02297         *
+                      (fig-forth-auto680):02298         * Not in model, needed for abstraction:
+                      (fig-forth-auto680):02299         * ( --- NATWID )
+                      (fig-forth-auto680):02300         * The byte width of objects on stack.
+17EB 86               (fig-forth-auto680):02301                 FCB     $86
+17EC 4E41545749       (fig-forth-auto680):02302                 FCC     'NATWI' ; 'NATWID'
+17F1 C4               (fig-forth-auto680):02303                 FCB     $C4
+17F2 17D1             (fig-forth-auto680):02304                 FDB     CON-11
+17F4 17E6             (fig-forth-auto680):02305         NATWC   FDB     DOCON
+17F6 0002             (fig-forth-auto680):02306         NATWCV  FDB     NATWID
+                      (fig-forth-auto680):02307         *
+                      (fig-forth-auto680):02308         * Not in model, needed for abstraction:
+                      (fig-forth-auto680):02309         * Note that this is not defined as an INCREMENTER!
+                      (fig-forth-auto680):02310         * Coded to increment by the exact constant returned by NATWID
+                      (fig-forth-auto680):02311         * ( n --- n+NATWID )
+17F8 84               (fig-forth-auto680):02312                 FCB     $84
+17F9 4E4154           (fig-forth-auto680):02313                 FCC     'NAT'   ; 'NAT+'
+17FC AB               (fig-forth-auto680):02314                 FCB     $AB
+17FD 17EB             (fig-forth-auto680):02315                 FDB     NATWC-9
+17FF 1801             (fig-forth-auto680):02316         NATP    FDB     *+NATWID
+1801 ECC4             (fig-forth-auto680):02317                 LDD     ,U
+1803 E38CF0           (fig-forth-auto680):02318                 ADDD    NATWCV,PCR      ; Looking ahead, does not have to be PCRelative.
+1806 EDC4             (fig-forth-auto680):02319                 STD     ,U
+1808 39               (fig-forth-auto680):02320                 RTS
+                      (fig-forth-auto680):02321         * How this might have been done for 6800 model:
+                      (fig-forth-auto680):02322         *       CLRA    ; We know the natural width is less than 255, LOL.
+                      (fig-forth-auto680):02323         *       LDAB    NATWCV+1
+                      (fig-forth-auto680):02324         *       TSX
+                      (fig-forth-auto680):02325         *       ADDB    1,X
+                      (fig-forth-auto680):02326         *       ADCA    ,X
+                      (fig-forth-auto680):02327         *       JMP     STABX
+                      (fig-forth-auto680):02328         *
+                      (fig-forth-auto680):02329         * ======>>  50  <<
+                      (fig-forth-auto680):02330         * ( init --- )
+                      (fig-forth-auto680):02331         * { init VARIABLE name } typical input
+                      (fig-forth-auto680):02332         * Use CONSTANT to CREATE a header and compile the initial value, init, 
+                      (fig-forth-auto680):02333         * then overwrite the characteristic to point to DOVAR.
+1809 88               (fig-forth-auto680):02334                 FCB     $88
+180A 5641524941424C   (fig-forth-auto680):02335                 FCC     'VARIABL'       ; 'VARIABLE'
+1811 C5               (fig-forth-auto680):02336                 FCB     $C5
+1812 17F8             (fig-forth-auto680):02337                 FDB     NATP-7
+1814 17B617DC1C35     (fig-forth-auto680):02338         VAR     FDB     DOCOL,CON,PSCODE
+                      (fig-forth-auto680):02339         * ( --- vadr ) 
+                      (fig-forth-auto680):02340         * Characteristic of a VARIABLE. 
+                      (fig-forth-auto680):02341         * A VARIABLE pushes its PFA address on the stack. 
+                      (fig-forth-auto680):02342         * The parameter field of a VARIABLE is the actual allocation of the variable,
+                      (fig-forth-auto680):02343         * so that pushing its address allows its contents to be @ed (fetched). 
+                      (fig-forth-auto680):02344         * Ordinary arrays and strings that do not subscript themselves
+                      (fig-forth-auto680):02345         * may be allocated by defining a variable
+                      (fig-forth-auto680):02346         * and immediately ALLOTting the remaining needed space.
+                      (fig-forth-auto680):02347         * VARIABLES are global to all users,
+                      (fig-forth-auto680):02348         * and thus should be hidden in resource monitors, but aren't.
+181A 3002             (fig-forth-auto680):02349         DOVAR   LEAX    NATWID,X        ; Point to the first natural width word of the parameters.
+181C 3610             (fig-forth-auto680):02350                 PSHU    X
+181E 39               (fig-forth-auto680):02351                 RTS
+                      (fig-forth-auto680):02352         * DOVAR LDA W
+                      (fig-forth-auto680):02353         *       LDB W+1
+                      (fig-forth-auto680):02354         *       ADDB #2
+                      (fig-forth-auto680):02355         *       ADCA #0 A,B now contain the address of the variable
+                      (fig-forth-auto680):02356         *       JMP     PUSHBA
+                      (fig-forth-auto680):02357         *
+                      (fig-forth-auto680):02358         * ======>>  51  <<
+                      (fig-forth-auto680):02359         * ( ub --- )
+                      (fig-forth-auto680):02360         * { uboffset USER name } typical input
+                      (fig-forth-auto680):02361         * CREATE a header and compile the unsigned byte offset in the per-USER table, 
+                      (fig-forth-auto680):02362         * then overwrite the header with a call to DOUSER.
+                      (fig-forth-auto680):02363         * The USER is entirely responsible for maintaining allocation!
+181F 84               (fig-forth-auto680):02364                 FCB     $84
+1820 555345           (fig-forth-auto680):02365                 FCC     'USE'   ; 'USER'
+1823 D2               (fig-forth-auto680):02366                 FCB     $D2
+1824 1809             (fig-forth-auto680):02367                 FDB     VAR-11
+1826 17B617DC1C35     (fig-forth-auto680):02368         USER    FDB     DOCOL,CON,PSCODE
+                      (fig-forth-auto680):02369         * ( --- vadr ) 
+                      (fig-forth-auto680):02370         * Characteristic of a per-USER variable. 
+                      (fig-forth-auto680):02371         * USER variables are similiar to VARIABLEs,
+                      (fig-forth-auto680):02372         * but are allocated (by hand!) in the per-user table. 
+                      (fig-forth-auto680):02373         * A USER variable's parameter field contains its offset in the per-user table.
+182C 1FB8             (fig-forth-auto680):02374         DOUSER  TFR     DP,A    ; Make a pointer to the direct page.
+182E 5F               (fig-forth-auto680):02375                 CLRB
+                      (fig-forth-auto680):02376         *       See Alternative -- alternatives start from this point.
+182F E302             (fig-forth-auto680):02377                 ADDD    NATWID,X        ; Add it to the offset to the per-user variable.
+1831 3606             (fig-forth-auto680):02378                 PSHU    D
+1833 1F01             (fig-forth-auto680):02379                 TFR     D,X     ; Cache the pointer in X for the caller.
+1835 39               (fig-forth-auto680):02380                 RTS
+                      (fig-forth-auto680):02381         * Hey, the per-user table could actually be larger than 256 bytes!
+                      (fig-forth-auto680):02382         * But we knew that. It's just not as esthetic to calculate it this way.
+                      (fig-forth-auto680):02383         * Alternative A:
+                      (fig-forth-auto680):02384         *       LDX     NATWID,X        ; Keep the offset
+                      (fig-forth-auto680):02385         *       EXG     D,X     ; Prepare for EA 
+                      (fig-forth-auto680):02386         *       LEAX    D,X
+                      (fig-forth-auto680):02387         *       PSHU    X
+                      (fig-forth-auto680):02388         *       RTS
+                      (fig-forth-auto680):02389         * Alternative B:
+                      (fig-forth-auto680):02390         *       PSHS    Y       ; Get Y free for calculations.
+                      (fig-forth-auto680):02391         *       TFR     D,Y     ; Y points to the UP base
+                      (fig-forth-auto680):02392         *       LDD     NATWID,X        ; Get the offset
+                      (fig-forth-auto680):02393         *       LEAX    D,Y     ; Leave the pointer cached in X.
+                      (fig-forth-auto680):02394         *       PSHU    X
+                      (fig-forth-auto680):02395         *       PULS    Y,PC
+                      (fig-forth-auto680):02396         *
+                      (fig-forth-auto680):02397         * From the 6800 model:
+                      (fig-forth-auto680):02398         * DOUSER        LDX     W       get offset  into user's table
+                      (fig-forth-auto680):02399         *       LDA 2,X
+                      (fig-forth-auto680):02400         *       LDB 3,X
+                      (fig-forth-auto680):02401         *       ADDB UP+1       add to users base address
+                      (fig-forth-auto680):02402         *       ADCA UP
+                      (fig-forth-auto680):02403         *       JMP     PUSHBA  push address of user's variable
+                      (fig-forth-auto680):02404         *
+                      (fig-forth-auto680):02405         * ######>> screen 35 <<
+                      (fig-forth-auto680):02406         * ======>>  52  <<
+                      (fig-forth-auto680):02407         * ( --- 0 )
+1836 81               (fig-forth-auto680):02408                 FCB     $81
+1837 B0               (fig-forth-auto680):02409                 FCB     $B0     0
+1838 181F             (fig-forth-auto680):02410                 FDB     USER-7
+183A 17E6             (fig-forth-auto680):02411         ZERO    FDB     DOCON
+183C 0000             (fig-forth-auto680):02412                 FDB     0000
+                      (fig-forth-auto680):02413         *
+                      (fig-forth-auto680):02414         * ======>>  53  <<
+                      (fig-forth-auto680):02415         * ( --- 1 )
+183E 81               (fig-forth-auto680):02416                 FCB     $81
+183F B1               (fig-forth-auto680):02417                 FCB     $B1     1
+1840 1836             (fig-forth-auto680):02418                 FDB     ZERO-4
+1842 17E6             (fig-forth-auto680):02419         ONE     FDB     DOCON
+1844 0001             (fig-forth-auto680):02420         ONEV    FDB     1
+                      (fig-forth-auto680):02421         *
+                      (fig-forth-auto680):02422         * ======>>  54  <<
+                      (fig-forth-auto680):02423         * ( --- 2 )
+1846 81               (fig-forth-auto680):02424                 FCB     $81
+1847 B2               (fig-forth-auto680):02425                 FCB     $B2     2
+1848 183E             (fig-forth-auto680):02426                 FDB     ONE-4
+184A 17E6             (fig-forth-auto680):02427         TWO     FDB     DOCON
+184C 0002             (fig-forth-auto680):02428         TWOV    FDB     2
+                      (fig-forth-auto680):02429         *
+                      (fig-forth-auto680):02430         * ======>>  55  <<
+                      (fig-forth-auto680):02431         * ( --- 3 )
+184E 81               (fig-forth-auto680):02432                 FCB     $81
+184F B3               (fig-forth-auto680):02433                 FCB     $B3     3
+1850 1846             (fig-forth-auto680):02434                 FDB     TWO-4
+1852 17E6             (fig-forth-auto680):02435         THREE   FDB     DOCON
+1854 0003             (fig-forth-auto680):02436                 FDB     3
+                      (fig-forth-auto680):02437         *
+                      (fig-forth-auto680):02438         * ======>>  56  <<
+                      (fig-forth-auto680):02439         * ( --- SP ) 
+                      (fig-forth-auto680):02440         * ASCII SPACE character
+1856 82               (fig-forth-auto680):02441                 FCB     $82
+1857 42               (fig-forth-auto680):02442                 FCC     'B'     ; 'BL'
+1858 CC               (fig-forth-auto680):02443                 FCB     $CC
+1859 184E             (fig-forth-auto680):02444                 FDB     THREE-4
+185B 17E6             (fig-forth-auto680):02445         BL      FDB     DOCON   ascii blank
+185D 0020             (fig-forth-auto680):02446                 FDB     $20
+                      (fig-forth-auto680):02447         *
+                      (fig-forth-auto680):02448         * ======>>  57  <<
+                      (fig-forth-auto680):02449         * This really shouldn't be a CONSTANT.
+                      (fig-forth-auto680):02450         * ( --- adr )    
+                      (fig-forth-auto680):02451         * The base of the disk buffer space.
+185F 85               (fig-forth-auto680):02452                 FCB     $85
+1860 46495253         (fig-forth-auto680):02453                 FCC     'FIRS'  ; 'FIRST'
+1864 D4               (fig-forth-auto680):02454                 FCB     $D4
+1865 1856             (fig-forth-auto680):02455                 FDB     BL-5
+1867 17E6             (fig-forth-auto680):02456         FIRST   FDB     DOCON
+1869 6BE0             (fig-forth-auto680):02457                 FDB     BUFBAS
+                      (fig-forth-auto680):02458         *       FDB     MEMEND-528      (132 * NBLK)
+                      (fig-forth-auto680):02459         *
+                      (fig-forth-auto680):02460         * ======>>  58  <<
+                      (fig-forth-auto680):02461         * This really shouldn't be a CONSTANT.
+                      (fig-forth-auto680):02462         * ( --- adr ) 
+                      (fig-forth-auto680):02463         * The limit of the disk buffer space.
+186B 85               (fig-forth-auto680):02464                 FCB     $85
+186C 4C494D49         (fig-forth-auto680):02465                 FCC     'LIMI'  ; 'LIMIT' :     ( the end of memory +1 )
+1870 D4               (fig-forth-auto680):02466                 FCB     $D4
+1871 185F             (fig-forth-auto680):02467                 FDB     FIRST-8
+1873 17E6             (fig-forth-auto680):02468         LIMIT   FDB     DOCON
+1875 7000             (fig-forth-auto680):02469                 FDB     BUFBAS+BUFSZ
+                      (fig-forth-auto680):02470         * In 6800 model, was
+                      (fig-forth-auto680):02471         *       FDB     MEMEND
+                      (fig-forth-auto680):02472         *
+                      (fig-forth-auto680):02473         * ======>>  59  <<
+                      (fig-forth-auto680):02474         * ( --- sectorsize )
+                      (fig-forth-auto680):02475         * The size, in bytes, of a buffer.
+1877 85               (fig-forth-auto680):02476                 FCB     $85
+1878 422F4255         (fig-forth-auto680):02477                 FCC     'B/BU'  ; 'B/BUF' :     (bytes/buffer)
+187C C6               (fig-forth-auto680):02478                 FCB     $C6
+187D 186B             (fig-forth-auto680):02479                 FDB     LIMIT-8
+187F 17E6             (fig-forth-auto680):02480         BBUF    FDB     DOCON
+1881 0100             (fig-forth-auto680):02481                 FDB     SECTSZ
+                      (fig-forth-auto680):02482         * Hardcoded in 6800 model:
+                      (fig-forth-auto680):02483         *       FDB     128
+                      (fig-forth-auto680):02484         *
+                      (fig-forth-auto680):02485         * ======>>  60  <<
+                      (fig-forth-auto680):02486         * ( --- blocksperscreen )      
+                      (fig-forth-auto680):02487         * The size, in blocks, of a screen.
+                      (fig-forth-auto680):02488         * Should this be the same as NBLK, the number of block buffers maintained?
+1883 85               (fig-forth-auto680):02489                 FCB     $85
+1884 422F5343         (fig-forth-auto680):02490                 FCC     'B/SC'  ; 'B/SCR' :     (blocks/screen)
+1888 D2               (fig-forth-auto680):02491                 FCB     $D2
+1889 1877             (fig-forth-auto680):02492                 FDB     BBUF-8
+188B 17E6             (fig-forth-auto680):02493         BSCR    FDB     DOCON
+188D 0004             (fig-forth-auto680):02494                 FDB     SCRSZ/SECTSZ
+                      (fig-forth-auto680):02495         * Hardcoded in 6800 model as:
+                      (fig-forth-auto680):02496         *       FDB     8
+                      (fig-forth-auto680):02497         *       blocks/screen = 1024 / "B/BUF" = 8, if sectors are 128 bytes.
+                      (fig-forth-auto680):02498         *
+                      (fig-forth-auto680):02499         * ======>>  61  <<
+                      (fig-forth-auto680):02500         * ( n --- adr )
+                      (fig-forth-auto680):02501         * Calculate the address of entry (#n/2) in the boot-up parameter table. 
+                      (fig-forth-auto680):02502         * (Adds the base of the boot-up table to n.)
+188F 87               (fig-forth-auto680):02503                 FCB     $87
+1890 2B4F52494749     (fig-forth-auto680):02504                 FCC     '+ORIGI'        ; '+ORIGIN'
+1896 CE               (fig-forth-auto680):02505                 FCB     $CE
+1897 1883             (fig-forth-auto680):02506                 FDB     BSCR-8
+1899 17B61399120016C1 (fig-forth-auto680):02507         PORIG   FDB     DOCOL,LIT,ORIG,PLUS
+18A1 1662             (fig-forth-auto680):02508                 FDB     SEMIS
+                      (fig-forth-auto680):02509         *
+                      (fig-forth-auto680):02510         * ######>> screen 36 <<
+                      (fig-forth-auto680):02511         * ======>>  62  <<
+                      (fig-forth-auto680):02512         * ( n --- adr )
+                      (fig-forth-auto680):02513         * This is the per-task variable recording the initial parameter stack pointer.
+18A3 82               (fig-forth-auto680):02514                 FCB     $82
+18A4 53               (fig-forth-auto680):02515                 FCC     'S'     ; 'S0'
+18A5 B0               (fig-forth-auto680):02516                 FCB     $B0
+18A6 188F             (fig-forth-auto680):02517                 FDB     PORIG-10
+18A8 182C             (fig-forth-auto680):02518         SZERO   FDB     DOUSER
+18AA 001E             (fig-forth-auto680):02519                 FDB     XSPZER-UORIG
+                      (fig-forth-auto680):02520         *
+                      (fig-forth-auto680):02521         * ======>>  63  <<
+                      (fig-forth-auto680):02522         * ( n --- adr )
+                      (fig-forth-auto680):02523         * This is the per-task variable recording the initial return stack pointer.
+18AC 82               (fig-forth-auto680):02524                 FCB     $82
+18AD 52               (fig-forth-auto680):02525                 FCC     'R'     ; 'R0'
+18AE B0               (fig-forth-auto680):02526                 FCB     $B0
+18AF 18A3             (fig-forth-auto680):02527                 FDB     SZERO-5
+18B1 182C             (fig-forth-auto680):02528         RZERO   FDB     DOUSER
+18B3 0020             (fig-forth-auto680):02529                 FDB     XRZERO-UORIG
+                      (fig-forth-auto680):02530         *
+                      (fig-forth-auto680):02531         * ======>>  64  <<
+                      (fig-forth-auto680):02532         * ( --- vadr )   
+                      (fig-forth-auto680):02533         * Terminal Input Buffer address. 
+                      (fig-forth-auto680):02534         * Note that this is a variable, so users may allocate their own buffers, but it must be @ed.
+18B5 83               (fig-forth-auto680):02535                 FCB     $83
+18B6 5449             (fig-forth-auto680):02536                 FCC     'TI'    ; 'TIB'
+18B8 C2               (fig-forth-auto680):02537                 FCB     $C2
+18B9 18AC             (fig-forth-auto680):02538                 FDB     RZERO-5
+18BB 182C             (fig-forth-auto680):02539         TIB     FDB     DOUSER
+18BD 0022             (fig-forth-auto680):02540                 FDB     XTIB-UORIG
+                      (fig-forth-auto680):02541         *
+                      (fig-forth-auto680):02542         * ======>>  65  <<
+                      (fig-forth-auto680):02543         * ( --- maxnamewidth )
+                      (fig-forth-auto680):02544         * This is the maximum width to which symbol names will be recorded.
+18BF 85               (fig-forth-auto680):02545                 FCB     $85
+18C0 57494454         (fig-forth-auto680):02546                 FCC     'WIDT'  ; 'WIDTH'
+18C4 C8               (fig-forth-auto680):02547                 FCB     $C8
+18C5 18B5             (fig-forth-auto680):02548                 FDB     TIB-6
+18C7 182C             (fig-forth-auto680):02549         WIDTH   FDB     DOUSER
+18C9 0024             (fig-forth-auto680):02550                 FDB     XWIDTH-UORIG
+                      (fig-forth-auto680):02551         *
+                      (fig-forth-auto680):02552         * ======>>  66  <<
+                      (fig-forth-auto680):02553         * ( --- vadr )   
+                      (fig-forth-auto680):02554         * Availability of error messages on disk.
+                      (fig-forth-auto680):02555         * Contains 1 if messages available, 
+                      (fig-forth-auto680):02556         * 0 if not,
+                      (fig-forth-auto680):02557         * -1 if a disk error has occurred.
+18CB 87               (fig-forth-auto680):02558                 FCB     $87
+18CC 5741524E494E     (fig-forth-auto680):02559                 FCC     'WARNIN'        ; 'WARNING'
+18D2 C7               (fig-forth-auto680):02560                 FCB     $C7
+18D3 18BF             (fig-forth-auto680):02561                 FDB     WIDTH-8
+18D5 182C             (fig-forth-auto680):02562         WARN    FDB     DOUSER
+18D7 0026             (fig-forth-auto680):02563                 FDB     XWARN-UORIG
+                      (fig-forth-auto680):02564         *
+                      (fig-forth-auto680):02565         * ======>>  67  <<
+                      (fig-forth-auto680):02566         * ( --- vadr )   
+                      (fig-forth-auto680):02567         * Boundary for FORGET.
+18D9 85               (fig-forth-auto680):02568                 FCB     $85
+18DA 46454E43         (fig-forth-auto680):02569                 FCC     'FENC'  ; 'FENCE'
+18DE C5               (fig-forth-auto680):02570                 FCB     $C5
+18DF 18CB             (fig-forth-auto680):02571                 FDB     WARN-10
+18E1 182C             (fig-forth-auto680):02572         FENCE   FDB     DOUSER
+18E3 0028             (fig-forth-auto680):02573                 FDB     XFENCE-UORIG
+                      (fig-forth-auto680):02574         *
+                      (fig-forth-auto680):02575         * ======>>  68  <<
+                      (fig-forth-auto680):02576         * ( --- vadr )   
+                      (fig-forth-auto680):02577         * Dictionary pointer, fetched by HERE.
+18E5 82               (fig-forth-auto680):02578                 FCB     $82
+18E6 44               (fig-forth-auto680):02579                 FCC     'D'     ; 'DP' :        points to first free byte at end of dictionary
+18E7 D0               (fig-forth-auto680):02580                 FCB     $D0
+18E8 18D9             (fig-forth-auto680):02581                 FDB     FENCE-8
+18EA 182C             (fig-forth-auto680):02582         DICTPT  FDB     DOUSER
+18EC 002A             (fig-forth-auto680):02583                 FDB     XDICTP-UORIG
+                      (fig-forth-auto680):02584         *
+                      (fig-forth-auto680):02585         * ======>>  68.5  <<
+                      (fig-forth-auto680):02586         * ( --- vadr ) ******* Need to check what this is!
+                      (fig-forth-auto680):02587         * Used in maintaining vocabularies.
+                      (fig-forth-auto680):02588         * I think it points to the "parent" vocabulary, but I'm not sure.
+                      (fig-forth-auto680):02589         * Or maybe this is the CONTEXT vocabulary. I'll have to come back here. *****
+18EE 88               (fig-forth-auto680):02590                 FCB     $88
+18EF 564F432D4C494E   (fig-forth-auto680):02591                 FCC     'VOC-LIN'       ; 'VOC-LINK'
+18F6 CB               (fig-forth-auto680):02592                 FCB     $CB
+18F7 18E5             (fig-forth-auto680):02593                 FDB     DICTPT-5
+18F9 182C             (fig-forth-auto680):02594         VOCLIN  FDB     DOUSER
+18FB 002C             (fig-forth-auto680):02595                 FDB     XVOCL-UORIG
+                      (fig-forth-auto680):02596         *
+                      (fig-forth-auto680):02597         * ======>>  69  <<
+                      (fig-forth-auto680):02598         * ( --- vadr )   
+                      (fig-forth-auto680):02599         * Disk block being interpreted. 
+                      (fig-forth-auto680):02600         * Zero refers to terminal.
+                      (fig-forth-auto680):02601         * ******** Should be made a 32 bit user variable! ********
+                      (fig-forth-auto680):02602         * But the base system needs to have full 32 bit support, div and mul, etc.
+                      (fig-forth-auto680):02603         * before we can do that.
+18FD 83               (fig-forth-auto680):02604                 FCB     $83
+18FE 424C             (fig-forth-auto680):02605                 FCC     'BL'    ; 'BLK'
+1900 CB               (fig-forth-auto680):02606                 FCB     $CB
+1901 18EE             (fig-forth-auto680):02607                 FDB     VOCLIN-11
+1903 182C             (fig-forth-auto680):02608         BLK     FDB     DOUSER
+1905 002E             (fig-forth-auto680):02609                 FDB     XBLK-UORIG
+                      (fig-forth-auto680):02610         *
+                      (fig-forth-auto680):02611         * ======>>  70  <<
+                      (fig-forth-auto680):02612         * ( --- vadr )   
+                      (fig-forth-auto680):02613         * Input buffer offset/cursor.
+1907 82               (fig-forth-auto680):02614                 FCB     $82
+1908 49               (fig-forth-auto680):02615                 FCC     'I'     ; 'IN' :        scan pointer for input line buffer
+1909 CE               (fig-forth-auto680):02616                 FCB     $CE
+190A 18FD             (fig-forth-auto680):02617                 FDB     BLK-6
+190C 182C             (fig-forth-auto680):02618         IN      FDB     DOUSER
+190E 0030             (fig-forth-auto680):02619                 FDB     XIN-UORIG
+                      (fig-forth-auto680):02620         *
+                      (fig-forth-auto680):02621         * ======>>  71  <<
+                      (fig-forth-auto680):02622         * ( --- vadr )   
+                      (fig-forth-auto680):02623         * Output buffer offset/cursor.
+1910 83               (fig-forth-auto680):02624                 FCB     $83
+1911 4F55             (fig-forth-auto680):02625                 FCC     'OU'    ; 'OUT'
+1913 D4               (fig-forth-auto680):02626                 FCB     $D4
+1914 1907             (fig-forth-auto680):02627                 FDB     IN-5
+1916 182C             (fig-forth-auto680):02628         OUT     FDB     DOUSER
+1918 0032             (fig-forth-auto680):02629                 FDB     XOUT-UORIG
+                      (fig-forth-auto680):02630         *
+                      (fig-forth-auto680):02631         * ======>>  72  <<
+                      (fig-forth-auto680):02632         * ( --- vadr )   
+                      (fig-forth-auto680):02633         * Screen currently being edited, once we have an editor running. 
+191A 83               (fig-forth-auto680):02634                 FCB     $83
+191B 5343             (fig-forth-auto680):02635                 FCC     'SC'    ; 'SCR'
+191D D2               (fig-forth-auto680):02636                 FCB     $D2
+191E 1910             (fig-forth-auto680):02637                 FDB     OUT-6
+1920 182C             (fig-forth-auto680):02638         SCR     FDB     DOUSER
+1922 0034             (fig-forth-auto680):02639                 FDB     XSCR-UORIG
+                      (fig-forth-auto680):02640         * ######>> screen 37 <<
+                      (fig-forth-auto680):02641         *
+                      (fig-forth-auto680):02642         * ======>>  73  <<
+                      (fig-forth-auto680):02643         * ( --- vadr )   
+                      (fig-forth-auto680):02644         * Sector offset for LOADing screens,
+                      (fig-forth-auto680):02645         * set by DRIVE to make a new drive the default.
+                      (fig-forth-auto680):02646         * This should also be 32 bit or bigger.
+1924 86               (fig-forth-auto680):02647                 FCB     $86
+1925 4F46465345       (fig-forth-auto680):02648                 FCC     'OFFSE' ; 'OFFSET'
+192A D4               (fig-forth-auto680):02649                 FCB     $D4
+192B 191A             (fig-forth-auto680):02650                 FDB     SCR-6
+192D 182C             (fig-forth-auto680):02651         OFSET   FDB     DOUSER
+192F 0036             (fig-forth-auto680):02652                 FDB     XOFSET-UORIG
+                      (fig-forth-auto680):02653         *
+                      (fig-forth-auto680):02654         * ======>>  74  <<
+                      (fig-forth-auto680):02655         * ( --- vadr )   
+                      (fig-forth-auto680):02656         * Current context of interpretation (vocabulary root).
+1931 87               (fig-forth-auto680):02657                 FCB     $87
+1932 434F4E544558     (fig-forth-auto680):02658                 FCC     'CONTEX'        ; 'CONTEXT' :   points to pointer to vocab to search first
+1938 D4               (fig-forth-auto680):02659                 FCB     $D4
+1939 1924             (fig-forth-auto680):02660                 FDB     OFSET-9
+193B 182C             (fig-forth-auto680):02661         CONTXT  FDB     DOUSER
+193D 0038             (fig-forth-auto680):02662                 FDB     XCONT-UORIG
+                      (fig-forth-auto680):02663         *
+                      (fig-forth-auto680):02664         * ======>>  75  <<
+                      (fig-forth-auto680):02665         * ( --- vadr )   
+                      (fig-forth-auto680):02666         * Current context of definition (vocabulary root).
+193F 87               (fig-forth-auto680):02667                 FCB     $87
+1940 43555252454E     (fig-forth-auto680):02668                 FCC     'CURREN'        ; 'CURRENT' :   points to ptr. to vocab being extended
+1946 D4               (fig-forth-auto680):02669                 FCB     $D4
+1947 1931             (fig-forth-auto680):02670                 FDB     CONTXT-10
+1949 182C             (fig-forth-auto680):02671         CURENT  FDB     DOUSER
+194B 003A             (fig-forth-auto680):02672                 FDB     XCURR-UORIG
+                      (fig-forth-auto680):02673         *
+                      (fig-forth-auto680):02674         * ======>>  76  <<
+                      (fig-forth-auto680):02675         * ( --- vadr )   
+                      (fig-forth-auto680):02676         * Compiler/interpreter state.
+194D 85               (fig-forth-auto680):02677                 FCB     $85
+194E 53544154         (fig-forth-auto680):02678                 FCC     'STAT'  ; 'STATE' :     1 if compiling, 0 if not
+1952 C5               (fig-forth-auto680):02679                 FCB     $C5
+1953 193F             (fig-forth-auto680):02680                 FDB     CURENT-10
+1955 182C             (fig-forth-auto680):02681         STATE   FDB     DOUSER
+1957 003C             (fig-forth-auto680):02682                 FDB     XSTATE-UORIG
+                      (fig-forth-auto680):02683         *
+                      (fig-forth-auto680):02684         * ======>>  77  <<
+                      (fig-forth-auto680):02685         * ( --- vadr )   
+                      (fig-forth-auto680):02686         * Numeric conversion base.
+1959 84               (fig-forth-auto680):02687                 FCB     $84
+195A 424153           (fig-forth-auto680):02688                 FCC     'BAS'   ; 'BASE' :      number base for all input & output
+195D C5               (fig-forth-auto680):02689                 FCB     $C5
+195E 194D             (fig-forth-auto680):02690                 FDB     STATE-8
+1960 182C             (fig-forth-auto680):02691         BASE    FDB     DOUSER
+1962 003E             (fig-forth-auto680):02692                 FDB     XBASE-UORIG
+                      (fig-forth-auto680):02693         *
+                      (fig-forth-auto680):02694         * ======>>  78  <<
+                      (fig-forth-auto680):02695         * ( --- vadr ) 
+                      (fig-forth-auto680):02696         * Decimal point location for output.
+1964 83               (fig-forth-auto680):02697                 FCB     $83
+1965 4450             (fig-forth-auto680):02698                 FCC     'DP'    ; 'DPL'
+1967 CC               (fig-forth-auto680):02699                 FCB     $CC
+1968 1959             (fig-forth-auto680):02700                 FDB     BASE-7
+196A 182C             (fig-forth-auto680):02701         DPL     FDB     DOUSER
+196C 0040             (fig-forth-auto680):02702                 FDB     XDPL-UORIG
+                      (fig-forth-auto680):02703         *
+                      (fig-forth-auto680):02704         * ======>>  79  <<
+                      (fig-forth-auto680):02705         * ( --- vadr )   
+                      (fig-forth-auto680):02706         * Field width for I/O formatting.
+196E 83               (fig-forth-auto680):02707                 FCB     $83
+196F 464C             (fig-forth-auto680):02708                 FCC     'FL'    ; 'FLD'
+1971 C4               (fig-forth-auto680):02709                 FCB     $C4
+1972 1964             (fig-forth-auto680):02710                 FDB     DPL-6
+1974 182C             (fig-forth-auto680):02711         FLD     FDB     DOUSER
+1976 0042             (fig-forth-auto680):02712                 FDB     XFLD-UORIG
+                      (fig-forth-auto680):02713         *
+                      (fig-forth-auto680):02714         * ======>>  80  <<
+                      (fig-forth-auto680):02715         * ( --- vadr )   
+                      (fig-forth-auto680):02716         * Compiler stack mark for stack check.
+1978 83               (fig-forth-auto680):02717                 FCB     $83
+1979 4353             (fig-forth-auto680):02718                 FCC     'CS'    ; 'CSP'
+197B D0               (fig-forth-auto680):02719                 FCB     $D0
+197C 196E             (fig-forth-auto680):02720                 FDB     FLD-6
+197E 182C             (fig-forth-auto680):02721         CSP     FDB     DOUSER
+1980 0044             (fig-forth-auto680):02722                 FDB     XCSP-UORIG
+                      (fig-forth-auto680):02723         *
+                      (fig-forth-auto680):02724         * ======>>  81  <<
+                      (fig-forth-auto680):02725         * ( --- vadr )   
+                      (fig-forth-auto680):02726         * Editing cursor location. 
+1982 82               (fig-forth-auto680):02727                 FCB     $82
+1983 52               (fig-forth-auto680):02728                 FCC     'R'     ; 'R#'
+1984 A3               (fig-forth-auto680):02729                 FCB     $A3
+1985 1978             (fig-forth-auto680):02730                 FDB     CSP-6
+1987 182C             (fig-forth-auto680):02731         RNUM    FDB     DOUSER
+1989 0046             (fig-forth-auto680):02732                 FDB     XRNUM-UORIG
+                      (fig-forth-auto680):02733         *
+                      (fig-forth-auto680):02734         * ======>>  82  <<
+                      (fig-forth-auto680):02735         * ( --- vadr )   
+                      (fig-forth-auto680):02736         * Pointer to last HELD character in PAD.
+198B 83               (fig-forth-auto680):02737                 FCB     $83
+198C 484C             (fig-forth-auto680):02738                 FCC     'HL'    ; 'HLD'
+198E C4               (fig-forth-auto680):02739                 FCB     $C4
+198F 1982             (fig-forth-auto680):02740                 FDB     RNUM-5
+1991 17E6             (fig-forth-auto680):02741         HLD     FDB     DOCON
+1993 7C48             (fig-forth-auto680):02742                 FDB     XHLD
+                      (fig-forth-auto680):02743         *
+                      (fig-forth-auto680):02744         * ======>>  82.5  <<== SPECIAL
+                      (fig-forth-auto680):02745         * ( --- vadr )   
+                      (fig-forth-auto680):02746         * Line width of active terminal.
+1995 87               (fig-forth-auto680):02747                 FCB     $87
+1996 434F4C554D4E     (fig-forth-auto680):02748                 FCC     'COLUMN'        ; 'COLUMNS' :   line width of terminal
+199C D3               (fig-forth-auto680):02749                 FCB     $D3
+199D 198B             (fig-forth-auto680):02750                 FDB     HLD-6
+199F 182C             (fig-forth-auto680):02751         COLUMS  FDB     DOUSER
+19A1 004C             (fig-forth-auto680):02752                 FDB     XCOLUM-UORIG
+                      (fig-forth-auto680):02753         *
+                      (fig-forth-auto680):02754         * ######>> screen 38 <<
+                      (fig-forth-auto680):02755         **
+                      (fig-forth-auto680):02756         ** An INCREMENTER probably should not be defined without a defined CONSTANT?
+                      (fig-forth-auto680):02757         **
+                      (fig-forth-auto680):02758         ** Make an INCREMENTER compiling word (not in model):
+                      (fig-forth-auto680):02759         ** ( n --- )
+                      (fig-forth-auto680):02760         ** { n INCREMENTER name } typical input
+                      (fig-forth-auto680):02761         ** CREATE a header and compile the increment constant, 
+                      (fig-forth-auto680):02762         ** then overwrite the header with a call to DOINC.
+                      (fig-forth-auto680):02763         *       FCB     $8B
+                      (fig-forth-auto680):02764         *       FCC     'INCREMENTE'    ; 'INCREMENTER'
+                      (fig-forth-auto680):02765         *       FCB     $D2
+                      (fig-forth-auto680):02766         *       FDB     COLUMS-10
+                      (fig-forth-auto680):02767         * INCR  FDB     DOCOL,CON,PSCODE
+                      (fig-forth-auto680):02768         ** ( n --- ninc ) 
+                      (fig-forth-auto680):02769         ** Characteristic of an INCREMENTER.
+                      (fig-forth-auto680):02770         ** This is too naive:
+                      (fig-forth-auto680):02771         * DOINC LDD     ,U
+                      (fig-forth-auto680):02772         *       ADDD    NATWID,X        ; Add the increment.
+                      (fig-forth-auto680):02773         *       STD     ,U
+                      (fig-forth-auto680):02774         *       RTS
+                      (fig-forth-auto680):02775         * Compiling word should check that it is compiling a CONSTANT.
+                      (fig-forth-auto680):02776         *
+                      (fig-forth-auto680):02777         * ======>>  83  <<
+                      (fig-forth-auto680):02778         * ( n --- n+1 )
+19A3 82               (fig-forth-auto680):02779                 FCB     $82
+19A4 31               (fig-forth-auto680):02780                 FCC     '1'     ; '1+'
+19A5 AB               (fig-forth-auto680):02781                 FCB     $AB
+19A6 1995             (fig-forth-auto680):02782                 FDB     COLUMS-10
+                      (fig-forth-auto680):02783         * Using the model keeps things semantically connected for other processors:
+19A8 17B6184216C1     (fig-forth-auto680):02784         ONEP    FDB     DOCOL,ONE,PLUS
+19AE 1662             (fig-forth-auto680):02785                 FDB     SEMIS
+                      (fig-forth-auto680):02786         ** Greedy alternative:
+                      (fig-forth-auto680):02787         * ONEP  FDB     *+NATWID
+                      (fig-forth-auto680):02788         *       LDD     ,U
+                      (fig-forth-auto680):02789         *       ADDD    ONEV,PCR
+                      (fig-forth-auto680):02790         *       STD     ,U
+                      (fig-forth-auto680):02791         *       RTS
+                      (fig-forth-auto680):02792         * Naive alternative:
+                      (fig-forth-auto680):02793         * ONEP  FDB     DOINC
+                      (fig-forth-auto680):02794         *       FDB     1
+                      (fig-forth-auto680):02795         * Naive alternative:
+                      (fig-forth-auto680):02796         * ONEP  FDB     *+NATWID
+                      (fig-forth-auto680):02797         *       LDD     ,U
+                      (fig-forth-auto680):02798         *       ADDD    #1       ; It's hard to imagine 1+ being other than 1.
+                      (fig-forth-auto680):02799         *       STD     ,U
+                      (fig-forth-auto680):02800         *       RTS
+                      (fig-forth-auto680):02801         *
+                      (fig-forth-auto680):02802         * ======>>  84  <<
+                      (fig-forth-auto680):02803         * ( n --- n+2 )
+19B0 82               (fig-forth-auto680):02804                 FCB     $82
+19B1 32               (fig-forth-auto680):02805                 FCC     '2'     ; '2+'
+19B2 AB               (fig-forth-auto680):02806                 FCB     $AB
+19B3 19A3             (fig-forth-auto680):02807                 FDB     ONEP-5
+                      (fig-forth-auto680):02808         * Using the model keeps things semantically connected for other processors:
+19B5 17B6184A16C1     (fig-forth-auto680):02809         TWOP    FDB     DOCOL,TWO,PLUS
+19BB 1662             (fig-forth-auto680):02810                 FDB     SEMIS
+                      (fig-forth-auto680):02811         ** Greedy alternative:
+                      (fig-forth-auto680):02812         * TWOP  FDB     *+NATWID
+                      (fig-forth-auto680):02813         *       LDD     ,U
+                      (fig-forth-auto680):02814         *       ADDD    TWOV,PCR         ; See NAT+ (NATP)
+                      (fig-forth-auto680):02815         *       STD     ,U
+                      (fig-forth-auto680):02816         *       RTS
+                      (fig-forth-auto680):02817         * Naive alternative:
+                      (fig-forth-auto680):02818         * TWOP  FDB     DOINC
+                      (fig-forth-auto680):02819         *       FDB     2
+                      (fig-forth-auto680):02820         * Naive alternative:
+                      (fig-forth-auto680):02821         * TWOP  FDB     *+NATWID
+                      (fig-forth-auto680):02822         *       LDD     ,U
+                      (fig-forth-auto680):02823         *       ADDD    #2       ; See NAT+ (NATP)
+                      (fig-forth-auto680):02824         *       STD     ,U
+                      (fig-forth-auto680):02825         *       RTS
+                      (fig-forth-auto680):02826         *
+                      (fig-forth-auto680):02827         * ======>>  85  <<
+                      (fig-forth-auto680):02828         * ( --- adr )
+                      (fig-forth-auto680):02829         * Get the DICTPT allocation, like a USER constant.  
+                      (fig-forth-auto680):02830         * Should check the stack and heap for collision.
+19BD 84               (fig-forth-auto680):02831                 FCB     $84
+19BE 484552           (fig-forth-auto680):02832                 FCC     'HER'   ; 'HERE'
+19C1 C5               (fig-forth-auto680):02833                 FCB     $C5
+19C2 19B0             (fig-forth-auto680):02834                 FDB     TWOP-5
+19C4 17B618EA176F     (fig-forth-auto680):02835         HERE    FDB     DOCOL,DICTPT,AT
+19CA 1662             (fig-forth-auto680):02836                 FDB     SEMIS
+                      (fig-forth-auto680):02837         *
+                      (fig-forth-auto680):02838         * ======>>  86  <<
+                      (fig-forth-auto680):02839         * ( n --- )
+                      (fig-forth-auto680):02840         * Increase/decrease heap (add n to DP),
+                      (fig-forth-auto680):02841         * Should ERROR check stack/heap.
+19CC 85               (fig-forth-auto680):02842                 FCB     $85
+19CD 414C4C4F         (fig-forth-auto680):02843                 FCC     'ALLO'  ; 'ALLOT'
+19D1 D4               (fig-forth-auto680):02844                 FCB     $D4
+19D2 19BD             (fig-forth-auto680):02845                 FDB     HERE-7
+19D4 17B618EA174E     (fig-forth-auto680):02846         ALLOT   FDB     DOCOL,DICTPT,PSTORE
+19DA 1662             (fig-forth-auto680):02847                 FDB     SEMIS
+                      (fig-forth-auto680):02848         *
+                      (fig-forth-auto680):02849         * ======>>  87  <<
+                      (fig-forth-auto680):02850         * ( n --- )
+                      (fig-forth-auto680):02851         * Store word n at DP++,
+                      (fig-forth-auto680):02852         * Should ERROR check stack/heap.
+19DC 81               (fig-forth-auto680):02853                 FCB     $81     ; , (COMMA)
+19DD AC               (fig-forth-auto680):02854                 FCB     $AC
+19DE 19CC             (fig-forth-auto680):02855                 FDB     ALLOT-8
+19E0 17B619C4178717F4 (fig-forth-auto680):02856         COMMA   FDB     DOCOL,HERE,STORE,NATWC,ALLOT
+     19D4
+19EA 1662             (fig-forth-auto680):02857                 FDB     SEMIS
+                      (fig-forth-auto680):02858         * COMMA FDB     DOCOL,HERE,STORE,TWO,ALLOT
+                      (fig-forth-auto680):02859         *       FDB     SEMIS
+                      (fig-forth-auto680):02860         *
+                      (fig-forth-auto680):02861         * ======>>  88  <<
+                      (fig-forth-auto680):02862         * ( b --- )
+                      (fig-forth-auto680):02863         * Store byte b at DP+,
+                      (fig-forth-auto680):02864         * Should ERROR check stack/heap.
+19EC 82               (fig-forth-auto680):02865                 FCB     $82
+19ED 43               (fig-forth-auto680):02866                 FCC     'C'     ; 'C,'
+19EE AC               (fig-forth-auto680):02867                 FCB     $AC
+19EF 19DC             (fig-forth-auto680):02868                 FDB     COMMA-4
+19F1 17B619C417951842 (fig-forth-auto680):02869         CCOMM   FDB     DOCOL,HERE,CSTORE,ONE,ALLOT
+     19D4
+19FB 1662             (fig-forth-auto680):02870                 FDB     SEMIS
+                      (fig-forth-auto680):02871         *
+                      (fig-forth-auto680):02872         * ======>>  89  <<
+                      (fig-forth-auto680):02873         * ( n1 n2 --- n1-n2 )
+                      (fig-forth-auto680):02874         * Subtract top two words.
+19FD 81               (fig-forth-auto680):02875                 FCB     $81     ; -
+19FE AD               (fig-forth-auto680):02876                 FCB     $AD
+19FF 19EC             (fig-forth-auto680):02877                 FDB     CCOMM-5
+1A01 1A03             (fig-forth-auto680):02878         SUB     FDB     *+NATWID
+1A03 EC42             (fig-forth-auto680):02879                 LDD     NATWID,U        ; #2~6
+1A05 A3C1             (fig-forth-auto680):02880                 SUBD    ,U++    ; #2~9
+1A07 EDC4             (fig-forth-auto680):02881                 STD     ,U      ; #2~5
+1A09 39               (fig-forth-auto680):02882                 RTS             ; #1~5  = #7~25
+                      (fig-forth-auto680):02883         * SUB   FDB     DOCOL,MINUS,PLUS
+                      (fig-forth-auto680):02884         *       FDB     SEMIS   ; Costs 6 bytes and lots of cycles.
+                      (fig-forth-auto680):02885         *
+                      (fig-forth-auto680):02886         * ======>>  90  <<
+                      (fig-forth-auto680):02887         * ( n1 n2 --- n1==n2 )
+                      (fig-forth-auto680):02888         * Return flag true if n1 and n2 are equal, otherwise false.
+1A0A 81               (fig-forth-auto680):02889                 FCB     $81     =
+1A0B BD               (fig-forth-auto680):02890                 FCB     $BD
+1A0C 19FD             (fig-forth-auto680):02891                 FDB     SUB-4
+1A0E 17B61A01169E     (fig-forth-auto680):02892         EQUAL   FDB     DOCOL,SUB,ZEQU
+1A14 1662             (fig-forth-auto680):02893                 FDB     SEMIS
+                      (fig-forth-auto680):02894         *
+                      (fig-forth-auto680):02895         * ======>>  91  <<
+                      (fig-forth-auto680):02896         * ( n1 n2 --- n1<n2 )
+                      (fig-forth-auto680):02897         * Return flag true if n1 is less than n2, otherwise false.
+1A16 81               (fig-forth-auto680):02898                 FCB     $81     <
+1A17 BC               (fig-forth-auto680):02899                 FCB     $BC     
+1A18 1A0A             (fig-forth-auto680):02900                 FDB     EQUAL-4
+1A1A 1A1C             (fig-forth-auto680):02901         LESS    FDB     *+NATWID
+1A1C EC42             (fig-forth-auto680):02902                 LDD     NATWID,U
+1A1E A3C1             (fig-forth-auto680):02903                 SUBD    ,U++
+1A20 2C06             (fig-forth-auto680):02904                 BGE     FALSE
+1A22 CC0001           (fig-forth-auto680):02905         TRUE    LDD     #1
+1A25 EDC4             (fig-forth-auto680):02906                 STD     ,U
+1A27 39               (fig-forth-auto680):02907                 RTS
+1A28 CC0000           (fig-forth-auto680):02908         FALSE   LDD     #0
+1A2B EDC4             (fig-forth-auto680):02909                 STD     ,U
+1A2D 39               (fig-forth-auto680):02910                 RTS
+                      (fig-forth-auto680):02911         *       PULS A  ; 
+                      (fig-forth-auto680):02912         *       PULS B  ; 
+                      (fig-forth-auto680):02913         *       TFR S,X ; TSX : 
+                      (fig-forth-auto680):02914         *       CMPA 0,X
+                      (fig-forth-auto680):02915         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02916         *       BGT     LESST
+                      (fig-forth-auto680):02917         *       BNE     LESSF
+                      (fig-forth-auto680):02918         *       CMPB 1,X        ; Why not sub, sbc, bge?
+                      (fig-forth-auto680):02919         *       BHI     LESST
+                      (fig-forth-auto680):02920         * LESSF CLRB    ;
+                      (fig-forth-auto680):02921         *       BRA     LESSX
+                      (fig-forth-auto680):02922         * LESST LDB #1
+                      (fig-forth-auto680):02923         * LESSX CLRA    ;
+                      (fig-forth-auto680):02924         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):02925         *       JMP     PUSHBA
+                      (fig-forth-auto680):02926         *
+                      (fig-forth-auto680):02927         * ======>>  92  <<
+                      (fig-forth-auto680):02928         * ( n1 n2 --- n1>n2 )
+                      (fig-forth-auto680):02929         * Return flag true if n1 is greater than n2, false otherwise.
+1A2E 81               (fig-forth-auto680):02930                 FCB     $81     >
+1A2F BE               (fig-forth-auto680):02931                 FCB     $BE
+1A30 1A16             (fig-forth-auto680):02932                 FDB     LESS-4
+1A32 17B617331A1A     (fig-forth-auto680):02933         GREAT   FDB     DOCOL,SWAP,LESS
+1A38 1662             (fig-forth-auto680):02934                 FDB     SEMIS
+                      (fig-forth-auto680):02935         *
+                      (fig-forth-auto680):02936         * ======>>  93  <<
+                      (fig-forth-auto680):02937         * ( n1 n2 n3 --- n2 n3 n1 )
+                      (fig-forth-auto680):02938         * Rotate the top three words on stack,
+                      (fig-forth-auto680):02939         * bringing the third word to the top.
+1A3A 83               (fig-forth-auto680):02940                 FCB     $83
+1A3B 524F             (fig-forth-auto680):02941                 FCC     'RO'    ; 'ROT'
+1A3D D4               (fig-forth-auto680):02942                 FCB     $D4
+1A3E 1A2E             (fig-forth-auto680):02943                 FDB     GREAT-4
+1A40 1A42             (fig-forth-auto680):02944         ROT     FDB     *+NATWID
+1A42 3420             (fig-forth-auto680):02945                 PSHS    Y
+1A44 3736             (fig-forth-auto680):02946                 PULU    D,X,Y
+1A46 3616             (fig-forth-auto680):02947                 PSHU    D,X
+1A48 3620             (fig-forth-auto680):02948                 PSHU    Y
+1A4A 35A0             (fig-forth-auto680):02949                 PULS    Y,PC
+                      (fig-forth-auto680):02950         * ROT   FDB     DOCOL,TOR,SWAP,FROMR,SWAP
+                      (fig-forth-auto680):02951         *       FDB     SEMIS
+                      (fig-forth-auto680):02952         *
+                      (fig-forth-auto680):02953         * ======>>  94  <<
+                      (fig-forth-auto680):02954         * ( --- )
+                      (fig-forth-auto680):02955         * EMIT a SPACE.
+1A4C 85               (fig-forth-auto680):02956                 FCB     $85
+1A4D 53504143         (fig-forth-auto680):02957                 FCC     'SPAC'  ; 'SPACE'
+1A51 C5               (fig-forth-auto680):02958                 FCB     $C5
+1A52 1A3A             (fig-forth-auto680):02959                 FDB     ROT-6
+1A54 17B6185B1541     (fig-forth-auto680):02960         SPACE   FDB     DOCOL,BL,EMIT
+1A5A 1662             (fig-forth-auto680):02961                 FDB     SEMIS
+                      (fig-forth-auto680):02962         *
+                      (fig-forth-auto680):02963         * ======>>  95  <<
+                      (fig-forth-auto680):02964         *  ( n0 n1 --- min(n0,n1) )
+                      (fig-forth-auto680):02965         * Leave the minimum of the top two integers.
+                      (fig-forth-auto680):02966         * Being too greedy here, but, whatever.
+1A5C 83               (fig-forth-auto680):02967                 FCB     $83
+1A5D 4D49             (fig-forth-auto680):02968                 FCC     'MI'    ; 'MIN'
+1A5F CE               (fig-forth-auto680):02969                 FCB     $CE
+1A60 1A4C             (fig-forth-auto680):02970                 FDB     SPACE-8
+1A62 1A64             (fig-forth-auto680):02971         MIN     FDB     *+NATWID
+1A64 3706             (fig-forth-auto680):02972                 PULU    D
+1A66 10A3C4           (fig-forth-auto680):02973                 CMPD    ,U
+1A69 2F02             (fig-forth-auto680):02974                 BLE     MINX
+1A6B EDC4             (fig-forth-auto680):02975                 STD     ,U
+1A6D 39               (fig-forth-auto680):02976         MINX    RTS     
+                      (fig-forth-auto680):02977         * MIN   FDB     DOCOL,OVER,OVER,GREAT,ZBRAN
+                      (fig-forth-auto680):02978         *       FDB     MIN2-*-NATWID
+                      (fig-forth-auto680):02979         *       FDB     SWAP
+                      (fig-forth-auto680):02980         * MIN2  FDB     DROP
+                      (fig-forth-auto680):02981         *       FDB     SEMIS
+                      (fig-forth-auto680):02982         *
+                      (fig-forth-auto680):02983         * ======>>  96  <<
+                      (fig-forth-auto680):02984         * ( n0 n1 --- max(n0,n1) )
+                      (fig-forth-auto680):02985         * Leave the maximum of the top two integers.
+                      (fig-forth-auto680):02986         * Really should leave this as in the model.
+1A6E 83               (fig-forth-auto680):02987                 FCB     $83
+1A6F 4D41             (fig-forth-auto680):02988                 FCC     'MA'    ; 'MAX'
+1A71 D8               (fig-forth-auto680):02989                 FCB     $D8
+1A72 1A5C             (fig-forth-auto680):02990                 FDB     MIN-6
+1A74 1A76             (fig-forth-auto680):02991         MAX     FDB     *+NATWID
+1A76 3706             (fig-forth-auto680):02992                 PULU    D
+1A78 10A3C4           (fig-forth-auto680):02993                 CMPD    ,U
+1A7B 2F02             (fig-forth-auto680):02994                 BLE     MAXX
+1A7D EDC4             (fig-forth-auto680):02995                 STD     ,U
+1A7F 39               (fig-forth-auto680):02996         MAXX    RTS     
+                      (fig-forth-auto680):02997         * MAX   FDB     DOCOL,OVER,OVER,LESS,ZBRAN
+                      (fig-forth-auto680):02998         *       FDB     MAX2-*-NATWID
+                      (fig-forth-auto680):02999         *       FDB     SWAP
+                      (fig-forth-auto680):03000         * MAX2  FDB     DROP
+                      (fig-forth-auto680):03001         *       FDB     SEMIS
+                      (fig-forth-auto680):03002         *
+                      (fig-forth-auto680):03003         * ======>>  97  <<
+                      (fig-forth-auto680):03004         * ( 0 --- 0 )
+                      (fig-forth-auto680):03005         * ( n --- n n )
+                      (fig-forth-auto680):03006         * DUP if non-zero.
+1A80 84               (fig-forth-auto680):03007                 FCB     $84
+1A81 2D4455           (fig-forth-auto680):03008                 FCC     '-DU'   ; '-DUP'
+1A84 D0               (fig-forth-auto680):03009                 FCB     $D0
+1A85 1A6E             (fig-forth-auto680):03010                 FDB     MAX-6
+1A87 1A89             (fig-forth-auto680):03011         DDUP    FDB     *+NATWID
+1A89 ECC4             (fig-forth-auto680):03012                 LDD     ,U
+1A8B 2702             (fig-forth-auto680):03013                 BEQ     DDUPX
+1A8D 3606             (fig-forth-auto680):03014                 PSHU    D
+1A8F 39               (fig-forth-auto680):03015         DDUPX   RTS
+                      (fig-forth-auto680):03016         * DDUP  FDB     DOCOL,DUP,ZBRAN
+                      (fig-forth-auto680):03017         *       FDB     DDUP2-*-NATWID
+                      (fig-forth-auto680):03018         *       FDB     DUP
+                      (fig-forth-auto680):03019         * DDUP2 FDB     SEMIS
+                      (fig-forth-auto680):03020         *
+                      (fig-forth-auto680):03021         * ######>> screen 39 <<
+                      (fig-forth-auto680):03022         * ======>> 98.1 <<
+                      (fig-forth-auto680):03023         * Supplemental:
+                      (fig-forth-auto680):03024         * ( n<0 --- -1 )
+                      (fig-forth-auto680):03025         * ( n>=~ --- 1 )
+                      (fig-forth-auto680):03026         * Change top integer to its sign.
+1A90 86               (fig-forth-auto680):03027                 FCB     $86
+1A91 5349474E55       (fig-forth-auto680):03028                 FCC     'SIGNU' ; 'SIGNUM'
+1A96 CD               (fig-forth-auto680):03029                 FCB     $CD
+1A97 1A80             (fig-forth-auto680):03030                 FDB     DDUP-7
+1A99 1A9B             (fig-forth-auto680):03031         SIGNUM  FDB     *+NATWID
+1A9B C601             (fig-forth-auto680):03032         SIGNUE  LDB     #1
+1A9D A6C4             (fig-forth-auto680):03033                 LDA     ,U
+1A9F 2A01             (fig-forth-auto680):03034                 BPL     SIGNUP
+1AA1 50               (fig-forth-auto680):03035                 NEGB
+1AA2 1D               (fig-forth-auto680):03036         SIGNUP  SEX     ; Couldn't they have called SignEXtend EXT instead?
+1AA3 EDC4             (fig-forth-auto680):03037                 STD     ,U      ; Am I too much of a prude?
+1AA5 39               (fig-forth-auto680):03038                 RTS
+                      (fig-forth-auto680):03039         * 6800 model version should be something like this:
+                      (fig-forth-auto680):03040         *       LDB     #1
+                      (fig-forth-auto680):03041         *       CLRA
+                      (fig-forth-auto680):03042         *       TSX
+                      (fig-forth-auto680):03043         *       TST     ,X
+                      (fig-forth-auto680):03044         *       BPL     SIGNUP
+                      (fig-forth-auto680):03045         *       NEGB
+                      (fig-forth-auto680):03046         *       COMA
+                      (fig-forth-auto680):03047         * SIGNUP        JMP     STABX
+                      (fig-forth-auto680):03048         *
+                      (fig-forth-auto680):03049         * ======>>  98  <<
+                      (fig-forth-auto680):03050         * ( adr1 direction --- adr2 )
+                      (fig-forth-auto680):03051         * TRAVERSE the symbol name.
+                      (fig-forth-auto680):03052         * If direction is 1, find the end.
+                      (fig-forth-auto680):03053         * If direction is -1, find the beginning.
+1AA6 88               (fig-forth-auto680):03054                 FCB     $88
+1AA7 54524156455253   (fig-forth-auto680):03055                 FCC     'TRAVERS'       ; 'TRAVERSE'
+1AAE C5               (fig-forth-auto680):03056                 FCB     $C5
+1AAF 1A90             (fig-forth-auto680):03057                 FDB     SIGNUM-9
+1AB1 1AB3             (fig-forth-auto680):03058         TRAV    FDB     *+NATWID
+1AB3 8DE6             (fig-forth-auto680):03059                 BSR     SIGNUE  ; Convert negative to -, zero or positive to 1.
+1AB5 ECC1             (fig-forth-auto680):03060                 LDD     ,U++    ; Still in D, but we have to pop it anyway.
+1AB7 AEC4             (fig-forth-auto680):03061                 LDX     ,U      ; If D is 1 or -1, so is B.
+1AB9 867F             (fig-forth-auto680):03062                 LDA     #$7F    
+1ABB 3085             (fig-forth-auto680):03063         TRAVLP  LEAX    B,X     ; Don't look at the one we start at.
+1ABD A184             (fig-forth-auto680):03064                 CMPA    ,X      ; Not sure why we aren't just doing LDA ,X ; BPL.
+1ABF 24FA             (fig-forth-auto680):03065                 BCC     TRAVLP
+1AC1 AFC4             (fig-forth-auto680):03066         TRAVDN  STX     ,U
+1AC3 39               (fig-forth-auto680):03067                 RTS
+                      (fig-forth-auto680):03068         * Doing this in 6809 just because it can be done may be getting too greedy.
+                      (fig-forth-auto680):03069         * TRAV  FDB     DOCOL,SWAP
+                      (fig-forth-auto680):03070         * TRAV2 FDB     OVER,PLUS,LIT8
+                      (fig-forth-auto680):03071         *       FCB     $7F
+                      (fig-forth-auto680):03072         *       FDB     OVER,CAT,LESS,ZBRAN
+                      (fig-forth-auto680):03073         *       FDB     TRAV2-*-NATWID
+                      (fig-forth-auto680):03074         *       FDB     SWAP,DROP
+                      (fig-forth-auto680):03075         *       FDB     SEMIS
+                      (fig-forth-auto680):03076         *
+                      (fig-forth-auto680):03077         * ======>>  99  <<
+                      (fig-forth-auto680):03078         * ( --- symptr )
+                      (fig-forth-auto680):03079         * Fetch CURRENT as a per-USER constant.
+1AC4 86               (fig-forth-auto680):03080                 FCB     $86
+1AC5 4C41544553       (fig-forth-auto680):03081                 FCC     'LATES' ; 'LATEST'
+1ACA D4               (fig-forth-auto680):03082                 FCB     $D4
+1ACB 1AA6             (fig-forth-auto680):03083                 FDB     TRAV-11
+1ACD 17B61949176F176F (fig-forth-auto680):03084         LATEST  FDB     DOCOL,CURENT,AT,AT
+1AD5 1662             (fig-forth-auto680):03085                 FDB     SEMIS
+                      (fig-forth-auto680):03086         * LATEST        FDB     *+NATWID
+                      (fig-forth-auto680):03087         * Getting too greedy:
+                      (fig-forth-auto680):03088         * Version 1:
+                      (fig-forth-auto680):03089         *       TFR     DP,A
+                      (fig-forth-auto680):03090         *       CLRB
+                      (fig-forth-auto680):03091         *       TFR     D,X
+                      (fig-forth-auto680):03092         *       LDD     CURENT+NATWID,PCR
+                      (fig-forth-auto680):03093         *       LDX     [D,X]
+                      (fig-forth-auto680):03094         *       PSHU    X       ; Leave the address in X.
+                      (fig-forth-auto680):03095         *       RTS
+                      (fig-forth-auto680):03096         * Version 2:
+                      (fig-forth-auto680):03097         *       LEAX    CURENT,PCR
+                      (fig-forth-auto680):03098         *       JSR     [,X]
+                      (fig-forth-auto680):03099         *       PULU    X
+                      (fig-forth-auto680):03100         *       LDX     [,X]
+                      (fig-forth-auto680):03101         *       PSHU    X
+                      (fig-forth-auto680):03102         *       RTS     
+                      (fig-forth-auto680):03103         * Too greedy, too many smantic holes to fall through.
+                      (fig-forth-auto680):03104         * If the address at the CFA is made relative, 
+                      (fig-forth-auto680):03105         * this is part of the code that would be affected 
+                      (fig-forth-auto680):03106         * if it is in native CPU code.
+                      (fig-forth-auto680):03107         *
+                      (fig-forth-auto680):03108         * ======>>  100  <<
+                      (fig-forth-auto680):03109         * Wanted to do these as INCREMENTERs,
+                      (fig-forth-auto680):03110         * but I need to stick with the model as much as possible,
+                      (fig-forth-auto680):03111         * (mostly, LOL) adding code only to make the model more clear.
+                      (fig-forth-auto680):03112         * ( pfa --- lfa )     
+                      (fig-forth-auto680):03113         * Convert PFA to LFA, unchecked. (Bump back from contents to allocation link.)
+1AD7 83               (fig-forth-auto680):03114                 FCB     $83
+1AD8 4C46             (fig-forth-auto680):03115                 FCC     'LF'    ; 'LFA'
+1ADA C1               (fig-forth-auto680):03116                 FCB     $C1
+1ADB 1AC4             (fig-forth-auto680):03117                 FDB     LATEST-9
+1ADD 17B613A7         (fig-forth-auto680):03118         LFA     FDB     DOCOL,LIT8
+                      (fig-forth-auto680):03119         *       FCB     4
+1AE1 04               (fig-forth-auto680):03120                 FCB     2*NATWID
+1AE2 1A01             (fig-forth-auto680):03121                 FDB     SUB
+1AE4 1662             (fig-forth-auto680):03122                 FDB     SEMIS
+                      (fig-forth-auto680):03123         *
+                      (fig-forth-auto680):03124         * ======>>  101  <<
+                      (fig-forth-auto680):03125         * ( pfa --- cfa )    
+                      (fig-forth-auto680):03126         * Convert PFA to CFA, unchecked. (Bump back from contents to characterist code link.)
+1AE6 83               (fig-forth-auto680):03127                 FCB     $83
+1AE7 4346             (fig-forth-auto680):03128                 FCC     'CF'    ; 'CFA'
+1AE9 C1               (fig-forth-auto680):03129                 FCB     $C1
+1AEA 1AD7             (fig-forth-auto680):03130                 FDB     LFA-6
+                      (fig-forth-auto680):03131         * CFA   FDB     DOCOL,TWO,SUB
+1AEC 17B617F41A01     (fig-forth-auto680):03132         CFA     FDB     DOCOL,NATWC,SUB
+1AF2 1662             (fig-forth-auto680):03133                 FDB     SEMIS
+                      (fig-forth-auto680):03134         *
+                      (fig-forth-auto680):03135         * ======>>  102  <<
+                      (fig-forth-auto680):03136         * ( pfa --- nfa )     
+                      (fig-forth-auto680):03137         * Convert PFA to NFA. (Bump back from contents to beginning of symbol name.)
+1AF4 83               (fig-forth-auto680):03138                 FCB     $83
+1AF5 4E46             (fig-forth-auto680):03139                 FCC     'NF'    ; 'NFA'
+1AF7 C1               (fig-forth-auto680):03140                 FCB     $C1
+1AF8 1AE6             (fig-forth-auto680):03141                 FDB     CFA-6
+1AFA 17B613A7         (fig-forth-auto680):03142         NFA     FDB     DOCOL,LIT8
+                      (fig-forth-auto680):03143         *       FCB     5
+1AFE 05               (fig-forth-auto680):03144                 FCB     NATWID*2+1
+1AFF 1A01184216EA1AB1 (fig-forth-auto680):03145                 FDB     SUB,ONE,MINUS,TRAV
+1B07 1662             (fig-forth-auto680):03146                 FDB     SEMIS
+                      (fig-forth-auto680):03147         *
+                      (fig-forth-auto680):03148         * ======>>  103  <<
+                      (fig-forth-auto680):03149         * ( nfa --- pfa )     
+                      (fig-forth-auto680):03150         * Convert NFA to PFA. (Bump up from beginning of symbol name to contents.)
+1B09 83               (fig-forth-auto680):03151                 FCB     $83
+1B0A 5046             (fig-forth-auto680):03152                 FCC     'PF'    ; 'PFA'
+1B0C C1               (fig-forth-auto680):03153                 FCB     $C1
+1B0D 1AF4             (fig-forth-auto680):03154                 FDB     NFA-6
+1B0F 17B618421AB113A7 (fig-forth-auto680):03155         PFA     FDB     DOCOL,ONE,TRAV,LIT8
+                      (fig-forth-auto680):03156         *       FCB     5
+1B17 05               (fig-forth-auto680):03157                 FCB     NATWID*2+1
+1B18 16C1             (fig-forth-auto680):03158                 FDB     PLUS
+1B1A 1662             (fig-forth-auto680):03159                 FDB     SEMIS
+                      (fig-forth-auto680):03160         *
+                      (fig-forth-auto680):03161         * ######>> screen 40 <<
+                      (fig-forth-auto680):03162         * ======>>  104  <<
+                      (fig-forth-auto680):03163         * ( --- )
+                      (fig-forth-auto680):03164         * Save the parameter stack pointer in CSP for compiler checks.
+1B1C 84               (fig-forth-auto680):03165                 FCB     $84
+1B1D 214353           (fig-forth-auto680):03166                 FCC     '!CS'   ; '!CSP'
+1B20 D0               (fig-forth-auto680):03167                 FCB     $D0
+1B21 1B09             (fig-forth-auto680):03168                 FDB     PFA-6
+1B23 17B6163B197E1787 (fig-forth-auto680):03169         SCSP    FDB     DOCOL,SPAT,CSP,STORE
+1B2B 1662             (fig-forth-auto680):03170                 FDB     SEMIS
+                      (fig-forth-auto680):03171         *
+                      (fig-forth-auto680):03172         * ======>>  105  <<
+                      (fig-forth-auto680):03173         * ( 0 n --- )             ( *** )
+                      (fig-forth-auto680):03174         * ( true n --- IN BLK )   ( anything *** nothing )
+                      (fig-forth-auto680):03175         * If flag is false, do nothing. 
+                      (fig-forth-auto680):03176         * If flag is true, issue error MESSAGE and QUIT or ABORT, via ERROR. 
+                      (fig-forth-auto680):03177         * Leaves cursor position (IN)
+                      (fig-forth-auto680):03178         * and currently loading block number (BLK) on stack, for analysis.
+                      (fig-forth-auto680):03179         *
+                      (fig-forth-auto680):03180         * This one is too important to be high-level Forth codes.
+                      (fig-forth-auto680):03181         * When we have an error, we want to disturb as little as possible.
+                      (fig-forth-auto680):03182         * But fixing that cascades through ERROR and MESSAGE 
+                      (fig-forth-auto680):03183         * into the disk block system.
+                      (fig-forth-auto680):03184         * And we aren't ready for that yet.
+1B2D 86               (fig-forth-auto680):03185                 FCB     $86
+1B2E 3F4552524F       (fig-forth-auto680):03186                 FCC     '?ERRO' ; '?ERROR'
+1B33 D2               (fig-forth-auto680):03187                 FCB     $D2
+1B34 1B1C             (fig-forth-auto680):03188                 FDB     SCSP-7
+                      (fig-forth-auto680):03189         * QERR  FDB     *+NATWID
+                      (fig-forth-auto680):03190         *       LDD     NATWID,U
+                      (fig-forth-auto680):03191         *       BNE     QERROR
+                      (fig-forth-auto680):03192         *       LEAU    2*NATWID,U
+                      (fig-forth-auto680):03193         *       RTS
+                      (fig-forth-auto680):03194         ** this doesn't work anyway: QERROR     LBR     ERROR
+1B36 17B617331409     (fig-forth-auto680):03195         QERR    FDB     DOCOL,SWAP,ZBRAN
+1B3C 0006             (fig-forth-auto680):03196                 FDB     QERR2-*-NATWID
+1B3E 1FE613FA         (fig-forth-auto680):03197                 FDB     ERROR,BRAN
+1B42 0002             (fig-forth-auto680):03198                 FDB     QERR3-*-NATWID
+1B44 1725             (fig-forth-auto680):03199         QERR2   FDB     DROP
+1B46 1662             (fig-forth-auto680):03200         QERR3   FDB     SEMIS
+                      (fig-forth-auto680):03201         *       
+                      (fig-forth-auto680):03202         * ======>>  106  <<
+                      (fig-forth-auto680):03203         * STATE is compiling:
+                      (fig-forth-auto680):03204         * ( --- )                 ( *** )
+                      (fig-forth-auto680):03205         * STATE is compiling:
+                      (fig-forth-auto680):03206         * ( --- IN BLK )          ( anything *** nothing )
+                      (fig-forth-auto680):03207         * ERROR if not compiling.
+1B48 85               (fig-forth-auto680):03208                 FCB     $85
+1B49 3F434F4D         (fig-forth-auto680):03209                 FCC     '?COM'  ; '?COMP'
+1B4D D0               (fig-forth-auto680):03210                 FCB     $D0
+1B4E 1B2D             (fig-forth-auto680):03211                 FDB     QERR-9
+1B50 17B61955176F169E (fig-forth-auto680):03212         QCOMP   FDB     DOCOL,STATE,AT,ZEQU,LIT8
+     13A7
+1B5A 11               (fig-forth-auto680):03213                 FCB     $11
+1B5B 1B36             (fig-forth-auto680):03214                 FDB     QERR
+1B5D 1662             (fig-forth-auto680):03215                 FDB     SEMIS
+                      (fig-forth-auto680):03216         *
+                      (fig-forth-auto680):03217         * ======>>  107  <<
+                      (fig-forth-auto680):03218         * STATE is executing:
+                      (fig-forth-auto680):03219         * ( --- )                 ( *** )
+                      (fig-forth-auto680):03220         * STATE is executing:
+                      (fig-forth-auto680):03221         * ( --- IN BLK )          ( anything *** nothing )
+                      (fig-forth-auto680):03222         * ERROR if not executing.
+1B5F 85               (fig-forth-auto680):03223                 FCB     $85
+1B60 3F455845         (fig-forth-auto680):03224                 FCC     '?EXE'  ; '?EXEC'
+1B64 C3               (fig-forth-auto680):03225                 FCB     $C3
+1B65 1B48             (fig-forth-auto680):03226                 FDB     QCOMP-8
+1B67 17B61955176F13A7 (fig-forth-auto680):03227         QEXEC   FDB     DOCOL,STATE,AT,LIT8
+1B6F 12               (fig-forth-auto680):03228                 FCB     $12
+1B70 1B36             (fig-forth-auto680):03229                 FDB     QERR
+1B72 1662             (fig-forth-auto680):03230                 FDB     SEMIS
+                      (fig-forth-auto680):03231         *
+                      (fig-forth-auto680):03232         * ======>>  108  <<
+                      (fig-forth-auto680):03233         * ( n1 n1 --- )           ( *** )
+                      (fig-forth-auto680):03234         * ( n1 n2 --- IN BLK )    ( anything *** nothing )
+                      (fig-forth-auto680):03235         * ERROR if top two are unequal. 
+                      (fig-forth-auto680):03236         * MESSAGE says compiled conditionals do not match.
+1B74 86               (fig-forth-auto680):03237                 FCB     $86
+1B75 3F50414952       (fig-forth-auto680):03238                 FCC     '?PAIR' ; '?PAIRS'
+1B7A D3               (fig-forth-auto680):03239                 FCB     $D3
+1B7B 1B5F             (fig-forth-auto680):03240                 FDB     QEXEC-8
+1B7D 17B61A0113A7     (fig-forth-auto680):03241         QPAIRS  FDB     DOCOL,SUB,LIT8
+1B83 13               (fig-forth-auto680):03242                 FCB     $13
+1B84 1B36             (fig-forth-auto680):03243                 FDB     QERR
+1B86 1662             (fig-forth-auto680):03244                 FDB     SEMIS
+                      (fig-forth-auto680):03245         *
+                      (fig-forth-auto680):03246         * ======>>  109  <<
+                      (fig-forth-auto680):03247         * CSP and parameter stack are balanced (equal):
+                      (fig-forth-auto680):03248         * ( --- )                 ( *** )
+                      (fig-forth-auto680):03249         * CSP and parameter stack are not balanced (unequal):
+                      (fig-forth-auto680):03250         * ( --- IN BLK )          ( anything *** nothing )
+                      (fig-forth-auto680):03251         * ERROR if return/control stack is not at same level as last !CSP.
+                      (fig-forth-auto680):03252         * Usually indicates that a definition has been left incomplete.
+1B88 84               (fig-forth-auto680):03253                 FCB     $84
+1B89 3F4353           (fig-forth-auto680):03254                 FCC     '?CS'   ; '?CSP'
+1B8C D0               (fig-forth-auto680):03255                 FCB     $D0
+1B8D 1B74             (fig-forth-auto680):03256                 FDB     QPAIRS-9
+1B8F 17B6163B197E176F (fig-forth-auto680):03257         QCSP    FDB     DOCOL,SPAT,CSP,AT,SUB,LIT8
+     1A0113A7
+1B9B 14               (fig-forth-auto680):03258                 FCB     $14
+1B9C 1B36             (fig-forth-auto680):03259                 FDB     QERR
+1B9E 1662             (fig-forth-auto680):03260                 FDB     SEMIS
+                      (fig-forth-auto680):03261         *
+                      (fig-forth-auto680):03262         * ======>>  110  <<
+                      (fig-forth-auto680):03263         * Active BLK input:
+                      (fig-forth-auto680):03264         * ( --- )         ( *** )
+                      (fig-forth-auto680):03265         * No active BLK input:
+                      (fig-forth-auto680):03266         * ( --- IN BLK )          ( anything *** nothing )
+                      (fig-forth-auto680):03267         * ERROR if not loading, i. e., if BLK is zero.
+1BA0 88               (fig-forth-auto680):03268                 FCB     $88
+1BA1 3F4C4F4144494E   (fig-forth-auto680):03269                 FCC     '?LOADIN'       ; '?LOADING'
+1BA8 C7               (fig-forth-auto680):03270                 FCB     $C7
+1BA9 1B88             (fig-forth-auto680):03271                 FDB     QCSP-7
+1BAB 17B61903176F169E (fig-forth-auto680):03272         QLOAD   FDB     DOCOL,BLK,AT,ZEQU,LIT8
+     13A7
+1BB5 16               (fig-forth-auto680):03273                 FCB     $16
+1BB6 1B36             (fig-forth-auto680):03274                 FDB     QERR
+1BB8 1662             (fig-forth-auto680):03275                 FDB     SEMIS
+                      (fig-forth-auto680):03276         *
+                      (fig-forth-auto680):03277         * ######>> screen 41 <<
+                      (fig-forth-auto680):03278         * ======>>  111  <<
+                      (fig-forth-auto680):03279         * ( --- )
+                      (fig-forth-auto680):03280         * Compile an in-line literal value from the instruction stream.
+1BBA 87               (fig-forth-auto680):03281                 FCB     $87
+1BBB 434F4D50494C     (fig-forth-auto680):03282                 FCC     'COMPIL'        ; 'COMPILE'
+1BC1 C5               (fig-forth-auto680):03283                 FCB     $C5
+1BC2 1BA0             (fig-forth-auto680):03284                 FDB     QLOAD-11
+                      (fig-forth-auto680):03285         * COMPIL        FDB     DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
+                      (fig-forth-auto680):03286         * COMPIL        FDB     DOCOL,QCOMP,FROMR,NATP,DUP,TOR,AT,COMMA
+1BC4 17B61B50168B1742 (fig-forth-auto680):03287         COMPIL  FDB     DOCOL,QCOMP,FROMR,DUP,TOR,AT,COMMA
+     167C176F19E0
+1BD2 1662             (fig-forth-auto680):03288                 FDB     SEMIS
+                      (fig-forth-auto680):03289         *
+                      (fig-forth-auto680):03290         * ======>>  112  <<
+                      (fig-forth-auto680):03291         * ( --- )                                                 P
+                      (fig-forth-auto680):03292         * Clear the compile state bit(s) (shift to interpret).
+1BD4 C1               (fig-forth-auto680):03293                 FCB     $C1     [       immediate
+1BD5 DB               (fig-forth-auto680):03294                 FCB     $DB
+1BD6 1BBA             (fig-forth-auto680):03295                 FDB     COMPIL-10
+1BD8 17B6183A19551787 (fig-forth-auto680):03296         LBRAK   FDB     DOCOL,ZERO,STATE,STORE
+1BE0 1662             (fig-forth-auto680):03297                 FDB     SEMIS
+                      (fig-forth-auto680):03298         *
+                      (fig-forth-auto680):03299         * ======>>  113  <<
+                      (fig-forth-auto680):03300         * 
+     00C0             (fig-forth-auto680):03301         STCOMP  EQU     $C0
+                      (fig-forth-auto680):03302         * ( --- )
+                      (fig-forth-auto680):03303         * Set the compile state bit(s) (shift to compile).
+1BE2 81               (fig-forth-auto680):03304                 FCB     $81     ]
+1BE3 DD               (fig-forth-auto680):03305                 FCB     $DD
+1BE4 1BD4             (fig-forth-auto680):03306                 FDB     LBRAK-4
+1BE6 17B613A7         (fig-forth-auto680):03307         RBRAK   FDB     DOCOL,LIT8
+1BEA C0               (fig-forth-auto680):03308                 FCB     STCOMP
+1BEB 19551787         (fig-forth-auto680):03309                 FDB     STATE,STORE
+1BEF 1662             (fig-forth-auto680):03310                 FDB     SEMIS
+                      (fig-forth-auto680):03311         *
+                      (fig-forth-auto680):03312         * ======>>  114  <<
+                      (fig-forth-auto680):03313         * ( --- )
+                      (fig-forth-auto680):03314         * Toggle SMUDGE bit of LATEST definition header,
+                      (fig-forth-auto680):03315         * to hide it until defined or reveal it after definition.
+1BF1 86               (fig-forth-auto680):03316                 FCB     $86
+1BF2 534D554447       (fig-forth-auto680):03317                 FCC     'SMUDG' ; 'SMUDGE'
+1BF7 C5               (fig-forth-auto680):03318                 FCB     $C5
+1BF8 1BE2             (fig-forth-auto680):03319                 FDB     RBRAK-4
+1BFA 17B61ACD13A7     (fig-forth-auto680):03320         SMUDGE  FDB     DOCOL,LATEST,LIT8
+1C00 20               (fig-forth-auto680):03321                 FCB     FSMUDG
+1C01 1762             (fig-forth-auto680):03322                 FDB     TOGGLE
+1C03 1662             (fig-forth-auto680):03323                 FDB     SEMIS
+                      (fig-forth-auto680):03324         *
+                      (fig-forth-auto680):03325         * ======>>  115  <<
+                      (fig-forth-auto680):03326         * ( --- )
+                      (fig-forth-auto680):03327         * Set the conversion base to sixteen (b00010000).
+1C05 83               (fig-forth-auto680):03328                 FCB     $83
+1C06 4845             (fig-forth-auto680):03329                 FCC     'HE'    ; 'HEX'
+1C08 D8               (fig-forth-auto680):03330                 FCB     $D8
+1C09 1BF1             (fig-forth-auto680):03331                 FDB     SMUDGE-9
+1C0B 17B6             (fig-forth-auto680):03332         HEX     FDB     DOCOL
+1C0D 13A7             (fig-forth-auto680):03333                 FDB     LIT8
+1C0F 10               (fig-forth-auto680):03334                 FCB     16      ; decimal sixteen
+1C10 19601787         (fig-forth-auto680):03335                 FDB     BASE,STORE
+1C14 1662             (fig-forth-auto680):03336                 FDB     SEMIS
+                      (fig-forth-auto680):03337         *
+                      (fig-forth-auto680):03338         * ======>>  116  <<
+                      (fig-forth-auto680):03339         * ( --- )
+                      (fig-forth-auto680):03340         * Set the conversion base to ten (b00001010).
+1C16 87               (fig-forth-auto680):03341                 FCB     $87
+1C17 444543494D41     (fig-forth-auto680):03342                 FCC     'DECIMA'        ; 'DECIMAL'
+1C1D CC               (fig-forth-auto680):03343                 FCB     $CC
+1C1E 1C05             (fig-forth-auto680):03344                 FDB     HEX-6
+1C20 17B6             (fig-forth-auto680):03345         DEC     FDB     DOCOL
+1C22 13A7             (fig-forth-auto680):03346                 FDB     LIT8
+1C24 0A               (fig-forth-auto680):03347                 FCB     10      ; decimal ten
+1C25 19601787         (fig-forth-auto680):03348                 FDB     BASE,STORE
+1C29 1662             (fig-forth-auto680):03349                 FDB     SEMIS
+                      (fig-forth-auto680):03350         *
+                      (fig-forth-auto680):03351         * ######>> screen 42 <<
+                      (fig-forth-auto680):03352         * ======>>  117  <<
+                      (fig-forth-auto680):03353         * ( --- )         ( IP *** ) 
+                      (fig-forth-auto680):03354         * Pop the saved IP and use it to 
+                      (fig-forth-auto680):03355         * compile the latest symbol as a reference to a ;CODE definition;
+                      (fig-forth-auto680):03356         * overwrite the code field of the symbol found by LATEST
+                      (fig-forth-auto680):03357         * with the address of the low-level characteristic code
+                      (fig-forth-auto680):03358         * provided in the defining definition.
+                      (fig-forth-auto680):03359         * Look closely at where things return, consider the operation of R> and >R .
+                      (fig-forth-auto680):03360         *
+                      (fig-forth-auto680):03361         * The machine-level code which follows (;CODE) in the instruction stream
+                      (fig-forth-auto680):03362         * is not executed by the defining symbol,
+                      (fig-forth-auto680):03363         * but becomes the characteristic of the defined symbol. 
+                      (fig-forth-auto680):03364         * This is the usual way to generate the characteristics of VARIABLEs,
+                      (fig-forth-auto680):03365         * CONSTANTs, COLON definitions, etc., when FORTH compiles itself. 
+                      (fig-forth-auto680):03366         *
+                      (fig-forth-auto680):03367         * Finally, note that, if code shifts from low level back to high 
+                      (fig-forth-auto680):03368         * (native CPU machine code calling into a list of FORTH codes),
+                      (fig-forth-auto680):03369         * the low level code can't just call a high-level definition. 
+                      (fig-forth-auto680):03370         * Leaf definitions can directly call other leaf definitions, 
+                      (fig-forth-auto680):03371         * but not non-leafs.
+                      (fig-forth-auto680):03372         * It will need an anonymous list, probably embedded in the low-level code,
+                      (fig-forth-auto680):03373         * and Y and X will have to be set appropriately before entering the list.
+1C2B 87               (fig-forth-auto680):03374                 FCB     $87
+1C2C 283B434F4445     (fig-forth-auto680):03375                 FCC     '(;CODE'        ; '(;CODE)'
+1C32 A9               (fig-forth-auto680):03376                 FCB     $A9
+1C33 1C16             (fig-forth-auto680):03377                 FDB     DEC-10
+                      (fig-forth-auto680):03378         * PSCODE        FDB     DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
+1C35 17B6168B         (fig-forth-auto680):03379         PSCODE  FDB     DOCOL,FROMR     ; Y/IP is post-inc, needs no adjustment.
+1C39 1ACD1B0F1AEC1787 (fig-forth-auto680):03380                 FDB     LATEST,PFA,CFA,STORE
+1C41 1662             (fig-forth-auto680):03381                 FDB     SEMIS
+                      (fig-forth-auto680):03382         *
+                      (fig-forth-auto680):03383         * ======>>  118  <<
+                      (fig-forth-auto680):03384         * ( --- )                                                 P
+                      (fig-forth-auto680):03385         * ?CSP to see if there are loose ends in the defining definition
+                      (fig-forth-auto680):03386         * before shifting to the assembler,
+                      (fig-forth-auto680):03387         * compile (;CODE) in the defining definition's instruction stream,
+                      (fig-forth-auto680):03388         * shift to interpreting,
+                      (fig-forth-auto680):03389         * make the ASSEMBLER vocabulary current,
+                      (fig-forth-auto680):03390         * and !CSP to mark the stack
+                      (fig-forth-auto680):03391         * in preparation for assembling low-level code.
+                      (fig-forth-auto680):03392         * Note that ;CODE, unlike DOES>, is IMMEDIATE,
+                      (fig-forth-auto680):03393         * and compiles (;CODE),
+                      (fig-forth-auto680):03394         * which will do the actual work of changing
+                      (fig-forth-auto680):03395         * the LATEST definition's characteristic when the defining word runs.
+                      (fig-forth-auto680):03396         * Assembly is done by the interpreter, rather than the compiler.
+                      (fig-forth-auto680):03397         * I could have avoided the anomalous three-byte code fields by
+                      (fig-forth-auto680):03398         *
+                      (fig-forth-auto680):03399         * Note that the ASSEMBLER is not part of the model (at this time).
+                      (fig-forth-auto680):03400         * That means that, until the assembler is ready, 
+                      (fig-forth-auto680):03401         * if you want to define low-level words,
+                      (fig-forth-auto680):03402         * you have to poke (comma) in hand-assembled stuff.
+                      (fig-forth-auto680):03403         *
+1C43 C5               (fig-forth-auto680):03404                 FCB     $C5     immediate
+1C44 3B434F44         (fig-forth-auto680):03405                 FCC     ';COD'  ; ';CODE'
+1C48 C5               (fig-forth-auto680):03406                 FCB     $C5
+1C49 1C2B             (fig-forth-auto680):03407                 FDB     PSCODE-10
+1C4B 17B61B8F1BC41C35 (fig-forth-auto680):03408         SEMIC   FDB     DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
+     1BFA1BD81D56
+1C59 1662             (fig-forth-auto680):03409                 FDB     SEMIS
+                      (fig-forth-auto680):03410         * note: "QSTACK" will be replaced by "ASSEMBLER" later
+                      (fig-forth-auto680):03411         *
+                      (fig-forth-auto680):03412         * ######>> screen 43 <<
+                      (fig-forth-auto680):03413         * ======>>  119  <<
+                      (fig-forth-auto680):03414         * ( --- )                                                 C
+                      (fig-forth-auto680):03415         * Make the word currently being defined
+                      (fig-forth-auto680):03416         * build a header for DOES> definitions. 
+                      (fig-forth-auto680):03417         * Actually just compiles a CONSTANT zero
+                      (fig-forth-auto680):03418         * which can be overwritten later by DOES>.
+                      (fig-forth-auto680):03419         * Since the fig models were established, this technique has been deprecated.
+                      (fig-forth-auto680):03420         *
+                      (fig-forth-auto680):03421         * Note that <BUILDS is not IMMEDIATE,
+                      (fig-forth-auto680):03422         * and therefore executes during a definition's run-time,
+                      (fig-forth-auto680):03423         * rather than its compile-time. 
+                      (fig-forth-auto680):03424         * It is not intended to be used directly,
+                      (fig-forth-auto680):03425         * but rather so that one definition word can build another. 
+                      (fig-forth-auto680):03426         * Also, note that nothing particularly special happens
+                      (fig-forth-auto680):03427         * in the defining definition until DOES> executes. 
+                      (fig-forth-auto680):03428         * The name <BUILDS is intended to be a reminder of what is about to occur.
+                      (fig-forth-auto680):03429         *
+                      (fig-forth-auto680):03430         * <BUILDS probably should have compiled an ERROR instead of a ZERO CONSTANT.
+1C5B 87               (fig-forth-auto680):03431                 FCB     $87
+1C5C 3C4255494C44     (fig-forth-auto680):03432                 FCC     '<BUILD'        ; '<BUILDS'
+1C62 D3               (fig-forth-auto680):03433                 FCB     $D3
+1C63 1C43             (fig-forth-auto680):03434                 FDB     SEMIC-8
+1C65 17B6183A17DC     (fig-forth-auto680):03435         BUILDS  FDB     DOCOL,ZERO,CON
+1C6B 1662             (fig-forth-auto680):03436                 FDB     SEMIS
+                      (fig-forth-auto680):03437         *
+                      (fig-forth-auto680):03438         * ======>>  120  <<
+                      (fig-forth-auto680):03439         * ( --- )         ( IP *** )                              C
+                      (fig-forth-auto680):03440         * Define run-time behavior of definitions compiled/defined
+                      (fig-forth-auto680):03441         * by a high-level defining definition --
+                      (fig-forth-auto680):03442         * the FORTH equivalent of a compiler-compiler. 
+                      (fig-forth-auto680):03443         * DOES> assumes that the LATEST symbol table entry
+                      (fig-forth-auto680):03444         * has at least one word of parameter field,
+                      (fig-forth-auto680):03445         * which <BUILDS provides. 
+                      (fig-forth-auto680):03446         * Note that DOES> is also not IMMEDIATE. 
+                      (fig-forth-auto680):03447         *
+                      (fig-forth-auto680):03448         * When the defining word containing DOES> executes the DOES> icode,
+                      (fig-forth-auto680):03449         * it overwrites the LATEST symbol's CFA with jsr <XDOES,
+                      (fig-forth-auto680):03450         * overwrites the first word of that symbol's parameter field with its own IP,
+                      (fig-forth-auto680):03451         * and pops the previous IP from the return stack.
+                      (fig-forth-auto680):03452         * The icodes which follow DOES> in the stream
+                      (fig-forth-auto680):03453         * do not execute at the defining word's run-time.
+                      (fig-forth-auto680):03454         *
+                      (fig-forth-auto680):03455         * Examining XDOES in the virtual machine shows
+                      (fig-forth-auto680):03456         * that the defined word will execute those icodes
+                      (fig-forth-auto680):03457         * which follow DOES> at its own run-time. 
+                      (fig-forth-auto680):03458         *
+                      (fig-forth-auto680):03459         * The advantage of this kind of behaviour,
+                      (fig-forth-auto680):03460         * which you will also note in ;CODE,
+                      (fig-forth-auto680):03461         * is that the defined word can contain
+                      (fig-forth-auto680):03462         * both operations and data to be operated on. 
+                      (fig-forth-auto680):03463         * This is how FORTH data objects define their own behavior. 
+                      (fig-forth-auto680):03464         *
+                      (fig-forth-auto680):03465         * Finally, note that the effective parameter field for DOES> definitions
+                      (fig-forth-auto680):03466         * starts two NATWID words after the CFA, instead of just one
+                      (fig-forth-auto680):03467         * (four bytes instead of two in a sixteen-bit addressing Forth).
+                      (fig-forth-auto680):03468         *
+                      (fig-forth-auto680):03469         * VOCABULARYs will use this. See definition of word FORTH.
+1C6D 85               (fig-forth-auto680):03470                 FCB     $85
+1C6E 444F4553         (fig-forth-auto680):03471                 FCC     'DOES'  ; 'DOES>'
+1C72 BE               (fig-forth-auto680):03472                 FCB     $BE
+1C73 1C5B             (fig-forth-auto680):03473                 FDB     BUILDS-10
+                      (fig-forth-auto680):03474         * DOES  FDB     DOCOL,FROMR,TWOP,LATEST,PFA,STORE
+1C75 17B6168B         (fig-forth-auto680):03475         DOES    FDB     DOCOL,FROMR     ; Y/IP is post-inc, needs no adjustment.
+1C79 1ACD1B0F1787     (fig-forth-auto680):03476                 FDB     LATEST,PFA,STORE
+1C7F 1C35             (fig-forth-auto680):03477                 FDB     PSCODE
+                      (fig-forth-auto680):03478         *
+                      (fig-forth-auto680):03479         * ( --- PFA+NATWID )     ( *** IP )
+                      (fig-forth-auto680):03480         * Characteristic of a DOES> defined word. 
+                      (fig-forth-auto680):03481         * The characteristics of DOES> definitions are written in high-level
+                      (fig-forth-auto680):03482         * Forth codes rather than native CPU machine level code.
+                      (fig-forth-auto680):03483         * The first parameter word points to the high-level characteristic. 
+                      (fig-forth-auto680):03484         * This routine's job is to push the IP,
+                      (fig-forth-auto680):03485         * load the high level characteristic pointer in IP,
+                      (fig-forth-auto680):03486         * and leave the address following the characteristic pointer on the stack
+                      (fig-forth-auto680):03487         * so the parameter field can be accessed.
+1C81 ECE4             (fig-forth-auto680):03488         DODOES  LDD     ,S      ; Keep the return address.
+1C83 10AFE4           (fig-forth-auto680):03489                 STY     ,S      ; Save/nest the current IP on the return stack.
+1C86 10AE02           (fig-forth-auto680):03490                 LDY     NATWID,X        ; First parameter is new IP.
+1C89 3004             (fig-forth-auto680):03491                 LEAX    2*NATWID,X      ; Address of second parameter.
+1C8B 3610             (fig-forth-auto680):03492                 PSHU    X
+1C8D 1F05             (fig-forth-auto680):03493                 TFR     D,PC    ; Synthetic return.
+                      (fig-forth-auto680):03494         *
+                      (fig-forth-auto680):03495         * From the 6800 model:
+                      (fig-forth-auto680):03496         * DODOES        LDA IP
+                      (fig-forth-auto680):03497         *       LDB IP+1
+                      (fig-forth-auto680):03498         *       LDX     RP      make room on return stack
+                      (fig-forth-auto680):03499         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):03500         *       LEAX -1,X       ; 
+                      (fig-forth-auto680):03501         *       STX     RP
+                      (fig-forth-auto680):03502         *       STA 2,X push return address
+                      (fig-forth-auto680):03503         *       STB 3,X
+                      (fig-forth-auto680):03504         *       LDX     W       get addr of pointer to run-time code
+                      (fig-forth-auto680):03505         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):03506         *       LEAX 1,X        ; 
+                      (fig-forth-auto680):03507         *       STX     N       stash it in scratch area
+                      (fig-forth-auto680):03508         *       LDX     0,X     get new IP
+                      (fig-forth-auto680):03509         *       STX     IP
+                      (fig-forth-auto680):03510         *       CLRA    ;               get address of parameter
+                      (fig-forth-auto680):03511         *       LDB #2
+                      (fig-forth-auto680):03512         *       ADDB N+1
+                      (fig-forth-auto680):03513         *       ADCA N
+                      (fig-forth-auto680):03514         *       PSHS B  ; and push it on data stack
+                      (fig-forth-auto680):03515         *       PSHS A  ; 
+                      (fig-forth-auto680):03516         *       JMP     NEXT2
+                      (fig-forth-auto680):03517         *
+                      (fig-forth-auto680):03518         * ######>> screen 44 <<
+                      (fig-forth-auto680):03519         * ======>>  121  <<
+                      (fig-forth-auto680):03520         * ( strptr --- strptr+1 count )
+                      (fig-forth-auto680):03521         * Convert counted string to string and count. 
+                      (fig-forth-auto680):03522         * (Fetch the byte at strptr, post-increment.)
+1C8F 85               (fig-forth-auto680):03523                 FCB     $85
+1C90 434F554E         (fig-forth-auto680):03524                 FCC     'COUN'  ; 'COUNT'
+1C94 D4               (fig-forth-auto680):03525                 FCB     $D4
+1C95 1C6D             (fig-forth-auto680):03526                 FDB     DOES-8
+1C97 17B6174219A81733 (fig-forth-auto680):03527         COUNT   FDB     DOCOL,DUP,ONEP,SWAP,CAT
+     177B
+1CA1 1662             (fig-forth-auto680):03528                 FDB     SEMIS
+                      (fig-forth-auto680):03529         *
+                      (fig-forth-auto680):03530         * ======>>  122  <<
+                      (fig-forth-auto680):03531         * ( strptr count --- )
+                      (fig-forth-auto680):03532         * EMIT count characters at strptr.
+1CA3 84               (fig-forth-auto680):03533                 FCB     $84
+1CA4 545950           (fig-forth-auto680):03534                 FCC     'TYP'   ; 'TYPE'
+1CA7 C5               (fig-forth-auto680):03535                 FCB     $C5
+1CA8 1C8F             (fig-forth-auto680):03536                 FDB     COUNT-8
+1CAA 17B61A871409     (fig-forth-auto680):03537         TYPE    FDB     DOCOL,DDUP,ZBRAN
+1CB0 0016             (fig-forth-auto680):03538                 FDB     TYPE3-*-NATWID
+1CB2 171716C117331453 (fig-forth-auto680):03539                 FDB     OVER,PLUS,SWAP,XDO
+1CBA 1465177B1541141D (fig-forth-auto680):03540         TYPE2   FDB     I,CAT,EMIT,XLOOP
+1CC2 FFF6             (fig-forth-auto680):03541                 FDB     TYPE2-*-NATWID
+1CC4 13FA             (fig-forth-auto680):03542                 FDB     BRAN
+1CC6 0002             (fig-forth-auto680):03543                 FDB     TYPE4-*-NATWID
+1CC8 1725             (fig-forth-auto680):03544         TYPE3   FDB     DROP
+1CCA 1662             (fig-forth-auto680):03545         TYPE4   FDB     SEMIS
+                      (fig-forth-auto680):03546         *
+                      (fig-forth-auto680):03547         * ======>>  123  <<
+                      (fig-forth-auto680):03548         * ( strptr count1 --- strptr count2 )
+                      (fig-forth-auto680):03549         * Supress trailing blanks (subtract count of trailing blanks from strptr).
+1CCC 89               (fig-forth-auto680):03550                 FCB     $89
+1CCD 2D545241494C494E (fig-forth-auto680):03551                 FCC     '-TRAILIN'      ; '-TRAILING'
+1CD5 C7               (fig-forth-auto680):03552                 FCB     $C7
+1CD6 1CA3             (fig-forth-auto680):03553                 FDB     TYPE-7
+1CD8 17B61742183A1453 (fig-forth-auto680):03554         DTRAIL  FDB     DOCOL,DUP,ZERO,XDO
+1CE0 1717171716C11842 (fig-forth-auto680):03555         DTRAL2  FDB     OVER,OVER,PLUS,ONE,SUB,CAT,BL
+     1A01177B185B
+1CEE 1A011409         (fig-forth-auto680):03556                 FDB     SUB,ZBRAN
+1CF2 0006             (fig-forth-auto680):03557                 FDB     DTRAL3-*-NATWID
+1CF4 167013FA         (fig-forth-auto680):03558                 FDB     LEAVE,BRAN
+1CF8 0004             (fig-forth-auto680):03559                 FDB     DTRAL4-*-NATWID
+1CFA 18421A01         (fig-forth-auto680):03560         DTRAL3  FDB     ONE,SUB
+1CFE 141D             (fig-forth-auto680):03561         DTRAL4  FDB     XLOOP
+1D00 FFDE             (fig-forth-auto680):03562                 FDB     DTRAL2-*-NATWID
+1D02 1662             (fig-forth-auto680):03563                 FDB     SEMIS
+                      (fig-forth-auto680):03564         *
+                      (fig-forth-auto680):03565         * ======>>  124  <<
+                      (fig-forth-auto680):03566         * ( --- ) 
+                      (fig-forth-auto680):03567         * TYPE counted string out of instruction stream (updating IP).
+1D04 84               (fig-forth-auto680):03568                 FCB     $84
+1D05 282E22           (fig-forth-auto680):03569                 FCC     '(."'   ; '(.")'
+1D08 A9               (fig-forth-auto680):03570                 FCB     $A9
+1D09 1CCC             (fig-forth-auto680):03571                 FDB     DTRAIL-12
+                      (fig-forth-auto680):03572         * PDOTQ FDB     DOCOL,R,TWOP,COUNT,DUP,ONEP
+                      (fig-forth-auto680):03573         * PDOTQ FDB     DOCOL,R,NATP,COUNT,DUP,ONEP
+1D0B 17B616971C971742 (fig-forth-auto680):03574         PDOTQ   FDB     DOCOL,R,COUNT,DUP,ONEP
+     19A8
+1D15 168B16C1167C1CAA (fig-forth-auto680):03575                 FDB     FROMR,PLUS,TOR,TYPE
+1D1D 1662             (fig-forth-auto680):03576                 FDB     SEMIS
+                      (fig-forth-auto680):03577         *
+                      (fig-forth-auto680):03578         * ======>>  125  <<
+                      (fig-forth-auto680):03579         * ( --- )                                                 P
+                      (fig-forth-auto680):03580         * { ." something-to-be-printed " } typical input
+                      (fig-forth-auto680):03581         * Use WORD to parse to trailing quote;
+                      (fig-forth-auto680):03582         * if compiling, compile XDOTQ and string parsed,
+                      (fig-forth-auto680):03583         * otherwise, TYPE string.
+1D1F C2               (fig-forth-auto680):03584                 FCB     $C2     immediate
+1D20 2E               (fig-forth-auto680):03585                 FCC     '.'     ; '."'
+1D21 A2               (fig-forth-auto680):03586                 FCB     $A2
+1D22 1D04             (fig-forth-auto680):03587                 FDB     PDOTQ-7
+1D24 17B6             (fig-forth-auto680):03588         DOTQ    FDB     DOCOL
+1D26 13A7             (fig-forth-auto680):03589                 FDB     LIT8
+1D28 22               (fig-forth-auto680):03590                 FCB     $22     ascii quote
+1D29 1955176F1409     (fig-forth-auto680):03591                 FDB     STATE,AT,ZBRAN
+1D2F 0012             (fig-forth-auto680):03592                 FDB     DOTQ1-*-NATWID
+1D31 1BC41D0B1EBB     (fig-forth-auto680):03593                 FDB     COMPIL,PDOTQ,WORD
+1D37 19C4177B19A819D4 (fig-forth-auto680):03594                 FDB     HERE,CAT,ONEP,ALLOT,BRAN
+     13FA
+1D41 0008             (fig-forth-auto680):03595                 FDB     DOTQ2-*-NATWID
+1D43 1EBB19C41C971CAA (fig-forth-auto680):03596         DOTQ1   FDB     WORD,HERE,COUNT,TYPE
+1D4B 1662             (fig-forth-auto680):03597         DOTQ2   FDB     SEMIS
+                      (fig-forth-auto680):03598         *
+                      (fig-forth-auto680):03599         * ######>> screen 45 <<
+                      (fig-forth-auto680):03600         * ======>>  126  <<== MACHINE DEPENDENT
+                      (fig-forth-auto680):03601         * ( --- )                 ( *** )
+                      (fig-forth-auto680):03602         * ( --- IN BLK )          ( anything *** nothing )
+                      (fig-forth-auto680):03603         * ERROR if parameter stack out of bounds.
+                      (fig-forth-auto680):03604         * 
+                      (fig-forth-auto680):03605         * But checking whether the stack is in bounds or not
+                      (fig-forth-auto680):03606         * really should not use the stack.
+                      (fig-forth-auto680):03607         * And there really should be a ?RSTACK, as well.
+1D4D 86               (fig-forth-auto680):03608                 FCB     $86
+1D4E 3F53544143       (fig-forth-auto680):03609                 FCC     '?STAC' ; '?STACK'
+1D53 CB               (fig-forth-auto680):03610                 FCB     $CB
+1D54 1D1F             (fig-forth-auto680):03611                 FDB     DOTQ-5
+1D56 17B613A7         (fig-forth-auto680):03612         QSTACK  FDB     DOCOL,LIT8
+                      (fig-forth-auto680):03613         *       FCB     $12
+1D5A 12               (fig-forth-auto680):03614                 FCB     SINIT-ORIG
+                      (fig-forth-auto680):03615         * But why use that instead of XSPZER (S0)?
+                      (fig-forth-auto680):03616         * Multi-user or multi-tasking would not want that.
+                      (fig-forth-auto680):03617         *       CMPU    <XSPZER 
+                      (fig-forth-auto680):03618         *       FDB     PORIG,AT,TWO,SUB,SPAT,LESS,ONE
+1D5B 1899176F163B1A1A (fig-forth-auto680):03619                 FDB     PORIG,AT,SPAT,LESS,ONE  ; Not post-decrement push.
+     1842
+1D65 1B36             (fig-forth-auto680):03620                 FDB     QERR
+                      (fig-forth-auto680):03621         * prints 'empty stack'
+                      (fig-forth-auto680):03622         *
+1D67 163B             (fig-forth-auto680):03623         QSTAC2  FDB     SPAT
+                      (fig-forth-auto680):03624         * Here, we compare with a value at least 128
+                      (fig-forth-auto680):03625         * higher than dict. ptr. (DICTPT)
+1D69 19C413A7         (fig-forth-auto680):03626                 FDB     HERE,LIT8
+1D6D 80               (fig-forth-auto680):03627                 FCB     $80     ; This is a rough check anyway, leave it as is.
+1D6E 16C11A1A1409     (fig-forth-auto680):03628                 FDB     PLUS,LESS,ZBRAN
+1D74 0004             (fig-forth-auto680):03629                 FDB     QSTAC3-*-NATWID
+1D76 184A             (fig-forth-auto680):03630                 FDB     TWO     ; NOT the NATWID constant!
+1D78 1B36             (fig-forth-auto680):03631                 FDB     QERR
+                      (fig-forth-auto680):03632         * prints 'full stack'
+                      (fig-forth-auto680):03633         *
+1D7A 1662             (fig-forth-auto680):03634         QSTAC3  FDB     SEMIS
+                      (fig-forth-auto680):03635         *
+                      (fig-forth-auto680):03636         * ======>>  127  <<     this word's function
+                      (fig-forth-auto680):03637         *           is done by ?STACK in this version
+                      (fig-forth-auto680):03638         *       FCB     $85
+                      (fig-forth-auto680):03639         *       FCC     4,?FREE
+                      (fig-forth-auto680):03640         *       FCB     $C5
+                      (fig-forth-auto680):03641         *       FDB     QSTACK-9
+                      (fig-forth-auto680):03642         *QFREE  FDB     DOCOL,SPAT,HERE,LIT8
+                      (fig-forth-auto680):03643         *       FCB     $80
+                      (fig-forth-auto680):03644         *       FDB     PLUS,LESS,TWO,QERR,SEMIS        ; This TWO is not NATWID!
+                      (fig-forth-auto680):03645         *
+                      (fig-forth-auto680):03646         * ######>> screen 46 <<
+                      (fig-forth-auto680):03647         * ======>>  128  <<
+                      (fig-forth-auto680):03648         * ( buffer n --- )
+                      (fig-forth-auto680):03649         * ***** Check that this is how it works here:
+                      (fig-forth-auto680):03650         * Get up to n-1 characters from the keyboard,
+                      (fig-forth-auto680):03651         * storing at buffer and echoing, with backspace editing,
+                      (fig-forth-auto680):03652         * quitting when a CR is read.
+                      (fig-forth-auto680):03653         * Terminate it with a NUL.
+1D7C 86               (fig-forth-auto680):03654                 FCB     $86
+1D7D 4558504543       (fig-forth-auto680):03655                 FCC     'EXPEC' ; 'EXPECT'
+1D82 D4               (fig-forth-auto680):03656                 FCB     $D4
+1D83 1D4D             (fig-forth-auto680):03657                 FDB     QSTACK-9
+1D85 17B6171716C11717 (fig-forth-auto680):03658         EXPECT  FDB     DOCOL,OVER,PLUS,OVER,XDO        ; brace the buffer area
+     1453
+                      (fig-forth-auto680):03659         * EXPEC2        FDB     KEY,DUP,LIT8
+1D8F 1555             (fig-forth-auto680):03660         EXPEC2  FDB     KEY
+1D91 1399001C13B9     (fig-forth-auto680):03661                 FDB     LIT,$1C,SHOTOS  ; DBG
+1D97 174213A7         (fig-forth-auto680):03662                 FDB     DUP,LIT8
+1D9B 0E               (fig-forth-auto680):03663                 FCB     BACKSP-ORIG
+1D9C 1899176F1A0E1409 (fig-forth-auto680):03664                 FDB     PORIG,AT,EQUAL,ZBRAN    ; check for backspacing 
+1DA4 001D             (fig-forth-auto680):03665                 FDB     EXPEC3-*-NATWID
+1DA6 172513A7         (fig-forth-auto680):03666                 FDB     DROP,LIT8
+1DAA 08               (fig-forth-auto680):03667                 FCB     8       ( backspace character to emit )
+1DAB 171714651A0E1742 (fig-forth-auto680):03668                 FDB     OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS     ; back I up TWO characters 
+     168B184A1A0116C1
+1DBB 167C1A0113FA     (fig-forth-auto680):03669                 FDB     TOR,SUB,BRAN
+1DC1 0025             (fig-forth-auto680):03670                 FDB     EXPEC6-*-NATWID
+1DC3 174213A7         (fig-forth-auto680):03671         EXPEC3  FDB     DUP,LIT8
+1DC7 0D               (fig-forth-auto680):03672                 FCB     $D      ( carriage return )
+1DC8 1A0E1409         (fig-forth-auto680):03673                 FDB     EQUAL,ZBRAN
+1DCC 000C             (fig-forth-auto680):03674                 FDB     EXPEC4-*-NATWID
+1DCE 16701725185B183A (fig-forth-auto680):03675                 FDB     LEAVE,DROP,BL,ZERO,BRAN ; I think this is the NUL terminator.
+     13FA
+1DD8 0002             (fig-forth-auto680):03676                 FDB     EXPEC5-*-NATWID
+1DDA 1742             (fig-forth-auto680):03677         EXPEC4  FDB     DUP
+1DDC 14651795183A1465 (fig-forth-auto680):03678         EXPEC5  FDB     I,CSTORE,ZERO,I,ONEP,STORE
+     19A81787
+1DE8 1541141D         (fig-forth-auto680):03679         EXPEC6  FDB     EMIT,XLOOP
+1DEC FFA1             (fig-forth-auto680):03680                 FDB     EXPEC2-*-NATWID
+1DEE 1725             (fig-forth-auto680):03681                 FDB     DROP
+1DF0 1662             (fig-forth-auto680):03682                 FDB     SEMIS
+                      (fig-forth-auto680):03683         *
+                      (fig-forth-auto680):03684         * ======>>  129  <<
+                      (fig-forth-auto680):03685         * ( --- )
+                      (fig-forth-auto680):03686         * EXPECT 128 (TWID) characters to TIB.
+1DF2 85               (fig-forth-auto680):03687                 FCB     $85
+1DF3 51554552         (fig-forth-auto680):03688                 FCC     'QUER'  ; 'QUERY'
+1DF7 D9               (fig-forth-auto680):03689                 FCB     $D9
+1DF8 1D7C             (fig-forth-auto680):03690                 FDB     EXPECT-9
+1DFA 17B618BB176F199F (fig-forth-auto680):03691         QUERY   FDB     DOCOL,TIB,AT,COLUMS
+1E02 176F1D8513DC183A (fig-forth-auto680):03692                 FDB     AT,EXPECT,TRON,ZERO,IN,STORE,TROFF
+     190C178713D0
+1E10 1662             (fig-forth-auto680):03693                 FDB     SEMIS
+                      (fig-forth-auto680):03694         *
+                      (fig-forth-auto680):03695         * ======>>  130  <<
+                      (fig-forth-auto680):03696         * ( --- )                                                 P
+                      (fig-forth-auto680):03697         * End interpretation of a line or screen, and/or prepare for a new block. 
+                      (fig-forth-auto680):03698         * Note that the name of this definition is an empty string,
+                      (fig-forth-auto680):03699         * so it matches on the terminating NUL in the terminal or block buffer.
+1E12 C1               (fig-forth-auto680):03700                 FCB     $C1     immediate       < carriage return >
+1E13 80               (fig-forth-auto680):03701                 FCB     $80
+1E14 1DF2             (fig-forth-auto680):03702                 FDB     QUERY-8
+1E16 17B61903176F1409 (fig-forth-auto680):03703         NULL    FDB     DOCOL,BLK,AT,ZBRAN
+1E1E 0024             (fig-forth-auto680):03704                 FDB     NULL2-*-NATWID
+1E20 18421903174E     (fig-forth-auto680):03705                 FDB     ONE,BLK,PSTORE
+1E26 183A190C17871903 (fig-forth-auto680):03706                 FDB     ZERO,IN,STORE,BLK,AT,BSCR,MOD
+     176F188B2334
+1E34 169E             (fig-forth-auto680):03707                 FDB     ZEQU
+                      (fig-forth-auto680):03708         *     check for end of screen
+1E36 1409             (fig-forth-auto680):03709                 FDB     ZBRAN
+1E38 0006             (fig-forth-auto680):03710                 FDB     NULL1-*-NATWID
+1E3A 1B67168B1725     (fig-forth-auto680):03711                 FDB     QEXEC,FROMR,DROP
+1E40 13FA             (fig-forth-auto680):03712         NULL1   FDB     BRAN
+1E42 0004             (fig-forth-auto680):03713                 FDB     NULL3-*-NATWID
+1E44 168B1725         (fig-forth-auto680):03714         NULL2   FDB     FROMR,DROP
+1E48 1662             (fig-forth-auto680):03715         NULL3   FDB     SEMIS
+                      (fig-forth-auto680):03716         *
+                      (fig-forth-auto680):03717         * ######>> screen 47 <<
+                      (fig-forth-auto680):03718         * ======>>  133  <<
+                      (fig-forth-auto680):03719         * ( adr n b --- )
+                      (fig-forth-auto680):03720         * Fill n bytes at adr with b.
+1E4A 84               (fig-forth-auto680):03721                 FCB     $84
+1E4B 46494C           (fig-forth-auto680):03722                 FCC     'FIL'   ; 'FILL'
+1E4E CC               (fig-forth-auto680):03723                 FCB     $CC
+1E4F 1E12             (fig-forth-auto680):03724                 FDB     NULL-4
+1E51 17B61733167C1717 (fig-forth-auto680):03725         FILL    FDB     DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
+     1795174219A8
+1E5F 168B18421A011583 (fig-forth-auto680):03726                 FDB     FROMR,ONE,SUB,CMOVE
+1E67 1662             (fig-forth-auto680):03727                 FDB     SEMIS
+                      (fig-forth-auto680):03728         *
+                      (fig-forth-auto680):03729         * ======>>  134  <<
+                      (fig-forth-auto680):03730         * ( adr n --- )
+                      (fig-forth-auto680):03731         * Fill n bytes with 0.
+1E69 85               (fig-forth-auto680):03732                 FCB     $85
+1E6A 45524153         (fig-forth-auto680):03733                 FCC     'ERAS'  ; 'ERASE'
+1E6E C5               (fig-forth-auto680):03734                 FCB     $C5
+1E6F 1E4A             (fig-forth-auto680):03735                 FDB     FILL-7
+1E71 17B6183A1E51     (fig-forth-auto680):03736         ERASE   FDB     DOCOL,ZERO,FILL
+1E77 1662             (fig-forth-auto680):03737                 FDB     SEMIS
+                      (fig-forth-auto680):03738         *
+                      (fig-forth-auto680):03739         * ======>>  135  <<
+                      (fig-forth-auto680):03740         * ( adr n --- )
+                      (fig-forth-auto680):03741         * Fill n bytes with ASCII SPACE.
+1E79 86               (fig-forth-auto680):03742                 FCB     $86
+1E7A 424C414E4B       (fig-forth-auto680):03743                 FCC     'BLANK' ; 'BLANKS'
+1E7F D3               (fig-forth-auto680):03744                 FCB     $D3
+1E80 1E69             (fig-forth-auto680):03745                 FDB     ERASE-8
+1E82 17B6185B1E51     (fig-forth-auto680):03746         BLANKS  FDB     DOCOL,BL,FILL
+1E88 1662             (fig-forth-auto680):03747                 FDB     SEMIS
+                      (fig-forth-auto680):03748         *
+                      (fig-forth-auto680):03749         * ======>>  136  <<
+                      (fig-forth-auto680):03750         * ( c --- )
+                      (fig-forth-auto680):03751         * Format a character at the left of the HLD output buffer.
+1E8A 84               (fig-forth-auto680):03752                 FCB     $84
+1E8B 484F4C           (fig-forth-auto680):03753                 FCC     'HOL'   ; 'HOLD'
+1E8E C4               (fig-forth-auto680):03754                 FCB     $C4
+1E8F 1E79             (fig-forth-auto680):03755                 FDB     BLANKS-9
+1E91 17B61399FFFF1991 (fig-forth-auto680):03756         HOLD    FDB     DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
+     174E1991176F1795
+1EA1 1662             (fig-forth-auto680):03757                 FDB     SEMIS
+                      (fig-forth-auto680):03758         *
+                      (fig-forth-auto680):03759         * ======>>  137  <<
+                      (fig-forth-auto680):03760         * ( --- adr )
+                      (fig-forth-auto680):03761         * Give the address of the output PAD buffer. 
+                      (fig-forth-auto680):03762         * PAD points to the end of a 68 byte buffer for numeric conversion.
+1EA3 83               (fig-forth-auto680):03763                 FCB     $83
+1EA4 5041             (fig-forth-auto680):03764                 FCC     'PA'    ; 'PAD'
+1EA6 C4               (fig-forth-auto680):03765                 FCB     $C4
+1EA7 1E8A             (fig-forth-auto680):03766                 FDB     HOLD-7
+1EA9 17B619C413A7     (fig-forth-auto680):03767         PAD     FDB     DOCOL,HERE,LIT8
+1EAF 44               (fig-forth-auto680):03768                 FCB     $44
+1EB0 16C1             (fig-forth-auto680):03769                 FDB     PLUS
+1EB2 1662             (fig-forth-auto680):03770                 FDB     SEMIS
+                      (fig-forth-auto680):03771         *
+                      (fig-forth-auto680):03772         * ######>> screen 48 <<
+                      (fig-forth-auto680):03773         * ======>>  138  <<
+                      (fig-forth-auto680):03774         * ( c --- )
+                      (fig-forth-auto680):03775         * Scan a string terminated by the character c or ASCII NUL out of input;
+                      (fig-forth-auto680):03776         * store symbol at WORDPAD with leading count byte and trailing ASCII NUL. 
+                      (fig-forth-auto680):03777         * Leading c are passed over, per ENCLOSE.
+                      (fig-forth-auto680):03778         * Scans from BLK, or from TIB if BLK is zero. 
+                      (fig-forth-auto680):03779         * May overwrite the numeric conversion pad,
+                      (fig-forth-auto680):03780         * if really long (length > 31) symbols are scanned.
+1EB4 84               (fig-forth-auto680):03781                 FCB     $84
+1EB5 574F52           (fig-forth-auto680):03782                 FCC     'WOR'   ; 'WORD'
+1EB8 C4               (fig-forth-auto680):03783                 FCB     $C4
+1EB9 1EA3             (fig-forth-auto680):03784                 FDB     PAD-6
+1EBB 17B61903176F1409 (fig-forth-auto680):03785         WORD    FDB     DOCOL,BLK,AT,ZBRAN
+1EC3 000A             (fig-forth-auto680):03786                 FDB     WORD2-*-NATWID
+1EC5 1903176F249113FA (fig-forth-auto680):03787                 FDB     BLK,AT,BLOCK,BRAN
+1ECD 0004             (fig-forth-auto680):03788                 FDB     WORD3-*-NATWID
+1ECF 18BB176F         (fig-forth-auto680):03789         WORD2   FDB     TIB,AT
+1ED3 190C176F16C11733 (fig-forth-auto680):03790         WORD3   FDB     IN,AT,PLUS,SWAP,ENCLOS,HERE,LIT8
+     14FD19C413A7
+1EE1 22               (fig-forth-auto680):03791                 FCB     34
+1EE2 1E82190C174E1717 (fig-forth-auto680):03792                 FDB     BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
+     1A01167C169719C4
+1EF2 179516C119C419A8 (fig-forth-auto680):03793                 FDB     CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
+     168B1583
+1EFE 1662             (fig-forth-auto680):03794                 FDB     SEMIS
+                      (fig-forth-auto680):03795         *
+                      (fig-forth-auto680):03796         * ######>> screen 49 <<
+                      (fig-forth-auto680):03797         * ======>>  139  <<
+                      (fig-forth-auto680):03798         * ( d1 string --- d2 adr )
+                      (fig-forth-auto680):03799         * Convert the text at string into a number, accumulating the result into d1,
+                      (fig-forth-auto680):03800         * leaving adr pointing to the first character not converted. 
+                      (fig-forth-auto680):03801         * If DPL is non-negative at entry,
+                      (fig-forth-auto680):03802         * accumulates the number of characters converted into DPL.
+1F00 88               (fig-forth-auto680):03803                 FCB     $88
+1F01 284E554D424552   (fig-forth-auto680):03804                 FCC     '(NUMBER'       ; '(NUMBER)'
+1F08 A9               (fig-forth-auto680):03805                 FCB     $A9
+1F09 1EB4             (fig-forth-auto680):03806                 FDB     WORD-7
+1F0B 17B6             (fig-forth-auto680):03807         PNUMB   FDB     DOCOL
+1F0D 19A81742167C177B (fig-forth-auto680):03808         PNUMB2  FDB     ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
+     1960176F14741409
+1F1D 002A             (fig-forth-auto680):03809                 FDB     PNUMB4-*-NATWID
+1F1F 17331960176F15A0 (fig-forth-auto680):03810                 FDB     SWAP,BASE,AT,USTAR,DROP,ROT,BASE
+     17251A401960
+1F2D 176F15A016CF196A (fig-forth-auto680):03811                 FDB     AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
+     176F19A81409
+1F3B 0006             (fig-forth-auto680):03812                 FDB     PNUMB3-*-NATWID
+1F3D 1842196A174E     (fig-forth-auto680):03813                 FDB     ONE,DPL,PSTORE
+1F43 168B13FA         (fig-forth-auto680):03814         PNUMB3  FDB     FROMR,BRAN
+1F47 FFC4             (fig-forth-auto680):03815                 FDB     PNUMB2-*-NATWID
+1F49 168B             (fig-forth-auto680):03816         PNUMB4  FDB     FROMR
+1F4B 1662             (fig-forth-auto680):03817                 FDB     SEMIS
+                      (fig-forth-auto680):03818         *
+                      (fig-forth-auto680):03819         * ======>>  140  <<
+                      (fig-forth-auto680):03820         * ( ctstr --- d )
+                      (fig-forth-auto680):03821         * Convert text at ctstr to a double integer,
+                      (fig-forth-auto680):03822         * taking the 0 ERROR if the conversion is not valid. 
+                      (fig-forth-auto680):03823         * If a decimal point is present,
+                      (fig-forth-auto680):03824         * accumulate the count of digits to the decimal point's right into DPL
+                      (fig-forth-auto680):03825         * (negative DPL at exit indicates single precision). 
+                      (fig-forth-auto680):03826         * ctstr is a counted string
+                      (fig-forth-auto680):03827         * -- the first byte at ctstr is the length of the string,
+                      (fig-forth-auto680):03828         * but NUMBER ignores the count and expects a NUL terminator instead.
+1F4D 86               (fig-forth-auto680):03829                 FCB     $86
+1F4E 4E554D4245       (fig-forth-auto680):03830                 FCC     'NUMBE' ; 'NUMBER'
+1F53 D2               (fig-forth-auto680):03831                 FCB     $D2
+1F54 1F00             (fig-forth-auto680):03832                 FDB     PNUMB-11
+1F56 17B6183A183A1A40 (fig-forth-auto680):03833         NUMB    FDB     DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,LIT8
+     174219A8177B13A7
+1F66 2D               (fig-forth-auto680):03834                 FCC     "-"     minus sign
+1F67 1A0E1742167C16C1 (fig-forth-auto680):03835                 FDB     EQUAL,DUP,TOR,PLUS,LIT,$FFFF
+     1399FFFF
+1F73 196A17871F0B1742 (fig-forth-auto680):03836         NUMB1   FDB     DPL,STORE,PNUMB,DUP,CAT,BL,SUB
+     177B185B1A01
+1F81 1409             (fig-forth-auto680):03837                 FDB     ZBRAN
+1F83 0013             (fig-forth-auto680):03838                 FDB     NUMB2-*-NATWID
+1F85 1742177B13A7     (fig-forth-auto680):03839                 FDB     DUP,CAT,LIT8
+1F8B 2E               (fig-forth-auto680):03840                 FCC     "."
+1F8C 1A01183A1B36183A (fig-forth-auto680):03841                 FDB     SUB,ZERO,QERR,ZERO,BRAN
+     13FA
+1F96 FFDB             (fig-forth-auto680):03842                 FDB     NUMB1-*-NATWID
+1F98 1725168B1409     (fig-forth-auto680):03843         NUMB2   FDB     DROP,FROMR,ZBRAN
+1F9E 0002             (fig-forth-auto680):03844                 FDB     NUMB3-*-NATWID
+1FA0 16FD             (fig-forth-auto680):03845                 FDB     DMINUS
+1FA2 1662             (fig-forth-auto680):03846         NUMB3   FDB     SEMIS
+                      (fig-forth-auto680):03847         *
+                      (fig-forth-auto680):03848         * ======>>  141  <<
+                      (fig-forth-auto680):03849         * ( --- locptr length true )      { -FIND name } typical input
+                      (fig-forth-auto680):03850         * ( --- false )
+                      (fig-forth-auto680):03851         * Parse a word, then FIND,
+                      (fig-forth-auto680):03852         * first in the definition vocabulary,
+                      (fig-forth-auto680):03853         * then in the CONTEXT (interpretation) vocabulary, if necessary.
+                      (fig-forth-auto680):03854         * Returns what (FIND) returns, flag and optional location and length.
+1FA4 85               (fig-forth-auto680):03855                 FCB     $85
+1FA5 2D46494E         (fig-forth-auto680):03856                 FCC     '-FIN'  ; '-FIND'
+1FA9 C4               (fig-forth-auto680):03857                 FCB     $C4
+1FAA 1F4D             (fig-forth-auto680):03858                 FDB     NUMB-9
+1FAC 17B6185B1EBB19C4 (fig-forth-auto680):03859         DFIND   FDB     DOCOL,BL,WORD,HERE,CONTXT,AT,AT
+     193B176F176F
+1FBA 14AF1742169E1409 (fig-forth-auto680):03860                 FDB     PFIND,DUP,ZEQU,ZBRAN
+1FC2 0008             (fig-forth-auto680):03861                 FDB     DFIND2-*-NATWID
+1FC4 172519C41ACD14AF (fig-forth-auto680):03862                 FDB     DROP,HERE,LATEST,PFIND
+1FCC 1662             (fig-forth-auto680):03863         DFIND2  FDB     SEMIS
+                      (fig-forth-auto680):03864         *
+                      (fig-forth-auto680):03865         * ######>> screen 50 <<
+                      (fig-forth-auto680):03866         * ======>>  142  <<
+                      (fig-forth-auto680):03867         * ( anything --- nothing )        ( anything *** nothing )
+                      (fig-forth-auto680):03868         * An indirection for ABORT, for ERROR,
+                      (fig-forth-auto680):03869         * which may be modified carefully.
+1FCE 87               (fig-forth-auto680):03870                 FCB     $87
+1FCF 2841424F5254     (fig-forth-auto680):03871                 FCC     '(ABORT'        ; '(ABORT)'
+1FD5 A9               (fig-forth-auto680):03872                 FCB     $A9
+1FD6 1FA4             (fig-forth-auto680):03873                 FDB     DFIND-8
+1FD8 17B62204         (fig-forth-auto680):03874         PABORT  FDB     DOCOL,ABORT
+1FDC 1662             (fig-forth-auto680):03875                 FDB     SEMIS
+                      (fig-forth-auto680):03876         *
+                      (fig-forth-auto680):03877         * ======>>  143  <<
+1FDE 85               (fig-forth-auto680):03878                 FCB     $85
+1FDF 4552524F         (fig-forth-auto680):03879                 FCC     'ERRO'  ; 'ERROR'
+1FE3 D2               (fig-forth-auto680):03880                 FCB     $D2
+1FE4 1FCE             (fig-forth-auto680):03881                 FDB     PABORT-10
+                      (fig-forth-auto680):03882         * This really should not be high level, according to best practices.
+                      (fig-forth-auto680):03883         * But fixing that cascades through MESSAGE,
+                      (fig-forth-auto680):03884         * requiring re-architecting the disk block system.
+                      (fig-forth-auto680):03885         * First, we need to get this transliteration running.
+1FE6 17B618D5176F16B0 (fig-forth-auto680):03886         ERROR   FDB     DOCOL,WARN,AT,ZLESS
+1FEE 1409             (fig-forth-auto680):03887                 FDB     ZBRAN
+1FF0 0002             (fig-forth-auto680):03888                 FDB     ERROR2-*-NATWID
+                      (fig-forth-auto680):03889         * note: WARNING is
+                      (fig-forth-auto680):03890         * -1 to abort,
+                      (fig-forth-auto680):03891         * 0 to print error #
+                      (fig-forth-auto680):03892         * and 1 to print error message from disc
+1FF2 1FD8             (fig-forth-auto680):03893                 FDB     PABORT
+1FF4 19C41C971CAA1D0B (fig-forth-auto680):03894         ERROR2  FDB     HERE,COUNT,TYPE,PDOTQ
+1FFC 0407             (fig-forth-auto680):03895                 FCB     4,7     ( bell )
+1FFE 203F20           (fig-forth-auto680):03896                 FCC     " ? "
+2001 252A1648190C176F (fig-forth-auto680):03897                 FDB     MESS,SPSTOR,IN,AT,BLK,AT,QUIT
+     1903176F21D6
+200F 1662             (fig-forth-auto680):03898                 FDB     SEMIS
+                      (fig-forth-auto680):03899         *
+                      (fig-forth-auto680):03900         * ======>>  144  <<
+                      (fig-forth-auto680):03901         * ( n adr --- )
+                      (fig-forth-auto680):03902         * Mask byte at adr with n.
+                      (fig-forth-auto680):03903         * Not in FIG, don't need it for 8 bit characters after all.
+                      (fig-forth-auto680):03904         *       FCB     $85
+                      (fig-forth-auto680):03905         *       FCC     'CMAS'  ; 'CMASK'
+                      (fig-forth-auto680):03906         *       FCB     $CB     ; 'K'
+                      (fig-forth-auto680):03907         *       FDB     ERROR-8
+                      (fig-forth-auto680):03908         * CMASK FDB     *+NATWID
+                      (fig-forth-auto680):03909         *       LDX     ,U++    ; adr
+                      (fig-forth-auto680):03910         *       LDD     ,U++    ; mask
+                      (fig-forth-auto680):03911         *       ANDB    ,X
+                      (fig-forth-auto680):03912         *       STB     ,X
+                      (fig-forth-auto680):03913         *       RTS
+                      (fig-forth-auto680):03914         *
+                      (fig-forth-auto680):03915         * ( adr --- adr )
+                      (fig-forth-auto680):03916         * Mask high bit of tail of name in PAD buffer.
+                      (fig-forth-auto680):03917         * Not in FIG, need it for 8 bit characters.
+2011 86               (fig-forth-auto680):03918                 FCB     $86
+2012 4944464C41       (fig-forth-auto680):03919                 FCC     'IDFLA' ; 'IDFLAT'
+2017 D4               (fig-forth-auto680):03920                 FCB     $D4     ; 'T'
+2018 1FDE             (fig-forth-auto680):03921                 FDB     ERROR-8
+201A 201C             (fig-forth-auto680):03922         IDFLAT  FDB     *+NATWID
+201C AEC4             (fig-forth-auto680):03923                 LDX     ,U
+201E E684             (fig-forth-auto680):03924                 LDB     ,X      ; get the count
+2020 C43F             (fig-forth-auto680):03925                 ANDB    #CTMASK
+2022 A685             (fig-forth-auto680):03926                 LDA     B,X     ; point to the tail
+2024 847F             (fig-forth-auto680):03927                 ANDA    #$7F    ; Clear the EndOfName flag bit.
+2026 A785             (fig-forth-auto680):03928                 STA     B,X
+2028 39               (fig-forth-auto680):03929                 RTS
+                      (fig-forth-auto680):03930         *
+                      (fig-forth-auto680):03931         * ( symptr --- )
+                      (fig-forth-auto680):03932         * Print definition's name from its NFA.
+2029 83               (fig-forth-auto680):03933                 FCB     $83
+202A 4944             (fig-forth-auto680):03934                 FCC     'ID'    ; 'ID.'
+202C AE               (fig-forth-auto680):03935                 FCB     $AE
+202D 2011             (fig-forth-auto680):03936                 FDB     IDFLAT-9
+202F 17B61EA913A7     (fig-forth-auto680):03937         IDDOT   FDB     DOCOL,PAD,LIT8
+2035 20               (fig-forth-auto680):03938                 FCB     32
+2036 13A7             (fig-forth-auto680):03939                 FDB     LIT8
+2038 5F               (fig-forth-auto680):03940                 FCB     $5F     ( underline )
+2039 1E5117421B0F1ADD (fig-forth-auto680):03941                 FDB     FILL,DUP,PFA,LFA,OVER,SUB,PAD
+     17171A011EA9
+                      (fig-forth-auto680):03942         *       FDB     SWAP,CMOVE,PAD,COUNT,LIT8
+2047 173315831EA9     (fig-forth-auto680):03943                 FDB     SWAP,CMOVE,PAD
+204D 201A             (fig-forth-auto680):03944                 FDB     IDFLAT
+204F 1C9713A7         (fig-forth-auto680):03945                 FDB     COUNT,LIT8
+2053 1F               (fig-forth-auto680):03946                 FCB     31
+2054 16091CAA1A54     (fig-forth-auto680):03947                 FDB     AND,TYPE,SPACE
+205A 1662             (fig-forth-auto680):03948                 FDB     SEMIS
+                      (fig-forth-auto680):03949         *
+                      (fig-forth-auto680):03950         * ######>> screen 51 <<
+                      (fig-forth-auto680):03951         * ======>>  145  <<
+                      (fig-forth-auto680):03952         * ( --- )         { CREATE name } input
+                      (fig-forth-auto680):03953         * Parse a name (length < 32 characters) and create a header,
+                      (fig-forth-auto680):03954         * reporting first duplicate found in either the defining vocabulary
+                      (fig-forth-auto680):03955         * or the context (interpreting) vocabulary. 
+                      (fig-forth-auto680):03956         * Install the header in the defining vocabulary
+                      (fig-forth-auto680):03957         * with CFA dangerously pointing to the parameter field.
+                      (fig-forth-auto680):03958         * Leave the name SMUDGEd.
+205C 86               (fig-forth-auto680):03959                 FCB     $86
+205D 4352454154       (fig-forth-auto680):03960                 FCC     'CREAT' ; 'CREATE'
+2062 C5               (fig-forth-auto680):03961                 FCB     $C5
+2063 2029             (fig-forth-auto680):03962                 FDB     IDDOT-6
+2065 17B61FAC1409     (fig-forth-auto680):03963         CREATE  FDB     DOCOL,DFIND,ZBRAN
+206B 0018             (fig-forth-auto680):03964                 FDB     CREAT2-*-NATWID
+206D 17251D0B         (fig-forth-auto680):03965                 FDB     DROP,PDOTQ
+2071 08               (fig-forth-auto680):03966                 FCB     8
+2072 07               (fig-forth-auto680):03967                 FCB     7       ( bel )
+2073 72656465663A20   (fig-forth-auto680):03968                 FCC     "redef: "
+207A 1AFA202F13A7     (fig-forth-auto680):03969                 FDB     NFA,IDDOT,LIT8
+2080 04               (fig-forth-auto680):03970                 FCB     4
+2081 252A1A54         (fig-forth-auto680):03971                 FDB     MESS,SPACE
+2085 19C41742177B18C7 (fig-forth-auto680):03972         CREAT2  FDB     HERE,DUP,CAT,WIDTH,AT,MIN
+     176F1A62
+2091 19A819D4174213A7 (fig-forth-auto680):03973                 FDB     ONEP,ALLOT,DUP,LIT8
+2099 A0               (fig-forth-auto680):03974                 FCB     ($80|FSMUDG)            ; Bracket the name.
+209A 176219C418421A01 (fig-forth-auto680):03975                 FDB     TOGGLE,HERE,ONE,SUB,LIT8
+     13A7
+20A4 80               (fig-forth-auto680):03976                 FCB     $80
+20A5 17621ACD19E01949 (fig-forth-auto680):03977                 FDB     TOGGLE,LATEST,COMMA,CURENT,AT,STORE
+     176F1787
+                      (fig-forth-auto680):03978         *       FDB     HERE,TWOP,COMMA
+20B1 19C417FF19E0     (fig-forth-auto680):03979                 FDB     HERE,NATP,COMMA
+20B7 1662             (fig-forth-auto680):03980                 FDB     SEMIS
+                      (fig-forth-auto680):03981         *
+                      (fig-forth-auto680):03982         * ######>> screen 52 <<
+                      (fig-forth-auto680):03983         * ======>>  146  <<
+                      (fig-forth-auto680):03984         * ( --- )                                         P
+                      (fig-forth-auto680):03985         *                       { [COMPILE] name } typical use
+                      (fig-forth-auto680):03986         * -DFIND next WORD and COMPILE it, literally;
+                      (fig-forth-auto680):03987         * used to compile immediate definitions into words.
+20B9 C9               (fig-forth-auto680):03988                 FCB     $C9     immediate
+20BA 5B434F4D50494C45 (fig-forth-auto680):03989                 FCC     '[COMPILE'      ; '[COMPILE]'
+20C2 DD               (fig-forth-auto680):03990                 FCB     $DD
+20C3 205C             (fig-forth-auto680):03991                 FDB     CREATE-9
+20C5 17B61FAC169E183A (fig-forth-auto680):03992         BCOMP   FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
+     1B3617251AEC19E0
+20D5 1662             (fig-forth-auto680):03993                 FDB     SEMIS
+                      (fig-forth-auto680):03994         *
+                      (fig-forth-auto680):03995         * ======>>  147  <<
+                      (fig-forth-auto680):03996         * ( n --- ) if compiling.                          P
+                      (fig-forth-auto680):03997         * ( n --- n ) if interpreting.
+                      (fig-forth-auto680):03998         * Compile n as a literal, if compiling.
+20D7 C7               (fig-forth-auto680):03999                 FCB     $C7     immediate
+20D8 4C4954455241     (fig-forth-auto680):04000                 FCC     'LITERA'        ; 'LITERAL'
+20DE CC               (fig-forth-auto680):04001                 FCB     $CC
+20DF 20B9             (fig-forth-auto680):04002                 FDB     BCOMP-12
+20E1 17B61955176F1409 (fig-forth-auto680):04003         LITER   FDB     DOCOL,STATE,AT,ZBRAN
+20E9 0006             (fig-forth-auto680):04004                 FDB     LITER2-*-NATWID
+20EB 1BC4139919E0     (fig-forth-auto680):04005                 FDB     COMPIL,LIT,COMMA
+20F1 1662             (fig-forth-auto680):04006         LITER2  FDB     SEMIS
+                      (fig-forth-auto680):04007         *
+                      (fig-forth-auto680):04008         * ======>>  148  <<
+                      (fig-forth-auto680):04009         * ( d --- )  if compiling.                        P
+                      (fig-forth-auto680):04010         * ( d --- d ) if interpreting.
+                      (fig-forth-auto680):04011         * Compile d as a double literal, if compiling.
+20F3 C8               (fig-forth-auto680):04012                 FCB     $C8     immediate
+20F4 444C4954455241   (fig-forth-auto680):04013                 FCC     'DLITERA'       ; 'DLITERAL'
+20FB CC               (fig-forth-auto680):04014                 FCB     $CC
+20FC 20D7             (fig-forth-auto680):04015                 FDB     LITER-10
+20FE 17B61955176F1409 (fig-forth-auto680):04016         DLITER  FDB     DOCOL,STATE,AT,ZBRAN
+2106 0006             (fig-forth-auto680):04017                 FDB     DLITE2-*-NATWID
+2108 173320E120E1     (fig-forth-auto680):04018                 FDB     SWAP,LITER,LITER        ; Just two literals in the right order.
+210E 1662             (fig-forth-auto680):04019         DLITE2  FDB     SEMIS
+                      (fig-forth-auto680):04020         *
+                      (fig-forth-auto680):04021         * ######>> screen 53 <<
+                      (fig-forth-auto680):04022         * ======>>  149  <<
+                      (fig-forth-auto680):04023         * ( --- )
+                      (fig-forth-auto680):04024         * Interpret or compile, according to STATE. 
+                      (fig-forth-auto680):04025         * Searches words parsed in dictionary first, via -FIND,
+                      (fig-forth-auto680):04026         * then checks for valid NUMBER.
+                      (fig-forth-auto680):04027         * Pushes or COMPILEs double literal if NUMBER leaves DPL non-negative. 
+                      (fig-forth-auto680):04028         * ERROR checks the stack via ?STACK before returning to its caller. 
+2110 89               (fig-forth-auto680):04029                 FCB     $89
+2111 494E544552505245 (fig-forth-auto680):04030                 FCC     'INTERPRE'      ; 'INTERPRET'
+2119 D4               (fig-forth-auto680):04031                 FCB     $D4
+211A 20F3             (fig-forth-auto680):04032                 FDB     DLITER-11
+211C 17B6             (fig-forth-auto680):04033         INTERP  FDB     DOCOL
+211E 1FAC1409         (fig-forth-auto680):04034         INTER2  FDB     DFIND,ZBRAN
+2122 001A             (fig-forth-auto680):04035                 FDB     INTER5-*-NATWID
+2124 1955176F1A1A     (fig-forth-auto680):04036                 FDB     STATE,AT,LESS
+212A 1409             (fig-forth-auto680):04037                 FDB     ZBRAN
+212C 0008             (fig-forth-auto680):04038                 FDB     INTER3-*-NATWID
+212E 1AEC19E013FA     (fig-forth-auto680):04039                 FDB     CFA,COMMA,BRAN
+2134 0004             (fig-forth-auto680):04040                 FDB     INTER4-*-NATWID
+2136 1AEC13EB         (fig-forth-auto680):04041         INTER3  FDB     CFA,EXEC
+213A 13FA             (fig-forth-auto680):04042         INTER4  FDB     BRAN
+213C 0018             (fig-forth-auto680):04043                 FDB     INTER7-*-NATWID
+213E 19C41F56196A176F (fig-forth-auto680):04044         INTER5  FDB     HERE,NUMB,DPL,AT,ONEP,ZBRAN
+     19A81409
+214A 0006             (fig-forth-auto680):04045                 FDB     INTER6-*-NATWID
+214C 20FE13FA         (fig-forth-auto680):04046                 FDB     DLITER,BRAN
+2150 0004             (fig-forth-auto680):04047                 FDB     INTER7-*-NATWID
+2152 172520E1         (fig-forth-auto680):04048         INTER6  FDB     DROP,LITER
+2156 1D5613FA         (fig-forth-auto680):04049         INTER7  FDB     QSTACK,BRAN
+215A FFC2             (fig-forth-auto680):04050                 FDB     INTER2-*-NATWID
+                      (fig-forth-auto680):04051         *       FDB     SEMIS   never executed
+                      (fig-forth-auto680):04052         
+                      (fig-forth-auto680):04053         *
+                      (fig-forth-auto680):04054         * ######>> screen 54 <<
+                      (fig-forth-auto680):04055         * ======>>  150  <<
+                      (fig-forth-auto680):04056         * ( --- )
+                      (fig-forth-auto680):04057         * Toggle precedence bit of LATEST definition header. 
+                      (fig-forth-auto680):04058         * During compiling, most symbols scanned are compiled. 
+                      (fig-forth-auto680):04059         * IMMEDIATE definitions execute whenever the outer INTERPRETer scans them,
+                      (fig-forth-auto680):04060         * but may be compiled via ' (TICK).
+215C 89               (fig-forth-auto680):04061                 FCB     $89
+215D 494D4D4544494154 (fig-forth-auto680):04062                 FCC     'IMMEDIAT'      ; 'IMMEDIATE'
+2165 C5               (fig-forth-auto680):04063                 FCB     $C5
+2166 2110             (fig-forth-auto680):04064                 FDB     INTERP-12
+2168 17B61ACD13A7     (fig-forth-auto680):04065         IMMED   FDB     DOCOL,LATEST,LIT8
+216E 40               (fig-forth-auto680):04066                 FCB     FIMMED
+216F 1762             (fig-forth-auto680):04067                 FDB     TOGGLE
+2171 1662             (fig-forth-auto680):04068                 FDB     SEMIS
+                      (fig-forth-auto680):04069         *
+                      (fig-forth-auto680):04070         * ======>>  151  <<
+                      (fig-forth-auto680):04071         * ( --- )         { VOCABULARY name } input
+                      (fig-forth-auto680):04072         * Create a vocabulary entry with a flag for terminating vocabulary searches.
+                      (fig-forth-auto680):04073         * Store the current search context in it for linking.
+                      (fig-forth-auto680):04074         * At run-time, VOCABULARY makes itself the CONTEXT vocabulary.
+2173 8A               (fig-forth-auto680):04075                 FCB     $8A
+2174 564F434142554C41 (fig-forth-auto680):04076                 FCC     'VOCABULAR'     ; 'VOCABULARY'
+     52
+217D D9               (fig-forth-auto680):04077                 FCB     $D9
+217E 215C             (fig-forth-auto680):04078                 FDB     IMMED-12
+2180 17B61C65139981A0 (fig-forth-auto680):04079         VOCAB   FDB     DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
+     19E01949176F1AEC
+2190 19E019C418F9176F (fig-forth-auto680):04080                 FDB     COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
+     19E018F917871C75
+                      (fig-forth-auto680):04081         * DOVOC FDB     TWOP,CONTXT,STORE
+21A0 17FF193B1787     (fig-forth-auto680):04082         DOVOC   FDB     NATP,CONTXT,STORE
+21A6 1662             (fig-forth-auto680):04083                 FDB     SEMIS
+                      (fig-forth-auto680):04084         *
+                      (fig-forth-auto680):04085         * ======>>  152  <<
+                      (fig-forth-auto680):04086         *
+                      (fig-forth-auto680):04087         * Note: FORTH does not go here in the rom-able dictionary,
+                      (fig-forth-auto680):04088         *    since FORTH is a type of variable.
+                      (fig-forth-auto680):04089         *
+                      (fig-forth-auto680):04090         * (Should make a proper architecture for this at some point.)
+                      (fig-forth-auto680):04091         *
+                      (fig-forth-auto680):04092         *
+                      (fig-forth-auto680):04093         * ======>>  153  <<
+                      (fig-forth-auto680):04094         * ( --- )
+                      (fig-forth-auto680):04095         * Makes the current interpretation CONTEXT vocabulary
+                      (fig-forth-auto680):04096         * also the CURRENT defining vocabulary.
+21A8 8B               (fig-forth-auto680):04097                 FCB     $8B
+21A9 444546494E495449 (fig-forth-auto680):04098                 FCC     'DEFINITION'    ; 'DEFINITIONS'
+     4F4E
+21B3 D3               (fig-forth-auto680):04099                 FCB     $D3
+21B4 2173             (fig-forth-auto680):04100                 FDB     VOCAB-13
+21B6 17B6193B176F1949 (fig-forth-auto680):04101         DEFIN   FDB     DOCOL,CONTXT,AT,CURENT,STORE
+     1787
+21C0 1662             (fig-forth-auto680):04102                 FDB     SEMIS
+                      (fig-forth-auto680):04103         *
+                      (fig-forth-auto680):04104         * ======>>  154  <<
+                      (fig-forth-auto680):04105         * ( --- )
+                      (fig-forth-auto680):04106         * Parse out a comment and toss it away. 
+                      (fig-forth-auto680):04107         * Leaves the first 32 characters in WORDPAD, which may or may not be useful.
+21C2 C1               (fig-forth-auto680):04108                 FCB     $C1     immediate       (
+21C3 A8               (fig-forth-auto680):04109                 FCB     $A8
+21C4 21A8             (fig-forth-auto680):04110                 FDB     DEFIN-14
+21C6 17B613A7         (fig-forth-auto680):04111         PAREN   FDB     DOCOL,LIT8
+21CA 29               (fig-forth-auto680):04112                 FCC     ")"
+21CB 1EBB             (fig-forth-auto680):04113                 FDB     WORD
+21CD 1662             (fig-forth-auto680):04114                 FDB     SEMIS
+                      (fig-forth-auto680):04115         *
+                      (fig-forth-auto680):04116         * ######>> screen 55 <<
+                      (fig-forth-auto680):04117         * ======>>  155  <<
+                      (fig-forth-auto680):04118         * ( anything *** nothing )
+                      (fig-forth-auto680):04119         * Clear return stack. 
+                      (fig-forth-auto680):04120         * Then INTERPRET and, if not compiling, prompt with OK,
+                      (fig-forth-auto680):04121         * in infinite loop.
+21CF 84               (fig-forth-auto680):04122                 FCB     $84
+21D0 515549           (fig-forth-auto680):04123                 FCC     'QUI'   ; 'QUIT'
+21D3 D4               (fig-forth-auto680):04124                 FCB     $D4
+21D4 21C2             (fig-forth-auto680):04125                 FDB     PAREN-4
+21D6 17B6183A19031787 (fig-forth-auto680):04126         QUIT    FDB     DOCOL,ZERO,BLK,STORE
+21DE 1BD8             (fig-forth-auto680):04127                 FDB     LBRAK
+                      (fig-forth-auto680):04128         *
+                      (fig-forth-auto680):04129         *  Here is the outer interpretter
+                      (fig-forth-auto680):04130         *  which gets a line of input, does it, prints " OK"
+                      (fig-forth-auto680):04131         *  then repeats :
+21E0 165315761DFA211C (fig-forth-auto680):04132         QUIT2   FDB     RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
+     1955176F169E
+21EE 1409             (fig-forth-auto680):04133                 FDB     ZBRAN
+21F0 0006             (fig-forth-auto680):04134                 FDB     QUIT3-*-NATWID
+21F2 1D0B             (fig-forth-auto680):04135                 FDB     PDOTQ
+21F4 03               (fig-forth-auto680):04136                 FCB     3
+21F5 204F4B           (fig-forth-auto680):04137                 FCC     ' OK'   ; ' OK'
+21F8 13FA             (fig-forth-auto680):04138         QUIT3   FDB     BRAN
+21FA FFE4             (fig-forth-auto680):04139                 FDB     QUIT2-*-NATWID
+                      (fig-forth-auto680):04140         *       FDB     SEMIS   ( never executed )
+                      (fig-forth-auto680):04141         *
+                      (fig-forth-auto680):04142         * ======>>  156  <<
+                      (fig-forth-auto680):04143         * ( anything --- nothing )        ( anything *** nothing )
+                      (fig-forth-auto680):04144         * Clear parameter stack,
+                      (fig-forth-auto680):04145         * set STATE to interpret and BASE to DECIMAL,
+                      (fig-forth-auto680):04146         * return to input from terminal,
+                      (fig-forth-auto680):04147         * restore DRIVE OFFSET to 0,
+                      (fig-forth-auto680):04148         * print out "Forth-68",
+                      (fig-forth-auto680):04149         * set interpret and define vocabularies to FORTH,
+                      (fig-forth-auto680):04150         * and finally, QUIT. 
+                      (fig-forth-auto680):04151         * Used to force the system to a known state
+                      (fig-forth-auto680):04152         * and return control to the initial INTERPRETer.
+21FC 85               (fig-forth-auto680):04153                 FCB     $85
+21FD 41424F52         (fig-forth-auto680):04154                 FCC     'ABOR'  ; 'ABORT'
+2201 D4               (fig-forth-auto680):04155                 FCB     $D4
+2202 21CF             (fig-forth-auto680):04156                 FDB     QUIT-7
+2204 17B616481C201D56 (fig-forth-auto680):04157         ABORT   FDB     DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
+     242415761D0B
+2212 0A               (fig-forth-auto680):04158                 FCB     10
+2213 466F7274682D3638 (fig-forth-auto680):04159                 FCC     "Forth-6809"
+     3039
+221D 29FE21B6         (fig-forth-auto680):04160                 FDB     FORTH,DEFIN
+2221 21D6             (fig-forth-auto680):04161                 FDB     QUIT
+                      (fig-forth-auto680):04162         *       FDB     SEMIS   never executed
+                      (fig-forth-auto680):04163                 PAGE
+                      (fig-forth-auto680):04164         *
+                      (fig-forth-auto680):04165         * ######>> screen 56 <<
+                      (fig-forth-auto680):04166         * bootstrap code... moves rom contents to ram :
+                      (fig-forth-auto680):04167         * ======>>  157  <<
+2223 84               (fig-forth-auto680):04168                 FCB     $84
+2224 434F4C           (fig-forth-auto680):04169                 FCC     'COL'   ; 'COLD'
+2227 C4               (fig-forth-auto680):04170                 FCB     $C4
+2228 21FC             (fig-forth-auto680):04171                 FDB     ABORT-8
+222A 222C             (fig-forth-auto680):04172         COLD    FDB     *+NATWID
+                      (fig-forth-auto680):04173         * Ultimately, we want position indepence,
+                      (fig-forth-auto680):04174         * so I'm using PCR where it seems reasonable.
+222C 10EE8DEFE1       (fig-forth-auto680):04175         CENT    LDS     SINIT,PCR       ; Get a useable return stack, at least.
+2231 867C             (fig-forth-auto680):04176                 LDA     #IUPDP          ; This is not relative to PC.
+2233 1F8B             (fig-forth-auto680):04177                 TFR     A,DP            ; And a useable direct page, too.
+     7C               (fig-forth-auto680):04178                 SETDP   IUPDP   ; (For good measure.)
+                      (fig-forth-auto680):04179         *
+                      (fig-forth-auto680):04180         * We'll keep this here for the time being.
+                      (fig-forth-auto680):04181         * There are better ways to do this, of course.
+                      (fig-forth-auto680):04182         * Re-architect, re-architect.
+2235 308D006A         (fig-forth-auto680):04183                 LEAX    RAM,PCR 
+2239 9F28             (fig-forth-auto680):04184                 STX     <XFENCE ; Borrow this variable for a loop terminator.
+223B 318D07F2         (fig-forth-auto680):04185                 LEAY    REND,PCR        ; top of destination
+223F 308D00A3         (fig-forth-auto680):04186                 LEAX    ERAM,PCR        ; top of stuff to move
+2243 A682             (fig-forth-auto680):04187         COLD2   LDA     ,-X
+2245 A7A2             (fig-forth-auto680):04188                 STA     ,-Y     ; move TASK & FORTH to ram
+2247 9C28             (fig-forth-auto680):04189                 CMPX    <XFENCE
+2249 26F8             (fig-forth-auto680):04190                 BNE     COLD2
+                      (fig-forth-auto680):04191         *
+                      (fig-forth-auto680):04192         * CENT  LDS     #REND-1 top of destination
+                      (fig-forth-auto680):04193         *       LDX     #ERAM   top of stuff to move
+                      (fig-forth-auto680):04194         * COLD2 LEAX -1,X       ; 
+                      (fig-forth-auto680):04195         *       LDA 0,X
+                      (fig-forth-auto680):04196         *       PSHS A  ; move TASK & FORTH to ram
+                      (fig-forth-auto680):04197         *       CMPX    #RAM
+                      (fig-forth-auto680):04198         *       BNE     COLD2
+                      (fig-forth-auto680):04199         *
+                      (fig-forth-auto680):04200         *       LDS     #XFENCE-1       put stack at a safe place for now
+                      (fig-forth-auto680):04201         *                               But that is taken care of.
+                      (fig-forth-auto680):04202         *       LDX     COLINT
+                      (fig-forth-auto680):04203         *       STX     XCOLUM
+224B AE8DEFD3         (fig-forth-auto680):04204                 LDX     COLINT,PCR
+224F 9F4C             (fig-forth-auto680):04205                 STX     <XCOLUM
+                      (fig-forth-auto680):04206         *       LDX     DELINT
+                      (fig-forth-auto680):04207         *       STX     XDELAY
+2251 AE8DEFCF         (fig-forth-auto680):04208                 LDX     DELINT,PCR
+2255 9F4A             (fig-forth-auto680):04209                 STX     <XDELAY
+                      (fig-forth-auto680):04210         *       LDX     VOCINT
+                      (fig-forth-auto680):04211         *       STX     XVOCL
+2257 AE8DEFC5         (fig-forth-auto680):04212                 LDX     VOCINT,PCR
+225B 9F2C             (fig-forth-auto680):04213                 STX     <XVOCL
+                      (fig-forth-auto680):04214         *       LDX     DPINIT
+                      (fig-forth-auto680):04215         *       STX     XDICTP
+225D AE8DEFBD         (fig-forth-auto680):04216                 LDX     DPINIT,PCR
+2261 9F2A             (fig-forth-auto680):04217                 STX     <XDICTP
+                      (fig-forth-auto680):04218         *       LDX     FENCIN
+                      (fig-forth-auto680):04219         *       STX     XFENCE
+2263 AE8DEFB5         (fig-forth-auto680):04220                 LDX     FENCIN,PCR
+2267 9F28             (fig-forth-auto680):04221                 STX     <XFENCE
+                      (fig-forth-auto680):04222         *
+2269 10EE8DEFA4       (fig-forth-auto680):04223         WENT    LDS     SINIT,PCR       ; Get a useable return stack, at least.
+226E 867C             (fig-forth-auto680):04224                 LDA     #IUPDP          ; This is not relative to PC.
+2270 1F8B             (fig-forth-auto680):04225                 TFR     A,DP            ; And a useable direct page, too.
+     7C               (fig-forth-auto680):04226                 SETDP   IUPDP   ; (For good measure.)
+                      (fig-forth-auto680):04227         *
+2272 308DEF9C         (fig-forth-auto680):04228                 LEAX    SINIT,PCR
+2276 3410             (fig-forth-auto680):04229                 PSHS    X       ; for loop termination
+2278 5F               (fig-forth-auto680):04230                 CLRB            ; Yes, I'm being a little ridiculous. Only a little.
+2279 1F02             (fig-forth-auto680):04231                 TFR     D,Y
+227B 31A828           (fig-forth-auto680):04232                 LEAY    XFENCE-UORIG,Y  ; top of destination
+227E 308DEF9A         (fig-forth-auto680):04233                 LEAX    FENCIN,PCR      ; top of stuff to move
+2282 EC83             (fig-forth-auto680):04234         WARM2   LDD     ,--X    ; All entries are 16 bit.
+2284 EDA3             (fig-forth-auto680):04235                 STD     ,--Y
+2286 ACE4             (fig-forth-auto680):04236                 CMPX    ,S
+2288 26F8             (fig-forth-auto680):04237                 BNE     WARM2
+228A 3262             (fig-forth-auto680):04238                 LEAS    2,S     ; But we'll reset the return stack shortly, anyway.
+                      (fig-forth-auto680):04239         * WENT  LDS     #XFENCE-1       top of destination
+                      (fig-forth-auto680):04240         *       LDX     #FENCIN         top of stuff to move
+                      (fig-forth-auto680):04241         * WARM2 LEAX -1,X       ; 
+                      (fig-forth-auto680):04242         *       LDA 0,X
+                      (fig-forth-auto680):04243         *       PSHS A  ; 
+                      (fig-forth-auto680):04244         *       CMPX    #SINIT
+                      (fig-forth-auto680):04245         *       BNE     WARM2
+                      (fig-forth-auto680):04246         *
+                      (fig-forth-auto680):04247         *       LDS     SINIT
+                      (fig-forth-auto680):04248         * S is already there.
+                      (fig-forth-auto680):04249         *       LDX     UPINIT
+                      (fig-forth-auto680):04250         *       STX     UP              init user ram pointer
+                      (fig-forth-auto680):04251         * UP is already there (DP).
+                      (fig-forth-auto680):04252         *       LDX     #ABORT
+                      (fig-forth-auto680):04253         *       STX     IP
+228C 318DFF76         (fig-forth-auto680):04254                 LEAY    ABORT+NATWID,PCR        ; IP never points to DOCOL!
+                      (fig-forth-auto680):04255         *
+2290 12               (fig-forth-auto680):04256                 NOP             Here is a place to jump to special user
+2291 12               (fig-forth-auto680):04257                 NOP             initializations such as I/0 interrups
+2292 12               (fig-forth-auto680):04258                 NOP
+                      (fig-forth-auto680):04259         *
+                      (fig-forth-auto680):04260         * For systems with TRACE:
+2293 8E0000           (fig-forth-auto680):04261                 LDX     #00
+                      (fig-forth-auto680):04262         *       STX     TRLIM   clear trace mode
+2296 9F0A             (fig-forth-auto680):04263                 STX     <TRLIM  clear trace mode (both bytes)
+2298 8E0000           (fig-forth-auto680):04264                 LDX     #0
+                      (fig-forth-auto680):04265         *       STX     BRKPT   clear breakpoint address
+229B 9F0C             (fig-forth-auto680):04266                 STX     <BRKPT  clear breakpoint address
+                      (fig-forth-auto680):04267         *       JMP     RPSTOR+2 start the virtual machine running !
+229D 17F3B5           (fig-forth-auto680):04268                 LBSR    RPSTOR+NATWID start the virtual machine running !
+22A0 16EF85           (fig-forth-auto680):04269                 LBRA    NEXT    ; But we must also give RP! someplace to return.
+                      (fig-forth-auto680):04270         *       RP! sets up the return stack pointer, then Y references abort.
+                      (fig-forth-auto680):04271         *
+                      (fig-forth-auto680):04272         * Here is the stuff that gets copied to ram :
+                      (fig-forth-auto680):04273         * (not * at address $140:)
+                      (fig-forth-auto680):04274         * at an appropriate address:
+                      (fig-forth-auto680):04275         *
+22A3 3000300000000000 (fig-forth-auto680):04276         RAM     FDB     $3000,$3000,0,0
+                      (fig-forth-auto680):04277                 
+                      (fig-forth-auto680):04278         * ======>>  (152)  <<
+                      (fig-forth-auto680):04279         * ( --- )                                                 P
+                      (fig-forth-auto680):04280         * Makes FORTH the current interpretation vocabulary.
+                      (fig-forth-auto680):04281         * In order to make this ROMmable, this entry is set up as the tail-end, 
+                      (fig-forth-auto680):04282         * and copied to RAM in the start-up code.
+                      (fig-forth-auto680):04283         * We want a more elegant solution to this, too. Greedy, maybe.
+22AB C5               (fig-forth-auto680):04284                 FCB     $C5     immediate
+22AC 464F5254         (fig-forth-auto680):04285                 FCC     'FORT'  ; 'FORTH'
+22B0 C8               (fig-forth-auto680):04286                 FCB     $C8
+22B1 29DD             (fig-forth-auto680):04287                 FDB     NOOP-7  ; Note that this does not link to COLD!
+22B3 1C8121A081A02A26 (fig-forth-auto680):04288         RFORTH  FDB     DODOES,DOVOC,$81A0,TASK-7
+22BB 0000             (fig-forth-auto680):04289                 FDB     0
+22BD 28432920466F7274 (fig-forth-auto680):04290                 FCC     "(C) Forth Interest Group, 1979"
+     6820496E74657265
+     73742047726F7570
+     2C2031393739
+22DB 84               (fig-forth-auto680):04291                 FCB     $84
+22DC 544153           (fig-forth-auto680):04292                 FCC     'TAS'   ; 'TASK'
+22DF CB               (fig-forth-auto680):04293                 FCB     $CB
+22E0 29F6             (fig-forth-auto680):04294                 FDB     FORTH-8
+22E2 17B61662         (fig-forth-auto680):04295         RTASK   FDB     DOCOL,SEMIS
+22E6 4461766964204C69 (fig-forth-auto680):04296         ERAM    FCC     "David Lion"    
+     6F6E
+                      (fig-forth-auto680):04297                 PAGE
+                      (fig-forth-auto680):04298         *
+                      (fig-forth-auto680):04299         * ######>> screen 57 <<
+                      (fig-forth-auto680):04300         * ======>>  158  <<
+                      (fig-forth-auto680):04301         * ( n0 --- d0 )
+                      (fig-forth-auto680):04302         * Sign extend n0 to a double integer.
+22F0 84               (fig-forth-auto680):04303                 FCB     $84
+22F1 532D3E           (fig-forth-auto680):04304                 FCC     'S->'   ; 'S->D'
+22F4 C4               (fig-forth-auto680):04305                 FCB     $C4
+22F5 2223             (fig-forth-auto680):04306                 FDB     COLD-7  ; Note that this does not link to FORTH (RFORTH)!
+22F7 17B6174216B016EA (fig-forth-auto680):04307         STOD    FDB     DOCOL,DUP,ZLESS,MINUS
+22FF 1662             (fig-forth-auto680):04308                 FDB     SEMIS
+                      (fig-forth-auto680):04309         
+                      (fig-forth-auto680):04310         
+                      (fig-forth-auto680):04311         *
+                      (fig-forth-auto680):04312         * ======>>  159  <<
+                      (fig-forth-auto680):04313         * ( multiplier multiplicand --- product )
+                      (fig-forth-auto680):04314         * Signed word multiply.
+2301 81               (fig-forth-auto680):04315                 FCB     $81     ; *
+2302 AA               (fig-forth-auto680):04316                 FCB     $AA
+2303 22F0             (fig-forth-auto680):04317                 FDB     STOD-7
+2305 2307             (fig-forth-auto680):04318         STAR    FDB     *+NATWID
+2307 17F298           (fig-forth-auto680):04319                 LBSR    USTAR+NATWID    ; or [USTAR,PCR]?
+230A 3342             (fig-forth-auto680):04320                 LEAU    NATWID,U        ; Drop high word.
+230C 39               (fig-forth-auto680):04321                 RTS
+                      (fig-forth-auto680):04322         *       JSR     USTARS
+                      (fig-forth-auto680):04323         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):04324         *       LEAS 1,S        ; 
+                      (fig-forth-auto680):04325         *       JMP     NEXT
+                      (fig-forth-auto680):04326         *
+                      (fig-forth-auto680):04327         * ======>>  160  <<
+                      (fig-forth-auto680):04328         * ( dividend divisor --- remainder quotient )
+                      (fig-forth-auto680):04329         * M/ in word-only form, i. e., signed division of 2nd word by top word,
+                      (fig-forth-auto680):04330         * yielding signed word quotient and remainder.
+230D 84               (fig-forth-auto680):04331                 FCB     $84
+230E 2F4D4F           (fig-forth-auto680):04332                 FCC     '/MO'   ; '/MOD'
+2311 C4               (fig-forth-auto680):04333                 FCB     $C4
+2312 2301             (fig-forth-auto680):04334                 FDB     STAR-4
+2314 17B6167C22F7168B (fig-forth-auto680):04335         SLMOD   FDB     DOCOL,TOR,STOD,FROMR,USLASH
+     15D6
+231E 1662             (fig-forth-auto680):04336                 FDB     SEMIS
+                      (fig-forth-auto680):04337         *
+                      (fig-forth-auto680):04338         * ======>>  161  <<
+                      (fig-forth-auto680):04339         * ( dividend divisor --- quotient )
+                      (fig-forth-auto680):04340         * Signed word divide without remainder.
+2320 81               (fig-forth-auto680):04341                 FCB     $81     ; /
+2321 AF               (fig-forth-auto680):04342                 FCB     $AF
+2322 230D             (fig-forth-auto680):04343                 FDB     SLMOD-7
+2324 17B6231417331725 (fig-forth-auto680):04344         SLASH   FDB     DOCOL,SLMOD,SWAP,DROP
+232C 1662             (fig-forth-auto680):04345                 FDB     SEMIS
+                      (fig-forth-auto680):04346         *
+                      (fig-forth-auto680):04347         * ======>>  162  <<
+                      (fig-forth-auto680):04348         * ( dividend divisor --- remainder )
+                      (fig-forth-auto680):04349         * Remainder function, result takes sign of dividend.
+232E 83               (fig-forth-auto680):04350                 FCB     $83
+232F 4D4F             (fig-forth-auto680):04351                 FCC     'MO'    ; 'MOD'
+2331 C4               (fig-forth-auto680):04352                 FCB     $C4
+2332 2320             (fig-forth-auto680):04353                 FDB     SLASH-4
+2334 17B623141725     (fig-forth-auto680):04354         MOD     FDB     DOCOL,SLMOD,DROP
+233A 1662             (fig-forth-auto680):04355                 FDB     SEMIS
+                      (fig-forth-auto680):04356         *
+                      (fig-forth-auto680):04357         * ======>>  163  <<
+                      (fig-forth-auto680):04358         * ( multiplier multiplicand divisor --- remainder quotient )
+                      (fig-forth-auto680):04359         * Signed precise division of product:
+                      (fig-forth-auto680):04360         * multiply 2nd and 3rd words on stack
+                      (fig-forth-auto680):04361         * and divide the 31-bit product by the top word,
+                      (fig-forth-auto680):04362         * leaving both quotient and remainder.
+                      (fig-forth-auto680):04363         * Remainder takes sign of product. 
+                      (fig-forth-auto680):04364         * Guaranteed not to lose significant bits in 16 bit integer math.
+233C 85               (fig-forth-auto680):04365                 FCB     $85
+233D 2A2F4D4F         (fig-forth-auto680):04366                 FCC     '*/MO'  ; '*/MOD'
+2341 C4               (fig-forth-auto680):04367                 FCB     $C4
+2342 232E             (fig-forth-auto680):04368                 FDB     MOD-6
+2344 17B6167C15A0168B (fig-forth-auto680):04369         SSMOD   FDB     DOCOL,TOR,USTAR,FROMR,USLASH
+     15D6
+234E 1662             (fig-forth-auto680):04370                 FDB     SEMIS
+                      (fig-forth-auto680):04371         *
+                      (fig-forth-auto680):04372         * ======>>  164  <<
+                      (fig-forth-auto680):04373         * ( multiplier multiplicand divisor --- quotient )
+                      (fig-forth-auto680):04374         *   */MOD without remainder.
+2350 82               (fig-forth-auto680):04375                 FCB     $82
+2351 2A               (fig-forth-auto680):04376                 FCC     '*'     ; '*/'
+2352 AF               (fig-forth-auto680):04377                 FCB     $AF
+2353 233C             (fig-forth-auto680):04378                 FDB     SSMOD-8
+2355 17B6234417331725 (fig-forth-auto680):04379         SSLASH  FDB     DOCOL,SSMOD,SWAP,DROP
+235D 1662             (fig-forth-auto680):04380                 FDB     SEMIS
+                      (fig-forth-auto680):04381         *
+                      (fig-forth-auto680):04382         * ======>>  165  <<
+                      (fig-forth-auto680):04383         * ( ud1 u1 --- u2 ud2 )
+                      (fig-forth-auto680):04384         * U/ with an (unsigned) double quotient. 
+                      (fig-forth-auto680):04385         * Guaranteed not to lose significant bits in 32 bit / 16 bit bit integer math,
+                      (fig-forth-auto680):04386         * if you are prepared to deal with the extra 16 bits of result.
+235F 85               (fig-forth-auto680):04387                 FCB     $85
+2360 4D2F4D4F         (fig-forth-auto680):04388                 FCC     'M/MO'  ; 'M/MOD'
+2364 C4               (fig-forth-auto680):04389                 FCB     $C4
+2365 2350             (fig-forth-auto680):04390                 FDB     SSLASH-5
+2367 17B6167C183A1697 (fig-forth-auto680):04391         MSMOD   FDB     DOCOL,TOR,ZERO,R,USLASH
+     15D6
+2371 168B1733167C15D6 (fig-forth-auto680):04392                 FDB     FROMR,SWAP,TOR,USLASH,FROMR
+     168B
+237B 1662             (fig-forth-auto680):04393                 FDB     SEMIS
+                      (fig-forth-auto680):04394         *
+                      (fig-forth-auto680):04395         * ======>>  166  <<
+                      (fig-forth-auto680):04396         * ( n>=0 --- n )
+                      (fig-forth-auto680):04397         * ( n<0 --- -n )
+                      (fig-forth-auto680):04398         * Convert the top of stack to its absolute value.
+237D 83               (fig-forth-auto680):04399                 FCB     $83
+237E 4142             (fig-forth-auto680):04400                 FCC     'AB'    ; 'ABS'
+2380 D3               (fig-forth-auto680):04401                 FCB     $D3
+2381 235F             (fig-forth-auto680):04402                 FDB     MSMOD-8
+2383 17B6174216B01409 (fig-forth-auto680):04403         ABS     FDB     DOCOL,DUP,ZLESS,ZBRAN
+238B 0002             (fig-forth-auto680):04404                 FDB     ABS2-*-NATWID
+238D 16EA             (fig-forth-auto680):04405                 FDB     MINUS
+238F 1662             (fig-forth-auto680):04406         ABS2    FDB     SEMIS
+                      (fig-forth-auto680):04407         *
+                      (fig-forth-auto680):04408         * ======>>  167  <<
+                      (fig-forth-auto680):04409         * ( d>=0 --- d )
+                      (fig-forth-auto680):04410         * ( d<0 --- -d )
+                      (fig-forth-auto680):04411         * Convert the top double to its absolute value.
+2391 84               (fig-forth-auto680):04412                 FCB     $84
+2392 444142           (fig-forth-auto680):04413                 FCC     'DAB'   ; 'DABS'
+2395 D3               (fig-forth-auto680):04414                 FCB     $D3
+2396 237D             (fig-forth-auto680):04415                 FDB     ABS-6
+2398 17B6174216B01409 (fig-forth-auto680):04416         DABS    FDB     DOCOL,DUP,ZLESS,ZBRAN
+23A0 0002             (fig-forth-auto680):04417                 FDB     DABS2-*-NATWID
+23A2 16FD             (fig-forth-auto680):04418                 FDB     DMINUS
+23A4 1662             (fig-forth-auto680):04419         DABS2   FDB     SEMIS
+                      (fig-forth-auto680):04420         *
+                      (fig-forth-auto680):04421         * ######>> screen 58 <<
+                      (fig-forth-auto680):04422         * Disc primitives :
+                      (fig-forth-auto680):04423         * ======>>  168  <<
+                      (fig-forth-auto680):04424         * ( --- vadr )   
+                      (fig-forth-auto680):04425         * Least Recently Used buffer.
+                      (fig-forth-auto680):04426         * Really should be with FIRST and LIMIT in the per-task table.
+23A6 83               (fig-forth-auto680):04427                 FCB     $83
+23A7 5553             (fig-forth-auto680):04428                 FCC     'US'    ; 'USE'
+23A9 C5               (fig-forth-auto680):04429                 FCB     $C5
+23AA 2391             (fig-forth-auto680):04430                 FDB     DABS-7
+23AC 17E6             (fig-forth-auto680):04431         USE     FDB     DOCON
+23AE 7C58             (fig-forth-auto680):04432                 FDB     XUSE
+                      (fig-forth-auto680):04433         * ======>>  169  <<
+                      (fig-forth-auto680):04434         * ( --- vadr )   
+                      (fig-forth-auto680):04435         * Most Recently Used buffer.
+                      (fig-forth-auto680):04436         * Really should be with FIRST and LIMIT in the per-task table.
+23B0 84               (fig-forth-auto680):04437                 FCB     $84
+23B1 505245           (fig-forth-auto680):04438                 FCC     'PRE'   ; 'PREV'
+23B4 D6               (fig-forth-auto680):04439                 FCB     $D6
+23B5 23A6             (fig-forth-auto680):04440                 FDB     USE-6
+23B7 17E6             (fig-forth-auto680):04441         PREV    FDB     DOCON
+23B9 7C5A             (fig-forth-auto680):04442                 FDB     XPREV
+                      (fig-forth-auto680):04443         * ======>>  170  <<
+                      (fig-forth-auto680):04444         * ( buffer1 --- buffer2 f )
+                      (fig-forth-auto680):04445         * Bump to next buffer,
+                      (fig-forth-auto680):04446         * flag false if result is PREVious buffer,
+                      (fig-forth-auto680):04447         * otherwise flag true. 
+                      (fig-forth-auto680):04448         * Used in the LRU allocation routines.
+23BB 84               (fig-forth-auto680):04449                 FCB     $84
+23BC 2B4255           (fig-forth-auto680):04450                 FCC     '+BU'   ; '+BUF'
+23BF C6               (fig-forth-auto680):04451                 FCB     $C6
+23C0 23B0             (fig-forth-auto680):04452                 FDB     PREV-7
+23C2 17B613A7         (fig-forth-auto680):04453         PBUF    FDB     DOCOL,LIT8
+23C6 84               (fig-forth-auto680):04454                 FCB     $84
+23C7 16C1174218731A0E (fig-forth-auto680):04455                 FDB     PLUS,DUP,LIMIT,EQUAL,ZBRAN
+     1409
+23D1 0004             (fig-forth-auto680):04456                 FDB     PBUF2-*-NATWID
+23D3 17251867         (fig-forth-auto680):04457                 FDB     DROP,FIRST
+23D7 174223B7176F1A01 (fig-forth-auto680):04458         PBUF2   FDB     DUP,PREV,AT,SUB
+23DF 1662             (fig-forth-auto680):04459                 FDB     SEMIS
+                      (fig-forth-auto680):04460         *
+                      (fig-forth-auto680):04461         * ======>>  171  <<
+                      (fig-forth-auto680):04462         * ( --- )
+                      (fig-forth-auto680):04463         * Mark PREVious buffer dirty, in need of being written out.
+23E1 86               (fig-forth-auto680):04464                 FCB     $86
+23E2 5550444154       (fig-forth-auto680):04465                 FCC     'UPDAT' ; 'UPDATE'
+23E7 C5               (fig-forth-auto680):04466                 FCB     $C5
+23E8 23BB             (fig-forth-auto680):04467                 FDB     PBUF-7
+23EA 17B623B7176F176F (fig-forth-auto680):04468         UPDATE  FDB     DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
+     13998000161923B7
+     176F1787
+23FE 1662             (fig-forth-auto680):04469                 FDB     SEMIS
+                      (fig-forth-auto680):04470         *
+                      (fig-forth-auto680):04471         * ======>>  172  <<
+                      (fig-forth-auto680):04472         * ( --- )
+                      (fig-forth-auto680):04473         * Mark all buffers empty. 
+                      (fig-forth-auto680):04474         * Standard method of discarding changes.
+2400 8D               (fig-forth-auto680):04475                 FCB     $8D
+2401 454D5054592D4255 (fig-forth-auto680):04476                 FCC     'EMPTY-BUFFER'  ; 'EMPTY-BUFFERS'
+     46464552
+240D D3               (fig-forth-auto680):04477                 FCB     $D3
+240E 23E1             (fig-forth-auto680):04478                 FDB     UPDATE-9
+2410 17B6186718731717 (fig-forth-auto680):04479         MTBUF   FDB     DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
+     1A011E71
+241C 1662             (fig-forth-auto680):04480                 FDB     SEMIS
+                      (fig-forth-auto680):04481         *
+                      (fig-forth-auto680):04482         * ======>>  173  <<
+                      (fig-forth-auto680):04483         * ( --- )
+                      (fig-forth-auto680):04484         * Clear the current offset to the block numbers in the drive interface.
+                      (fig-forth-auto680):04485         * The drives need to be re-architected.
+                      (fig-forth-auto680):04486         * Would be cool to have RAM and ROM drives supported
+                      (fig-forth-auto680):04487         * in addition to regular physical persistent store.
+241E 83               (fig-forth-auto680):04488                 FCB     $83
+241F 4452             (fig-forth-auto680):04489                 FCC     'DR'    ; 'DR0'
+2421 B0               (fig-forth-auto680):04490                 FCB     $B0
+2422 2400             (fig-forth-auto680):04491                 FDB     MTBUF-16
+2424 17B6183A192D1787 (fig-forth-auto680):04492         DRZERO  FDB     DOCOL,ZERO,OFSET,STORE
+242C 1662             (fig-forth-auto680):04493                 FDB     SEMIS
+                      (fig-forth-auto680):04494         *
+                      (fig-forth-auto680):04495         * ======>>  174  <<== system dependant word
+                      (fig-forth-auto680):04496         * ( --- )
+                      (fig-forth-auto680):04497         * Set the current offset in the drive interface to reference the second drive.
+                      (fig-forth-auto680):04498         * The hard-coded number in there needs to be in a table.
+242E 83               (fig-forth-auto680):04499                 FCB     $83
+242F 4452             (fig-forth-auto680):04500                 FCC     'DR'    ; 'DR1'
+2431 B1               (fig-forth-auto680):04501                 FCB     $B1
+2432 241E             (fig-forth-auto680):04502                 FDB     DRZERO-6
+2434 17B6139907D0192D (fig-forth-auto680):04503         DRONE   FDB     DOCOL,LIT,$07D0,OFSET,STORE
+     1787
+243E 1662             (fig-forth-auto680):04504                 FDB     SEMIS
+                      (fig-forth-auto680):04505         *
+                      (fig-forth-auto680):04506         * ######>> screen 59 <<
+                      (fig-forth-auto680):04507         * ======>>  175  <<
+                      (fig-forth-auto680):04508         * ( n --- buffer )
+                      (fig-forth-auto680):04509         * Get a free buffer,
+                      (fig-forth-auto680):04510         * assign it to block n,
+                      (fig-forth-auto680):04511         * return buffer address.
+                      (fig-forth-auto680):04512         * Will free a buffer by writing it, if necessary. 
+                      (fig-forth-auto680):04513         * Does not actually read the block. 
+                      (fig-forth-auto680):04514         * A bug in the fig LRU algorithm, which I have not fixed,
+                      (fig-forth-auto680):04515         * gives the PREVious buffer if USE gets set to PREVious.
+                      (fig-forth-auto680):04516         * (The bug is that USE sometimes gets set to PREVious.) 
+                      (fig-forth-auto680):04517         * This bug sometimes causes sector moves to become sector fills.
+2440 86               (fig-forth-auto680):04518                 FCB     $86
+2441 4255464645       (fig-forth-auto680):04519                 FCC     'BUFFE' ; 'BUFFER'
+2446 D2               (fig-forth-auto680):04520                 FCB     $D2
+2447 242E             (fig-forth-auto680):04521                 FDB     DRONE-6
+2449 17B623AC176F1742 (fig-forth-auto680):04522         BUFFER  FDB     DOCOL,USE,AT,DUP,TOR
+     167C
+2453 23C21409         (fig-forth-auto680):04523         BUFFR2  FDB     PBUF,ZBRAN
+2457 FFFA             (fig-forth-auto680):04524                 FDB     BUFFR2-*-NATWID
+2459 23AC17871697176F (fig-forth-auto680):04525                 FDB     USE,STORE,R,AT,ZLESS
+     16B0
+2463 1409             (fig-forth-auto680):04526                 FDB     ZBRAN
+2465 0012             (fig-forth-auto680):04527                 FDB     BUFFR3-*-NATWID
+                      (fig-forth-auto680):04528         *       FDB     R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
+2467 169717FF1697176F (fig-forth-auto680):04529                 FDB     R,NATP,R,AT,LIT,$7FFF,AND,ZERO,RW
+     13997FFF1609183A
+     263A
+                      (fig-forth-auto680):04530         * BUFFR3        FDB     R,STORE,R,PREV,STORE,FROMR,TWOP
+2479 16971787169723B7 (fig-forth-auto680):04531         BUFFR3  FDB     R,STORE,R,PREV,STORE,FROMR,NATP
+     1787168B17FF
+2487 1662             (fig-forth-auto680):04532                 FDB     SEMIS
+                      (fig-forth-auto680):04533         *
+                      (fig-forth-auto680):04534         * ######>> screen 60 <<
+                      (fig-forth-auto680):04535         * ======>>  176  <<
+                      (fig-forth-auto680):04536         * ( n --- buffer )
+                      (fig-forth-auto680):04537         * Get BUFFER containing block n, relative to OFFSET. 
+                      (fig-forth-auto680):04538         * If block n is not in a buffer, bring it in. 
+                      (fig-forth-auto680):04539         * Returns buffer address.
+2489 85               (fig-forth-auto680):04540                 FCB     $85
+248A 424C4F43         (fig-forth-auto680):04541                 FCC     'BLOC'  ; 'BLOCK'
+248E CB               (fig-forth-auto680):04542                 FCB     $CB
+248F 2440             (fig-forth-auto680):04543                 FDB     BUFFER-9
+2491 17B6192D176F16C1 (fig-forth-auto680):04544         BLOCK   FDB     DOCOL,OFSET,AT,PLUS,TOR
+     167C
+249B 23B7176F1742176F (fig-forth-auto680):04545                 FDB     PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
+     16971A01174216C1
+     1409
+24AD 0032             (fig-forth-auto680):04546                 FDB     BLOCK5-*-NATWID
+24AF 23C2169E1409     (fig-forth-auto680):04547         BLOCK3  FDB     PBUF,ZEQU,ZBRAN
+24B5 0012             (fig-forth-auto680):04548                 FDB     BLOCK4-*-NATWID
+                      (fig-forth-auto680):04549         *       FDB     DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
+24B7 1725169724491742 (fig-forth-auto680):04550                 FDB     DROP,R,BUFFER,DUP,R,ONE,RW,NATWC,SUB
+     16971842263A17F4
+     1A01
+24C9 1742176F16971A01 (fig-forth-auto680):04551         BLOCK4  FDB     DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
+     174216C1169E1409
+24D9 FFD4             (fig-forth-auto680):04552                 FDB     BLOCK3-*-NATWID
+24DB 174223B71787     (fig-forth-auto680):04553                 FDB     DUP,PREV,STORE
+                      (fig-forth-auto680):04554         * BLOCK5        FDB     FROMR,DROP,TWOP
+24E1 168B172517FF     (fig-forth-auto680):04555         BLOCK5  FDB     FROMR,DROP,NATP
+24E7 1662             (fig-forth-auto680):04556                 FDB     SEMIS
+                      (fig-forth-auto680):04557         *
+                      (fig-forth-auto680):04558         * ######>> screen 61 <<
+                      (fig-forth-auto680):04559         * ======>>  177  <<
+                      (fig-forth-auto680):04560         * ( line screen --- buffer C/L)
+                      (fig-forth-auto680):04561         * Bring in the sector containing the specified line of the specified screen. 
+                      (fig-forth-auto680):04562         * Returns the buffer address and the width of the screen. 
+                      (fig-forth-auto680):04563         * Screen number is relative to OFFSET. 
+                      (fig-forth-auto680):04564         * The line number may be beyond screen 4,
+                      (fig-forth-auto680):04565         * (LINE) will get the appropriate screen.
+24E9 86               (fig-forth-auto680):04566                 FCB     $86
+24EA 284C494E45       (fig-forth-auto680):04567                 FCC     '(LINE' ; '(LINE)'
+24EF A9               (fig-forth-auto680):04568                 FCB     $A9
+24F0 2489             (fig-forth-auto680):04569                 FDB     BLOCK-8
+24F2 17B6167C13A7     (fig-forth-auto680):04570         PLINE   FDB     DOCOL,TOR,LIT8
+24F8 40               (fig-forth-auto680):04571                 FCB     $40
+24F9 187F2344168B188B (fig-forth-auto680):04572                 FDB     BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,LIT8
+     230516C1249116C1
+     13A7
+250B 40               (fig-forth-auto680):04573                 FCB     $40
+250C 1662             (fig-forth-auto680):04574                 FDB     SEMIS
+                      (fig-forth-auto680):04575         *
+                      (fig-forth-auto680):04576         * ======>>  178  <<
+                      (fig-forth-auto680):04577         * ( line screen --- )
+                      (fig-forth-auto680):04578         * Print the line of the screen as found by (LINE), suppress trailing BLANKS.
+250E 85               (fig-forth-auto680):04579                 FCB     $85
+250F 2E4C494E         (fig-forth-auto680):04580                 FCC     '.LIN'  ; '.LINE'
+2513 C5               (fig-forth-auto680):04581                 FCB     $C5
+2514 24E9             (fig-forth-auto680):04582                 FDB     PLINE-9
+2516 17B624F21CD81CAA (fig-forth-auto680):04583         DLINE   FDB     DOCOL,PLINE,DTRAIL,TYPE
+251E 1662             (fig-forth-auto680):04584                 FDB     SEMIS
+                      (fig-forth-auto680):04585         *
+                      (fig-forth-auto680):04586         * ======>>  179  <<
+                      (fig-forth-auto680):04587         * ( n --- )
+                      (fig-forth-auto680):04588         * If WARNING is 0, print "MESSAGE #n";
+                      (fig-forth-auto680):04589         * otherwise, print line n relative to screen 4,
+                      (fig-forth-auto680):04590         * the line number may be negative. 
+                      (fig-forth-auto680):04591         * Uses .LINE, but counter-adjusts to be relative to the real drive 0.
+2520 87               (fig-forth-auto680):04592                 FCB     $87
+2521 4D4553534147     (fig-forth-auto680):04593                 FCC     'MESSAG'        ; 'MESSAGE'
+2527 C5               (fig-forth-auto680):04594                 FCB     $C5
+2528 250E             (fig-forth-auto680):04595                 FDB     DLINE-8
+252A 17B618D5176F1409 (fig-forth-auto680):04596         MESS    FDB     DOCOL,WARN,AT,ZBRAN
+2532 0019             (fig-forth-auto680):04597                 FDB     MESS3-*-NATWID
+2534 1A871409         (fig-forth-auto680):04598                 FDB     DDUP,ZBRAN
+2538 0013             (fig-forth-auto680):04599                 FDB     MESS3-*-NATWID
+253A 13A7             (fig-forth-auto680):04600                 FDB     LIT8
+253C 04               (fig-forth-auto680):04601                 FCB     4
+253D 192D176F188B2324 (fig-forth-auto680):04602                 FDB     OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
+     1A01251613FA
+254B 000B             (fig-forth-auto680):04603                 FDB     MESS4-*-NATWID
+254D 1D0B             (fig-forth-auto680):04604         MESS3   FDB     PDOTQ
+254F 06               (fig-forth-auto680):04605                 FCB     6
+2550 657272202320     (fig-forth-auto680):04606                 FCC     'err # '        ; 'err # '
+2556 28D1             (fig-forth-auto680):04607                 FDB     DOT
+2558 1662             (fig-forth-auto680):04608         MESS4   FDB     SEMIS
+                      (fig-forth-auto680):04609         *
+                      (fig-forth-auto680):04610         * ======>>  180  <<
+                      (fig-forth-auto680):04611         * ( n --- )
+                      (fig-forth-auto680):04612         * Begin interpretation of screen (block) n. 
+                      (fig-forth-auto680):04613         * See also ARROW, SEMIS, and NULL.
+255A 84               (fig-forth-auto680):04614                 FCB     $84
+255B 4C4F41           (fig-forth-auto680):04615                 FCC     'LOA'   ; 'LOAD' :      input:scr #
+255E C4               (fig-forth-auto680):04616                 FCB     $C4
+255F 2520             (fig-forth-auto680):04617                 FDB     MESS-10
+2561 17B61903176F167C (fig-forth-auto680):04618         LOAD    FDB     DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
+     190C176F167C183A
+     190C1787
+2575 188B230519031787 (fig-forth-auto680):04619                 FDB     BSCR,STAR,BLK,STORE
+257D 211C168B190C1787 (fig-forth-auto680):04620                 FDB     INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
+     168B19031787
+258B 1662             (fig-forth-auto680):04621                 FDB     SEMIS
+                      (fig-forth-auto680):04622         *
+                      (fig-forth-auto680):04623         * ======>>  181  <<
+                      (fig-forth-auto680):04624         * ( --- )                                                 P
+                      (fig-forth-auto680):04625         * Continue interpreting source code on the next screen.
+258D C3               (fig-forth-auto680):04626                 FCB     $C3
+258E 2D2D             (fig-forth-auto680):04627                 FCC     '--'    ; '-->'
+2590 BE               (fig-forth-auto680):04628                 FCB     $BE
+2591 255A             (fig-forth-auto680):04629                 FDB     LOAD-7
+2593 17B61BAB183A190C (fig-forth-auto680):04630         ARROW   FDB     DOCOL,QLOAD,ZERO,IN,STORE,BSCR
+     1787188B
+259F 1903176F17172334 (fig-forth-auto680):04631                 FDB     BLK,AT,OVER,MOD,SUB,BLK,PSTORE
+     1A011903174E
+25AD 1662             (fig-forth-auto680):04632                 FDB     SEMIS
+                      (fig-forth-auto680):04633                 PAGE
+                      (fig-forth-auto680):04634         *
+                      (fig-forth-auto680):04635         *
+                      (fig-forth-auto680):04636         * ######>> screen 63 <<
+                      (fig-forth-auto680):04637         *    The next 4 subroutines are machine dependent, and are
+                      (fig-forth-auto680):04638         *    called by words 13 through 16 in the dictionary.
+                      (fig-forth-auto680):04639         *
+                      (fig-forth-auto680):04640         * ======>>  182  << code for EMIT
+                      (fig-forth-auto680):04641         * ( --- ) No parameter stack effect.
+                      (fig-forth-auto680):04642         * Interfaces directly with ROM. Expects output character in D (therefore, B).
+                      (fig-forth-auto680):04643         * Output using rom CHROUT: redirectable to a printer on Coco.
+                      (fig-forth-auto680):04644         * Outputs the character on stack (low byte of 1 bit word/cell).
+25AF 3468             (fig-forth-auto680):04645         PEMIT   PSHS    Y,U,DP  ; Save everything important! (For good measure, only.)
+25B1 1F98             (fig-forth-auto680):04646                 TFR     B,A     ; Coco ROM wants it in A.
+25B3 5F               (fig-forth-auto680):04647                 CLRB
+25B4 1F9B             (fig-forth-auto680):04648                 TFR     B,DP    ; Give the ROM its direct page.
+25B6 AD9FA002         (fig-forth-auto680):04649                 JSR     [$A002] ; Output the character in A.
+25BA 35E8             (fig-forth-auto680):04650                 PULS    Y,U,DP,PC
+                      (fig-forth-auto680):04651         * PEMIT STB N   save B
+                      (fig-forth-auto680):04652         *       STX     N+1     save X
+                      (fig-forth-auto680):04653         *       LDB ACIAC
+                      (fig-forth-auto680):04654         *       BITB #2 check ready bit
+                      (fig-forth-auto680):04655         *       BEQ     PEMIT+4 if not ready for more data
+                      (fig-forth-auto680):04656         *       STA ACIAD
+                      (fig-forth-auto680):04657         *       LDX     UP
+                      (fig-forth-auto680):04658         *       STB IOSTAT-UORIG,X
+                      (fig-forth-auto680):04659         *       LDB N   recover B & X
+                      (fig-forth-auto680):04660         *       LDX     N+1
+                      (fig-forth-auto680):04661         *       RTS             only A register may change
+                      (fig-forth-auto680):04662         *  PEMIT        JMP     $E1D1   for MIKBUG
+                      (fig-forth-auto680):04663         *  PEMIT        FCB     $3F,$11,$39     for PROTO
+                      (fig-forth-auto680):04664         *  PEMIT        JMP     $D286 for Smoke Signal DOS
+                      (fig-forth-auto680):04665         *
+                      (fig-forth-auto680):04666         * ======>>  183  << code for KEY
+                      (fig-forth-auto680):04667         * ( --- ) No parameter stack effect.
+                      (fig-forth-auto680):04668         * Returns character or break flag in D, since this interfaces with Coco ROM.
+                      (fig-forth-auto680):04669         * Wait for key from POLCAT on Coco.
+                      (fig-forth-auto680):04670         * Returns the character code for the key pressed.
+25BC 3468             (fig-forth-auto680):04671         PKEY    PSHS    Y,U,DP  ; Must save everything important for this one.
+25BE 86CF             (fig-forth-auto680):04672                 LDA     #$CF    ; a cursor of sorts
+25C0 5F               (fig-forth-auto680):04673                 CLRB
+25C1 1F9B             (fig-forth-auto680):04674                 TFR     B,DP
+     00               (fig-forth-auto680):04675                 SETDP   0
+25C3 9E88             (fig-forth-auto680):04676                 LDX     <$88    ; location
+25C5 E684             (fig-forth-auto680):04677                 LDB     ,X      ; save glyph
+25C7 A784             (fig-forth-auto680):04678                 STA     ,X
+25C9 AD9FA000         (fig-forth-auto680):04679         PKEYLP  JSR     [$A000]
+25CD B7041A           (fig-forth-auto680):04680                 STA     $41A    ; DBG!
+25D0 27F7             (fig-forth-auto680):04681                 BEQ     PKEYLP
+25D2 FD0418           (fig-forth-auto680):04682                 STD     $418    ; DBG!
+25D5 E784             (fig-forth-auto680):04683                 STB     ,X      ; restore
+25D7 5F               (fig-forth-auto680):04684         PKEYR   CLRB            ; for the break flag, shares code with PQTER
+25D8 8103             (fig-forth-auto680):04685                 CMPA    #3      ; break key
+25DA 2601             (fig-forth-auto680):04686                 BNE     PKEYGT
+25DC 53               (fig-forth-auto680):04687                 COMB            ; for the break flag
+25DD 1E89             (fig-forth-auto680):04688         PKEYGT  EXG     A,B     ; Leave it in D for return.
+25DF 35E8             (fig-forth-auto680):04689                 PULS    Y,U,DP,PC       ; Shares exit with PQTER
+     7C               (fig-forth-auto680):04690                 SETDP IUPDP
+                      (fig-forth-auto680):04691         * PKEY  STB N
+                      (fig-forth-auto680):04692         *       STX     N+1
+                      (fig-forth-auto680):04693         *       LDB ACIAC
+                      (fig-forth-auto680):04694         *       ASRB    ;
+                      (fig-forth-auto680):04695         *       BCC     PKEY+4  no incoming data yet
+                      (fig-forth-auto680):04696         *       LDA ACIAD
+                      (fig-forth-auto680):04697         *       ANDA #$7F       strip parity bit
+                      (fig-forth-auto680):04698         *       LDX     UP
+                      (fig-forth-auto680):04699         *       STB IOSTAT+1-UORIG,X
+                      (fig-forth-auto680):04700         *       LDB N
+                      (fig-forth-auto680):04701         *       LDX     N+1
+                      (fig-forth-auto680):04702         *       RTS
+                      (fig-forth-auto680):04703         *  PKEY JMP     $E1AC   for MIKBUG
+                      (fig-forth-auto680):04704         *  PKEY FCB     $3F,$14,$39     for PROTO
+                      (fig-forth-auto680):04705         *  PKEY JMP     $D289 for Smoke Signal DOS
+                      (fig-forth-auto680):04706         *
+                      (fig-forth-auto680):04707         * ######>> screen 64 <<
+                      (fig-forth-auto680):04708         * ======>>  184  << code for ?TERMINAL
+                      (fig-forth-auto680):04709         * ( --- f ) Should change this to no stack effect.
+                      (fig-forth-auto680):04710         * check break key using POLCAT
+                      (fig-forth-auto680):04711         * Returns a flag to tell whether the break key was pressed or not.
+25E1 3468             (fig-forth-auto680):04712         PQTER   PSHS Y,U,DP
+25E3 5F               (fig-forth-auto680):04713                 CLRB
+25E4 1F9B             (fig-forth-auto680):04714                 TFR B,DP
+25E6 AD9FA000         (fig-forth-auto680):04715                 JSR [$A000]     ; Look but don't wait.
+25EA 20EB             (fig-forth-auto680):04716                 BRA PKEYR
+                      (fig-forth-auto680):04717         * PQTER LDA ACIAC       Test for 'break'  condition
+                      (fig-forth-auto680):04718         *       ANDA #$11       mask framing error bit and
+                      (fig-forth-auto680):04719         *                       input buffer full
+                      (fig-forth-auto680):04720         *       BEQ     PQTER2
+                      (fig-forth-auto680):04721         *       LDA ACIAD       clear input buffer
+                      (fig-forth-auto680):04722         *       LDA #01
+                      (fig-forth-auto680):04723         * PQTER2        RTS
+                      (fig-forth-auto680):04724         
+                      (fig-forth-auto680):04725         
+                      (fig-forth-auto680):04726                 PAGE
+                      (fig-forth-auto680):04727         *
+                      (fig-forth-auto680):04728         * ======>>  185  << code for CR
+                      (fig-forth-auto680):04729         * ( --- ) No stack effect.
+                      (fig-forth-auto680):04730         * Interfaces directly with ROM. 
+                      (fig-forth-auto680):04731         * For Coco just output a CR.
+                      (fig-forth-auto680):04732         * Also subject to redirection in Coco BASIC ROM.
+25EC C60D             (fig-forth-auto680):04733         PCR     LDB #$0D
+25EE 20BF             (fig-forth-auto680):04734                 BRA PEMIT       ; Just steal the code.
+                      (fig-forth-auto680):04735         * PCR   LDA #$D carriage return
+                      (fig-forth-auto680):04736         *       BSR     PEMIT
+                      (fig-forth-auto680):04737         *       LDA #$A line feed
+                      (fig-forth-auto680):04738         *       BSR     PEMIT
+                      (fig-forth-auto680):04739         *       LDA #$7F        rubout
+                      (fig-forth-auto680):04740         *       LDX     UP
+                      (fig-forth-auto680):04741         *       LDB XDELAY+1-UORIG,X
+                      (fig-forth-auto680):04742         * PCR2  DECB    ;
+                      (fig-forth-auto680):04743         *       BMI     PQTER2  return if minus
+                      (fig-forth-auto680):04744         *       PSHS B  ; save counter
+                      (fig-forth-auto680):04745         *       BSR     PEMIT   print RUBOUTs to delay.....
+                      (fig-forth-auto680):04746         *       PULS B  ; 
+                      (fig-forth-auto680):04747         *       BRA     PCR2    repeat
+                      (fig-forth-auto680):04748         
+                      (fig-forth-auto680):04749         
+                      (fig-forth-auto680):04750                 PAGE
+                      (fig-forth-auto680):04751         *
+                      (fig-forth-auto680):04752         * ######>> screen 66 <<
+                      (fig-forth-auto680):04753         * ======>>  187  <<
+                      (fig-forth-auto680):04754         * ( ??? )
+                      (fig-forth-auto680):04755         * Query the disk, I suppose.
+                      (fig-forth-auto680):04756         * Not sure what the model had in mind for this stub.
+25F0 85               (fig-forth-auto680):04757                 FCB     $85
+25F1 3F444953         (fig-forth-auto680):04758                 FCC     '?DIS'  ; '?DISC'
+25F5 C3               (fig-forth-auto680):04759                 FCB     $C3
+25F6 258D             (fig-forth-auto680):04760                 FDB     ARROW-6
+25F8 25FA             (fig-forth-auto680):04761         QDISC   FDB     *+NATWID
+25FA 7E1228           (fig-forth-auto680):04762                 JMP     NEXT
+                      (fig-forth-auto680):04763         *
+                      (fig-forth-auto680):04764         * ######>> screen 67 <<
+                      (fig-forth-auto680):04765         * ======>>  189  <<
+                      (fig-forth-auto680):04766         * ( ??? )
+                      (fig-forth-auto680):04767         * Write one block of data to disk.
+                      (fig-forth-auto680):04768         * Parameters unspecified in model. Stub in model.
+25FD 8B               (fig-forth-auto680):04769                 FCB     $8B
+25FE 424C4F434B2D5752 (fig-forth-auto680):04770                 FCC     'BLOCK-WRIT'    ; 'BLOCK-WRITE'
+     4954
+2608 C5               (fig-forth-auto680):04771                 FCB     $C5
+2609 25F0             (fig-forth-auto680):04772                 FDB     QDISC-8
+260B 260D             (fig-forth-auto680):04773         BWRITE  FDB     *+NATWID
+260D 7E1228           (fig-forth-auto680):04774                 JMP     NEXT
+                      (fig-forth-auto680):04775         *
+                      (fig-forth-auto680):04776         * ######>> screen 68 <<
+                      (fig-forth-auto680):04777         * ======>>  190  <<
+                      (fig-forth-auto680):04778         * ( ??? )
+                      (fig-forth-auto680):04779         * Read one block of data from disk.
+                      (fig-forth-auto680):04780         * Parameters unspecified in model. Stub in model.
+2610 8A               (fig-forth-auto680):04781                 FCB     $8A
+2611 424C4F434B2D5245 (fig-forth-auto680):04782                 FCC     'BLOCK-REA'     ; 'BLOCK-READ'
+     41
+261A C4               (fig-forth-auto680):04783                 FCB     $C4
+261B 25FD             (fig-forth-auto680):04784                 FDB     BWRITE-14
+261D 261F             (fig-forth-auto680):04785         BREAD   FDB     *+NATWID
+261F 7E1228           (fig-forth-auto680):04786                 JMP     NEXT
+                      (fig-forth-auto680):04787         *
+                      (fig-forth-auto680):04788         *The next 3 words are written to create a substitute for disc
+                      (fig-forth-auto680):04789         * mass memory,located between $3210 & $3FFF in ram.
+                      (fig-forth-auto680):04790         * ======>>  190.1  <<
+2622 82               (fig-forth-auto680):04791                 FCB     $82
+2623 4C               (fig-forth-auto680):04792                 FCC     'L'     ; 'LO'
+2624 CF               (fig-forth-auto680):04793                 FCB     $CF
+2625 2610             (fig-forth-auto680):04794                 FDB     BREAD-13
+2627 17E6             (fig-forth-auto680):04795         LO      FDB     DOCON
+2629 7000             (fig-forth-auto680):04796                 FDB     MEMEND  a system dependent equate at front
+                      (fig-forth-auto680):04797         *
+                      (fig-forth-auto680):04798         * ======>>  190.2  <<
+262B 82               (fig-forth-auto680):04799                 FCB     $82
+262C 48               (fig-forth-auto680):04800                 FCC     'H'     ; 'HI'
+262D C9               (fig-forth-auto680):04801                 FCB     $C9
+262E 2622             (fig-forth-auto680):04802                 FDB     LO-5
+2630 17E6             (fig-forth-auto680):04803         HI      FDB     DOCON
+2632 7FFF             (fig-forth-auto680):04804                 FDB     MEMTOP  ( $3FFF or $7FFF in this version )
+                      (fig-forth-auto680):04805         *
+                      (fig-forth-auto680):04806         * ######>> screen 69 <<
+                      (fig-forth-auto680):04807         * ======>>  191  <<
+                      (fig-forth-auto680):04808         * ( buffer sector f --- )
+                      (fig-forth-auto680):04809         * Read or Write the specified (absolute -- ignores OFFSET) sector
+                      (fig-forth-auto680):04810         * from or to the specified buffer. 
+                      (fig-forth-auto680):04811         * A zero flag specifies write,
+                      (fig-forth-auto680):04812         * non-zero specifies read. 
+                      (fig-forth-auto680):04813         * Sector is an unsigned integer,
+                      (fig-forth-auto680):04814         * buffer is the buffer's address. 
+                      (fig-forth-auto680):04815         * Will need to use the CoCo ROM disk routines. 
+                      (fig-forth-auto680):04816         * For now, provides a virtual disk in RAM.
+2634 83               (fig-forth-auto680):04817                 FCB     $83
+2635 522F             (fig-forth-auto680):04818                 FCC     'R/'    ; 'R/W'
+2637 D7               (fig-forth-auto680):04819                 FCB     $D7
+2638 262B             (fig-forth-auto680):04820                 FDB     HI-5
+263A 17B6167C187F2305 (fig-forth-auto680):04821         RW      FDB     DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
+     262716C117422630
+     1A321409
+264E 000D             (fig-forth-auto680):04822                 FDB     RW2-*-NATWID
+2650 1D0B             (fig-forth-auto680):04823                 FDB     PDOTQ
+2652 08               (fig-forth-auto680):04824                 FCB     8
+2653 2052616E6765203F (fig-forth-auto680):04825                 FCC     ' Range ?'      ; ' Range ?'
+265B 21D6             (fig-forth-auto680):04826                 FDB     QUIT
+265D 168B1409         (fig-forth-auto680):04827         RW2     FDB     FROMR,ZBRAN
+2661 0002             (fig-forth-auto680):04828                 FDB     RW3-*-NATWID
+2663 1733             (fig-forth-auto680):04829                 FDB     SWAP
+2665 187F1583         (fig-forth-auto680):04830         RW3     FDB     BBUF,CMOVE
+2669 1662             (fig-forth-auto680):04831                 FDB     SEMIS
+                      (fig-forth-auto680):04832         *
+                      (fig-forth-auto680):04833         * From BIF-6809:
+                      (fig-forth-auto680):04834         * RW    PSHS Y,U,DP
+                      (fig-forth-auto680):04835         *       LDY $C006 control table
+                      (fig-forth-auto680):04836         *       LDX #DROFFS+7   ; This is BIF's table of drive sizes.
+                      (fig-forth-auto680):04837         *       LDD 2,U
+                      (fig-forth-auto680):04838         * RWD   SUBD ,X++ sectors
+                      (fig-forth-auto680):04839         *       BHS RWD
+                      (fig-forth-auto680):04840         *       BVC RWR table end?
+                      (fig-forth-auto680):04841         *       LDD #6
+                      (fig-forth-auto680):04842         *       PSHU D
+                      (fig-forth-auto680):04843         *       JMP ERROR
+                      (fig-forth-auto680):04844         * RWR   ADDD ,--X back one
+                      (fig-forth-auto680):04845         *       PSHS X
+                      (fig-forth-auto680):04846         *       PSHU D
+                      (fig-forth-auto680):04847         *       LDD #18 sectors/track
+                      (fig-forth-auto680):04848         *       PSHU D
+                      (fig-forth-auto680):04849         *       DOCOL
+                      (fig-forth-auto680):04850         *       FDB SLAMOD
+                      (fig-forth-auto680):04851         *       FDB XMACH
+                      (fig-forth-auto680):04852         *       PULU D
+                      (fig-forth-auto680):04853         *       STB 2,Y track
+                      (fig-forth-auto680):04854         *       PULU D
+                      (fig-forth-auto680):04855         *       INCB
+                      (fig-forth-auto680):04856         *       STB 3,Y sector
+                      (fig-forth-auto680):04857         *       PULS D table entry
+                      (fig-forth-auto680):04858         *       SUBD #DROFFS+7
+                      (fig-forth-auto680):04859         *       ASRB drive #
+                      (fig-forth-auto680):04860         *       STB 1,Y
+                      (fig-forth-auto680):04861         *       LDD 4,U buffer
+                      (fig-forth-auto680):04862         *       STD 4,Y
+                      (fig-forth-auto680):04863         *       LDB #2 coco READ
+                      (fig-forth-auto680):04864         *       LDX ,U 0?
+                      (fig-forth-auto680):04865         *       BNE *+3
+                      (fig-forth-auto680):04866         *       INCB coco WRITE
+                      (fig-forth-auto680):04867         *       STB ,Y op code
+                      (fig-forth-auto680):04868         *       CLRA
+                      (fig-forth-auto680):04869         *       TFR A,DP
+                      (fig-forth-auto680):04870         *       JSR [$C004]     ROM handles timeout
+                      (fig-forth-auto680):04871         *       PULS Y,U,DP     if IRQ enabled
+                      (fig-forth-auto680):04872         *       LEAU 6,U
+                      (fig-forth-auto680):04873         *       LDX $C006
+                      (fig-forth-auto680):04874         *       LDB 6,X coco status
+                      (fig-forth-auto680):04875         *       BEQ RWE
+                      (fig-forth-auto680):04876         *       LDX <UP
+                      (fig-forth-auto680):04877         *       LDD #0 no disc
+                      (fig-forth-auto680):04878         *       STD UWARN,X
+                      (fig-forth-auto680):04879         *       LDD #8
+                      (fig-forth-auto680):04880         *       PSHU D
+                      (fig-forth-auto680):04881         *       JMP ERROR
+                      (fig-forth-auto680):04882         * RWE   NEXT
+                      (fig-forth-auto680):04883         *
+                      (fig-forth-auto680):04884         * ######>> screen 72 <<
+                      (fig-forth-auto680):04885         * ======>>  192  <<
+                      (fig-forth-auto680):04886         * ( --- ) compiling                                       P
+                      (fig-forth-auto680):04887         * ( --- adr ) interpreting
+                      (fig-forth-auto680):04888         * { ' name } input
+                      (fig-forth-auto680):04889         * Parse a symbol name from input and search the dictionary for it, per -FIND;
+                      (fig-forth-auto680):04890         * compile the address as a literal if compiling,
+                      (fig-forth-auto680):04891         * otherwise just push it. 
+266B C1               (fig-forth-auto680):04892                 FCB     $C1     immediate
+266C A7               (fig-forth-auto680):04893                 FCB     $A7     '       ( tick )
+266D 2634             (fig-forth-auto680):04894                 FDB     RW-6
+266F 17B61FAC169E183A (fig-forth-auto680):04895         TICK    FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
+     1B36172520E1
+267D 1662             (fig-forth-auto680):04896                 FDB     SEMIS
+                      (fig-forth-auto680):04897         *
+                      (fig-forth-auto680):04898         * ======>>  193  <<
+                      (fig-forth-auto680):04899         * ( --- ) { FORGET name } input
+                      (fig-forth-auto680):04900         * Parse out name of definition to FORGET to, -DFIND it,
+                      (fig-forth-auto680):04901         * then lop it and everything that follows out of the dictionary. 
+                      (fig-forth-auto680):04902         * In fig Forth, CURRENT and CONTEXT have to be the same to FORGET.
+267F 86               (fig-forth-auto680):04903                 FCB     $86
+2680 464F524745       (fig-forth-auto680):04904                 FCC     'FORGE' ; 'FORGET'
+2685 D4               (fig-forth-auto680):04905                 FCB     $D4
+2686 266B             (fig-forth-auto680):04906                 FDB     TICK-4
+2688 17B61949176F193B (fig-forth-auto680):04907         FORGET  FDB     DOCOL,CURENT,AT,CONTXT,AT,SUB,LIT8
+     176F1A0113A7
+2696 18               (fig-forth-auto680):04908                 FCB     $18
+2697 1B36266F174218E1 (fig-forth-auto680):04909                 FDB     QERR,TICK,DUP,FENCE,AT,LESS,LIT8
+     176F1A1A13A7
+26A5 15               (fig-forth-auto680):04910                 FCB     $15
+26A6 1B361742183A1899 (fig-forth-auto680):04911                 FDB     QERR,DUP,ZERO,PORIG,GREAT,LIT8
+     1A3213A7
+26B2 15               (fig-forth-auto680):04912                 FCB     $15
+26B3 1B3617421AFA18EA (fig-forth-auto680):04913                 FDB     QERR,DUP,NFA,DICTPT,STORE,LFA,AT,CONTXT,AT,STORE
+     17871ADD176F193B
+     176F1787
+26C7 1662             (fig-forth-auto680):04914                 FDB     SEMIS
+                      (fig-forth-auto680):04915         *
+                      (fig-forth-auto680):04916         * ######>> screen 73 <<
+                      (fig-forth-auto680):04917         * ======>>  194  <<
+                      (fig-forth-auto680):04918         *  ( adr --- )                                             C
+                      (fig-forth-auto680):04919         * Calculate a back reference from HERE and compile it. 
+26C9 84               (fig-forth-auto680):04920                 FCB     $84
+26CA 424143           (fig-forth-auto680):04921                 FCC     'BAC'   ; 'BACK'
+26CD CB               (fig-forth-auto680):04922                 FCB     $CB
+26CE 267F             (fig-forth-auto680):04923                 FDB     FORGET-9
+26D0 17B619C41A0119E0 (fig-forth-auto680):04924         BACK    FDB     DOCOL,HERE,SUB,COMMA
+26D8 1662             (fig-forth-auto680):04925                 FDB     SEMIS
+                      (fig-forth-auto680):04926         *
+                      (fig-forth-auto680):04927         * ======>>  195  <<
+                      (fig-forth-auto680):04928         * ( --- )   runtime
+                      (fig-forth-auto680):04929         * typical use: BEGIN code-loop test UNTIL  
+                      (fig-forth-auto680):04930         * typical use: BEGIN code-loop AGAIN  
+                      (fig-forth-auto680):04931         * typical use: BEGIN code-loop test WHILE code-true REPEAT  
+                      (fig-forth-auto680):04932         * ( --- adr n )  compile time                       P,C
+                      (fig-forth-auto680):04933         * Push HERE for BACK reference for general (non-counting) loops,
+                      (fig-forth-auto680):04934         * with BEGIN construct flag.
+                      (fig-forth-auto680):04935         * A better flag: $4245 (ASCII for 'BE').
+26DA C5               (fig-forth-auto680):04936                 FCB     $C5
+26DB 42454749         (fig-forth-auto680):04937                 FCC     'BEGI'  ; 'BEGIN'
+26DF CE               (fig-forth-auto680):04938                 FCB     $CE
+26E0 26C9             (fig-forth-auto680):04939                 FDB     BACK-7
+26E2 17B61B5019C41842 (fig-forth-auto680):04940         BEGIN   FDB     DOCOL,QCOMP,HERE,ONE    ; ONE is a flag for BEGIN loops.
+26EA 1662             (fig-forth-auto680):04941                 FDB     SEMIS
+                      (fig-forth-auto680):04942         *
+                      (fig-forth-auto680):04943         * ======>>  196  <<
+                      (fig-forth-auto680):04944         * ( --- )   runtime
+                      (fig-forth-auto680):04945         * typical use: test IF code-true ELSE code-false ENDIF 
+                      (fig-forth-auto680):04946         * ENDIF is just a sort of intersection piece, 
+                      (fig-forth-auto680):04947         * marking where execution resumes after both branches.
+                      (fig-forth-auto680):04948         * ( adr n --- ) compile time
+                      (fig-forth-auto680):04949         * Check the mark and resolve the IF.
+                      (fig-forth-auto680):04950         * A better flag: $4846 (ASCII for 'IF').
+26EC C5               (fig-forth-auto680):04951                 FCB     $C5
+26ED 454E4449         (fig-forth-auto680):04952                 FCC     'ENDI'  ; 'ENDIF'
+26F1 C6               (fig-forth-auto680):04953                 FCB     $C6
+26F2 26DA             (fig-forth-auto680):04954                 FDB     BEGIN-8
+26F4 17B61B50184A1B7D (fig-forth-auto680):04955         ENDIF   FDB     DOCOL,QCOMP,TWO,QPAIRS,HERE     ; This TWO is a flag for IF.
+     19C4
+26FE 17171A0117331787 (fig-forth-auto680):04956                 FDB     OVER,SUB,SWAP,STORE
+2706 1662             (fig-forth-auto680):04957                 FDB     SEMIS
+                      (fig-forth-auto680):04958         *
+                      (fig-forth-auto680):04959         * ======>>  197  <<
+                      (fig-forth-auto680):04960         * ( --- )   runtime
+                      (fig-forth-auto680):04961         * typical use: test IF code-true ELSE code-false ENDIF 
+                      (fig-forth-auto680):04962         * ( adr n --- ) 
+                      (fig-forth-auto680):04963         * Alias for ENDIF .
+2708 C4               (fig-forth-auto680):04964                 FCB     $C4
+2709 544845           (fig-forth-auto680):04965                 FCC     'THE'   ; 'THEN'
+270C CE               (fig-forth-auto680):04966                 FCB     $CE
+270D 26EC             (fig-forth-auto680):04967                 FDB     ENDIF-8
+270F 17B626F4         (fig-forth-auto680):04968         THEN    FDB     DOCOL,ENDIF
+2713 1662             (fig-forth-auto680):04969                 FDB     SEMIS
+                      (fig-forth-auto680):04970         *
+                      (fig-forth-auto680):04971         * ======>>  198  <<
+                      (fig-forth-auto680):04972         * ( limit index --- )   runtime
+                      (fig-forth-auto680):04973         * typical use: DO code-loop LOOP  
+                      (fig-forth-auto680):04974         * typical use: DO code-loop increment +LOOP
+                      (fig-forth-auto680):04975         * Counted loop, index is initial value of index.
+                      (fig-forth-auto680):04976         * Will loop until index equals (positive going)
+                      (fig-forth-auto680):04977         * or passes (negative going) limit.
+                      (fig-forth-auto680):04978         *  ( --- adr n )  compile time                        P,C
+                      (fig-forth-auto680):04979         * Compile (DO), push HERE for BACK reference,
+                      (fig-forth-auto680):04980         * and push DO control construct flag.
+                      (fig-forth-auto680):04981         * A better flag: $444F (ASCII for 'DO').
+2715 C2               (fig-forth-auto680):04982                 FCB     $C2
+2716 44               (fig-forth-auto680):04983                 FCC     'D'     ; 'DO'
+2717 CF               (fig-forth-auto680):04984                 FCB     $CF
+2718 2708             (fig-forth-auto680):04985                 FDB     THEN-7
+271A 17B61BC4145319C4 (fig-forth-auto680):04986         DO      FDB     DOCOL,COMPIL,XDO,HERE,THREE     ; THREE is a flag for DO loops.
+     1852
+2724 1662             (fig-forth-auto680):04987                 FDB     SEMIS
+                      (fig-forth-auto680):04988         *
+                      (fig-forth-auto680):04989         * ======>>  199  <<
+                      (fig-forth-auto680):04990         * ( --- )   runtime
+                      (fig-forth-auto680):04991         * typical use: DO code-loop LOOP  
+                      (fig-forth-auto680):04992         * Increments the index by one and branches back to beginning of loop.
+                      (fig-forth-auto680):04993         * Will loop until index equals limit.
+                      (fig-forth-auto680):04994         * ( adr n --- )  compile time                        P,C
+                      (fig-forth-auto680):04995         * Check the mark and compile (LOOP), fill in BACK reference.
+                      (fig-forth-auto680):04996         * A better flag: $444F (ASCII for 'DO').
+2726 C4               (fig-forth-auto680):04997                 FCB     $C4
+2727 4C4F4F           (fig-forth-auto680):04998                 FCC     'LOO'   ; 'LOOP'
+272A D0               (fig-forth-auto680):04999                 FCB     $D0
+272B 2715             (fig-forth-auto680):05000                 FDB     DO-5
+272D 17B618521B7D1BC4 (fig-forth-auto680):05001         LOOP    FDB     DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK    ; THREE for DO loops.
+     141D26D0
+2739 1662             (fig-forth-auto680):05002                 FDB     SEMIS
+                      (fig-forth-auto680):05003         *
+                      (fig-forth-auto680):05004         * ======>>  200  <<
+                      (fig-forth-auto680):05005         * ( n --- )   runtime
+                      (fig-forth-auto680):05006         * typical use: DO code-loop increment +LOOP
+                      (fig-forth-auto680):05007         * Increments the index by n and branches back to beginning of loop.
+                      (fig-forth-auto680):05008         * Will loop until index equals (positive going)
+                      (fig-forth-auto680):05009         * or passes (negative going) limit.
+                      (fig-forth-auto680):05010         * ( adr n --- )  compile time                       P,C
+                      (fig-forth-auto680):05011         * Check the mark and compile (+LOOP), fill in BACK reference.
+                      (fig-forth-auto680):05012         * A better flag: $444F (ASCII for 'DO').
+273B C5               (fig-forth-auto680):05013                 FCB     $C5
+273C 2B4C4F4F         (fig-forth-auto680):05014                 FCC     '+LOO'  ; '+LOOP'
+2740 D0               (fig-forth-auto680):05015                 FCB     $D0
+2741 2726             (fig-forth-auto680):05016                 FDB     LOOP-7
+2743 17B618521B7D1BC4 (fig-forth-auto680):05017         PLOOP   FDB     DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK   ; THREE for DO loops.
+     143C26D0
+274F 1662             (fig-forth-auto680):05018                 FDB     SEMIS
+                      (fig-forth-auto680):05019         *
+                      (fig-forth-auto680):05020         * ======>>  201  <<
+                      (fig-forth-auto680):05021         * ( n --- )   runtime
+                      (fig-forth-auto680):05022         * typical use: BEGIN code-loop test UNTIL  
+                      (fig-forth-auto680):05023         * Will loop until UNTIL tests true.
+                      (fig-forth-auto680):05024         * ( adr n --- )  compile time                      P,C
+                      (fig-forth-auto680):05025         * Check the mark and compile (0BRANCH), fill in BACK reference.
+                      (fig-forth-auto680):05026         * A better flag: $4245 (ASCII for 'BE').
+2751 C5               (fig-forth-auto680):05027                 FCB     $C5
+2752 554E5449         (fig-forth-auto680):05028                 FCC     'UNTI'  ; 'UNTIL' :     ( same as END )
+2756 CC               (fig-forth-auto680):05029                 FCB     $CC
+2757 273B             (fig-forth-auto680):05030                 FDB     PLOOP-8
+2759 17B618421B7D1BC4 (fig-forth-auto680):05031         UNTIL   FDB     DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK      ; ONE for BEGIN loops.
+     140926D0
+2765 1662             (fig-forth-auto680):05032                 FDB     SEMIS
+                      (fig-forth-auto680):05033         *
+                      (fig-forth-auto680):05034         * ######>> screen 74 <<
+                      (fig-forth-auto680):05035         * ======>>  202  <<
+                      (fig-forth-auto680):05036         * ( n --- )   runtime
+                      (fig-forth-auto680):05037         * typical use: BEGIN code-loop test END  
+                      (fig-forth-auto680):05038         * ( adr n --- ) 
+                      (fig-forth-auto680):05039         * Alias for UNTIL .
+2767 C3               (fig-forth-auto680):05040                 FCB     $C3
+2768 454E             (fig-forth-auto680):05041                 FCC     'EN'    ; 'END'
+276A C4               (fig-forth-auto680):05042                 FCB     $C4
+276B 2751             (fig-forth-auto680):05043                 FDB     UNTIL-8
+276D 17B62759         (fig-forth-auto680):05044         END     FDB     DOCOL,UNTIL
+2771 1662             (fig-forth-auto680):05045                 FDB     SEMIS
+                      (fig-forth-auto680):05046         *
+                      (fig-forth-auto680):05047         * ======>>  203  <<
+                      (fig-forth-auto680):05048         * ( --- )   runtime
+                      (fig-forth-auto680):05049         * typical use: BEGIN code-loop AGAIN  
+                      (fig-forth-auto680):05050         * Will loop forever 
+                      (fig-forth-auto680):05051         * (or until something uses R> DROP to force the current definition to die,
+                      (fig-forth-auto680):05052         *  or perhaps ABORT or ERROR or some such other drastic means stops things).
+                      (fig-forth-auto680):05053         * ( adr n --- )  compile time                      P,C
+                      (fig-forth-auto680):05054         * Check the mark and compile (0BRANCH), fill in BACK reference.
+                      (fig-forth-auto680):05055         * A better flag: $4245 (ASCII for 'BE').
+2773 C5               (fig-forth-auto680):05056                 FCB     $C5
+2774 41474149         (fig-forth-auto680):05057                 FCC     'AGAI'  ; 'AGAIN'
+2778 CE               (fig-forth-auto680):05058                 FCB     $CE
+2779 2767             (fig-forth-auto680):05059                 FDB     END-6
+277B 17B618421B7D1BC4 (fig-forth-auto680):05060         AGAIN   FDB     DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK       ; ONE for BEGIN loops.
+     13FA26D0
+2787 1662             (fig-forth-auto680):05061                 FDB     SEMIS
+                      (fig-forth-auto680):05062         *
+                      (fig-forth-auto680):05063         * ======>>  204  <<
+                      (fig-forth-auto680):05064         * ( --- )   runtime
+                      (fig-forth-auto680):05065         * typical use: BEGIN code-loop test WHILE code-true REPEAT  
+                      (fig-forth-auto680):05066         * Will loop until WHILE tests false, skipping code-true on end.
+                      (fig-forth-auto680):05067         * REPEAT marks where execution resumes after the WHILE find a false flag.
+                      (fig-forth-auto680):05068         * ( aadr1 n1 adr2 n2 --- )   compile time         P,C
+                      (fig-forth-auto680):05069         * Check the marks for WHILE and BEGIN,
+                      (fig-forth-auto680):05070         * compile BRANCH and BACK fill adr1 reference,
+                      (fig-forth-auto680):05071         * FILL-IN 0BRANCH reference at adr2.
+                      (fig-forth-auto680):05072         * Better flags: $4245 (ASCII for 'BE') and $5747 (ASCII for 'WH').
+2789 C6               (fig-forth-auto680):05073                 FCB     $C6
+278A 5245504541       (fig-forth-auto680):05074                 FCC     'REPEA' ; 'REPEAT'
+278F D4               (fig-forth-auto680):05075                 FCB     $D4
+2790 2773             (fig-forth-auto680):05076                 FDB     AGAIN-8
+2792 17B6167C167C277B (fig-forth-auto680):05077         REPEAT  FDB     DOCOL,TOR,TOR,AGAIN,FROMR,FROMR ; ONE for BEGIN loops.
+     168B168B
+279E 184A1A0126F4     (fig-forth-auto680):05078                 FDB     TWO,SUB,ENDIF   ; TWO is for IF, 4 is for WHILE.
+27A4 1662             (fig-forth-auto680):05079                 FDB     SEMIS
+                      (fig-forth-auto680):05080         *
+                      (fig-forth-auto680):05081         * ======>>  205  <<
+                      (fig-forth-auto680):05082         * ( n --- )   runtime
+                      (fig-forth-auto680):05083         * typical use: test IF code-true ELSE code-false ENDIF 
+                      (fig-forth-auto680):05084         * Will pass execution to the true part on a true flag 
+                      (fig-forth-auto680):05085         * and to the false part on a false flag.
+                      (fig-forth-auto680):05086         * ( --- adr n )  compile time                       P,C
+                      (fig-forth-auto680):05087         * Compile a 0BRANCH and dummy offset
+                      (fig-forth-auto680):05088         * and push IF reference to fill in and
+                      (fig-forth-auto680):05089         * IF control construct flag.
+                      (fig-forth-auto680):05090         * A better flag: $4946 (ASCII for 'IF').
+27A6 C2               (fig-forth-auto680):05091                 FCB     $C2
+27A7 49               (fig-forth-auto680):05092                 FCC     'I'     ; 'IF'
+27A8 C6               (fig-forth-auto680):05093                 FCB     $C6
+27A9 2789             (fig-forth-auto680):05094                 FDB     REPEAT-9
+27AB 17B61BC4140919C4 (fig-forth-auto680):05095         IF      FDB     DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO  ; TWO is a flag for IF.
+     183A19E0184A
+27B9 1662             (fig-forth-auto680):05096                 FDB     SEMIS
+                      (fig-forth-auto680):05097         *
+                      (fig-forth-auto680):05098         * ======>>  206  <<
+                      (fig-forth-auto680):05099         * ( --- )   runtime
+                      (fig-forth-auto680):05100         * typical use: test IF code-true ELSE code-false ENDIF 
+                      (fig-forth-auto680):05101         * ELSE is just a sort of intersection piece, 
+                      (fig-forth-auto680):05102         * marking where execution resumes on a false branch.
+                      (fig-forth-auto680):05103         * ( adr1 n --- adr2 n )  compile time         P,C
+                      (fig-forth-auto680):05104         * Check the marks,
+                      (fig-forth-auto680):05105         * compile BRANCH with dummy offset,
+                      (fig-forth-auto680):05106         * resolve IF reference,
+                      (fig-forth-auto680):05107         * and leave reference to BRANCH for ELSE.
+                      (fig-forth-auto680):05108         * A better flag: $4946 (ASCII for 'IF').
+27BB C4               (fig-forth-auto680):05109                 FCB     $C4
+27BC 454C53           (fig-forth-auto680):05110                 FCC     'ELS'   ; 'ELSE'
+27BF C5               (fig-forth-auto680):05111                 FCB     $C5
+27C0 27A6             (fig-forth-auto680):05112                 FDB     IF-5
+27C2 17B6184A1B7D1BC4 (fig-forth-auto680):05113         ELSE    FDB     DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
+     13FA19C4
+27CE 183A19E01733184A (fig-forth-auto680):05114                 FDB     ZERO,COMMA,SWAP,TWO,ENDIF,TWO   ; TWO is a flag for IF.
+     26F4184A
+27DA 1662             (fig-forth-auto680):05115                 FDB     SEMIS
+                      (fig-forth-auto680):05116         *
+                      (fig-forth-auto680):05117         * ======>>  207  <<
+                      (fig-forth-auto680):05118         * ( n --- )   runtime
+                      (fig-forth-auto680):05119         * typical use: BEGIN code-loop test WHILE code-true REPEAT  
+                      (fig-forth-auto680):05120         * Will loop until WHILE tests false, skipping code-true on end.
+                      (fig-forth-auto680):05121         * ( --- adr n ) compile time                        P,C
+                      (fig-forth-auto680):05122         * Compile 0BRANCH with dummy offset (using IF),
+                      (fig-forth-auto680):05123         * push WHILE reference.
+                      (fig-forth-auto680):05124         * BEGIN flag will sit underneath this.
+                      (fig-forth-auto680):05125         * Better flags: $4245 (ASCII for 'BE') and $5747 (ASCII for 'WH').
+27DC C5               (fig-forth-auto680):05126                 FCB     $C5
+27DD 5748494C         (fig-forth-auto680):05127                 FCC     'WHIL'  ; 'WHILE'
+27E1 C5               (fig-forth-auto680):05128                 FCB     $C5
+27E2 27BB             (fig-forth-auto680):05129                 FDB     ELSE-7
+27E4 17B627AB19B5     (fig-forth-auto680):05130         WHILE   FDB     DOCOL,IF,TWOP   ; TWO is a flag for IF, 4 is for WHILE.
+27EA 1662             (fig-forth-auto680):05131                 FDB     SEMIS
+                      (fig-forth-auto680):05132         *
+                      (fig-forth-auto680):05133         * ######>> screen 75 <<
+                      (fig-forth-auto680):05134         * ======>>  208  <<
+                      (fig-forth-auto680):05135         * ( count --- )
+                      (fig-forth-auto680):05136         * EMIT count spaces, for non-zero, non-negative counts.
+27EC 86               (fig-forth-auto680):05137                 FCB     $86
+27ED 5350414345       (fig-forth-auto680):05138                 FCC     'SPACE' ; 'SPACES'
+27F2 D3               (fig-forth-auto680):05139                 FCB     $D3
+27F3 27DC             (fig-forth-auto680):05140                 FDB     WHILE-8
+27F5 17B6183A1A741A87 (fig-forth-auto680):05141         SPACES  FDB     DOCOL,ZERO,MAX,DDUP,ZBRAN
+     1409
+27FF 000A             (fig-forth-auto680):05142                 FDB     SPACE3-*-NATWID
+2801 183A1453         (fig-forth-auto680):05143                 FDB     ZERO,XDO
+2805 1A54141D         (fig-forth-auto680):05144         SPACE2  FDB     SPACE,XLOOP
+2809 FFFA             (fig-forth-auto680):05145                 FDB     SPACE2-*-NATWID
+280B 1662             (fig-forth-auto680):05146         SPACE3  FDB     SEMIS
+                      (fig-forth-auto680):05147         *
+                      (fig-forth-auto680):05148         * ======>>  209  <<
+                      (fig-forth-auto680):05149         * ( --- )
+                      (fig-forth-auto680):05150         * Initialize HLD for converting a double integer. 
+                      (fig-forth-auto680):05151         * Stores the PAD address in HLD.
+280D 82               (fig-forth-auto680):05152                 FCB     $82
+280E 3C               (fig-forth-auto680):05153                 FCC     '<'     ; '<#'
+280F A3               (fig-forth-auto680):05154                 FCB     $A3
+2810 27EC             (fig-forth-auto680):05155                 FDB     SPACES-9
+2812 17B61EA919911787 (fig-forth-auto680):05156         BDIGS   FDB     DOCOL,PAD,HLD,STORE
+281A 1662             (fig-forth-auto680):05157                 FDB     SEMIS
+                      (fig-forth-auto680):05158         *
+                      (fig-forth-auto680):05159         * ======>>  210  <<
+                      (fig-forth-auto680):05160         * ( d --- string length )
+                      (fig-forth-auto680):05161         * Terminate numeric conversion,
+                      (fig-forth-auto680):05162         * drop the number being converted,
+                      (fig-forth-auto680):05163         * leave the address of the conversion string and the length, ready for TYPE.
+281C 82               (fig-forth-auto680):05164                 FCB     $82
+281D 23               (fig-forth-auto680):05165                 FCC     '#'     ; '#>'
+281E BE               (fig-forth-auto680):05166                 FCB     $BE
+281F 280D             (fig-forth-auto680):05167                 FDB     BDIGS-5
+2821 17B6172517251991 (fig-forth-auto680):05168         EDIGS   FDB     DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
+     176F1EA917171A01
+2831 1662             (fig-forth-auto680):05169                 FDB     SEMIS
+                      (fig-forth-auto680):05170         *
+                      (fig-forth-auto680):05171         * ======>>  211  <<
+                      (fig-forth-auto680):05172         * ( n d --- d )
+                      (fig-forth-auto680):05173         * Put sign of n (as a flag) at the head of the conversion string.
+                      (fig-forth-auto680):05174         * Drop the sign flag.
+2833 84               (fig-forth-auto680):05175                 FCB     $84
+2834 534947           (fig-forth-auto680):05176                 FCC     'SIG'   ; 'SIGN'
+2837 CE               (fig-forth-auto680):05177                 FCB     $CE
+2838 281C             (fig-forth-auto680):05178                 FDB     EDIGS-5
+283A 17B61A4016B01409 (fig-forth-auto680):05179         SIGN    FDB     DOCOL,ROT,ZLESS,ZBRAN
+2842 0005             (fig-forth-auto680):05180                 FDB     SIGN2-*-NATWID
+2844 13A7             (fig-forth-auto680):05181                 FDB     LIT8
+2846 2D               (fig-forth-auto680):05182                 FCC     "-"     
+2847 1E91             (fig-forth-auto680):05183                 FDB     HOLD
+2849 1662             (fig-forth-auto680):05184         SIGN2   FDB     SEMIS
+                      (fig-forth-auto680):05185         *
+                      (fig-forth-auto680):05186         * ======>>  212  <<
+                      (fig-forth-auto680):05187         * ( d --- d/base )
+                      (fig-forth-auto680):05188         * Generate next most significant digit in the conversion BASE,
+                      (fig-forth-auto680):05189         * putting the digit at the head of the conversion string.
+284B 81               (fig-forth-auto680):05190                 FCB     $81     #
+284C A3               (fig-forth-auto680):05191                 FCB     $A3
+284D 2833             (fig-forth-auto680):05192                 FDB     SIGN-7
+284F 17B61960176F2367 (fig-forth-auto680):05193         DIG     FDB     DOCOL,BASE,AT,MSMOD,ROT,LIT8
+     1A4013A7
+285B 09               (fig-forth-auto680):05194                 FCB     9
+285C 17171A1A1409     (fig-forth-auto680):05195                 FDB     OVER,LESS,ZBRAN
+2862 0005             (fig-forth-auto680):05196                 FDB     DIG2-*-NATWID
+2864 13A7             (fig-forth-auto680):05197                 FDB     LIT8
+2866 07               (fig-forth-auto680):05198                 FCB     7
+2867 16C1             (fig-forth-auto680):05199                 FDB     PLUS
+2869 13A7             (fig-forth-auto680):05200         DIG2    FDB     LIT8
+286B 30               (fig-forth-auto680):05201                 FCC     "0"     ascii zero
+286C 16C11E91         (fig-forth-auto680):05202                 FDB     PLUS,HOLD
+2870 1662             (fig-forth-auto680):05203                 FDB     SEMIS
+                      (fig-forth-auto680):05204         *
+                      (fig-forth-auto680):05205         * ======>>  213  <<
+                      (fig-forth-auto680):05206         * ( d --- dzero )
+                      (fig-forth-auto680):05207         * Convert d to a numeric string using # until the result is zero.
+                      (fig-forth-auto680):05208         * Leave the double result on the stack for #> to drop.
+2872 82               (fig-forth-auto680):05209                 FCB     $82
+2873 23               (fig-forth-auto680):05210                 FCC     '#'     ; '#S'
+2874 D3               (fig-forth-auto680):05211                 FCB     $D3
+2875 284B             (fig-forth-auto680):05212                 FDB     DIG-4
+2877 17B6             (fig-forth-auto680):05213         DIGS    FDB     DOCOL
+2879 284F171717171619 (fig-forth-auto680):05214         DIGS2   FDB     DIG,OVER,OVER,OR,ZEQU,ZBRAN
+     169E1409
+2885 FFF2             (fig-forth-auto680):05215                 FDB     DIGS2-*-NATWID
+2887 1662             (fig-forth-auto680):05216                 FDB     SEMIS
+                      (fig-forth-auto680):05217         *
+                      (fig-forth-auto680):05218         * ######>> screen 76 <<
+                      (fig-forth-auto680):05219         * ======>>  214  <<
+                      (fig-forth-auto680):05220         * ( n width --- )
+                      (fig-forth-auto680):05221         * Print n on the output device in the current conversion base,
+                      (fig-forth-auto680):05222         * with sign,
+                      (fig-forth-auto680):05223         * right aligned in a field at least width wide.
+2889 82               (fig-forth-auto680):05224                 FCB     $82
+288A 2E               (fig-forth-auto680):05225                 FCC     '.'     ; '.R'
+288B D2               (fig-forth-auto680):05226                 FCB     $D2
+288C 2872             (fig-forth-auto680):05227                 FDB     DIGS-5
+288E 17B6167C22F7168B (fig-forth-auto680):05228         DOTR    FDB     DOCOL,TOR,STOD,FROMR,DDOTR
+     28A0
+2898 1662             (fig-forth-auto680):05229                 FDB     SEMIS
+                      (fig-forth-auto680):05230         *
+                      (fig-forth-auto680):05231         * ======>>  215  <<
+                      (fig-forth-auto680):05232         * ( d width --- )
+                      (fig-forth-auto680):05233         * Print d on the output device in the current conversion base,
+                      (fig-forth-auto680):05234         * with sign,
+                      (fig-forth-auto680):05235         * right aligned in a field at least width wide.
+289A 83               (fig-forth-auto680):05236                 FCB     $83
+289B 442E             (fig-forth-auto680):05237                 FCC     'D.'    ; 'D.R'
+289D D2               (fig-forth-auto680):05238                 FCB     $D2
+289E 2889             (fig-forth-auto680):05239                 FDB     DOTR-5
+28A0 17B6167C17331717 (fig-forth-auto680):05240         DDOTR   FDB     DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
+     239828122877283A
+28B0 2821168B17171A01 (fig-forth-auto680):05241                 FDB     EDIGS,FROMR,OVER,SUB,SPACES,TYPE
+     27F51CAA
+28BC 1662             (fig-forth-auto680):05242                 FDB     SEMIS
+                      (fig-forth-auto680):05243         *
+                      (fig-forth-auto680):05244         * ======>>  216  <<
+                      (fig-forth-auto680):05245         * D.      ( d --- )
+                      (fig-forth-auto680):05246         * Print d on the output device in the current conversion base,
+                      (fig-forth-auto680):05247         * with sign,
+                      (fig-forth-auto680):05248         * in free format with trailing space.
+28BE 82               (fig-forth-auto680):05249                 FCB     $82
+28BF 44               (fig-forth-auto680):05250                 FCC     'D'     ; 'D.'
+28C0 AE               (fig-forth-auto680):05251                 FCB     $AE
+28C1 289A             (fig-forth-auto680):05252                 FDB     DDOTR-6
+28C3 17B6183A28A01A54 (fig-forth-auto680):05253         DDOT    FDB     DOCOL,ZERO,DDOTR,SPACE
+28CB 1662             (fig-forth-auto680):05254                 FDB     SEMIS
+                      (fig-forth-auto680):05255         *
+                      (fig-forth-auto680):05256         * ======>>  217  <<
+                      (fig-forth-auto680):05257         * ( n --- )
+                      (fig-forth-auto680):05258         * Print n on the output device in the current conversion base,
+                      (fig-forth-auto680):05259         * with sign,
+                      (fig-forth-auto680):05260         * in free format with trailing space.
+28CD 81               (fig-forth-auto680):05261                 FCB     $81     .
+28CE AE               (fig-forth-auto680):05262                 FCB     $AE
+28CF 28BE             (fig-forth-auto680):05263                 FDB     DDOT-5
+28D1 17B622F728C3     (fig-forth-auto680):05264         DOT     FDB     DOCOL,STOD,DDOT
+28D7 1662             (fig-forth-auto680):05265                 FDB     SEMIS
+                      (fig-forth-auto680):05266         *
+                      (fig-forth-auto680):05267         * ======>>  218  <<
+                      (fig-forth-auto680):05268         * ( adr --- )
+                      (fig-forth-auto680):05269         * Print signed word at adr, per DOT.
+28D9 81               (fig-forth-auto680):05270                 FCB     $81     ?
+28DA BF               (fig-forth-auto680):05271                 FCB     $BF
+28DB 28CD             (fig-forth-auto680):05272                 FDB     DOT-4
+28DD 17B6176F28D1     (fig-forth-auto680):05273         QUEST   FDB     DOCOL,AT,DOT
+28E3 1662             (fig-forth-auto680):05274                 FDB     SEMIS
+                      (fig-forth-auto680):05275         *
+                      (fig-forth-auto680):05276         * ######>> screen 77 <<
+                      (fig-forth-auto680):05277         * ======>>  219  <<
+                      (fig-forth-auto680):05278         * ( n --- )
+                      (fig-forth-auto680):05279         * Print out screen n as a field of ASCII,
+                      (fig-forth-auto680):05280         * with line numbers in decimal.
+28E5 84               (fig-forth-auto680):05281                 FCB     $84
+28E6 4C4953           (fig-forth-auto680):05282                 FCC     'LIS'   ; 'LIST'
+28E9 D4               (fig-forth-auto680):05283                 FCB     $D4
+28EA 28D9             (fig-forth-auto680):05284                 FDB     QUEST-4
+28EC 17B61C2015761742 (fig-forth-auto680):05285         LIST    FDB     DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
+     192017871D0B
+28FA 06               (fig-forth-auto680):05286                 FCB     6
+28FB 534352202320     (fig-forth-auto680):05287                 FCC     "SCR # "
+2901 28D113A7         (fig-forth-auto680):05288                 FDB     DOT,LIT8
+2905 10               (fig-forth-auto680):05289                 FCB     $10
+2906 183A1453         (fig-forth-auto680):05290                 FDB     ZERO,XDO
+290A 157614651852     (fig-forth-auto680):05291         LIST2   FDB     CR,I,THREE
+2910 288E1A5414651920 (fig-forth-auto680):05292                 FDB     DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
+     176F2516141D
+291E FFEA             (fig-forth-auto680):05293                 FDB     LIST2-*-NATWID
+2920 1576             (fig-forth-auto680):05294                 FDB     CR
+2922 1662             (fig-forth-auto680):05295                 FDB     SEMIS
+                      (fig-forth-auto680):05296         *
+                      (fig-forth-auto680):05297         * ======>>  220  <<
+                      (fig-forth-auto680):05298         * ( start end --- )
+                      (fig-forth-auto680):05299         * Print comment lines (line 0, and line 1 if C/L < 41) of screens
+                      (fig-forth-auto680):05300         * from start to end.
+2924 85               (fig-forth-auto680):05301                 FCB     $85
+2925 494E4445         (fig-forth-auto680):05302                 FCC     'INDE'  ; 'INDEX'
+2929 D8               (fig-forth-auto680):05303                 FCB     $D8
+292A 28E5             (fig-forth-auto680):05304                 FDB     LIST-7
+292C 17B6157619A81733 (fig-forth-auto680):05305         INDEX   FDB     DOCOL,CR,ONEP,SWAP,XDO
+     1453
+2936 157614651852     (fig-forth-auto680):05306         INDEX2  FDB     CR,I,THREE
+293C 288E1A54183A1465 (fig-forth-auto680):05307                 FDB     DOTR,SPACE,ZERO,I,DLINE
+     2516
+2946 15691409         (fig-forth-auto680):05308                 FDB     QTERM,ZBRAN
+294A 0002             (fig-forth-auto680):05309                 FDB     INDEX3-*-NATWID
+294C 1670             (fig-forth-auto680):05310                 FDB     LEAVE
+294E 141D             (fig-forth-auto680):05311         INDEX3  FDB     XLOOP
+2950 FFE4             (fig-forth-auto680):05312                 FDB     INDEX2-*-NATWID
+2952 1662             (fig-forth-auto680):05313                 FDB     SEMIS
+                      (fig-forth-auto680):05314         *
+                      (fig-forth-auto680):05315         * ======>>  221  <<
+                      (fig-forth-auto680):05316         * ( n --- )
+                      (fig-forth-auto680):05317         * List a printer page full of screens.
+                      (fig-forth-auto680):05318         * Line and screen number are in current base.
+2954 85               (fig-forth-auto680):05319                 FCB     $85
+2955 54524941         (fig-forth-auto680):05320                 FCC     'TRIA'  ; 'TRIAD'
+2959 C4               (fig-forth-auto680):05321                 FCB     $C4
+295A 2924             (fig-forth-auto680):05322                 FDB     INDEX-8
+295C 17B6185223241852 (fig-forth-auto680):05323         TRIAD   FDB     DOCOL,THREE,SLASH,THREE,STAR
+     2305
+2966 1852171716C11733 (fig-forth-auto680):05324                 FDB     THREE,OVER,PLUS,SWAP,XDO
+     1453
+2970 15761465         (fig-forth-auto680):05325         TRIAD2  FDB     CR,I
+2974 28EC15691409     (fig-forth-auto680):05326                 FDB     LIST,QTERM,ZBRAN
+297A 0002             (fig-forth-auto680):05327                 FDB     TRIAD3-*-NATWID
+297C 1670             (fig-forth-auto680):05328                 FDB     LEAVE
+297E 141D             (fig-forth-auto680):05329         TRIAD3  FDB     XLOOP
+2980 FFEE             (fig-forth-auto680):05330                 FDB     TRIAD2-*-NATWID
+2982 157613A7         (fig-forth-auto680):05331                 FDB     CR,LIT8
+2986 0F               (fig-forth-auto680):05332                 FCB     $0F
+2987 252A1576         (fig-forth-auto680):05333                 FDB     MESS,CR
+298B 1662             (fig-forth-auto680):05334                 FDB     SEMIS
+                      (fig-forth-auto680):05335         *
+                      (fig-forth-auto680):05336         * ######>> screen 78 <<
+                      (fig-forth-auto680):05337         * ======>>  222  <<
+                      (fig-forth-auto680):05338         * ( --- )
+                      (fig-forth-auto680):05339         * Alphabetically list the definitions in the current vocabulary.
+298D 85               (fig-forth-auto680):05340                 FCB     $85
+298E 564C4953         (fig-forth-auto680):05341                 FCC     'VLIS'  ; 'VLIST'
+2992 D4               (fig-forth-auto680):05342                 FCB     $D4
+2993 2954             (fig-forth-auto680):05343                 FDB     TRIAD-8
+2995 17B613A7         (fig-forth-auto680):05344         VLIST   FDB     DOCOL,LIT8
+2999 80               (fig-forth-auto680):05345                 FCB     $80
+299A 19161787193B176F (fig-forth-auto680):05346                 FDB     OUT,STORE,CONTXT,AT,AT
+     176F
+29A4 1916176F199F176F (fig-forth-auto680):05347         VLIST1  FDB     OUT,AT,COLUMS,AT,LIT8
+     13A7
+29AE 20               (fig-forth-auto680):05348                 FCB     32
+29AF 1A011A321409     (fig-forth-auto680):05349                 FDB     SUB,GREAT,ZBRAN
+29B5 0008             (fig-forth-auto680):05350                 FDB     VLIST2-*-NATWID
+29B7 1576183A19161787 (fig-forth-auto680):05351                 FDB     CR,ZERO,OUT,STORE
+29BF 1742202F1A541A54 (fig-forth-auto680):05352         VLIST2  FDB     DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT
+     1B0F1ADD176F
+29CD 1742169E15691619 (fig-forth-auto680):05353                 FDB     DUP,ZEQU,QTERM,OR,ZBRAN
+     1409
+29D7 FFCB             (fig-forth-auto680):05354                 FDB     VLIST1-*-NATWID
+29D9 1725             (fig-forth-auto680):05355                 FDB     DROP
+29DB 1662             (fig-forth-auto680):05356                 FDB     SEMIS
+                      (fig-forth-auto680):05357         *
+                      (fig-forth-auto680):05358         * ======>>  XX  <<
+                      (fig-forth-auto680):05359         * ( --- )
+                      (fig-forth-auto680):05360         * Mostly for place holding.
+29DD 84               (fig-forth-auto680):05361                 FCB     $84
+29DE 4E4F4F           (fig-forth-auto680):05362                 FCC     'NOO'   ; 'NOOP'
+29E1 D0               (fig-forth-auto680):05363                 FCB     $D0
+29E2 298D             (fig-forth-auto680):05364                 FDB     VLIST-8
+29E4 1228             (fig-forth-auto680):05365         NOOP    FDB     NEXT    a useful no-op
+29E6 0000000000000000 (fig-forth-auto680):05366         ZZZZ    FDB     0,0,0,0,0,0,0,0 end of rom program
+     0000000000000000
+                      (fig-forth-auto680):05367         
+                      (fig-forth-auto680):05368                 PAGE
+                      (fig-forth-auto680):05369         *  These things, up through the lable 'REND', are overwritten
+                      (fig-forth-auto680):05370         *  at time of cold load and should have the same contents
+                      (fig-forth-auto680):05371         *  as shown here:
+                      (fig-forth-auto680):05372         *
+                      (fig-forth-auto680):05373         * This can be moved whereever the bottom of the
+                      (fig-forth-auto680):05374         * user's dictionary is going to be put.
+                      (fig-forth-auto680):05375         *
+29F6 C5               (fig-forth-auto680):05376                 FCB     $C5     immediate
+29F7 464F5254         (fig-forth-auto680):05377                 FCC     'FORT'  ; 'FORTH'
+29FB C8               (fig-forth-auto680):05378                 FCB     $C8
+29FC 29DD             (fig-forth-auto680):05379                 FDB     NOOP-7
+29FE 1C8121A081A02A26 (fig-forth-auto680):05380         FORTH   FDB     DODOES,DOVOC,$81A0,TASK-7
+2A06 0000             (fig-forth-auto680):05381                 FDB     0
+                      (fig-forth-auto680):05382         *
+2A08 28432920466F7274 (fig-forth-auto680):05383                 FCC     "(C) Forth Interest Group, 1979"
+     6820496E74657265
+     73742047726F7570
+     2C2031393739
+                      (fig-forth-auto680):05384         
+2A26 84               (fig-forth-auto680):05385                 FCB     $84
+2A27 544153           (fig-forth-auto680):05386                 FCC     'TAS'   ; 'TASK'
+2A2A CB               (fig-forth-auto680):05387                 FCB     $CB
+2A2B 29F6             (fig-forth-auto680):05388                 FDB     FORTH-8
+2A2D 17B61662         (fig-forth-auto680):05389         TASK    FDB     DOCOL,SEMIS
+                      (fig-forth-auto680):05390         * 
+     2A31             (fig-forth-auto680):05391         REND    EQU     *       ( first empty location in dictionary )
+                      (fig-forth-auto680):05392         
+                      (fig-forth-auto680):05393         
+                      (fig-forth-auto680):05394         
+                      (fig-forth-auto680):05395         
+                      (fig-forth-auto680):05396         
+                      (fig-forth-auto680):05397         
+                      (fig-forth-auto680):05398         
+                      (fig-forth-auto680):05399                 PAGE
+                      (fig-forth-auto680):05400                 OPT     L
+                      (fig-forth-auto680):05401                 END
diff --git a/work.dsk b/work.dsk
new file mode 100644
index 0000000..1075881
Binary files /dev/null and b/work.dsk differ