
#         ciforth : a generic I86 ISO FORTH by HCC FIG

# $Id: ci86.gnr,v 4.15.5.19 2005/02/18 17:32:33 albert Exp $
# Copyright (2000): Albert van der Horst by GNU Public License
#
#HCC FIG Holland : Hobby Computer Club, Forth Interest Group  Holland
        #  66,106
 #   ciforth $Revision: 4.15.5.19 $
#
# For the generic system (to generate ciforth in an other configuration than this one):
#     http://home.hccnet.nl/a.w.m.van.der.horst/ci86gnr.html
#
# If this is a configured assembly file, it should be accompanied with configured
# documentation (texinfo, ps, html.)
# WITHOUT THE DOCUMENTATION: GIVE UP! GET THE REAL THING!
# You have a configured system, if there are NO curly brackets on the next line.
#                          
#
# Configuration of this particular version:
# 32-bits protected mode 
# running under Linux  #  with native forth I/O 
# Normally ciforth doesn't observe ISO >IN.
# Contains :
# (there may be no items here.)
#        Security words
#         Loadable words, i.e. all of ISO CORE, more than is needed
#           for a self contained kernel.
# A field in the header to point to source
# An extra field in the header for double links or free use.
#
#
# Gnu as version of ciforth created by ``m4'' from generic listing.
# This source can be assembled using versions better than 2.13.
# This file must be assembled and linked in the following (unexpected) way:
#       as lina.s
#       strip a.out --strip-unneeded -R .bss -R .data -R .text
#       ld a.out -o lina
# The stripping is required, because otherwise two program sections
# are created. It is tricky, because the least deviation of the above
# command may result in loss of the entry point, and an unusable binary.
# Optionally follow by
#       strip  -s -R .bss
# to strip more irrelevant crap.

.Intel_syntax prefix

 /* 
        A generic version of ISO FORTH for IBM type standard PC's by
                Albert van der Horst

                in cooperation with
                HCC Forth user group
                The Netherlands
                www.forth.hccnet.nl

              based on
              FIG-FORTH
   implemented by:  Charlie Krajewski
                    205 ( BIG ) Blue Rd.
                    Middletown, CT  06457

  The listing has been made possible by the
  prior work of:
               Thomas Newman, Hayward, Ca.

 : other_acknowledgements
         John_Cassidy
         Kim_Harris
         George_Flammer
         Robert_D._Villwock #

 : for tools
         Richard M. Stallman
         Linus Torvalds

No one who programs with FORTH can afford to be without:
  "Starting Forth  by Leo Brodie" and "Thinking Forth by Leo Brodie".
   Both out of print.

This Forth is a descendant in the 300+ (RCS)- generations from fig-Forth.

For nostalgic reasons the following comment has never been removed:
   Although there is much to be said for typing in your own
   listing and getting it running, there is much to be said
   not typing in your own listing.  If you feel that 100+
   pages of plinking is nutty, contact me for availability
   of a disc with source & executable files.  Obtainable at
   a bargain basement price, prepare yourself for bargain
   basement support.

All publications of the FORTH Interest Group are public domain.
They may be further distributed by the inclusion of this
credit notice:
               This publication has been made available by:

               FORTH Interest Group
               P.O. Box 1105
               San Carlos, Ca.  94070
[I feel obliged to keep this last one in (%AH). Note that although it is
based on fig-Forth no stone is left unturned.]
 */ 
        #
# ########################################################################################
#                       PREPARATION (no code)
# ########################################################################################
FIGREL  =     4       # FIG RELEASE #
FIGREV  =     0       # FIG REVISION #
USRVER  =     0      # USER VERSION NUMBER, a digit now
#
#      VERY ELEMENTARY .
CW      =     4    # Size of a cell in Forth, not in the bootcode.
ERRORSCREEN =     48    # Screen where the error messages start.
#
#      MEMORY LAYOUT.
# Normally this is specified at the m4 configuration level.
# For a configured system these values can be changed at this single place. 
NBUF    =     8    # No. of buffers, or screens 
KBBUF   =     1024      # Data bytes per disk buffer
US      =     0x40*CW  # User variable space
EM      =     (0x4000000)-0x74     # Where the memory ends w.r.t. ORIG. 1) 
EMP     =     (EM-1)/0x1000+1 # Number of pages.
RTS     =     0x10000    # Return stack & terminal input buffer
#
# NOTE 1:
#This trick to not have a round memory allocated convinces loaders
# on Linux 1.24 and following to load the elf header in memory
# in front of the executable, and not in some other place.
# ciforth relies on modifying the elf header in behalf of SAVE-SYSTEM.
#This is more convenient than creating it from scratch. It also leaves
# alone the load address generated by ``ld'', and all other things we
# are not aware of.


#
#      ASCII CHARACTER EQUIVALENTS
#
ABL     =     ' '     # SPACE
ACR     =     0x0D     # CR
AMS     =     '-'
ASO     =     '['
ASC     =     ']'
ADOT    =     '.'
ALF      =     0x0A     # LINE FEED, USED INTERNALLY AS
                        # LINE ENDER
AFF      =     0x0C     # FORM FEED
BELL    =     0x07     # ^G
BSIN    =     0x08     # INPUT DELETE CHARACTER
BSOUT   =     0x08     # OUTPUT BACKSPACE ( ^H )
#
#      HEADER RELATED EQUATES
B_DUMMY   =     0x01     # dea is dummy, from vocabulary link
B_INVIS   =     0x02     # dea is invisible, "smudged".
B_IMMED   =     0x04     # dea is a immediate.
B_DENOT   =     0x08     # dea is a denotation.
C_HOFFSET =     0       # Offsets of code field in cells, w.r.t. dea
D_HOFFSET =     1       # Same for data field
F_HOFFSET =     2       # Same for flag field
L_HOFFSET =     3       # Same for link field
N_HOFFSET =     4       # Same for name field
S_HOFFSET =     5       # Same for source field
X_HOFFSET =     S_HOFFSET+1# Same for extra field
PH_OFFSET =     5+1+1   # Past header field: Start of data area. 
BD_OFFSET =     5+1+1+1 # Start of BODY for CREATEd word.
HEADSIZE  =     (CW*(PH_OFFSET))  #In cells, only to clean up source.
#
 #  
#
#
BPS     =     512             #Bytes/sector, common to all of MSDOS
SPB     =     KBBUF/BPS
#
#
#
#
#
# 


# ------------------------------------------------------------      
#   Start of constants stolen from C.                                 
# ------------------------------------------------------------      

SEEK_SET	=	0x0
TCGETS	=	0x5401
TCSETS	=	0x5402
ECHO	=	0x8
EAGAIN	=	0xb
EINTR	=	0x4
EPIPE	=	0x20
VMIN	=	0x6
VTIME	=	0x5
ICANON	=	0x2
O_RDWR	=	0x2
O_RDONLY	=	0x0
O_WRONLY	=	0x1
O_CREAT	=	0x40
O_NONBLOCK	=	0x800
SIZE_TERMIO	=	0x3c

# Numbers of system calls. See "Linux kernel Internals" Appendix A. 
# By M.Beck, H. Boehme e.a. Addison Wesley.                         
# The system calls themselves are extensively documented in chapter 
# 2 of the man pages, e.g. "man 2 exit"
exit	=	0x1
open	=	0x5
close	=	0x6
creat	=	0x8
unlink	=	0xa
chdir	=	0xc
read	=	0x3
select	=	0x52
_newselect	=	0x8e
write	=	0x4
ioctl	=	0x36
ioperm	=	0x65
iopl	=	0x6e
lseek	=	0x13
execve	=	0xb
fork	=	0x2
waitpid	=	0x7
# ------------------------------------------------------------      
#   End of constants stolen from C.                                 
# ------------------------------------------------------------      

RAWIO           =     (ECHO | ICANON)
        .global  _start        # Entry point. 
# 
# 


        .section forth,"awx"
        #
ORIG:
# 
# 
    
    

# 

# 
# 
NOBOOT:         # Skip till here if not booting.

# 
ENDBOOT:


#
# 

# 
# 

# 
#
#

#


#************************
         # Assembler directive

#************************

# 
#


# 4.15.3.2
ciforth:
_start:
 # 
COLD_ENTRY:
        CLD                     # DIR = INC
       MOV     DWORD PTR[USINI+(CW*(31))],%ESP #Remember ARGS.

        MOV     %EAX,%DS
        MOV     %SS,%EAX           #Atomic with next instruction.
        MOV     %ESP,DWORD PTR[USINI+(CW*(2))]    #PARAM. STACK
        MOV     %EBP,DWORD PTR[USINI+(CW*(3))]    #RETURN STACK
        MOV     %ESI,OFFSET CLD1  # (IP) <-
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#
CLD1:   .long      COLD    #  This is a piece of headerless high level code.
#
# ########################################################################################
#                       FORTH ITSELF
# ########################################################################################
#
 /* 
   FORTH REGISTERS
   The names under FORTH are used in the generic source.

   FORTH   8088     FORTH PRESERVATION RULES
   -----   ----     ----- ------------ -----
   HIP   %ESI      High level Interpreter Pointer.  Must be preserved
                    across FORTH words.

   WOR   %EAX      Working register.  When entering a word
                    via its code field the DEA is passed in WOR.

   SPO   %ESP      Parameter stack pointer.  Must be preserved
                    across FORTH words.

   RPO   %EBP      Return stack pointer.  Must be preserved across
                    FORTH words.

            %EAX      General register.  Used to pass data from
                    FORTH words, see label APUSH or macro _APUSH

            %EDX      General register.  Used to pass more data from
                    FORTH words, see label DPUSH or macro _DPUSH

            %EBX      General purpose register.

            %ECX      General purpose register.

            %CS      Segment register. Must be preserved
                    across FORTH words.

            %DS      ditto

            %SS      ibid

            %ES      Temporary segment register only used by
                    a few words. However it MUST remain equal to
                    %DS, such that string primitives can be used
                    with impunity.

----------------------------------------------------------
 */ 
        #
 /* 
---------------------------------------------

   COMMENT CONVENTIONS
   ------- -----------

   =       IS EQUAL TO
   <-      ASSIGNMENT

  NAME        =  Address of name
  (NAME)      =  Contents of name

  CFA         =  CODE FIELD ADDRESS : a pointer to executable code
  DFA         =  DATA FIELD ADDRESS : a pointer to
                        data/high level code/ DOES> pointer
  FFA         =  FLAG FIELD ADDRESS: contains flags
  LFA         =  LINK FIELD ADDRESS: a pointer
  NFA         =  NAME FIELD ADDRESS: a pointer to a variable number of chars
  PHA         =  POST HEADER ADDRESS

  S1          =  Parameter stack - 1st cell
  S2          =  Parameter stack - 2nd cell
  R1          =  Return stack    - 1st cell
  R2          =  Return stack    - 2nd cell

  LSB         =  Least significant bit
  MSB         =  Most  significant bit
  LB          =  Low byte
  HB          =  High byte
  LW          =  Low  cell

------------------------------------------------------------
 */ 
# 
        #
# 
#
# 
# In 32 bit versions there may be no jumps to NEXT at all 
# The label NEXT1 is rarely relevant (for _OLDDEBUG_) 
DPUSH:  PUSH    %EDX      # Fall through.
APUSH:  PUSH    %EAX
NEXT:
#
        LODSD           #AX <- (IP)
NEXT1:  MOV     %EAX,%EAX   # (WOR) <- (IP)

        JMP     DWORD PTR[%EAX]    # TO `CFA'
#
#       Dictionary starts here.

DP0:
# Vocabularies all end in a link to 0.

#  *********
#  *   '   *
#  *********
#
        .balign    4,0x90
N_TICK:
        .long      1
        .ASCII      "'"
        .balign    4,0x90
TICK:
        .long    DOCOL
        .long    TICK+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    0
        .long    N_TICK
        .long    0
        .long    0

        .long      ITICK
        .long      LITER
        .long      SEMIS
#

#  *********
#  *   &   *
#  *********
#
        .balign    4,0x90
N_DCHAR:
        .long      1
        .ASCII      "&"
        .balign    4,0x90
DCHAR:
        .long    DOCOL
        .long    DCHAR+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    TICK
        .long    N_DCHAR
        .long    0
        .long    0

        .long      INBRS
        .long      SWAP, DROP
        .long      LDUP, QBL
        .long      LIT, 10, QERR
        .long      LITER
        .long      QDELIM
        .long      SEMIS
#

#  *********
#  *   ^   *
#  *********
#
        .balign    4,0x90
N_DCTL:
        .long      1
        .ASCII      "^"
        .balign    4,0x90
DCTL:
        .long    DOCOL
        .long    DCTL+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    DCHAR
        .long    N_DCTL
        .long    0
        .long    0

        .long      INBRS
        .long      SWAP, DROP
        .long      LDUP, QBL
        .long      LIT, 10, QERR
        .long      LIT, '@', LSUB
        .long      LITER
        .long      QDELIM
        .long      SEMIS
#

#  *********
#  *   0   *
#  *********
#
        .balign    4,0x90
N_DEN0:
        .long      1
        .ASCII      "0"
        .balign    4,0x90
DEN0:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DCTL
        .long    N_DEN0
        .long    0
        .long    0

#  *********
#  *   1   *
#  *********
#
        .balign    4,0x90
N_DEN1:
        .long      1
        .ASCII      "1"
        .balign    4,0x90
DEN1:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN0
        .long    N_DEN1
        .long    0
        .long    0

#  *********
#  *   2   *
#  *********
#
        .balign    4,0x90
N_DEN2:
        .long      1
        .ASCII      "2"
        .balign    4,0x90
DEN2:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN1
        .long    N_DEN2
        .long    0
        .long    0

#  *********
#  *   3   *
#  *********
#
        .balign    4,0x90
N_DEN3:
        .long      1
        .ASCII      "3"
        .balign    4,0x90
DEN3:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN2
        .long    N_DEN3
        .long    0
        .long    0

#  *********
#  *   4   *
#  *********
#
        .balign    4,0x90
N_DEN4:
        .long      1
        .ASCII      "4"
        .balign    4,0x90
DEN4:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN3
        .long    N_DEN4
        .long    0
        .long    0

#  *********
#  *   5   *
#  *********
#
        .balign    4,0x90
N_DEN5:
        .long      1
        .ASCII      "5"
        .balign    4,0x90
DEN5:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN4
        .long    N_DEN5
        .long    0
        .long    0

#  *********
#  *   6   *
#  *********
#
        .balign    4,0x90
N_DEN6:
        .long      1
        .ASCII      "6"
        .balign    4,0x90
DEN6:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN5
        .long    N_DEN6
        .long    0
        .long    0


#  *********
#  *   7   *
#  *********
#
        .balign    4,0x90
N_DEN7:
        .long      1
        .ASCII      "7"
        .balign    4,0x90
DEN7:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN6
        .long    N_DEN7
        .long    0
        .long    0

#  *********
#  *   8   *
#  *********
#
        .balign    4,0x90
N_DEN8:
        .long      1
        .ASCII      "8"
        .balign    4,0x90
DEN8:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN7
        .long    N_DEN8
        .long    0
        .long    0

#  *********
#  *   9   *
#  *********
#
        .balign    4,0x90
N_DEN9:
        .long      1
        .ASCII      "9"
        .balign    4,0x90
DEN9:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN8
        .long    N_DEN9
        .long    0
        .long    0

#  *********
#  *   A   *
#  *********
#
        .balign    4,0x90
N_DENA:
        .long      1
        .ASCII      "A"
        .balign    4,0x90
DENA:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEN9
        .long    N_DENA
        .long    0
        .long    0

#  *********
#  *   B   *
#  *********
#
        .balign    4,0x90
N_DENB:
        .long      1
        .ASCII      "B"
        .balign    4,0x90
DENB:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DENA
        .long    N_DENB
        .long    0
        .long    0


#  *********
#  *   C   *
#  *********
#
        .balign    4,0x90
N_DENC:
        .long      1
        .ASCII      "C"
        .balign    4,0x90
DENC:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DENB
        .long    N_DENC
        .long    0
        .long    0

#  *********
#  *   D   *
#  *********
#
        .balign    4,0x90
N_DEND:
        .long      1
        .ASCII      "D"
        .balign    4,0x90
DEND:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DENC
        .long    N_DEND
        .long    0
        .long    0

#  *********
#  *   E   *
#  *********
#
        .balign    4,0x90
N_DENE:
        .long      1
        .ASCII      "E"
        .balign    4,0x90
DENE:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DEND
        .long    N_DENE
        .long    0
        .long    0

#  *********
#  *   F   *
#  *********
#
        .balign    4,0x90
N_DENF:
        .long      1
        .ASCII      "F"
        .balign    4,0x90
DENF:
        .long    DOCOL
        .long    LNUMB
        .long    B_IMMED + B_DENOT
        .long    DENE
        .long    N_DENF
        .long    0
        .long    0

#

#  *********
#  *   -   *
#  *********
#
        .balign    4,0x90
N_DENM:
        .long      1
        .ASCII      "-"
        .balign    4,0x90
DENM:
        .long    DOCOL
        .long    DENM+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    DENF
        .long    N_DENM
        .long    0
        .long    0

        .long      PNUMB, DNEGA, SDLITE
        .long      SEMIS
#

#  *********
#  *   +   *
#  *********
#
        .balign    4,0x90
N_DENP:
        .long      1
        .ASCII      "+"
        .balign    4,0x90
DENP:
        .long    DOCOL
        .long    DENP+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    DENM
        .long    N_DENP
        .long    0
        .long    0

        .long      PNUMB, SDLITE
        .long      SEMIS
#

#  *********
#  *   "   *
#  *********
#
        .balign    4,0x90
N_DENQ:
        .long      1
        .ASCII      "\""
        .balign    4,0x90
DENQ:
        .long    DOCOL
        .long    DENQ+HEADSIZE
        .long    B_IMMED + B_DENOT
        .long    DENP
        .long    N_DENQ
        .long    0
        .long    0

        .long      LIT, SKIP, COMMA        #  'SKIP , HERE >R 0 ,
        .long      HERE, TOR, ZERO, COMMA
DENQ1:
        .long      LIT, '"', PPARS         #           BEGIN &" (PARSE)
        .long      INBRS, LDUP, LIT, '"', EQUAL #           IN[] DUP &" =
        .long      ZBRAN
        .long      DENQ2-.-CW                 #           WHILE
        .long      TDROP, ONEP             #           2DROP 1+ R@ $+!
        .long      LDUP, ALLOT, RR, SADD
        .long      BRAN
        .long      DENQ1-.-CW                  #           REPEAT
DENQ2:
        .long      QBL, ZEQU
        .long      LIT, 10, QERR           #           ?BLANK 0= 5 ?ERROR
        .long      DROP                    #                DROP R@ $+!
        .long      LDUP, ALLOT, RR, SADD
 .long LALIGN
        .long      FROMR, SFET, DLITE      #           R> $@ POSTPONE DLITERAL #
        .long      SEMIS
#

# The FORTH word is the only non-denotation in the ONLY vocabulary.
#  *************
#  *   FORTH   *
#  *************
#
        .balign    4,0x90
N_FORTH:
        .long      5
        .ASCII      "FORTH"
        .balign    4,0x90
FORTH:
        .long    DODOE
        .long    FORTH+HEADSIZE
        .long    B_IMMED
        .long    DENQ
        .long    N_FORTH
        .long    0
        .long    0

        .long      DOVOC
        .long      0       # END OF VOCABULARY LIST

        .balign    4,0x90

        .long    0x0
        .long    0
        .long    B_DUMMY
        .long    TASK
        .long    (ZERO+(CW*(D_HOFFSET)))
        .long    0
        .long    0

#
#
#

#  ************
#  *   CORE   *
#  ************
#
        .balign    4,0x90
N_CORE:
        .long      4
        .ASCII      "CORE"
        .balign    4,0x90
CORE:
        .long    DOCOL
        .long    CORE+HEADSIZE
        .long    0x0
        .long    0
        .long    N_CORE
        .long    0
        .long    0

        .long      ZERO    # Not (fully) present.
        .long      SEMIS
#

#  ***********
#  *   CPU   *
#  ***********
#
        .balign    4,0x90
N_LCPU:
        .long      3
        .ASCII      "CPU"
        .balign    4,0x90
LCPU:
        .long    DOCOL
        .long    LCPU+HEADSIZE
        .long    0x0
        .long    CORE
        .long    N_LCPU
        .long    0
        .long    0


       .long      LIT, 0x0CD1856, ZERO      # '80386'
           # '80386'
# 

        .long      SEMIS
#

#  ***************
#  *   VERSION   *
#  ***************
#
        .balign    4,0x90
N_LVERSION:
        .long      7
        .ASCII      "VERSION"
        .balign    4,0x90
LVERSION:
        .long    DOCOL
        .long    LVERSION+HEADSIZE
        .long    0x0
        .long    LCPU
        .long    N_LVERSION
        .long    0
        .long    0

 /* 
#       If this is there it is an official release
        .long      SKIP
        .long      22
IBMPC:  .byte      'IBM-PC ciforth'
        .byte      FIGREL+0x40,ADOT,FIGREV+0x30,ADOT,USRVER+0x30
        .long      LIT, IBMPC, LIT, 22
 */ 
#       If M4_VERSION exists and contains a . it is an official release
        .long      SKIP
         .long      5
SB0: .ASCII      "4.0.6"
       .balign    4,0x90
        .long      LIT, SB0
        .long      LIT, 5
        .long      SEMIS
#

#  ************
#  *   NAME   *
#  ************
#
        .balign    4,0x90
N_LNAME:
        .long      4
        .ASCII      "NAME"
        .balign    4,0x90
LNAME:
        .long    DOCOL
        .long    LNAME+HEADSIZE
        .long    0x0
        .long    LVERSION
        .long    N_LNAME
        .long    0
        .long    0

        .long      SKIP
         .long      7
SB1: .ASCII      "ciforth"
       .balign    4,0x90
        .long      LIT, SB1
        .long      LIT, 7
        .long      SEMIS
#

#  ****************
#  *   SUPPLIER   *
#  ****************
#
        .balign    4,0x90
N_SUPPLIER:
        .long      8
        .ASCII      "SUPPLIER"
        .balign    4,0x90
SUPPLIER:
        .long    DOCOL
        .long    SUPPLIER+HEADSIZE
        .long    0x0
        .long    LNAME
        .long    N_SUPPLIER
        .long    0
        .long    0

        .long      SKIP
         .long      20
SB2: .ASCII      "Albert van der Horst"
       .balign    4,0x90
        .long      LIT, SB2
        .long      LIT, 20
        .long      SEMIS
#
#

#  ************
#  *   ONLY   *
#  ************
#
        .balign    4,0x90
N_ONLY:
        .long      4
        .ASCII      "ONLY"
        .balign    4,0x90
ONLY:
        .long    DODOE
        .long    ONLY+HEADSIZE
        .long    B_IMMED
        .long    0
        .long    N_ONLY
        .long    0
        .long    0

        .long      DOVOC
        .long      FORTH     # NEXT VOCABULARY 
ONLYBODY:

        .balign    4,0x90

        .long    0x0
        .long    0
        .long    B_DUMMY
        .long    FORTH
        .long    (ZERO+(CW*(D_HOFFSET)))
        .long    0
        .long    0

#

#  *******************
#  *   ENVIRONMENT   *
#  *******************
#
        .balign    4,0x90
N_ENV:
        .long      11
        .ASCII      "ENVIRONMENT"
        .balign    4,0x90
ENV:
        .long    DODOE
        .long    ENV+HEADSIZE
        .long    B_IMMED
        .long    ONLY
        .long    N_ENV
        .long    0
        .long    0

        .long      DOVOC
        .long      ONLY       # NEXT VOCABULARY 

        .balign    4,0x90

        .long    0x0
        .long    0
        .long    B_DUMMY
        .long    SUPPLIER
        .long    (ZERO+(CW*(D_HOFFSET)))
        .long    0
        .long    0

#

#  ************
#  *   NOOP   *
#  ************
#
        .balign    4,0x90
N_NOOP:
        .long      4
        .ASCII      "NOOP"
        .balign    4,0x90
NOOP:
        .long    NOOP+HEADSIZE
        .long    NOOP+HEADSIZE
        .long    0x0
        .long    ENV
        .long    N_NOOP
        .long    0
        .long    0

       LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#
# 
#

#  ***********
#  *   LIT   *
#  ***********
#
        .balign    4,0x90
N_LIT:
        .long      3
        .ASCII      "LIT"
        .balign    4,0x90
LIT:
        .long    LIT+HEADSIZE
        .long    LIT+HEADSIZE
        .long    0x0
        .long    NOOP
        .long    N_LIT
        .long    0
        .long    0

        LODSD           # AX <- LITERAL
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             # TO TOP OF STACK
#

#  ***************
#  *   EXECUTE   *
#  ***************
#
        .balign    4,0x90
N_EXEC:
        .long      7
        .ASCII      "EXECUTE"
        .balign    4,0x90
EXEC:
        .long    EXEC+HEADSIZE
        .long    EXEC+HEADSIZE
        .long    0x0
        .long    LIT
        .long    N_EXEC
        .long    0
        .long    0

        POP     %EAX      # GET XT
        JMP     DWORD PTR[%EAX]  #(IP) <- (PFA)
#


#  ***************
#  *   RECURSE   *
#  ***************
#
        .balign    4,0x90
N_RECURSE:
        .long      7
        .ASCII      "RECURSE"
        .balign    4,0x90
RECURSE:
        .long    DOCOL
        .long    RECURSE+HEADSIZE
        .long    B_IMMED
        .long    EXEC
        .long    N_RECURSE
        .long    0
        .long    0

        .long      LATEST, COMMA
        .long      SEMIS
#
#

#  **************
#  *   BRANCH   *
#  **************
#
        .balign    4,0x90
N_BRAN:
        .long      6
        .ASCII      "BRANCH"
        .balign    4,0x90
BRAN:
        .long    (SKIP+HEADSIZE)
        .long    BRAN+HEADSIZE
        .long    0x0
        .long    RECURSE
        .long    N_BRAN
        .long    0
        .long    0

#

#  ************
#  *   SKIP   *
#  ************
#
        .balign    4,0x90
N_SKIP:
        .long      4
        .ASCII      "SKIP"
        .balign    4,0x90
SKIP:
        .long    SKIP+HEADSIZE
        .long    SKIP+HEADSIZE
        .long    0x0
        .long    BRAN
        .long    N_SKIP
        .long    0
        .long    0

BRAN1:  LODSD

        DEC     %EAX
        OR      %AL, OFFSET 4 - 1
        INC     %EAX
#
        ADD     %ESI,%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***************
#  *   0BRANCH   *
#  ***************
#
        .balign    4,0x90
N_ZBRAN:
        .long      7
        .ASCII      "0BRANCH"
        .balign    4,0x90
ZBRAN:
        .long    ZBRAN+HEADSIZE
        .long    ZBRAN+HEADSIZE
        .long    0x0
        .long    SKIP
        .long    N_ZBRAN
        .long    0
        .long    0

        POP     %EAX      # GET STACK VALUE
        OR      %EAX,%EAX   # ZERO?
        JZ      BRAN1   # YES, BRANCH
        LEA     %ESI,[%ESI+(CW*(1))]
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#
#

#  **************
#  *   (LOOP)   *
#  **************
#
        .balign    4,0x90
N_XLOOP:
        .long      6
        .ASCII      "(LOOP)"
        .balign    4,0x90
XLOOP:
        .long    XLOOP+HEADSIZE
        .long    XLOOP+HEADSIZE
        .long    0x0
        .long    ZBRAN
        .long    N_XLOOP
        .long    0
        .long    0

        MOV     %EBX,1    # INCREMENT
XLOO1:  ADD     [%EBP],%EBX # INDEX = INDEX + INCR
        MOV     %EAX,[%EBP] # GET NEW INDEX
        SUB     %EAX,[%EBP+(CW*(1))]        # COMPARE WITH LIMIT
        XOR     %EAX,%EBX   # TEST SIGN
        JS      BRAN1   # KEEP LOOPING
#
#  END OF `DO' LOOP
        LEA     %EBP,[%EBP+(CW*(3))]  # ADJ RETURN STACK
        LEA     %ESI,[%ESI+(CW*(1))]       # BYPASS BRANCH OFFSET
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***************
#  *   (+LOOP)   *
#  ***************
#
        .balign    4,0x90
N_XPLOO:
        .long      7
        .ASCII      "(+LOOP)"
        .balign    4,0x90
XPLOO:
        .long    XPLOO+HEADSIZE
        .long    XPLOO+HEADSIZE
        .long    0x0
        .long    XLOOP
        .long    N_XPLOO
        .long    0
        .long    0

        POP     %EBX      # GET LOOP VALUE
        JMP SHORT     XLOO1
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]              #Helpfull for disassembly.
#

#  ************
#  *   (DO)   *
#  ************
#
        .balign    4,0x90
N_XDO:
        .long      4
        .ASCII      "(DO)"
        .balign    4,0x90
XDO:
        .long    XDO+HEADSIZE
        .long    XDO+HEADSIZE
        .long    0x0
        .long    XPLOO
        .long    N_XDO
        .long    0
        .long    0

        LODSD
        ADD     %EAX,%ESI  #Make absolute
        POP     %EDX      # INITIAL INDEX VALUE
        POP     %EBX      # LIMIT VALUE
        XCHG    %EBP,%ESP   # GET RETURN STACK
        PUSH    %EAX      # Target location.
        PUSH    %EBX
        PUSH    %EDX
        XCHG    %EBP,%ESP   # GET PARAMETER STACK
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   (?DO)   *
#  *************
#
        .balign    4,0x90
N_XQDO:
        .long      5
        .ASCII      "(?DO)"
        .balign    4,0x90
XQDO:
        .long    XQDO+HEADSIZE
        .long    XQDO+HEADSIZE
        .long    0x0
        .long    XDO
        .long    N_XQDO
        .long    0
        .long    0

        LODSD
        ADD     %EAX,%ESI  #Make absolute
        POP     %EDX      # INITIAL INDEX VALUE
        POP     %EBX      # LIMIT VALUE
        CMP     %EDX,%EBX
        JZ      QXDO1
        XCHG    %EBP,%ESP   # GET RETURN STACK
        PUSH    %EAX      # Target location.
        PUSH    %EBX
        PUSH    %EDX
        XCHG    %EBP,%ESP   # GET PARAMETER STACK
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
QXDO1:  MOV     %ESI,%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   I   *
#  *********
#
        .balign    4,0x90
N_IDO:
        .long      1
        .ASCII      "I"
        .balign    4,0x90
IDO:
        .long    IDO+HEADSIZE
        .long    IDO+HEADSIZE
        .long    0x0
        .long    XQDO
        .long    N_IDO
        .long    0
        .long    0

        MOV     %EAX,[%EBP] # GET INDEX VALUE
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             # TO PARAMETER STACK
#

#  *********
#  *   J   *
#  *********
#
        .balign    4,0x90
N_JDO:
        .long      1
        .ASCII      "J"
        .balign    4,0x90
JDO:
        .long    JDO+HEADSIZE
        .long    JDO+HEADSIZE
        .long    0x0
        .long    IDO
        .long    N_JDO
        .long    0
        .long    0

        MOV     %EAX,[%EBP+(CW*(3))] # GET INDEX VALUE
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             # TO PARAMETER STACK
#

#  **************
#  *   UNLOOP   *
#  **************
#
        .balign    4,0x90
N_UNLOOP:
        .long      6
        .ASCII      "UNLOOP"
        .balign    4,0x90
UNLOOP:
        .long    DOCOL
        .long    UNLOOP+HEADSIZE
        .long    B_IMMED
        .long    JDO
        .long    N_UNLOOP
        .long    0
        .long    0

        .long      LIT, RDROP, COMMA
        .long      LIT, RDROP, COMMA
        .long      LIT, RDROP, COMMA
        .long      SEMIS
#

#  ***************
#  *   +ORIGIN   *
#  ***************
#
        .balign    4,0x90
N_PORIG:
        .long      7
        .ASCII      "+ORIGIN"
        .balign    4,0x90
PORIG:
        .long    DOCOL
        .long    PORIG+HEADSIZE
        .long    0x0
        .long    UNLOOP
        .long    N_PORIG
        .long    0
        .long    0

        .long      LIT
        .long      USINI
        .long      PLUS
        .long      SEMIS
#
#      Initialisation block for user variables through DOC-LINK
#       <<<<< must be in same order as user variables >>>>>
#
#        .long      WARM_ENTRY FIXME
#        .long      COLD_ENTRY
USINI:  .long      STRUSA  # User area currently in use, cold value same as next.
        .long      STRUSA  # INIT (U0) user area of the main task 1
        .long      INITS0  # INIT (S0)         2
        .long      INITR0  # INIT (R0)         3
        .long      STRTIB  # INIT (TIB)        4
        .long      BSIN    # RUBOUT: get rid of latest char 5
        .long      0       # AVAILABLE         6
        .long      1       # INIT (WARNING)     7
        .long      INITDP  #      INIT (FENCE)  8
DPA:    .long      INITDP  #      INIT (DP)     9
        .long      ENV #       INIT (VOC-LINK) 10

        .long      0       # INIT (OFFSET) 
#
#
#
#
#
#
        .long      0, 0            # WHERE             12 13 
        .long      0, 0            #REMAINDER   14 15 
# 
        .SPACE   US-(. - USINI)        # All user can be initialised.
#
#      <<<<< end of data used by cold start >>>>>

#  *************
#  *   DIGIT   *
#  *************
#
        .balign    4,0x90
N_DIGIT:
        .long      5
        .ASCII      "DIGIT"
        .balign    4,0x90
DIGIT:
        .long    DIGIT+HEADSIZE
        .long    DIGIT+HEADSIZE
        .long    0x0
        .long    PORIG
        .long    N_DIGIT
        .long    0
        .long    0

        POP     %EDX      #NUMBER BASE
        POP     %EAX      #ASCII DIGIT
        SUB     %AL,OFFSET '0'
        JB      DIGI2   #NUMBER ERROR
        CMP     %AL,OFFSET 9
        JBE     DIGI1   #NUMBER = 0 THRU 9
        SUB     %AL,OFFSET 7
        CMP     %AL,OFFSET 10   #NUMBER 'A' THRU 'Z'?
        JB      DIGI2   #NO
DIGI1:  CMP     %AL,%DL   # COMPARE NUMBER TO BASE
        JAE     DIGI2   #NUMBER ERROR
        SUB     %EDX,%EDX   #ZERO
        MOV     %DL,%AL   #NEW BINARY NUMBER
        MOV     %AL,OFFSET 1    #TRUE FLAG
        NEG     %EAX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             #ADD TO STACK
#   NUMBER ERROR
DIGI2:  SUB     %EAX,%EAX   #FALSE FLAG
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   ~MATCH   *
#  **************
#
        .balign    4,0x90
N_NMATCH:
        .long      6
        .ASCII      "~MATCH"
        .balign    4,0x90
NMATCH:
        .long    DOCOL
        .long    NMATCH+HEADSIZE
        .long    0x0
        .long    DIGIT
        .long    N_NMATCH
        .long    0
        .long    0

#
        .long      TOR                           # Remember dea
        .long      TDUP
        .long      RR, TNFA, FETCH, SFET
        .long      ROT, MIN
        .long      CORA
        .long      FROMR, SWAP                   # Leave flag on top of dea.
        .long      SEMIS                            #
#

#  **************
#  *   ?BLANK   *
#  **************
#
        .balign    4,0x90
N_QBL:
        .long      6
        .ASCII      "?BLANK"
        .balign    4,0x90
QBL:
        .long    DOCOL
        .long    QBL+HEADSIZE
        .long    0x0
        .long    NMATCH
        .long    N_QBL
        .long    0
        .long    0

        .long      LBL, ONEP, LESS
        .long      SEMIS
#

#  ************
#  *   IN[]   *
#  ************
#
        .balign    4,0x90
N_INBRS:
        .long      4
        .ASCII      "IN[]"
        .balign    4,0x90
INBRS:
        .long    DOCOL
        .long    INBRS+HEADSIZE
        .long    0x0
        .long    QBL
        .long    N_INBRS
        .long    0
        .long    0

        .long      SRC, CELLP, TFET
        .long      OVER, EQUAL
        .long      ZBRAN
        .long      INBRS1-.-CW
        .long      ZERO
        .long      BRAN
        .long      INBRS2-.-CW
INBRS1:
        .long      LDUP
        
        .long      CFET
        .long      ONE, LIN, PSTORE
INBRS2:
        .long      SEMIS
#

#  **************
#  *   (WORD)   *
#  **************
#
        .balign    4,0x90
N_LPWORD:
        .long      6
        .ASCII      "(WORD)"
        .balign    4,0x90
LPWORD:
        .long    DOCOL
        .long    LPWORD+HEADSIZE
        .long    0x0
        .long    INBRS
        .long    N_LPWORD
        .long    0
        .long    0

        .long      X
PWORD0: .long      DROP
        .long      INBRS, QBL
        .long      OVER, SRC, CELLP, FETCH, LSUB # At end?
        .long      LAND, ZEQU
        .long      ZBRAN
        .long      PWORD0-.-CW

        .long      X
PWORD1: .long      DROP
        .long      INBRS, QBL
        .long      ZBRAN
        .long      PWORD1-.-CW

        .long      OVER, LSUB
        
        .long      SEMIS
#

#  ***************
#  *   (PARSE)   *
#  ***************
#
        .balign    4,0x90
N_PPARS:
        .long      7
        .ASCII      "(PARSE)"
        .balign    4,0x90
PPARS:
        .long    DOCOL
        .long    PPARS+HEADSIZE
        .long    0x0
        .long    LPWORD
        .long    N_PPARS
        .long    0
        .long    0

        .long      SRC, CELLP, TFET
        .long      OVER, LSUB
        
        .long      ROT, SSPLIT, TSWAP
        .long      ZEQU
        .long      ZBRAN
        .long      PPARS8-.-CW
        .long      DROP, SRC, CELLP, FETCH
PPARS8: 
        .long      LIN, STORE
        .long SEMIS
#

#  ***********
#  *   SRC   *
#  ***********
#
        .balign    4,0x90
N_SRC:
        .long      3
        .ASCII      "SRC"
        .balign    4,0x90
SRC:
        .long    DOUSE
        .long    (CW*(27))
        .long    0x0
        .long    PPARS
        .long    N_SRC
        .long    0
        .long    0
      # And 28 and 29.
#


#  **************
#  *   SOURCE   *
#  **************
#
        .balign    4,0x90
N_SOURCE:
        .long      6
        .ASCII      "SOURCE"
        .balign    4,0x90
SOURCE:
        .long    DOCOL
        .long    SOURCE+HEADSIZE
        .long    0x0
        .long    SRC
        .long    N_SOURCE
        .long    0
        .long    0

        .long      SRC, FETCH
        .long      SRC, CELLP, FETCH
        .long      OVER, LSUB
        .long      SEMIS
#

#  ***********
#  *   >IN   *
#  ***********
#
        .balign    4,0x90
N_IIN:
        .long      3
        .ASCII      ">IN"
        .balign    4,0x90
IIN:
        .long    DOCOL
        .long    IIN+HEADSIZE
        .long    0x0
        .long    SOURCE
        .long    N_IIN
        .long    0
        .long    0

        .long      LIN, FETCH
        .long      SRC, FETCH, LSUB     
        .long      PIIN, STORE
        .long      PIIN
        .long      SEMIS
#
#

#  **********
#  *   CR   *
#  **********
#
        .balign    4,0x90
N_CR:
        .long      2
        .ASCII      "CR"
        .balign    4,0x90
CR:
        .long    DOCOL
        .long    CR+HEADSIZE
        .long    0x0
        .long    IIN
        .long    N_CR
        .long    0
        .long    0

        .long      LIT,ALF
        .long      EMIT
        .long      ZERO, LOUT, STORE
        .long      SEMIS
#

#  *************
#  *   CMOVE   *
#  *************
#
        .balign    4,0x90
N_LCMOVE:
        .long      5
        .ASCII      "CMOVE"
        .balign    4,0x90
LCMOVE:
        .long    LCMOVE+HEADSIZE
        .long    LCMOVE+HEADSIZE
        .long    0x0
        .long    CR
        .long    N_LCMOVE
        .long    0
        .long    0

        CLD             #direction
        MOV     %EBX,%ESI   #save 
        POP     %ECX      #count
        POP     %EDI      #dest
        POP     %ESI      #source
        REP     MOVSB
        MOV     %ESI,%EBX   #get back 
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   MOVE   *
#  ************
#
        .balign    4,0x90
N_LMOVE:
        .long      4
        .ASCII      "MOVE"
        .balign    4,0x90
LMOVE:
        .long    LMOVE+HEADSIZE
        .long    LMOVE+HEADSIZE
        .long    0x0
        .long    LCMOVE
        .long    N_LMOVE
        .long    0
        .long    0

        MOV     %EBX,%ESI   #SAVE 
        POP     %ECX      #count
        POP     %EDI      #dest
        POP     %ESI      #source
        CMP     %ESI,%EDI
        JC    MOVE1
        CLD             #INC DIRECTION
        JMP SHORT MOVE2
MOVE1:  STD
        ADD     %EDI,%ECX
        DEC     %EDI
        ADD     %ESI,%ECX
        DEC     %ESI
MOVE2:
        REP     MOVSB   #THAT'S THE MOVE
        CLD             #INC DIRECTION
        MOV     %ESI,%EBX   #GET BACK 
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***************
#  *   FARMOVE   *
#  ***************
#
        .balign    4,0x90
N_FMOVE:
        .long      7
        .ASCII      "FARMOVE"
        .balign    4,0x90
FMOVE:
        .long    FMOVE+HEADSIZE
        .long    FMOVE+HEADSIZE
        .long    0x0
        .long    LMOVE
        .long    N_FMOVE
        .long    0
        .long    0

        CLD             #direction
        MOV     %EAX,%ESI   #save 
        MOV     %EBX,%DS    #save 
        POP     %ECX      #count
        POP     %EDI      #dest
        POP     %EDX
        AND     %EDX,%EDX
        JZ      FARMV1
        MOV     %ES,%EDX
FARMV1:
        POP     %ESI      #source
        POP     %EDX
        PUSH    %DS
        PUSH    %EBX      #ES in fact.
        AND     %EDX,%EDX
        JZ      FARMV2
        MOV     %DS,%EDX
FARMV2:
        REP     MOVSB
        MOV     %ESI,%EAX   #restore 
        POP     %ES
        POP     %DS
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   UM*   *
#  ***********
#
        .balign    4,0x90
N_USTAR:
        .long      3
        .ASCII      "UM*"
        .balign    4,0x90
USTAR:
        .long    USTAR+HEADSIZE
        .long    USTAR+HEADSIZE
        .long    0x0
        .long    FMOVE
        .long    N_USTAR
        .long    0
        .long    0

        POP     %EAX
        POP     %EBX
        MUL     %EBX      #UNSIGNED
        XCHG    %EAX,%EDX   #AX NOW = MSW
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             #STORE DOUBLE CELL
#

#  **************
#  *   UM/MOD   *
#  **************
#
        .balign    4,0x90
N_USLAS:
        .long      6
        .ASCII      "UM/MOD"
        .balign    4,0x90
USLAS:
        .long    USLAS+HEADSIZE
        .long    USLAS+HEADSIZE
        .long    0x0
        .long    USTAR
        .long    N_USLAS
        .long    0
        .long    0

        POP     %EBX      #DIVISOR
        POP     %EDX      #MSW OF DIVIDEND
        POP     %EAX      #LSW OF DIVIDEND
        DIV     %EBX      #16 BIT DIVIDE
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             #STORE QUOT/REM
#

#  ***********
#  *   AND   *
#  ***********
#
        .balign    4,0x90
N_LAND:
        .long      3
        .ASCII      "AND"
        .balign    4,0x90
LAND:
        .long    LAND+HEADSIZE
        .long    LAND+HEADSIZE
        .long    0x0
        .long    USLAS
        .long    N_LAND
        .long    0
        .long    0

        POP     %EAX
        POP     %EBX
        AND     %EAX,%EBX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   OR   *
#  **********
#
        .balign    4,0x90
N_LOR:
        .long      2
        .ASCII      "OR"
        .balign    4,0x90
LOR:
        .long    LOR+HEADSIZE
        .long    LOR+HEADSIZE
        .long    0x0
        .long    LAND
        .long    N_LOR
        .long    0
        .long    0

        POP     %EAX      # (S1) <- (S1) OR (S2)
        POP     %EBX
        OR      %EAX,%EBX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   XOR   *
#  ***********
#
        .balign    4,0x90
N_LXOR:
        .long      3
        .ASCII      "XOR"
        .balign    4,0x90
LXOR:
        .long    LXOR+HEADSIZE
        .long    LXOR+HEADSIZE
        .long    0x0
        .long    LOR
        .long    N_LXOR
        .long    0
        .long    0

        POP     %EAX      # (S1) <- (S1) XOR (S2)
        POP     %EBX
        XOR     %EAX,%EBX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   INVERT   *
#  **************
#
        .balign    4,0x90
N_INVERT:
        .long      6
        .ASCII      "INVERT"
        .balign    4,0x90
INVERT:
        .long    INVERT+HEADSIZE
        .long    INVERT+HEADSIZE
        .long    0x0
        .long    LXOR
        .long    N_INVERT
        .long    0
        .long    0

        POP     %EAX      # (S1) <- (S1) XOR (S2)
        NOT     %EAX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   DSP@   *
#  ************
#
        .balign    4,0x90
N_SPFET:
        .long      4
        .ASCII      "DSP@"
        .balign    4,0x90
SPFET:
        .long    SPFET+HEADSIZE
        .long    SPFET+HEADSIZE
        .long    0x0
        .long    INVERT
        .long    N_SPFET
        .long    0
        .long    0

        MOV     %EAX,%ESP   # (S1) <- (SP)
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   DSP!   *
#  ************
#
        .balign    4,0x90
N_SPSTO:
        .long      4
        .ASCII      "DSP!"
        .balign    4,0x90
SPSTO:
        .long    SPSTO+HEADSIZE
        .long    SPSTO+HEADSIZE
        .long    0x0
        .long    SPFET
        .long    N_SPSTO
        .long    0
        .long    0

        POP     %EAX
        MOV     %ESP,%EAX        #RESET PARAM STACK POINTER
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#


#  *************
#  *   DEPTH   *
#  *************
#
        .balign    4,0x90
N_DEPTH:
        .long      5
        .ASCII      "DEPTH"
        .balign    4,0x90
DEPTH:
        .long    DOCOL
        .long    DEPTH+HEADSIZE
        .long    0x0
        .long    SPSTO
        .long    N_DEPTH
        .long    0
        .long    0

        .long      SZERO, FETCH
        .long      SPFET
        .long      LSUB
        .long      LIT, CW, SLASH
        .long      ONEM
        .long      SEMIS
#
#

#  ************
#  *   RSP@   *
#  ************
#
        .balign    4,0x90
N_RPFET:
        .long      4
        .ASCII      "RSP@"
        .balign    4,0x90
RPFET:
        .long    RPFET+HEADSIZE
        .long    RPFET+HEADSIZE
        .long    0x0
        .long    DEPTH
        .long    N_RPFET
        .long    0
        .long    0
      #(S1) <- (RP)
        PUSH    %EBP
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   RSP!   *
#  ************
#
        .balign    4,0x90
N_RPSTO:
        .long      4
        .ASCII      "RSP!"
        .balign    4,0x90
RPSTO:
        .long    RPSTO+HEADSIZE
        .long    RPSTO+HEADSIZE
        .long    0x0
        .long    RPFET
        .long    N_RPSTO
        .long    0
        .long    0

        POP     %EBP
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   EXIT   *
#  ************
#
        .balign    4,0x90
N_EXIT:
        .long      4
        .ASCII      "EXIT"
        .balign    4,0x90
EXIT:
        .long    EXIT+HEADSIZE
        .long    EXIT+HEADSIZE
        .long    0x0
        .long    RPSTO
        .long    N_EXIT
        .long    0
        .long    0

        MOV     %ESI,[%EBP] #(IP) <- (R1)
        LEA     %EBP,[%EBP+(CW*(1))]
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   CO   *
#  **********
#
        .balign    4,0x90
N_CO:
        .long      2
        .ASCII      "CO"
        .balign    4,0x90
CO:
        .long    CO+HEADSIZE
        .long    CO+HEADSIZE
        .long    0x0
        .long    EXIT
        .long    N_CO
        .long    0
        .long    0

        XCHG    %ESI,[%EBP]
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   (;)   *
#  ***********
#
        .balign    4,0x90
N_SEMIS:
        .long      3
        .ASCII      "(;)"
        .balign    4,0x90
SEMIS:
        .long    (EXIT+HEADSIZE)
        .long    SEMIS+HEADSIZE
        .long    0x0
        .long    CO
        .long    N_SEMIS
        .long    0
        .long    0

#

#  *************
#  *   LEAVE   *
#  *************
#
        .balign    4,0x90
N_LLEAV:
        .long      5
        .ASCII      "LEAVE"
        .balign    4,0x90
LLEAV:
        .long    DOCOL
        .long    LLEAV+HEADSIZE
        .long    0x0
        .long    SEMIS
        .long    N_LLEAV
        .long    0
        .long    0
  #LIMIT <- INDEX
        .long      RDROP, RDROP, RDROP
        .long      SEMIS
#

#  **********
#  *   >R   *
#  **********
#
        .balign    4,0x90
N_TOR:
        .long      2
        .ASCII      ">R"
        .balign    4,0x90
TOR:
        .long    TOR+HEADSIZE
        .long    TOR+HEADSIZE
        .long    0x0
        .long    LLEAV
        .long    N_TOR
        .long    0
        .long    0
        # (R1) <- (S1)
        POP     %EBX      #GET STACK PARAMETER
        LEA     %EBP,[%EBP - (CW*(1))]    #MOVE RETURN STACK DOWN
        MOV     [%EBP],%EBX #ADD TO RETURN STACK
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   R>   *
#  **********
#
        .balign    4,0x90
N_FROMR:
        .long      2
        .ASCII      "R>"
        .balign    4,0x90
FROMR:
        .long    FROMR+HEADSIZE
        .long    FROMR+HEADSIZE
        .long    0x0
        .long    TOR
        .long    N_FROMR
        .long    0
        .long    0
      #(S1) <- (R1)
        MOV     %EAX,[%EBP] # GET RETURN STACK VALUE
        LEA     %EBP,[%EBP + (CW*(1))]
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   RDROP   *
#  *************
#
        .balign    4,0x90
N_RDROP:
        .long      5
        .ASCII      "RDROP"
        .balign    4,0x90
RDROP:
        .long    RDROP+HEADSIZE
        .long    RDROP+HEADSIZE
        .long    0x0
        .long    FROMR
        .long    N_RDROP
        .long    0
        .long    0
      #(S1) <- (R1)
        LEA     %EBP,[%EBP+(CW*(1))]
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   R@   *
#  **********
#
        .balign    4,0x90
N_RR:
        .long      2
        .ASCII      "R@"
        .balign    4,0x90
RR:
        .long    (IDO+HEADSIZE)
        .long    RR+HEADSIZE
        .long    0x0
        .long    RDROP
        .long    N_RR
        .long    0
        .long    0

#

#  **********
#  *   0=   *
#  **********
#
        .balign    4,0x90
N_ZEQU:
        .long      2
        .ASCII      "0="
        .balign    4,0x90
ZEQU:
        .long    ZEQU+HEADSIZE
        .long    ZEQU+HEADSIZE
        .long    0x0
        .long    RR
        .long    N_ZEQU
        .long    0
        .long    0

        POP     %EAX
        NEG     %EAX
        CMC
        SBB     %EAX,%EAX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   0<   *
#  **********
#
        .balign    4,0x90
N_ZLESS:
        .long      2
        .ASCII      "0<"
        .balign    4,0x90
ZLESS:
        .long    ZLESS+HEADSIZE
        .long    ZLESS+HEADSIZE
        .long    0x0
        .long    ZEQU
        .long    N_ZLESS
        .long    0
        .long    0

        POP     %EAX
        OR      %EAX,%EAX   #SET FLAGS
        MOV     %EAX,0    #FALSE
        JNS     ZLESS1
        DEC     %EAX      #TRUE
ZLESS1: PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   +   *
#  *********
#
        .balign    4,0x90
N_PLUS:
        .long      1
        .ASCII      "+"
        .balign    4,0x90
PLUS:
        .long    PLUS+HEADSIZE
        .long    PLUS+HEADSIZE
        .long    0x0
        .long    ZLESS
        .long    N_PLUS
        .long    0
        .long    0

        POP     %EAX      #(S1) <- (S1) + (S2)
        POP     %EBX
        ADD     %EAX,%EBX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   D+   *
#  **********
#
        .balign    4,0x90
N_DPLUS:
        .long      2
        .ASCII      "D+"
        .balign    4,0x90
DPLUS:
        .long    DPLUS+HEADSIZE
        .long    DPLUS+HEADSIZE
        .long    0x0
        .long    PLUS
        .long    N_DPLUS
        .long    0
        .long    0

        POP     %EAX      # YHW
        POP     %EDX      # YLW
        POP     %EBX      # XHW
        POP     %ECX      # XLW
        ADD     %EDX,%ECX   # SLW
        ADC     %EAX,%EBX   # SHW
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   NEGATE   *
#  **************
#
        .balign    4,0x90
N_NEGATE:
        .long      6
        .ASCII      "NEGATE"
        .balign    4,0x90
NEGATE:
        .long    NEGATE+HEADSIZE
        .long    NEGATE+HEADSIZE
        .long    0x0
        .long    DPLUS
        .long    N_NEGATE
        .long    0
        .long    0

        POP     %EAX
        NEG     %EAX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***************
#  *   DNEGATE   *
#  ***************
#
        .balign    4,0x90
N_DNEGA:
        .long      7
        .ASCII      "DNEGATE"
        .balign    4,0x90
DNEGA:
        .long    DNEGA+HEADSIZE
        .long    DNEGA+HEADSIZE
        .long    0x0
        .long    NEGATE
        .long    N_DNEGA
        .long    0
        .long    0

        POP     %EBX
        POP     %ECX
        SUB     %EAX,%EAX
        MOV     %EDX,%EAX
        SUB     %EDX,%ECX   # MAKE 2'S COMPLEMENT
        SBB     %EAX,%EBX   # HIGH CELL
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
        #
#

#  ************
#  *   OVER   *
#  ************
#
        .balign    4,0x90
N_OVER:
        .long      4
        .ASCII      "OVER"
        .balign    4,0x90
OVER:
        .long    OVER+HEADSIZE
        .long    OVER+HEADSIZE
        .long    0x0
        .long    DNEGA
        .long    N_OVER
        .long    0
        .long    0

        POP     %EDX
        POP     %EAX
        PUSH    %EAX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   DROP   *
#  ************
#
        .balign    4,0x90
N_DROP:
        .long      4
        .ASCII      "DROP"
        .balign    4,0x90
DROP:
        .long    DROP+HEADSIZE
        .long    DROP+HEADSIZE
        .long    0x0
        .long    OVER
        .long    N_DROP
        .long    0
        .long    0

        POP     %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   2DROP   *
#  *************
#
        .balign    4,0x90
N_TDROP:
        .long      5
        .ASCII      "2DROP"
        .balign    4,0x90
TDROP:
        .long    TDROP+HEADSIZE
        .long    TDROP+HEADSIZE
        .long    0x0
        .long    DROP
        .long    N_TDROP
        .long    0
        .long    0

        POP     %EAX
        POP     %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   SWAP   *
#  ************
#
        .balign    4,0x90
N_SWAP:
        .long      4
        .ASCII      "SWAP"
        .balign    4,0x90
SWAP:
        .long    SWAP+HEADSIZE
        .long    SWAP+HEADSIZE
        .long    0x0
        .long    TDROP
        .long    N_SWAP
        .long    0
        .long    0

        POP     %EDX
        POP     %EAX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   DUP   *
#  ***********
#
        .balign    4,0x90
N_LDUP:
        .long      3
        .ASCII      "DUP"
        .balign    4,0x90
LDUP:
        .long    LDUP+HEADSIZE
        .long    LDUP+HEADSIZE
        .long    0x0
        .long    SWAP
        .long    N_LDUP
        .long    0
        .long    0

        POP     %EAX
        PUSH    %EAX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   2DUP   *
#  ************
#
        .balign    4,0x90
N_TDUP:
        .long      4
        .ASCII      "2DUP"
        .balign    4,0x90
TDUP:
        .long    TDUP+HEADSIZE
        .long    TDUP+HEADSIZE
        .long    0x0
        .long    LDUP
        .long    N_TDUP
        .long    0
        .long    0

        POP     %EAX
        POP     %EDX
        PUSH    %EDX
        PUSH    %EAX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   2SWAP   *
#  *************
#
        .balign    4,0x90
N_TSWAP:
        .long      5
        .ASCII      "2SWAP"
        .balign    4,0x90
TSWAP:
        .long    TSWAP+HEADSIZE
        .long    TSWAP+HEADSIZE
        .long    0x0
        .long    TDUP
        .long    N_TSWAP
        .long    0
        .long    0

        POP     %EBX
        POP     %ECX
        POP     %EAX
        POP     %EDX
        PUSH     %ECX
        PUSH     %EBX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   2OVER   *
#  *************
#
        .balign    4,0x90
N_TOVER:
        .long      5
        .ASCII      "2OVER"
        .balign    4,0x90
TOVER:
        .long    TOVER+HEADSIZE
        .long    TOVER+HEADSIZE
        .long    0x0
        .long    TSWAP
        .long    N_TOVER
        .long    0
        .long    0

        POP     %EBX
        POP     %ECX
        POP     %EAX
        POP     %EDX
        PUSH     %EDX
        PUSH     %EAX
        PUSH     %ECX
        PUSH     %EBX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   +!   *
#  **********
#
        .balign    4,0x90
N_PSTORE:
        .long      2
        .ASCII      "+!"
        .balign    4,0x90
PSTORE:
        .long    PSTORE+HEADSIZE
        .long    PSTORE+HEADSIZE
        .long    0x0
        .long    TOVER
        .long    N_PSTORE
        .long    0
        .long    0

        POP     %EBX      #ADDRESS
        POP     %EAX      #INCREMENT
        ADD     [%EBX],%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   TOGGLE   *
#  **************
#
        .balign    4,0x90
N_TOGGL:
        .long      6
        .ASCII      "TOGGLE"
        .balign    4,0x90
TOGGL:
        .long    TOGGL+HEADSIZE
        .long    TOGGL+HEADSIZE
        .long    0x0
        .long    PSTORE
        .long    N_TOGGL
        .long    0
        .long    0

        POP     %EAX      #BIT PATTERN
        POP     %EBX      #ADDR
        XOR     [%EBX],%EAX #
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   @   *
#  *********
#
        .balign    4,0x90
N_FETCH:
        .long      1
        .ASCII      "@"
        .balign    4,0x90
FETCH:
        .long    FETCH+HEADSIZE
        .long    FETCH+HEADSIZE
        .long    0x0
        .long    TOGGL
        .long    N_FETCH
        .long    0
        .long    0

        POP     %EBX
        MOV     %EAX,[%EBX]
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   C@   *
#  **********
#
        .balign    4,0x90
N_CFET:
        .long      2
        .ASCII      "C@"
        .balign    4,0x90
CFET:
        .long    CFET+HEADSIZE
        .long    CFET+HEADSIZE
        .long    0x0
        .long    FETCH
        .long    N_CFET
        .long    0
        .long    0

        POP     %EBX
        XOR     %EAX,%EAX
        MOV     %AL,[%EBX]
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   2@   *
#  **********
#
        .balign    4,0x90
N_TFET:
        .long      2
        .ASCII      "2@"
        .balign    4,0x90
TFET:
        .long    TFET+HEADSIZE
        .long    TFET+HEADSIZE
        .long    0x0
        .long    CFET
        .long    N_TFET
        .long    0
        .long    0

        POP     %EBX      #ADDR
        MOV     %EAX,[%EBX] #MSW
        MOV     %EDX,[%EBX+(CW*(1))]        #LSW
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   !   *
#  *********
#
        .balign    4,0x90
N_STORE:
        .long      1
        .ASCII      "!"
        .balign    4,0x90
STORE:
        .long    STORE+HEADSIZE
        .long    STORE+HEADSIZE
        .long    0x0
        .long    TFET
        .long    N_STORE
        .long    0
        .long    0

        POP     %EBX      #ADDR
        POP     %EAX      #DATA
        MOV     [%EBX],%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   C!   *
#  **********
#
        .balign    4,0x90
N_CSTOR:
        .long      2
        .ASCII      "C!"
        .balign    4,0x90
CSTOR:
        .long    CSTOR+HEADSIZE
        .long    CSTOR+HEADSIZE
        .long    0x0
        .long    STORE
        .long    N_CSTOR
        .long    0
        .long    0

        POP     %EBX      #ADDR
        POP     %EAX      #DATA
        MOV     [%EBX],%AL
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   2!   *
#  **********
#
        .balign    4,0x90
N_TSTOR:
        .long      2
        .ASCII      "2!"
        .balign    4,0x90
TSTOR:
        .long    TSTOR+HEADSIZE
        .long    TSTOR+HEADSIZE
        .long    0x0
        .long    CSTOR
        .long    N_TSTOR
        .long    0
        .long    0

        POP     %EBX      #ADDR
        POP     %EAX      #MSW
        MOV     [%EBX],%EAX
        POP     %EAX      #LSW
        MOV     [%EBX+(CW*(1))],%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   WITHIN   *
#  **************
#
        .balign    4,0x90
N_WITHIN:
        .long      6
        .ASCII      "WITHIN"
        .balign    4,0x90
WITHIN:
        .long    DOCOL
        .long    WITHIN+HEADSIZE
        .long    0x0
        .long    TSTOR
        .long    N_WITHIN
        .long    0
        .long    0

        .long      OVER, LSUB, TOR
        .long      LSUB, FROMR
        .long      ULESS
        .long      SEMIS
#


#  **********
#  *   L@   *
#  **********
#
        .balign    4,0x90
N_LFET:
        .long      2
        .ASCII      "L@"
        .balign    4,0x90
LFET:
        .long    LFET+HEADSIZE
        .long    LFET+HEADSIZE
        .long    0x0
        .long    WITHIN
        .long    N_LFET
        .long    0
        .long    0

        POP     %EBX      #Offset
        POP     %ECX      #Segment
        MOV     %EDX,%DS
        MOV     %DS,%ECX
        MOV     %EBX,[%EBX]
        MOV     %DS,%EDX
        PUSH    %EBX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   L!   *
#  **********
#
        .balign    4,0x90
N_LSTORE:
        .long      2
        .ASCII      "L!"
        .balign    4,0x90
LSTORE:
        .long    LSTORE+HEADSIZE
        .long    LSTORE+HEADSIZE
        .long    0x0
        .long    LFET
        .long    N_LSTORE
        .long    0
        .long    0

        POP     %EBX
        POP     %ECX
        POP     %EDX
        MOV     %EAX,%DS
        MOV     %DS,%ECX
        MOV     [%EBX],%EDX
        MOV     %DS,%EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#
#

#  *********
#  *   :   *
#  *********
#
        .balign    4,0x90
N_COLON:
        .long      1
        .ASCII      ":"
        .balign    4,0x90
COLON:
        .long    DOCOL
        .long    COLON+HEADSIZE
        .long    0x0
        .long    LSTORE
        .long    N_COLON
        .long    0
        .long    0

        .long      SCSP
        .long      LPWORD
        .long      PCREAT
        .long      LATEST, HIDDEN
        .long      RBRAC
        .long      PSCOD
DOCOL:  LEA     %EBP,[%EBP - (CW*(1))]  #Push HIP
        MOV     [%EBP],%ESI #R1 <- (IP)
         MOV     %ESI,[%EAX+(CW*(D_HOFFSET - C_HOFFSET))]  #(IP) <- (PFA)
#        CALL    DISPLAYSI
# 
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   ;   *
#  *********
#
        .balign    4,0x90
N_SEMI:
        .long      1
        .ASCII      ";"
        .balign    4,0x90
SEMI:
        .long    DOCOL
        .long    SEMI+HEADSIZE
        .long    B_IMMED
        .long    COLON
        .long    N_SEMI
        .long    0
        .long    0

        .long      QCSP
        .long      LIT, SEMIS, COMMA
        .long      LATEST, HIDDEN
        .long      LBRAC
        .long      SEMIS
#

#  ****************
#  *   CONSTANT   *
#  ****************
#
        .balign    4,0x90
N_LCONST:
        .long      8
        .ASCII      "CONSTANT"
        .balign    4,0x90
LCONST:
        .long    DOCOL
        .long    LCONST+HEADSIZE
        .long    0x0
        .long    SEMI
        .long    N_LCONST
        .long    0
        .long    0

        .long      LPWORD
        .long      PCREAT
        .long      LATEST, TDFA, STORE
        .long      PSCOD
DOCON:  MOV     %EAX,[%EAX+(CW*((D_HOFFSET)))] #GET DATA FROM PFA
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ****************
#  *   VARIABLE   *
#  ****************
#
        .balign    4,0x90
N_VAR:
        .long      8
        .ASCII      "VARIABLE"
        .balign    4,0x90
VAR:
        .long    DOCOL
        .long    VAR+HEADSIZE
        .long    0x0
        .long    LCONST
        .long    N_VAR
        .long    0
        .long    0

        .long      LPWORD
        .long      PCREAT
        .long      ZERO, COMMA
        .long      PSCOD
DOVAR:  MOV     %EAX,[%EAX+(CW*((D_HOFFSET)))] #(AX) <- PFA
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   USER   *
#  ************
#
        .balign    4,0x90
N_USER:
        .long      4
        .ASCII      "USER"
        .balign    4,0x90
USER:
        .long    DOCOL
        .long    USER+HEADSIZE
        .long    0x0
        .long    VAR
        .long    N_USER
        .long    0
        .long    0

        .long      LCONST
        .long      PSCOD
DOUSE:  MOV     %EBX,[%EAX+(CW*((D_HOFFSET)))] #PFA  
        MOV     %EDI,DWORD PTR[USINI]
        LEA     %EAX,[%EBX+%EDI]      #ADDR OF VARIABLE
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#
#

#  *********
#  *   _   *
#  *********
#
        .balign    4,0x90
N_X:
        .long      1
        .ASCII      "_"
        .balign    4,0x90
X:
        .long    X+HEADSIZE
        .long    X+HEADSIZE
        .long    0x0
        .long    USER
        .long    N_X
        .long    0
        .long    0

        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]    #Whatever happens to be in %EAX, i.e. the dea of ``_''.
#

#  *********
#  *   0   *
#  *********
#
        .balign    4,0x90
N_ZERO:
        .long      1
        .ASCII      "0"
        .balign    4,0x90
ZERO:
        .long    DOCON
        .long    0
        .long    0x0
        .long    X
        .long    N_ZERO
        .long    0
        .long    0

# The data field of 0 is used for an empty string.
#

#  *********
#  *   1   *
#  *********
#
        .balign    4,0x90
N_ONE:
        .long      1
        .ASCII      "1"
        .balign    4,0x90
ONE:
        .long    DOCON
        .long    1
        .long    0x0
        .long    ZERO
        .long    N_ONE
        .long    0
        .long    0

#

#  *********
#  *   2   *
#  *********
#
        .balign    4,0x90
N_TWO:
        .long      1
        .ASCII      "2"
        .balign    4,0x90
TWO:
        .long    DOCON
        .long    2
        .long    0x0
        .long    ONE
        .long    N_TWO
        .long    0
        .long    0

#

#  **********
#  *   BL   *
#  **********
#
        .balign    4,0x90
N_LBL:
        .long      2
        .ASCII      "BL"
        .balign    4,0x90
LBL:
        .long    DOCON
        .long    ABL
        .long    0x0
        .long    TWO
        .long    N_LBL
        .long    0
        .long    0

#

#
#  **********
#  *   $@   *
#  **********
#
        .balign    4,0x90
N_SFET:
        .long      2
        .ASCII      "$@"
        .balign    4,0x90
SFET:
        .long    SFET+HEADSIZE
        .long    SFET+HEADSIZE
        .long    0x0
        .long    LBL
        .long    N_SFET
        .long    0
        .long    0

        POP   %EBX
        MOV   %EAX,[%EBX]
        LEA   %EDX, [%EBX+(CW*(1))]
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   $!   *
#  **********
#
        .balign    4,0x90
N_SSTOR:
        .long      2
        .ASCII      "$!"
        .balign    4,0x90
SSTOR:
        .long    DOCOL
        .long    SSTOR+HEADSIZE
        .long    0x0
        .long    SFET
        .long    N_SSTOR
        .long    0
        .long    0

        .long TDUP, STORE, CELLP, SWAP, LCMOVE
        .long SEMIS
#

#  *************
#  *   $!-BD   *
#  *************
#
        .balign    4,0x90
N_SSTORBD:
        .long      5
        .ASCII      "$!-BD"
        .balign    4,0x90
SSTORBD:
        .long    DOCOL
        .long    SSTORBD+HEADSIZE
        .long    0x0
        .long    SSTOR
        .long    N_SSTORBD
        .long    0
        .long    0

        .long TDUP, CSTOR, ONEP, SWAP, LCMOVE
        .long SEMIS
#

#  ***********
#  *   $+!   *
#  ***********
#
        .balign    4,0x90
N_SADD:
        .long      3
        .ASCII      "$+!"
        .balign    4,0x90
SADD:
        .long    DOCOL
        .long    SADD+HEADSIZE
        .long    0x0
        .long    SSTORBD
        .long    N_SADD
        .long    0
        .long    0

        .long   LDUP, FETCH, TOR # Remember old count.
        .long   TDUP, PSTORE
        .long   CELLP, FROMR, PLUS, SWAP, LCMOVE
        .long SEMIS
#

#  ***********
#  *   $C+   *
#  ***********
#
        .balign    4,0x90
N_CHAPP:
        .long      3
        .ASCII      "$C+"
        .balign    4,0x90
CHAPP:
        .long    DOCOL
        .long    CHAPP+HEADSIZE
        .long    0x0
        .long    SADD
        .long    N_CHAPP
        .long    0
        .long    0

        .long   LDUP, TOR
        .long   LDUP, FETCH, PLUS, CELLP, CSTOR
        .long   ONE, FROMR, PSTORE
        .long SEMIS
#

#  **********
#  *   $,   *
#  **********
#
        .balign    4,0x90
N_SCOMMA:
        .long      2
        .ASCII      "$,"
        .balign    4,0x90
SCOMMA:
        .long    DOCOL
        .long    SCOMMA+HEADSIZE
        .long    0x0
        .long    CHAPP
        .long    N_SCOMMA
        .long    0
        .long    0

        .long HERE, TOR
        .long LDUP, CELLP, ALLOT
        .long RR, SSTOR, FROMR
 .long LALIGN
        .long SEMIS
#

#  ***********
#  *   C/L   *
#  ***********
#
        .balign    4,0x90
N_CSLL:
        .long      3
        .ASCII      "C/L"
        .balign    4,0x90
CSLL:
        .long    DOCON
        .long    64
        .long    0x0
        .long    SCOMMA
        .long    N_CSLL
        .long    0
        .long    0

#


#  *************
#  *   FIRST   *
#  *************
#
        .balign    4,0x90
N_FIRST:
        .long      5
        .ASCII      "FIRST"
        .balign    4,0x90
FIRST:
        .long    DOCON
        .long    BUF1
        .long    0x0
        .long    CSLL
        .long    N_FIRST
        .long    0
        .long    0

 #  
#
# 
#

#  *************
#  *   LIMIT   *
#  *************
#
        .balign    4,0x90
N_LIMIT:
        .long      5
        .ASCII      "LIMIT"
        .balign    4,0x90
LIMIT:
        .long    DOCON
        .long    BUF1+(KBBUF+2*CW)*NBUF
        .long    0x0
        .long    FIRST
        .long    N_LIMIT
        .long    0
        .long    0

# THE END  OF THE MEMORY 

#  **********
#  *   EM   *
#  **********
#
        .balign    4,0x90
N_LEM:
        .long      2
        .ASCII      "EM"
        .balign    4,0x90
LEM:
        .long    DOCON
        .long    ACTUAL_EM
        .long    0x0
        .long    LIMIT
        .long    N_LEM
        .long    0
        .long    0

#

#  **********
#  *   BM   *
#  **********
#
        .balign    4,0x90
N_LBM:
        .long      2
        .ASCII      "BM"
        .balign    4,0x90
LBM:
        .long    DOCON
        .long    ORIG
        .long    0x0
        .long    LEM
        .long    N_LBM
        .long    0
        .long    0

#

#  *************
#  *   B/BUF   *
#  *************
#
        .balign    4,0x90
N_BBUF:
        .long      5
        .ASCII      "B/BUF"
        .balign    4,0x90
BBUF:
        .long    DOCON
        .long    KBBUF
        .long    0x0
        .long    LBM
        .long    N_BBUF
        .long    0
        .long    0

#
# All user variables are initialised 
# with the values from USINI.
# The implementation relies on the initialisation of 
# those with numbers (1..11), so change in concord with USINI.

#  **********
#  *   U0   *
#  **********
#
        .balign    4,0x90
N_UZERO:
        .long      2
        .ASCII      "U0"
        .balign    4,0x90
UZERO:
        .long    DOUSE
        .long    (CW*(1))
        .long    0x0
        .long    BBUF
        .long    N_UZERO
        .long    0
        .long    0

#

#  **********
#  *   S0   *
#  **********
#
        .balign    4,0x90
N_SZERO:
        .long      2
        .ASCII      "S0"
        .balign    4,0x90
SZERO:
        .long    DOUSE
        .long    (CW*(2))
        .long    0x0
        .long    UZERO
        .long    N_SZERO
        .long    0
        .long    0

#

#  **********
#  *   R0   *
#  **********
#
        .balign    4,0x90
N_RZERO:
        .long      2
        .ASCII      "R0"
        .balign    4,0x90
RZERO:
        .long    DOUSE
        .long    (CW*(3))
        .long    0x0
        .long    SZERO
        .long    N_RZERO
        .long    0
        .long    0

#

#  ***********
#  *   TIB   *
#  ***********
#
        .balign    4,0x90
N_TIB:
        .long      3
        .ASCII      "TIB"
        .balign    4,0x90
TIB:
        .long    DOUSE
        .long    (CW*(4))
        .long    0x0
        .long    RZERO
        .long    N_TIB
        .long    0
        .long    0

#

#  **************
#  *   RUBOUT   *
#  **************
#
        .balign    4,0x90
N_RUBOUT:
        .long      6
        .ASCII      "RUBOUT"
        .balign    4,0x90
RUBOUT:
        .long    DOUSE
        .long    (CW*(5))
        .long    0x0
        .long    TIB
        .long    N_RUBOUT
        .long    0
        .long    0

#

#  ***************
#  *   WARNING   *
#  ***************
#
        .balign    4,0x90
N_LWARN:
        .long      7
        .ASCII      "WARNING"
        .balign    4,0x90
LWARN:
        .long    DOUSE
        .long    (CW*(7))
        .long    0x0
        .long    RUBOUT
        .long    N_LWARN
        .long    0
        .long    0

#

#  *************
#  *   FENCE   *
#  *************
#
        .balign    4,0x90
N_FENCE:
        .long      5
        .ASCII      "FENCE"
        .balign    4,0x90
FENCE:
        .long    DOUSE
        .long    (CW*(8))
        .long    0x0
        .long    LWARN
        .long    N_FENCE
        .long    0
        .long    0

#

#  **********
#  *   DP   *
#  **********
#
        .balign    4,0x90
N_LDP:
        .long      2
        .ASCII      "DP"
        .balign    4,0x90
LDP:
        .long    DOUSE
        .long    (CW*(9))
        .long    0x0
        .long    FENCE
        .long    N_LDP
        .long    0
        .long    0

#

#  ****************
#  *   VOC-LINK   *
#  ****************
#
        .balign    4,0x90
N_VOCL:
        .long      8
        .ASCII      "VOC-LINK"
        .balign    4,0x90
VOCL:
        .long    DOUSE
        .long    (CW*(10))
        .long    0x0
        .long    LDP
        .long    N_VOCL
        .long    0
        .long    0

#

#  **************
#  *   OFFSET   *
#  **************
#
        .balign    4,0x90
N_LOFFSET:
        .long      6
        .ASCII      "OFFSET"
        .balign    4,0x90
LOFFSET:
        .long    DOUSE
        .long    (CW*(11))
        .long    0x0
        .long    VOCL
        .long    N_LOFFSET
        .long    0
        .long    0

#
# End of user variables with fixed place.
#
#

#  *************
#  *   WHERE   *
#  *************
#
        .balign    4,0x90
N_LWHERE:
        .long      5
        .ASCII      "WHERE"
        .balign    4,0x90
LWHERE:
        .long    DOUSE
        .long    (CW*(12))
        .long    0x0
        .long    LOFFSET
        .long    N_LWHERE
        .long    0
        .long    0
    #  Occupies two CELLS! 
#

#  ***********
#  *   SCR   *
#  ***********
#
        .balign    4,0x90
N_SCR:
        .long      3
        .ASCII      "SCR"
        .balign    4,0x90
SCR:
        .long    DOUSE
        .long    (CW*(33))
        .long    0x0
        .long    LWHERE
        .long    N_SCR
        .long    0
        .long    0

#

#  *************
#  *   STATE   *
#  *************
#
        .balign    4,0x90
N_STATE:
        .long      5
        .ASCII      "STATE"
        .balign    4,0x90
STATE:
        .long    DOUSE
        .long    (CW*(18))
        .long    0x0
        .long    SCR
        .long    N_STATE
        .long    0
        .long    0

#

#  ************
#  *   BASE   *
#  ************
#
        .balign    4,0x90
N_BASE:
        .long      4
        .ASCII      "BASE"
        .balign    4,0x90
BASE:
        .long    DOUSE
        .long    (CW*(19))
        .long    0x0
        .long    STATE
        .long    N_BASE
        .long    0
        .long    0

#

#  ***********
#  *   DPL   *
#  ***********
#
        .balign    4,0x90
N_DPL:
        .long      3
        .ASCII      "DPL"
        .balign    4,0x90
DPL:
        .long    DOUSE
        .long    (CW*(20))
        .long    0x0
        .long    BASE
        .long    N_DPL
        .long    0
        .long    0

#

#  ***********
#  *   FLD   *
#  ***********
#
        .balign    4,0x90
N_LFLD:
        .long      3
        .ASCII      "FLD"
        .balign    4,0x90
LFLD:
        .long    DOUSE
        .long    (CW*(21))
        .long    0x0
        .long    DPL
        .long    N_LFLD
        .long    0
        .long    0

#


#  ***********
#  *   CSP   *
#  ***********
#
        .balign    4,0x90
N_LCSP:
        .long      3
        .ASCII      "CSP"
        .balign    4,0x90
LCSP:
        .long    DOUSE
        .long    (CW*(22))
        .long    0x0
        .long    LFLD
        .long    N_LCSP
        .long    0
        .long    0

#
#

#  **********
#  *   R#   *
#  **********
#
        .balign    4,0x90
N_RNUM:
        .long      2
        .ASCII      "R#"
        .balign    4,0x90
RNUM:
        .long    DOUSE
        .long    (CW*(23))
        .long    0x0
        .long    LCSP
        .long    N_RNUM
        .long    0
        .long    0

#

#  ***********
#  *   HLD   *
#  ***********
#
        .balign    4,0x90
N_HLD:
        .long      3
        .ASCII      "HLD"
        .balign    4,0x90
HLD:
        .long    DOUSE
        .long    (CW*(24))
        .long    0x0
        .long    RNUM
        .long    N_HLD
        .long    0
        .long    0

#

#  ***********
#  *   OUT   *
#  ***********
#
        .balign    4,0x90
N_LOUT:
        .long      3
        .ASCII      "OUT"
        .balign    4,0x90
LOUT:
        .long    DOUSE
        .long    (CW*(25))
        .long    0x0
        .long    HLD
        .long    N_LOUT
        .long    0
        .long    0

#

#  *************
#  *   (BLK)   *
#  *************
#
        .balign    4,0x90
N_PBLK:
        .long      5
        .ASCII      "(BLK)"
        .balign    4,0x90
PBLK:
        .long    DOUSE
        .long    (CW*(26))
        .long    0x0
        .long    LOUT
        .long    N_PBLK
        .long    0
        .long    0

#

#  **********
#  *   IN   *
#  **********
#
        .balign    4,0x90
N_LIN:
        .long      2
        .ASCII      "IN"
        .balign    4,0x90
LIN:
        .long    DOUSE
        .long    (CW*(29))
        .long    0x0
        .long    PBLK
        .long    N_LIN
        .long    0
        .long    0

#


#  *************
#  *   (>IN)   *
#  *************
#
        .balign    4,0x90
N_PIIN:
        .long      5
        .ASCII      "(>IN)"
        .balign    4,0x90
PIIN:
        .long    DOUSE
        .long    (CW*(30))
        .long    0x0
        .long    LIN
        .long    N_PIIN
        .long    0
        .long    0

#
#

#  ************
#  *   ARGS   *
#  ************
#
        .balign    4,0x90
N_ARGS:
        .long      4
        .ASCII      "ARGS"
        .balign    4,0x90
ARGS:
        .long    DOUSE
        .long    (CW*(31))
        .long    0x0
        .long    PIIN
        .long    N_ARGS
        .long    0
        .long    0

#

#  ***************
#  *   HANDLER   *
#  ***************
#
        .balign    4,0x90
N_HANDLER:
        .long      7
        .ASCII      "HANDLER"
        .balign    4,0x90
HANDLER:
        .long    DOUSE
        .long    (CW*(32))
        .long    0x0
        .long    ARGS
        .long    N_HANDLER
        .long    0
        .long    0

#

#  ***************
#  *   CURRENT   *
#  ***************
#
        .balign    4,0x90
N_CURR:
        .long      7
        .ASCII      "CURRENT"
        .balign    4,0x90
CURR:
        .long    DOUSE
        .long    (CW*(34))
        .long    0x0
        .long    HANDLER
        .long    N_CURR
        .long    0
        .long    0

#

#  *****************
#  *   REMAINDER   *
#  *****************
#
        .balign    4,0x90
N_REMAIND:
        .long      9
        .ASCII      "REMAINDER"
        .balign    4,0x90
REMAIND:
        .long    DOUSE
        .long    (CW*(14))
        .long    0x0
        .long    CURR
        .long    N_REMAIND
        .long    0
        .long    0

#      IMPORTANT
# REQUIRES ONE MORE CELL!
#

#  ***************
#  *   CONTEXT   *
#  ***************
#
        .balign    4,0x90
N_CONTEXT:
        .long      7
        .ASCII      "CONTEXT"
        .balign    4,0x90
CONTEXT:
        .long    DOUSE
        .long    (CW*(37))
        .long    0x0
        .long    REMAIND
        .long    N_CONTEXT
        .long    0
        .long    0
 # Up to  37+16
#      IMPORTANT
#     16 USER SPACE CELLS MUST BE KEPT FREE
#     IN ADDITION TO THE ONE FOR CONTEXT
#
#========== END USER VARIABLES =============
#

#  **********
#  *   1+   *
#  **********
#
        .balign    4,0x90
N_ONEP:
        .long      2
        .ASCII      "1+"
        .balign    4,0x90
ONEP:
        .long    DOCOL
        .long    ONEP+HEADSIZE
        .long    0x0
        .long    CONTEXT
        .long    N_ONEP
        .long    0
        .long    0

        .long      ONE
        .long      PLUS
        .long      SEMIS
#

#  *************
#  *   CELL+   *
#  *************
#
        .balign    4,0x90
N_CELLP:
        .long      5
        .ASCII      "CELL+"
        .balign    4,0x90
CELLP:
        .long    DOCOL
        .long    CELLP+HEADSIZE
        .long    0x0
        .long    ONEP
        .long    N_CELLP
        .long    0
        .long    0

        .long      LIT, CW
        .long      PLUS
        .long      SEMIS
#

#
#  *************
#  *   CELLS   *
#  *************
#
        .balign    4,0x90
N_LCELLS:
        .long      5
        .ASCII      "CELLS"
        .balign    4,0x90
LCELLS:
        .long    DOCOL
        .long    LCELLS+HEADSIZE
        .long    0x0
        .long    CELLP
        .long    N_LCELLS
        .long    0
        .long    0

        .long       TWO
        .long      LSHIFT
        .long      SEMIS
#

#  *************
#  *   CHAR+   *
#  *************
#
        .balign    4,0x90
N_CHARP:
        .long      5
        .ASCII      "CHAR+"
        .balign    4,0x90
CHARP:
        .long    DOCOL
        .long    (ONEP+HEADSIZE)
        .long    0x0
        .long    LCELLS
        .long    N_CHARP
        .long    0
        .long    0

#

#  *************
#  *   CHARS   *
#  *************
#
        .balign    4,0x90
N_CHARS:
        .long      5
        .ASCII      "CHARS"
        .balign    4,0x90
CHARS:
        .long    DOCOL
        .long    CHARS+HEADSIZE
        .long    B_IMMED
        .long    CHARP
        .long    N_CHARS
        .long    0
        .long    0

        .long      SEMIS
#

#  *************
#  *   ALIGN   *
#  *************
#
        .balign    4,0x90
N_LALIGN:
        .long      5
        .ASCII      "ALIGN"
        .balign    4,0x90
LALIGN:
        .long    DOCOL
        .long    LALIGN+HEADSIZE
        .long    B_IMMED
        .long    CHARS
        .long    N_LALIGN
        .long    0
        .long    0


        .long      LDP, FETCH
        .long      ALIGNED
        .long      LDP, STORE
#
        .long      SEMIS
#

#  ***************
#  *   ALIGNED   *
#  ***************
#
        .balign    4,0x90
N_ALIGNED :
        .long      7
        .ASCII      "ALIGNED"
        .balign    4,0x90
ALIGNED :
        .long    ALIGNED +HEADSIZE
        .long    ALIGNED +HEADSIZE
        .long    0x0
        .long    LALIGN
        .long    N_ALIGNED 
        .long    0
        .long    0


        POP     %EAX
        DEC     %EAX
        OR      %AL, OFFSET 3
        INC     %EAX
        PUSH    %EAX
#
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   HERE   *
#  ************
#
        .balign    4,0x90
N_HERE:
        .long      4
        .ASCII      "HERE"
        .balign    4,0x90
HERE:
        .long    DOCOL
        .long    HERE+HEADSIZE
        .long    0x0
        .long    ALIGNED 
        .long    N_HERE
        .long    0
        .long    0

        .long      LDP
        .long      FETCH
        .long      SEMIS
#

#  *************
#  *   ALLOT   *
#  *************
#
        .balign    4,0x90
N_ALLOT:
        .long      5
        .ASCII      "ALLOT"
        .balign    4,0x90
ALLOT:
        .long    DOCOL
        .long    ALLOT+HEADSIZE
        .long    0x0
        .long    HERE
        .long    N_ALLOT
        .long    0
        .long    0

        .long      LDP
        .long      PSTORE
        .long      SEMIS
#

#  *********
#  *   ,   *
#  *********
#
        .balign    4,0x90
N_COMMA:
        .long      1
        .ASCII      ","
        .balign    4,0x90
COMMA:
        .long    DOCOL
        .long    COMMA+HEADSIZE
        .long    0x0
        .long    ALLOT
        .long    N_COMMA
        .long    0
        .long    0

        .long      HERE
        .long      STORE
        .long      LIT, CW
        .long      ALLOT
        .long      SEMIS
#

#  **********
#  *   C,   *
#  **********
#
        .balign    4,0x90
N_CCOMM:
        .long      2
        .ASCII      "C,"
        .balign    4,0x90
CCOMM:
        .long    DOCOL
        .long    CCOMM+HEADSIZE
        .long    0x0
        .long    COMMA
        .long    N_CCOMM
        .long    0
        .long    0

        .long      HERE
        .long      CSTOR
        .long      ONE
        .long      ALLOT
        .long      SEMIS
#

#  *********
#  *   -   *
#  *********
#
        .balign    4,0x90
N_LSUB:
        .long      1
        .ASCII      "-"
        .balign    4,0x90
LSUB:
        .long    LSUB+HEADSIZE
        .long    LSUB+HEADSIZE
        .long    0x0
        .long    CCOMM
        .long    N_LSUB
        .long    0
        .long    0

        POP     %EDX      #S1
        POP     %EAX
        SUB     %EAX,%EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]      #S1 = S2 - S1
#

#  *********
#  *   =   *
#  *********
#
        .balign    4,0x90
N_EQUAL:
        .long      1
        .ASCII      "="
        .balign    4,0x90
EQUAL:
        .long    DOCOL
        .long    EQUAL+HEADSIZE
        .long    0x0
        .long    LSUB
        .long    N_EQUAL
        .long    0
        .long    0

        .long      LSUB
        .long      ZEQU
        .long      SEMIS
#

#  *********
#  *   <   *
#  *********
#
        .balign    4,0x90
N_LESS:
        .long      1
        .ASCII      "<"
        .balign    4,0x90
LESS:
        .long    LESS+HEADSIZE
        .long    LESS+HEADSIZE
        .long    0x0
        .long    EQUAL
        .long    N_LESS
        .long    0
        .long    0

        POP     %EDX      #S1
        POP     %EBX      #S2
        XOR     %EAX,%EAX   #0 default RESULT
        CMP     %EBX,%EDX
        JNL     LES1
        DEC     %EAX
LES1:   PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   U<   *
#  **********
#
        .balign    4,0x90
N_ULESS:
        .long      2
        .ASCII      "U<"
        .balign    4,0x90
ULESS:
        .long    ULESS+HEADSIZE
        .long    ULESS+HEADSIZE
        .long    0x0
        .long    LESS
        .long    N_ULESS
        .long    0
        .long    0

        POP     %EAX
        POP     %EDX
        SUB     %EDX,%EAX
        SBB     %EAX,%EAX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *********
#  *   >   *
#  *********
#
        .balign    4,0x90
N_GREAT:
        .long      1
        .ASCII      ">"
        .balign    4,0x90
GREAT:
        .long    DOCOL
        .long    GREAT+HEADSIZE
        .long    0x0
        .long    ULESS
        .long    N_GREAT
        .long    0
        .long    0

        .long      SWAP
        .long      LESS
        .long      SEMIS
#

#  **********
#  *   <>   *
#  **********
#
        .balign    4,0x90
N_UNEQ:
        .long      2
        .ASCII      "<>"
        .balign    4,0x90
UNEQ:
        .long    DOCOL
        .long    UNEQ+HEADSIZE
        .long    0x0
        .long    GREAT
        .long    N_UNEQ
        .long    0
        .long    0

        .long      LSUB
        .long      ZEQU
        .long      ZEQU
        .long      SEMIS
#

#  ***********
#  *   ROT   *
#  ***********
#
        .balign    4,0x90
N_ROT:
        .long      3
        .ASCII      "ROT"
        .balign    4,0x90
ROT:
        .long    ROT+HEADSIZE
        .long    ROT+HEADSIZE
        .long    0x0
        .long    UNEQ
        .long    N_ROT
        .long    0
        .long    0

        POP     %EDX      #S1
        POP     %EBX      #S2
        POP     %EAX      #S3
        PUSH    %EBX
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   SPACE   *
#  *************
#
        .balign    4,0x90
N_SPACE:
        .long      5
        .ASCII      "SPACE"
        .balign    4,0x90
SPACE:
        .long    DOCOL
        .long    SPACE+HEADSIZE
        .long    0x0
        .long    ROT
        .long    N_SPACE
        .long    0
        .long    0

        .long      LBL
        .long      EMIT
        .long      SEMIS
#

#  ************
#  *   ?DUP   *
#  ************
#
        .balign    4,0x90
N_QDUP:
        .long      4
        .ASCII      "?DUP"
        .balign    4,0x90
QDUP:
        .long    DOCOL
        .long    QDUP+HEADSIZE
        .long    0x0
        .long    SPACE
        .long    N_QDUP
        .long    0
        .long    0

        .long      LDUP
        .long      ZBRAN
        .long      QDUP1-.-CW # IF
        .long      LDUP    #THEN
QDUP1:  .long      SEMIS
#

#  **************
#  *   LATEST   *
#  **************
#
        .balign    4,0x90
N_LATEST:
        .long      6
        .ASCII      "LATEST"
        .balign    4,0x90
LATEST:
        .long    DOCOL
        .long    LATEST+HEADSIZE
        .long    0x0
        .long    QDUP
        .long    N_LATEST
        .long    0
        .long    0

        .long      CURR
        .long      FETCH
        .long      TLFA
        .long      FETCH
        .long      SEMIS
#

#  ************
#  *   >CFA   *
#  ************
#
        .balign    4,0x90
N_TCFA:
        .long      4
        .ASCII      ">CFA"
        .balign    4,0x90
TCFA:
        .long    DOCOL
        .long    TCFA+HEADSIZE
        .long    0x0
        .long    LATEST
        .long    N_TCFA
        .long    0
        .long    0

        .long      LIT, (CW*(C_HOFFSET))
        .long      PLUS
        .long      SEMIS
#

#  ************
#  *   >DFA   *
#  ************
#
        .balign    4,0x90
N_TDFA:
        .long      4
        .ASCII      ">DFA"
        .balign    4,0x90
TDFA:
        .long    DOCOL
        .long    TDFA+HEADSIZE
        .long    0x0
        .long    TCFA
        .long    N_TDFA
        .long    0
        .long    0

        .long      LIT, (CW*(D_HOFFSET))
        .long      PLUS
        .long      SEMIS
#

#  ************
#  *   >FFA   *
#  ************
#
        .balign    4,0x90
N_TFFA:
        .long      4
        .ASCII      ">FFA"
        .balign    4,0x90
TFFA:
        .long    DOCOL
        .long    TFFA+HEADSIZE
        .long    0x0
        .long    TDFA
        .long    N_TFFA
        .long    0
        .long    0

        .long      LIT, (CW*(F_HOFFSET))
        .long      PLUS
        .long      SEMIS
#

#  ************
#  *   >LFA   *
#  ************
#
        .balign    4,0x90
N_TLFA:
        .long      4
        .ASCII      ">LFA"
        .balign    4,0x90
TLFA:
        .long    DOCOL
        .long    TLFA+HEADSIZE
        .long    0x0
        .long    TFFA
        .long    N_TLFA
        .long    0
        .long    0

        .long      LIT, (CW*(L_HOFFSET))
        .long      PLUS
        .long      SEMIS
#

#  ************
#  *   >NFA   *
#  ************
#
        .balign    4,0x90
N_TNFA:
        .long      4
        .ASCII      ">NFA"
        .balign    4,0x90
TNFA:
        .long    DOCOL
        .long    TNFA+HEADSIZE
        .long    0x0
        .long    TLFA
        .long    N_TNFA
        .long    0
        .long    0

        .long      LIT,(CW*(N_HOFFSET))
        .long      PLUS
        .long      SEMIS
#


#
#  ************
#  *   >SFA   *
#  ************
#
        .balign    4,0x90
N_TSFA:
        .long      4
        .ASCII      ">SFA"
        .balign    4,0x90
TSFA:
        .long    DOCOL
        .long    TSFA+HEADSIZE
        .long    0x0
        .long    TNFA
        .long    N_TSFA
        .long    0
        .long    0

        .long      LIT,(CW*(S_HOFFSET))
        .long      PLUS
        .long      SEMIS
#
#


#
#  ************
#  *   >XFA   *
#  ************
#
        .balign    4,0x90
N_TXFA:
        .long      4
        .ASCII      ">XFA"
        .balign    4,0x90
TXFA:
        .long    DOCOL
        .long    TXFA+HEADSIZE
        .long    0x0
        .long    TSFA
        .long    N_TXFA
        .long    0
        .long    0

        .long      LIT,(CW*(X_HOFFSET))
        .long      PLUS
        .long      SEMIS
#
#

#  ************
#  *   >PHA   *
#  ************
#
        .balign    4,0x90
N_TPHA:
        .long      4
        .ASCII      ">PHA"
        .balign    4,0x90
TPHA:
        .long    DOCOL
        .long    TPHA+HEADSIZE
        .long    0x0
        .long    TXFA
        .long    N_TPHA
        .long    0
        .long    0

        .long      LIT,(CW*(PH_OFFSET))
        .long      PLUS
        .long      SEMIS
#

#  *************
#  *   >BODY   *
#  *************
#
        .balign    4,0x90
N_TOBODY:
        .long      5
        .ASCII      ">BODY"
        .balign    4,0x90
TOBODY:
        .long    DOCOL
        .long    TOBODY+HEADSIZE
        .long    0x0
        .long    TPHA
        .long    N_TOBODY
        .long    0
        .long    0

        .long      CTOD
        .long      TDFA, FETCH
        .long      CELLP           # Skip DOES> pointer.
        .long      SEMIS
#

#  *************
#  *   BODY>   *
#  *************
#
        .balign    4,0x90
N_BODYF:
        .long      5
        .ASCII      "BODY>"
        .balign    4,0x90
BODYF:
        .long    DOCOL
        .long    BODYF+HEADSIZE
        .long    0x0
        .long    TOBODY
        .long    N_BODYF
        .long    0
        .long    0

        .long      LIT,(CW*(BD_OFFSET))
        .long      LSUB
        .long      SEMIS
#

#  ************
#  *   CFA>   *
#  ************
#
        .balign    4,0x90
N_CTOD:
        .long      4
        .ASCII      "CFA>"
        .balign    4,0x90
CTOD:
        .long    DOCOL
        .long    CTOD+HEADSIZE
        .long    0x0
        .long    BODYF
        .long    N_CTOD
        .long    0
        .long    0

        .long      LIT,(CW*(C_HOFFSET))
        .long      LSUB
        .long      SEMIS
#

#  ************
#  *   >WID   *
#  ************
#
        .balign    4,0x90
N_TWID:
        .long      4
        .ASCII      ">WID"
        .balign    4,0x90
TWID:
        .long    DOCOL
        .long    TWID+HEADSIZE
        .long    0x0
        .long    CTOD
        .long    N_TWID
        .long    0
        .long    0

        .long      TOBODY
        .long      CELLP # Skip vfa link.
        .long      SEMIS
#

#  ************
#  *   >VFA   *
#  ************
#
        .balign    4,0x90
N_TVFA:
        .long      4
        .ASCII      ">VFA"
        .balign    4,0x90
TVFA:
        .long    DOCOL
        .long    TVFA+HEADSIZE
        .long    0x0
        .long    TWID
        .long    N_TVFA
        .long    0
        .long    0

        .long      TOBODY
        .long      SEMIS
#


#  ************
#  *   !CSP   *
#  ************
#
        .balign    4,0x90
N_SCSP:
        .long      4
        .ASCII      "!CSP"
        .balign    4,0x90
SCSP:
        .long    DOCOL
        .long    SCSP+HEADSIZE
        .long    0x0
        .long    TVFA
        .long    N_SCSP
        .long    0
        .long    0

        .long      SPFET
        .long      LCSP
        .long      STORE
        .long      SEMIS
#
#

#  **************
#  *   ?ERROR   *
#  **************
#
        .balign    4,0x90
N_QERR:
        .long      6
        .ASCII      "?ERROR"
        .balign    4,0x90
QERR:
        .long    DOCOL
        .long    QERR+HEADSIZE
        .long    0x0
        .long    SCSP
        .long    N_QERR
        .long    0
        .long    0

        .long      SWAP
        .long      ZBRAN
        .long      QERR1-.-CW #IF
        .long      LIN, FETCH
        .long      SRC, FETCH
        .long      LWHERE, TSTOR
        .long      THROW
        .long      BRAN
        .long      QERR2-.-CW  #ELSE
QERR1:  .long      DROP    #THEN
QERR2:  .long      SEMIS
#

#  **************
#  *   ?ERRUR   *
#  **************
#
        .balign    4,0x90
N_QERRUR:
        .long      6
        .ASCII      "?ERRUR"
        .balign    4,0x90
QERRUR:
        .long    DOCOL
        .long    QERRUR+HEADSIZE
        .long    0x0
        .long    QERR
        .long    N_QERRUR
        .long    0
        .long    0

        .long      ZERO, MIN, LDUP, QERR
        .long      SEMIS
#


#  **************
#  *   ?DELIM   *
#  **************
#
        .balign    4,0x90
N_QDELIM:
        .long      6
        .ASCII      "?DELIM"
        .balign    4,0x90
QDELIM:
        .long    DOCOL
        .long    QDELIM+HEADSIZE
        .long    0x0
        .long    QERRUR
        .long    N_QDELIM
        .long    0
        .long    0

        .long      INBRS
        .long      QBL
        .long      ZEQU
        .long      LIT, 10, QERR
        .long      DROP
        .long      SEMIS
#

#  ************
#  *   ?CSP   *
#  ************
#
        .balign    4,0x90
N_QCSP:
        .long      4
        .ASCII      "?CSP"
        .balign    4,0x90
QCSP:
        .long    DOCOL
        .long    QCSP+HEADSIZE
        .long    0x0
        .long    QDELIM
        .long    N_QCSP
        .long    0
        .long    0

        .long      SPFET
        .long      LCSP
        .long      FETCH
        .long      LSUB
        .long      LIT, 20, QERR
        .long      SEMIS
#

#  *************
#  *   ?COMP   *
#  *************
#
        .balign    4,0x90
N_QCOMP:
        .long      5
        .ASCII      "?COMP"
        .balign    4,0x90
QCOMP:
        .long    DOCOL
        .long    QCOMP+HEADSIZE
        .long    0x0
        .long    QCSP
        .long    N_QCOMP
        .long    0
        .long    0

        .long      STATE
        .long      FETCH
        .long      ZEQU
        .long      LIT, 17, QERR
        .long      SEMIS
#

#  *************
#  *   ?EXEC   *
#  *************
#
        .balign    4,0x90
N_QEXEC:
        .long      5
        .ASCII      "?EXEC"
        .balign    4,0x90
QEXEC:
        .long    DOCOL
        .long    QEXEC+HEADSIZE
        .long    0x0
        .long    QCOMP
        .long    N_QEXEC
        .long    0
        .long    0

        .long      STATE
        .long      FETCH
        .long      LIT, 18, QERR
        .long      SEMIS
#

#  **************
#  *   ?PAIRS   *
#  **************
#
        .balign    4,0x90
N_QPAIR:
        .long      6
        .ASCII      "?PAIRS"
        .balign    4,0x90
QPAIR:
        .long    DOCOL
        .long    QPAIR+HEADSIZE
        .long    0x0
        .long    QEXEC
        .long    N_QPAIR
        .long    0
        .long    0

        .long      LSUB
        .long      LIT, 19, QERR
        .long      SEMIS
#


#  ****************
#  *   ?LOADING   *
#  ****************
#
        .balign    4,0x90
N_QLOAD:
        .long      8
        .ASCII      "?LOADING"
        .balign    4,0x90
QLOAD:
        .long    DOCOL
        .long    QLOAD+HEADSIZE
        .long    0x0
        .long    QPAIR
        .long    N_QLOAD
        .long    0
        .long    0

        .long      BLK
        .long      FETCH
        .long      ZEQU
        .long      LIT, 22, QERR
        .long      SEMIS
#
#
#
#

#  *********
#  *   [   *
#  *********
#
        .balign    4,0x90
N_LBRAC:
        .long      1
        .ASCII      "["
        .balign    4,0x90
LBRAC:
        .long    DOCOL
        .long    LBRAC+HEADSIZE
        .long    B_IMMED
        .long    QLOAD
        .long    N_LBRAC
        .long    0
        .long    0

        .long      ZERO
        .long      STATE
        .long      STORE
        .long      SEMIS
#

#  *********
#  *   ]   *
#  *********
#
        .balign    4,0x90
N_RBRAC:
        .long      1
        .ASCII      "]"
        .balign    4,0x90
RBRAC:
        .long    DOCOL
        .long    RBRAC+HEADSIZE
        .long    0x0
        .long    LBRAC
        .long    N_RBRAC
        .long    0
        .long    0

        .long      ONE
        .long      STATE
        .long      STORE
        .long      SEMIS
#

#  **************
#  *   HIDDEN   *
#  **************
#
        .balign    4,0x90
N_HIDDEN:
        .long      6
        .ASCII      "HIDDEN"
        .balign    4,0x90
HIDDEN:
        .long    DOCOL
        .long    HIDDEN+HEADSIZE
        .long    0x0
        .long    RBRAC
        .long    N_HIDDEN
        .long    0
        .long    0

        .long      TFFA
        .long      LIT,B_INVIS
        .long      TOGGL
        .long      SEMIS
#

#  ***********
#  *   HEX   *
#  ***********
#
        .balign    4,0x90
N_HEX:
        .long      3
        .ASCII      "HEX"
        .balign    4,0x90
HEX:
        .long    DOCOL
        .long    HEX+HEADSIZE
        .long    0x0
        .long    HIDDEN
        .long    N_HEX
        .long    0
        .long    0

        .long      LIT,16
        .long      BASE
        .long      STORE
        .long      SEMIS
#

#  ***************
#  *   DECIMAL   *
#  ***************
#
        .balign    4,0x90
N_DECA:
        .long      7
        .ASCII      "DECIMAL"
        .balign    4,0x90
DECA:
        .long    DOCOL
        .long    DECA+HEADSIZE
        .long    0x0
        .long    HEX
        .long    N_DECA
        .long    0
        .long    0

        .long      LIT,10
        .long      BASE
        .long      STORE
        .long      SEMIS
#

#  ***************
#  *   (;CODE)   *
#  ***************
#
        .balign    4,0x90
N_PSCOD:
        .long      7
        .ASCII      "(;CODE)"
        .balign    4,0x90
PSCOD:
        .long    DOCOL
        .long    PSCOD+HEADSIZE
        .long    0x0
        .long    DECA
        .long    N_PSCOD
        .long    0
        .long    0

        .long      FROMR
        .long      LATEST
        .long      TCFA
        .long      STORE
        .long      SEMIS
#

#

#  **************
#  *   CREATE   *
#  **************
#
        .balign    4,0x90
N_CREATE:
        .long      6
        .ASCII      "CREATE"
        .balign    4,0x90
CREATE:
        .long    DOCOL
        .long    CREATE+HEADSIZE
        .long    0x0
        .long    PSCOD
        .long    N_CREATE
        .long    0
        .long    0

        .long      LPWORD
        .long      PCREAT
        .long      LIT, HLNOOP, COMMA
        .long      PSCOD
DODOE:  LEA     %EBP,[%EBP - (CW*(1))] #Push HIP.
        MOV     [%EBP],%ESI
        MOV     %ESI,[%EAX+(CW*((D_HOFFSET)))] #NEW IP 
        LEA     %EAX,[%ESI+(CW*(1))]
        MOV     %ESI,[%ESI]
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
HLNOOP: .long      SEMIS
#

#  *************
#  *   DOES>   *
#  *************
#
        .balign    4,0x90
N_DOES:
        .long      5
        .ASCII      "DOES>"
        .balign    4,0x90
DOES:
        .long    DOCOL
        .long    DOES+HEADSIZE
        .long    0x0
        .long    CREATE
        .long    N_DOES
        .long    0
        .long    0

        .long      FROMR
        .long      LATEST
        .long      TDFA
        .long      FETCH
        .long      STORE
        .long      SEMIS
#

#  *************
#  *   COUNT   *
#  *************
#
        .balign    4,0x90
N_COUNT:
        .long      5
        .ASCII      "COUNT"
        .balign    4,0x90
COUNT:
        .long    DOCOL
        .long    COUNT+HEADSIZE
        .long    0x0
        .long    DOES
        .long    N_COUNT
        .long    0
        .long    0

        .long      LDUP
        .long      ONEP
        .long      SWAP
        .long      CFET
        .long      SEMIS
#

#  *****************
#  *   -TRAILING   *
#  *****************
#
        .balign    4,0x90
N_DTRAI:
        .long      9
        .ASCII      "-TRAILING"
        .balign    4,0x90
DTRAI:
        .long    DOCOL
        .long    DTRAI+HEADSIZE
        .long    0x0
        .long    COUNT
        .long    N_DTRAI
        .long    0
        .long    0

        .long      LDUP
        .long      ZERO
        .long     XQDO
        .long      DTRA4-.-CW
DTRA1:  .long      OVER
        .long      OVER
        .long      PLUS
        .long      ONE
        .long      LSUB
        .long      CFET
        .long      QBL
        .long      ZEQU
        .long      ZBRAN
        .long      DTRA2-.-CW #IF
        .long      LLEAV
DTRA2:  .long      ONE
        .long      LSUB    # THEN
        .long     XLOOP
        .long      DTRA1-.-CW    # LOOP
DTRA4:
        .long      SEMIS
#


#  **********
#  *   S"   *
#  **********
#
        .balign    4,0x90
N_SQUOT:
        .long      2
        .ASCII      "S\""
        .balign    4,0x90
SQUOT:
        .long    DOCOL
        .long    SQUOT+HEADSIZE
        .long    B_IMMED
        .long    DTRAI
        .long    N_SQUOT
        .long    0
        .long    0

        .long      DENQ
        .long      SEMIS
#
#

#  **********
#  *   ."   *
#  **********
#
        .balign    4,0x90
N_DOTQ:
        .long      2
        .ASCII      ".\""
        .balign    4,0x90
DOTQ:
        .long    DOCOL
        .long    DOTQ+HEADSIZE
        .long    B_IMMED
        .long    SQUOT
        .long    N_DOTQ
        .long    0
        .long    0

        .long      DENQ
        .long      STATE
        .long      FETCH
        .long      ZBRAN
        .long      DOTQ1-.-CW # IF
        .long      LIT, LTYPE, COMMA
        .long      BRAN
        .long      DOTQ2-.-CW
DOTQ1:
        .long      LTYPE
DOTQ2:
        .long      SEMIS   # THEN
#

#  **********
#  *   .(   *
#  **********
#
        .balign    4,0x90
N_DOTP:
        .long      2
        .ASCII      ".("
        .balign    4,0x90
DOTP:
        .long    DOCOL
        .long    DOTP+HEADSIZE
        .long    B_IMMED
        .long    DOTQ
        .long    N_DOTP
        .long    0
        .long    0

        .long      LIT, ')'
        .long      PPARS
        .long      LTYPE
        .long      SEMIS
#

#  ***************
#  *   SET-SRC   *
#  ***************
#
        .balign    4,0x90
N_SETSRC:
        .long      7
        .ASCII      "SET-SRC"
        .balign    4,0x90
SETSRC:
        .long    DOCOL
        .long    SETSRC+HEADSIZE
        .long    0x0
        .long    DOTP
        .long    N_SETSRC
        .long    0
        .long    0

        .long      OVER, PLUS
        .long      SWAP, SRC, TSTOR
        .long      SRC, FETCH
        .long      LIN, STORE #  IN

#       .long      DOTS
        .long      SEMIS
#

#  ****************
#  *   EVALUATE   *
#  ****************
#
        .balign    4,0x90
N_EVALUATE:
        .long      8
        .ASCII      "EVALUATE"
        .balign    4,0x90
EVALUATE:
        .long    DOCOL
        .long    EVALUATE+HEADSIZE
        .long    0x0
        .long    SETSRC
        .long    N_EVALUATE
        .long    0
        .long    0

        .long      SAVE
        .long      SETSRC
        .long      LIT, INTER, CATCH
        .long      RESTO
        .long      THROW
        .long      SEMIS
#

#  ************
#  *   FILL   *
#  ************
#
        .balign    4,0x90
N_FILL:
        .long      4
        .ASCII      "FILL"
        .balign    4,0x90
FILL:
        .long    FILL+HEADSIZE
        .long    FILL+HEADSIZE
        .long    0x0
        .long    EVALUATE
        .long    N_FILL
        .long    0
        .long    0

#       Assume the extra segment points to the data segment 
        POP     %EAX      # FILL CHAR
        POP     %ECX      # FILL COUNT
        POP     %EDI      # BEGIN ADDR
        CLD             # INC DIRECTION
        REP     STOSB   #STORE BYTE
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ************
#  *   CORA   *
#  ************
#
        .balign    4,0x90
N_CORA:
        .long      4
        .ASCII      "CORA"
        .balign    4,0x90
CORA:
        .long    CORA+HEADSIZE
        .long    CORA+HEADSIZE
        .long    0x0
        .long    FILL
        .long    N_CORA
        .long    0
        .long    0

#       Assume the extra segment points to the data segment 
        MOV     %EDX,%ESI   #SAVE
        XOR     %EAX,%EAX   # Result
        POP     %ECX      # count
        POP     %EDI      # addr2
        POP     %ESI      # addr1
        CLD             # INC DIRECTION
        REP     CMPSB   # Compare BYTE
        JZ      CORA3
        MOV     %AL,1    #Remainder is already 0
        JNC     CORA3
        NEG     %EAX
CORA3:
        MOV     %ESI,%EDX  #Restore
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   $I   *
#  **********
#
        .balign    4,0x90
N_SINDEX:
        .long      2
        .ASCII      "$I"
        .balign    4,0x90
SINDEX:
        .long    SINDEX+HEADSIZE
        .long    SINDEX+HEADSIZE
        .long    0x0
        .long    CORA
        .long    N_SINDEX
        .long    0
        .long    0

#       Assume the extra segment points to the data segment 
        POP     %EAX      # char
        POP     %ECX      # count
        POP     %EDI      # addr
        OR      %ESI,%ESI   #Clear zero flag.
        CLD             # INC DIRECTION
        REPNZ     SCASB   # Compare BYTE
        JZ      SINDEX1
        XOR     %EDI,%EDI    #Not found: 0
        INC     %EDI
SINDEX1:
        DEC     %EDI
        PUSH    %EDI
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   $S   *
#  **********
#
        .balign    4,0x90
N_SSPLIT:
        .long      2
        .ASCII      "$S"
        .balign    4,0x90
SSPLIT:
        .long    SSPLIT+HEADSIZE
        .long    SSPLIT+HEADSIZE
        .long    0x0
        .long    SINDEX
        .long    N_SSPLIT
        .long    0
        .long    0

#       Assume the extra segment points to the data segment 
        POP     %EAX      # char
        POP     %ECX      # count
        MOV     %EBX,%ECX
        POP     %EDI      # addr
        OR      %EDI,%EDI   #Clear zero flag.
        MOV     %EDX,%EDI   # Copy
        CLD             # INC DIRECTION
        REPNZ     SCASB   # Compare BYTE
        JZ      SSPLIT1
# Not present.
        PUSH    %ECX   # Nil pointer.
        JMP SHORT SSPLIT2
SSPLIT1:
        PUSH    %EDI
        SUB     %EBX,%ECX
        DEC     %EBX      #Delimiter is not part of first string.
SSPLIT2:
        PUSH    %ECX   #Remaining length
        PUSH    %EDX   #Start of first string.
        PUSH    %EBX   #Skipped length.
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  *************
#  *   ERASE   *
#  *************
#
        .balign    4,0x90
N_LERASE:
        .long      5
        .ASCII      "ERASE"
        .balign    4,0x90
LERASE:
        .long    DOCOL
        .long    LERASE+HEADSIZE
        .long    0x0
        .long    SSPLIT
        .long    N_LERASE
        .long    0
        .long    0

        .long      ZERO
        .long      FILL
        .long      SEMIS
#


#  *************
#  *   BLANK   *
#  *************
#
        .balign    4,0x90
N_BLANK:
        .long      5
        .ASCII      "BLANK"
        .balign    4,0x90
BLANK:
        .long    DOCOL
        .long    BLANK+HEADSIZE
        .long    0x0
        .long    LERASE
        .long    N_BLANK
        .long    0
        .long    0

        .long      LBL
        .long      FILL
        .long      SEMIS
#
#

#  ************
#  *   HOLD   *
#  ************
#
        .balign    4,0x90
N_HOLD:
        .long      4
        .ASCII      "HOLD"
        .balign    4,0x90
HOLD:
        .long    DOCOL
        .long    HOLD+HEADSIZE
        .long    0x0
        .long    BLANK
        .long    N_HOLD
        .long    0
        .long    0

        .long      LIT,-1
        .long      HLD
        .long      PSTORE
        .long      HLD
        .long      FETCH
        .long      CSTOR
        .long      SEMIS
#

#  ***********
#  *   PAD   *
#  ***********
#
        .balign    4,0x90
N_PAD:
        .long      3
        .ASCII      "PAD"
        .balign    4,0x90
PAD:
        .long    DOCOL
        .long    PAD+HEADSIZE
        .long    0x0
        .long    HOLD
        .long    N_PAD
        .long    0
        .long    0

        .long      HERE
# Allow for a one line name, a double binary number and some hold char's
        .long      LIT,84+128+64
        .long      PLUS
        .long      SEMIS
#


#  ************
#  *   WORD   *
#  ************
#
        .balign    4,0x90
N_IWORD:
        .long      4
        .ASCII      "WORD"
        .balign    4,0x90
IWORD:
        .long    DOCOL
        .long    IWORD+HEADSIZE
        .long    0x0
        .long    PAD
        .long    N_IWORD
        .long    0
        .long    0

        .long      LDUP, LBL, EQUAL
        .long      ZBRAN
        .long      IWORD1-.-CW
         .long      DROP
         .long      LPWORD
        .long      BRAN
        .long      IWORD2-.-CW
IWORD1: .long      TOR
IWORD3:  .long      INBRS, RR, EQUAL
        .long      ZBRAN
        .long      IWORD4-.-CW
        .long      DROP
        .long      BRAN
        .long      IWORD3-.-CW
IWORD4:
        .long      DROP
        .long      LIT, -1, LIN, PSTORE # Backtrace to first non-delimiter.
        .long      FROMR, PPARS
#        .long      DOTS
IWORD2:
        .long      HERE
        .long      LIT,0x22
        .long      BLANK
        .long      HERE
        .long      SSTORBD     # FIXME
        .long      HERE
#        .long      DOTS
        .long      SEMIS
#
#

#  ************
#  *   CHAR   *
#  ************
#
        .balign    4,0x90
N_LCHAR:
        .long      4
        .ASCII      "CHAR"
        .balign    4,0x90
LCHAR:
        .long    DOCOL
        .long    LCHAR+HEADSIZE
        .long    0x0
        .long    IWORD
        .long    N_LCHAR
        .long    0
        .long    0

        .long      LPWORD, DROP, CFET
        .long      SEMIS
#

#  **************
#  *   [CHAR]   *
#  **************
#
        .balign    4,0x90
N_BCHAR:
        .long      6
        .ASCII      "[CHAR]"
        .balign    4,0x90
BCHAR:
        .long    DOCOL
        .long    BCHAR+HEADSIZE
        .long    B_IMMED
        .long    LCHAR
        .long    N_BCHAR
        .long    0
        .long    0

        .long      LCHAR, LITER
        .long      SEMIS
#

#  ****************
#  *   (NUMBER)   *
#  ****************
#
        .balign    4,0x90
N_PNUMB:
        .long      8
        .ASCII      "(NUMBER)"
        .balign    4,0x90
PNUMB:
        .long    DOCOL
        .long    PNUMB+HEADSIZE
        .long    0x0
        .long    BCHAR
        .long    N_PNUMB
        .long    0
        .long    0

        .long      ZERO, ZERO
        .long      ZERO, DPL, STORE
NPNUM1:  .long      INBRS   # BEGIN
        .long      LDUP, LIT, ADOT, EQUAL
        .long      ZBRAN
        .long      NPNUM2A-.-CW # IF
        .long      DROP, DPL, STORE, ZERO
        .long      BRAN
        .long      NPNUM3-.-CW # ELSE
NPNUM2A:
        .long      LDUP, LIT, ',', EQUAL
        .long      ZBRAN
        .long      NPNUM2-.-CW # IF
        .long      TDROP, ZERO
        .long      BRAN
        .long      NPNUM3-.-CW # ELSE
NPNUM2:
        .long      LDUP, QBL
        .long      ZBRAN
        .long      NPNUM4-.-CW # IF
        .long      DROP, DROP, ONE
        .long      BRAN
        .long      NPNUM3-.-CW # ELSE
NPNUM4:
        .long      SWAP, DROP
        .long      BASE, FETCH, DIGIT
        .long      ZEQU
        .long      LIT, 10, QERR

        .long      SWAP
        .long      BASE
        .long      FETCH
        .long      USTAR
        .long      DROP
        .long      ROT
        .long      BASE
        .long      FETCH
        .long      USTAR
        .long      DPLUS
        .long      ZERO
NPNUM3:                 # THEN THEN
        .long      ZBRAN
        .long      NPNUM1-.-CW
        .long      SEMIS
#

#  **************
#  *   NUMBER   *
#  **************
#
        .balign    4,0x90
N_NUMB:
        .long      6
        .ASCII      "NUMBER"
        .balign    4,0x90
NUMB:
        .long    DOCOL
        .long    NUMB+HEADSIZE
        .long    0x0
        .long    PNUMB
        .long    N_NUMB
        .long    0
        .long    0

LNUMB:
        .long      LIT, -1, LIN, PSTORE
        .long      PNUMB, SDLITE
        .long      SEMIS
#


#  ***************
#  *   >NUMBER   *
#  ***************
#
        .balign    4,0x90
N_TONUMB:
        .long      7
        .ASCII      ">NUMBER"
        .balign    4,0x90
TONUMB:
        .long    DOCOL
        .long    TONUMB+HEADSIZE
        .long    0x0
        .long    NUMB
        .long    N_TONUMB
        .long    0
        .long    0

        .long      TDUP, PLUS, TOR     # End available on return stack.
        .long      ZERO
        .long     XQDO
        .long      TONUM9-.-CW
TONUM1:
        .long      LDUP, CFET, BASE, FETCH, DIGIT
        .long      ZEQU
        .long      ZBRAN
        .long      TONUM4-.-CW # IF
        .long      DROP
        .long      LLEAV
TONUM4:
        .long      SWAP, TOR # Address out of the way.
        .long      SWAP
        .long      BASE
        .long      FETCH
        .long      USTAR
        .long      DROP
        .long      ROT
        .long      BASE
        .long      FETCH
        .long      USTAR
        .long      DPLUS
        .long      FROMR, ONEP     # Address back.
        .long     XLOOP
        .long      TONUM1-.-CW
TONUM9:
        .long      FROMR
        .long      OVER, LSUB
        .long      SEMIS
#
#

#  *************
#  *   FOUND   *
#  *************
#
        .balign    4,0x90
N_FOUND:
        .long      5
        .ASCII      "FOUND"
        .balign    4,0x90
FOUND:
        .long    DOCOL
        .long    FOUND+HEADSIZE
        .long    0x0
        .long    TONUMB
        .long    N_FOUND
        .long    0
        .long    0

        .long      CONTEXT, TOR
FOUND1: .long      RR, FETCH
#        .long      DOTS
        .long      PFIND, LDUP, ZEQU
        .long      ZBRAN
        .long      FOUND3-.-CW
        .long      DROP
        .long      RR, FETCH, LIT, ONLYBODY, LSUB #Was this ONLY?
        .long      ZBRAN
        .long      FOUND2-.-CW
        .long      FROMR, CELLP, TOR
        .long      BRAN
        .long      FOUND1-.-CW
FOUND2: .long      ZERO
FOUND3: .long      RDROP
        .long      SWAP,DROP,SWAP,DROP
        .long      SEMIS
#

#  ***************
#  *   PRESENT   *
#  ***************
#
        .balign    4,0x90
N_PRESENT:
        .long      7
        .ASCII      "PRESENT"
        .balign    4,0x90
PRESENT:
        .long    DOCOL
        .long    PRESENT+HEADSIZE
        .long    0x0
        .long    FOUND
        .long    N_PRESENT
        .long    0
        .long    0

        .long      LDUP, TOR
        .long      FOUND
        .long      LDUP
        .long      ZBRAN
        .long      PRES1-.-CW
        .long      LDUP
        .long      TNFA, FETCH, FETCH #  Get precise length.
        .long      RR, EQUAL
        .long      LAND
PRES1:
        .long      RDROP
        .long      SEMIS
#


#  ************
#  *   FIND   *
#  ************
#
        .balign    4,0x90
N_FIND:
        .long      4
        .ASCII      "FIND"
        .balign    4,0x90
FIND:
        .long    DOCOL
        .long    FIND+HEADSIZE
        .long    0x0
        .long    PRESENT
        .long    N_FIND
        .long    0
        .long    0

        .long      LDUP, COUNT, PRESENT
        .long      LDUP
        .long      ZBRAN
        .long      FIND1-.-CW #IF
        .long      SWAP, DROP # The address.
        # Fine point, get xt by TCFA. Even if a NOOP.
        .long      LDUP, TCFA, SWAP
        .long      TFFA, FETCH
        .long      LIT, B_IMMED, LAND
        .long      LIT, -1, SWAP
        .long      ZBRAN
        .long      FIND1-.-CW #IF
        .long      NEGATE
FIND1:               #THEN THEN
        .long      SEMIS
#


#  ***********
#  *   OPT   *
#  ***********
#
        .balign    4,0x90
N_OPT:
        .long      3
        .ASCII      "OPT"
        .balign    4,0x90
OPT:
        .long    DOCOL
        .long    OPT+HEADSIZE
        .long    0x0
        .long    FIND
        .long    N_OPT
        .long    0
        .long    0

        .long      SEMIS

#

#  **************
#  *   (FIND)   *
#  **************
#
        .balign    4,0x90
N_PFIND:
        .long      6
        .ASCII      "(FIND)"
        .balign    4,0x90
PFIND:
        .long    DOCOL
        .long    PFIND+HEADSIZE
        .long    0x0
        .long    OPT
        .long    N_PFIND
        .long    0
        .long    0

# The idea is to have a fast slim loop.
# The optimisation tries to skip, using the extra links.
# At all labels the stack is (sc, dea).
# PFIND0 : nothing known yet about dea
# PFINDM1 : dea has no optimisation possibilities any more
# PFINDM2 : dea has a possible match: ~MATCH returns 0(=equal)
# PFIND1 : dea is a match, inasfar name and prefix
# PFIND2 : dea is the match, or null.

PFIND0:                       #Start of fast loop.
        .long      OPT                   # (Speed optimisation).
        .long      LDUP
        .long      ZBRAN
        .long      PFIND2-.-CW
        .long      NMATCH
        .long      ZBRAN
        .long      PFINDM2-.-CW
PFINDM1:
        .long      TLFA, FETCH
        .long      LDUP, ZEQU
        .long      ZBRAN
        .long      PFIND0-.-CW      #End of fast loop.

# Exit for end of chain (fall through)
        .long      BRAN
        .long      PFIND2-.-CW
# Exit for possible match
# ~MATCH is sure in determining a no-match,
# a possible match must be investigated closely.
PFINDM2:
#
# Discard, because name too short to match dea, can't be a denotation.
        .long      TDUP, TNFA, FETCH, FETCH
        .long      LESS, ZEQU
        .long      ZBRAN
        .long      PFINDM1-.-CW
#
# Equal: found, barring invisibility and dummy entries.
        .long      TDUP, TNFA, FETCH, FETCH
        .long      LSUB
        .long      ZBRAN
        .long      PFIND1-.-CW
#
# Discard, unless dea is a denotation ("prefix")
        .long      LDUP, TFFA, FETCH
        .long      LIT, B_DENOT, LAND
        .long      ZBRAN
        .long      PFINDM1-.-CW

# Discard still, if invisible ("smudged") or dummy.
PFIND1:
        .long      LDUP, TFFA, FETCH
        .long      LIT, B_INVIS | B_DUMMY, LAND
        .long      ZEQU
        .long      ZBRAN
        .long      PFINDM1-.-CW

PFIND2:
        .long      SEMIS
#

#  *************
#  *   ERROR   *
#  *************
#
        .balign    4,0x90
N_ERROR:
        .long      5
        .ASCII      "ERROR"
        .balign    4,0x90
ERROR:
        .long    DOCOL
        .long    ERROR+HEADSIZE
        .long    0x0
        .long    PFIND
        .long    N_ERROR
        .long    0
        .long    0

        .long      LWHERE, TFET
        .long      OVER, LIT, 20, LSUB
        .long      MAX
        .long      SWAP,OVER, LSUB
        .long      ETYPE
        .long      SKIP
         .long      18
SB3: .ASCII      "? ciforth ERROR # "
       .balign    4,0x90
        .long      LIT, SB3
        .long      LIT, 18
        .long      ETYPE
        .long      BASE, FETCH
        .long      DECA
        .long      OVER
        .long      STOD, ZERO, PDDOTR      #This is about (.) 
        .long      ETYPE
        .long      BASE, STORE
        .long      MESS
        .long      SEMIS
#

#  *************
#  *   CATCH   *
#  *************
#
        .balign    4,0x90
N_CATCH:
        .long      5
        .ASCII      "CATCH"
        .balign    4,0x90
CATCH:
        .long    DOCOL
        .long    CATCH+HEADSIZE
        .long    0x0
        .long    ERROR
        .long    N_CATCH
        .long    0
        .long    0

        .long      SPFET, CELLP, TOR
        .long      HANDLER, FETCH, TOR
        .long      RPFET, HANDLER, STORE
        .long      EXEC
        .long      FROMR, HANDLER, STORE
        .long      RDROP, ZERO
        .long      SEMIS
#

#  *************
#  *   THROW   *
#  *************
#
        .balign    4,0x90
N_THROW:
        .long      5
        .ASCII      "THROW"
        .balign    4,0x90
THROW:
        .long    DOCOL
        .long    THROW+HEADSIZE
        .long    0x0
        .long    CATCH
        .long    N_THROW
        .long    0
        .long    0

        .long      LDUP
        .long      ZBRAN
        .long      THROW1-.-CW
        .long      HANDLER, FETCH, ZEQU
        .long      ZBRAN
        .long      THROW2-.-CW
        .long      ERROR
        .long      MTBUF  # A (too) crude way to remove locks
        .long      SZERO, FETCH, SPSTO
        .long      QUIT
THROW2:
        .long      HANDLER, FETCH, RPSTO
        .long      FROMR, HANDLER, STORE
        .long      FROMR, SWAP, TOR
        .long      SPSTO
        .long      FROMR
        .long      X
THROW1:
        .long      DROP
        .long      SEMIS
#


#  ****************
#  *   (ABORT")   *
#  ****************
#
        .balign    4,0x90
N_PABORTQ:
        .long      8
        .ASCII      "(ABORT\")"
        .balign    4,0x90
PABORTQ:
        .long    DOCOL
        .long    PABORTQ+HEADSIZE
        .long    0x0
        .long    THROW
        .long    N_PABORTQ
        .long    0
        .long    0

        .long      ROT
        .long      ZBRAN
        .long      PABQ1-.-CW #IF
        .long      ETYPE
        .long      SIGNON, ABORT
        .long      BRAN
        .long      PABQ2-.-CW #ELSE
PABQ1:  .long       TDROP
PABQ2:   .long      SEMIS
#

#  **************
#  *   ABORT"   *
#  **************
#
        .balign    4,0x90
N_ABORTQ:
        .long      6
        .ASCII      "ABORT\""
        .balign    4,0x90
ABORTQ:
        .long    DOCOL
        .long    ABORTQ+HEADSIZE
        .long    B_IMMED
        .long    PABORTQ
        .long    N_ABORTQ
        .long    0
        .long    0

        .long      QCOMP
        .long      DENQ
        .long      LIT, PABORTQ, COMMA
        .long      SEMIS
#
#

#  ***********
#  *   ID.   *
#  ***********
#
        .balign    4,0x90
N_IDDOT:
        .long      3
        .ASCII      "ID."
        .balign    4,0x90
IDDOT:
        .long    DOCOL
        .long    IDDOT+HEADSIZE
        .long    0x0
        .long    ABORTQ
        .long    N_IDDOT
        .long    0
        .long    0

        .long      LDUP, TFFA
        .long      FETCH, LIT, B_DUMMY, LXOR
        .long      ZBRAN
        .long      IDDOT1-.-CW
        .long      TNFA
        .long      FETCH
        .long      SFET
        .long      LTYPE
        .long      SPACE
        .long      SPACE
        .long      SPACE
        .long      BRAN
        .long      IDDOT2-.-CW
IDDOT1:
        .long      DROP
IDDOT2:
        .long      SEMIS
#

#  ****************
#  *   (CREATE)   *
#  ****************
#
        .balign    4,0x90
N_PCREAT:
        .long      8
        .ASCII      "(CREATE)"
        .balign    4,0x90
PCREAT:
        .long    DOCOL
        .long    PCREAT+HEADSIZE
        .long    0x0
        .long    IDDOT
        .long    N_PCREAT
        .long    0
        .long    0

        .long      LDUP
        .long      ZEQU
        .long      LIT, 5, QERR
        .long      TDUP
        .long      PRESENT
        .long      LDUP
        .long      ZBRAN
        .long      CREA1-.-CW #IF
        .long      TNFA, FETCH, SFET
        .long      ETYPE
        .long      LIT,4
        .long      MESS
        .long      X       #THEN
CREA1:  .long      DROP
 .long      LALIGN
        .long      SCOMMA
 .long      LALIGN
        .long      HERE,TOR

        .long      RR, TPHA, COMMA         # Code field.

        .long      RR, TPHA, COMMA         # Data field.

        .long      ZERO, COMMA # Flag field.

        .long      CURR, FETCH, TLFA
        .long      LDUP, FETCH
        .long      COMMA   # Link field.
        .long      RR, SWAP, STORE

        .long      COMMA   # Name field.


        .long      BLK, FETCH, LDUP, ZEQU
        .long      ZBRAN
        .long      CREA2-.-CW
        .long      DROP, LIN, FETCH
CREA2:  .long      COMMA  # Source field.

        .long      ZERO, COMMA
        .long      RDROP
        .long      SEMIS
#

#  *****************
#  *   [COMPILE]   *
#  *****************
#
        .balign    4,0x90
N_BCOMP:
        .long      9
        .ASCII      "[COMPILE]"
        .balign    4,0x90
BCOMP:
        .long    DOCOL
        .long    BCOMP+HEADSIZE
        .long    B_IMMED
        .long    PCREAT
        .long    N_BCOMP
        .long    0
        .long    0

        .long      LPWORD
        .long      PRESENT
        .long      LDUP
        .long      ZEQU
        .long      LIT, 16, QERR
        .long      TCFA
        .long      COMMA
        .long      SEMIS
#

#  ****************
#  *   POSTPONE   *
#  ****************
#
        .balign    4,0x90
N_POSTP:
        .long      8
        .ASCII      "POSTPONE"
        .balign    4,0x90
POSTP:
        .long    DOCOL
        .long    POSTP+HEADSIZE
        .long    B_IMMED
        .long    BCOMP
        .long    N_POSTP
        .long    0
        .long    0

        .long      LPWORD
        .long      PRESENT
        .long      LDUP
        .long      ZEQU
        .long      LIT, 15, QERR
        .long      LDUP, TFFA, FETCH
        .long      LIT, B_IMMED, LAND, ZEQU
        .long      ZBRAN
        .long      POSTP1-.-CW
         .long      LIT, LIT, COMMA
         .long      COMMA
         .long      LIT, COMMA, COMMA
        .long      BRAN
        .long      POSTP2-.-CW
POSTP1:
         .long      COMMA
POSTP2:
        .long      SEMIS
#

#  ***************
#  *   LITERAL   *
#  ***************
#
        .balign    4,0x90
N_LITER:
        .long      7
        .ASCII      "LITERAL"
        .balign    4,0x90
LITER:
        .long    DOCOL
        .long    LITER+HEADSIZE
        .long    B_IMMED
        .long    POSTP
        .long    N_LITER
        .long    0
        .long    0

        .long      STATE
        .long      FETCH
        .long      ZBRAN
        .long      LITE1-.-CW #IF
        .long      LIT, LIT, COMMA
        .long      COMMA   #THEN
LITE1:  .long      SEMIS
#

#  ****************
#  *   DLITERAL   *
#  ****************
#
        .balign    4,0x90
N_DLITE:
        .long      8
        .ASCII      "DLITERAL"
        .balign    4,0x90
DLITE:
        .long    DOCOL
        .long    DLITE+HEADSIZE
        .long    B_IMMED
        .long    LITER
        .long    N_DLITE
        .long    0
        .long    0

        .long      STATE
        .long      FETCH
        .long      ZBRAN
        .long      DLIT1-.-CW # IF
        .long      SWAP
        .long      LITER
        .long      LITER   # THEN
DLIT1:  .long      SEMIS
#
#

#  *****************
#  *   SDLITERAL   *
#  *****************
#
        .balign    4,0x90
N_SDLITE:
        .long      9
        .ASCII      "SDLITERAL"
        .balign    4,0x90
SDLITE:
        .long    DOCOL
        .long    SDLITE+HEADSIZE
        .long    B_IMMED
        .long    DLITE
        .long    N_SDLITE
        .long    0
        .long    0

        .long      DPL
        .long      FETCH
        .long      ZBRAN
        .long      SDLIT1-.-CW # IF
        .long      DLITE
        .long      BRAN
        .long      SDLIT2-.-CW # IF
SDLIT1:
        .long      DROP, LITER
SDLIT2:
        .long      SEMIS
#


#  **************
#  *   ?STACK   *
#  **************
#
        .balign    4,0x90
N_QSTAC:
        .long      6
        .ASCII      "?STACK"
        .balign    4,0x90
QSTAC:
        .long    DOCOL
        .long    QSTAC+HEADSIZE
        .long    0x0
        .long    SDLITE
        .long    N_QSTAC
        .long    0
        .long    0

        .long      SPFET
        .long      SZERO
        .long      FETCH
        .long      SWAP
        .long      ULESS
        .long      ONE, QERR
        .long      SPFET
        .long      HERE
        .long      LIT,0x80
        .long      PLUS
        .long      ULESS
        .long      LIT, 7, QERR
        .long      SEMIS
        #
#
#

#  *****************
#  *   INTERPRET   *
#  *****************
#
        .balign    4,0x90
N_INTER:
        .long      9
        .ASCII      "INTERPRET"
        .balign    4,0x90
INTER:
        .long    DOCOL
        .long    INTER+HEADSIZE
        .long    0x0
        .long    QSTAC
        .long    N_INTER
        .long    0
        .long    0

INTE1:
        .long      LPWORD
        .long      LDUP      # Zero length.
        .long      ZBRAN
        .long      INTE8-.-CW #WHILE
#       .long      DOTS
#       .long      TDUP, LTYPE
        .long      OVER, TOR       # Save old parse pointer.
        .long      FOUND
        .long      LDUP, ZEQU
        .long      LIT, 12, QERR
        .long      LDUP, TFFA, FETCH
        .long      LDUP, LIT, B_DENOT, LAND #Retain copy of flags.
        .long      ZBRAN
        .long      INTE3B-.-CW #IF
        .long      OVER, TNFA, FETCH, FETCH
        .long      RR, PLUS, LIN, STORE  #Skip over prefix.
INTE3B:                  #THEN 
        .long      RDROP           # Drop old parse pointer.
        .long      LIT, B_IMMED, LAND
        .long      STATE, FETCH, ZEQU, LOR
        .long      ZBRAN
        .long      INTE3-.-CW #IF
        .long      EXEC
        .long      BRAN
        .long      INTE4-.-CW #IF
INTE3:
        .long      COMMA
                        #THEN
INTE4:
        .long      QSTAC
        .long      BRAN
        .long      INTE1-.-CW  #AGAIN
INTE8:  .long      DROP, DROP
        .long      SEMIS
#

#  *****************
#  *   IMMEDIATE   *
#  *****************
#
        .balign    4,0x90
N_IMMED:
        .long      9
        .ASCII      "IMMEDIATE"
        .balign    4,0x90
IMMED:
        .long    DOCOL
        .long    IMMED+HEADSIZE
        .long    0x0
        .long    INTER
        .long    N_IMMED
        .long    0
        .long    0

        .long      LATEST
        .long      TFFA
        .long      LIT, B_IMMED
        .long      TOGGL
        .long      SEMIS
#

#  **************
#  *   PREFIX   *
#  **************
#
        .balign    4,0x90
N_PREFX:
        .long      6
        .ASCII      "PREFIX"
        .balign    4,0x90
PREFX:
        .long    DOCOL
        .long    PREFX+HEADSIZE
        .long    0x0
        .long    IMMED
        .long    N_PREFX
        .long    0
        .long    0

        .long      LATEST
        .long      TFFA
        .long      LIT, B_DENOT
        .long      TOGGL
        .long      SEMIS
#

#  ******************
#  *   VOCABULARY   *
#  ******************
#
        .balign    4,0x90
N_VOCAB:
        .long      10
        .ASCII      "VOCABULARY"
        .balign    4,0x90
VOCAB:
        .long    DOCOL
        .long    VOCAB+HEADSIZE
        .long    0x0
        .long    PREFX
        .long    N_VOCAB
        .long    0
        .long    0

        .long      CREATE
        .long      LATEST   # Link this DEA into VOC-LINK chain.
        .long      VOCL
        .long      FETCH
        .long      COMMA
        .long      VOCL
        .long      STORE
        .long      ZERO, COMMA   # Dummy code field
        .long      ZERO, COMMA   # Dummy data field
        .long      LIT, B_DUMMY, COMMA # Dummy flag field
        .long      ZERO, COMMA #Link field: empty chain
        .long      LIT, (ZERO+(CW*(D_HOFFSET))), COMMA #Empty string for name.
        .long      ZERO, COMMA
        .long      ZERO, COMMA
        .long      DOES
DOVOC:
        .long      ALSO
        .long      CELLP   # Make it a WID. 
        .long      CONTEXT
        .long      STORE
        .long      SEMIS
        #
#
#   The link to task is a cold start value only.
#   It is updated each time a definition is
#   appended to the 'FORTH' vocabulary.
#

#

#  *******************
#  *   DEFINITIONS   *
#  *******************
#
        .balign    4,0x90
N_DEFIN:
        .long      11
        .ASCII      "DEFINITIONS"
        .balign    4,0x90
DEFIN:
        .long    DOCOL
        .long    DEFIN+HEADSIZE
        .long    0x0
        .long    VOCAB
        .long    N_DEFIN
        .long    0
        .long    0

        .long      CONTEXT
        .long      FETCH
        .long      CURR
        .long      STORE
        .long      SEMIS
#

#  ************
#  *   ALSO   *
#  ************
#
        .balign    4,0x90
N_ALSO:
        .long      4
        .ASCII      "ALSO"
        .balign    4,0x90
ALSO:
        .long    DOCOL
        .long    ALSO+HEADSIZE
        .long    0x0
        .long    DEFIN
        .long    N_ALSO
        .long    0
        .long    0

        .long      CONTEXT, LDUP, CELLP
        .long      LIT, (CW*(16-1))
        .long      LMOVE
        .long      LIT, ONLYBODY  #End sentinel for array of word lists.
        .long      CONTEXT, LIT, (CW*(16)), PLUS
        .long      STORE #Trim sets of wordset.
        .long      SEMIS
#

#  ****************
#  *   PREVIOUS   *
#  ****************
#
        .balign    4,0x90
N_PREVI:
        .long      8
        .ASCII      "PREVIOUS"
        .balign    4,0x90
PREVI:
        .long    DOCOL
        .long    PREVI+HEADSIZE
        .long    0x0
        .long    ALSO
        .long    N_PREVI
        .long    0
        .long    0

        .long      CONTEXT, LDUP, CELLP, SWAP
        .long      LIT, (CW*(16))
        .long      LMOVE
        .long      SEMIS
#

#  *********
#  *   (   *
#  *********
#
        .balign    4,0x90
N_PAREN:
        .long      1
        .ASCII      "("
        .balign    4,0x90
PAREN:
        .long    DOCOL
        .long    PAREN+HEADSIZE
        .long    B_IMMED
        .long    PREVI
        .long    N_PAREN
        .long    0
        .long    0

        .long      LIT,')'
        .long      PPARS
        .long      TDROP
        .long      SEMIS
#
#

#  *********
#  *   \   *
#  *********
#
        .balign    4,0x90
N_BACKS:
        .long      1
        .ASCII      "\\"
        .balign    4,0x90
BACKS:
        .long    DOCOL
        .long    BACKS+HEADSIZE
        .long    B_IMMED
        .long    PAREN
        .long    N_BACKS
        .long    0
        .long    0

# Backup one character, just in case we are at the end of a line.
        .long      LIT, -1, LIN, PSTORE
        .long      LIT,ALF
        .long      PPARS
        .long      TDROP
        .long      SEMIS
#

#  ************
#  *   QUIT   *
#  ************
#
        .balign    4,0x90
N_QUIT:
        .long      4
        .ASCII      "QUIT"
        .balign    4,0x90
QUIT:
        .long    DOCOL
        .long    QUIT+HEADSIZE
        .long    0x0
        .long    BACKS
        .long    N_QUIT
        .long    0
        .long    0

        .long      LBRAC
QUIT1:                  #BEGIN
        .long      RZERO
        .long      FETCH
        .long      RPSTO
        .long      LIT
        .long      PACCEP
        .long      CATCH
        .long      LDUP, LIT, -EPIPE, EQUAL
        .long      ZBRAN
        .long      ENDIF7-.-CW
        .long      BYE     #End of input, no error!
ENDIF7:
        .long      QERRUR
        .long      SETSRC
        .long      INTER
        .long      OK
        .long      BRAN
        .long      QUIT1-.-CW  #AGAIN
        .long      SEMIS   #Unnecessary, but helpful for decompilation.
#

#  **********
#  *   OK   *
#  **********
#
        .balign    4,0x90
N_OK:
        .long      2
        .ASCII      "OK"
        .balign    4,0x90
OK:
        .long    DOCOL
        .long    OK+HEADSIZE
        .long    0x0
        .long    QUIT
        .long    N_OK
        .long    0
        .long    0

        .long      STATE
        .long      FETCH
        .long      ZEQU
        .long      ZBRAN
        .long      OK2-.-CW #IF
        .long      SKIP
         .long      3
SB4: .ASCII      " OK"
       .balign    4,0x90
        .long      LIT, SB4
        .long      LIT, 3
        .long      LTYPE
        .long      CR
OK2:
        .long      SEMIS
#

#  *************
#  *   ABORT   *
#  *************
#
        .balign    4,0x90
N_ABORT:
        .long      5
        .ASCII      "ABORT"
        .balign    4,0x90
ABORT:
        .long    DOCOL
        .long    ABORT+HEADSIZE
        .long    0x0
        .long    OK
        .long    N_ABORT
        .long    0
        .long    0

        .long      SZERO, FETCH, SPSTO
        .long      ZERO, HANDLER, STORE
        .long      DECA
        .long      ONLY
        .long      FORTH
        .long      DEFIN
        .long      QUIT
        .long      SEMIS   #Unnecessary, but helpful for decompilation.
#
#      WARM START VECTOR COMES HERE
#      For booting code we enter here, real mode and using the switchsegment.
#      BY control BREAK.
WARM_ENTRY:
# 
        
        MOV     %ESI,OFFSET WRM1
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]                      #Hope stacks are still okay.
#
WRM1:   .long      WARM
#

#  ************
#  *   WARM   *
#  ************
#
        .balign    4,0x90
N_WARM:
        .long      4
        .ASCII      "WARM"
        .balign    4,0x90
WARM:
        .long    DOCOL
        .long    WARM+HEADSIZE
        .long    0x0
        .long    ABORT
        .long    N_WARM
        .long    0
        .long    0

        .long      MTBUF
        .long      SIGNON
        .long      ABORT
        .long      SEMIS   #Unnecessary, but helpful for decompilation.
#


#  ***************
#  *   OPTIONS   *
#  ***************
#
        .balign    4,0x90
N_OPTIONS:
        .long      7
        .ASCII      "OPTIONS"
        .balign    4,0x90
OPTIONS:
        .long    DOCOL
        .long    OPTIONS+HEADSIZE
        .long    0x0
        .long    WARM
        .long    N_OPTIONS
        .long    0
        .long    0

#       Execute option.
        .long      ARGS, FETCH, CELLP, CELLP, FETCH, LDUP
        .long      ZBRAN
        .long      OPT4-.-CW # No options  

        .long      FETCH
        .long      LDUP
        .long      LIT,  0x0FF , LAND
        .long      LIT, '-', UNEQ
        .long      ZBRAN
        .long      OPT3-.-CW
        .long      LIT, 3, LDUP, ERROR
        .long      XCODE, STORE, BYE
OPT3:
        .long      LIT, 8, RSHIFT
        .long      LIT, 0x1F, LAND
        .long      LOAD
        .long      ZERO, SWAP # Sign on suppressed.
OPT4:
        .long      DROP
        .long      SEMIS   #Unnecessary, but helpful for decompilation.
#


#  ************
#  *   COLD   *
#  ************
#
        .balign    4,0x90
N_COLD:
        .long      4
        .ASCII      "COLD"
        .balign    4,0x90
COLD:
        .long    DOCOL
        .long    COLD+HEADSIZE
        .long    0x0
        .long    OPTIONS
        .long    N_COLD
        .long    0
        .long    0

        .long      ZERO, HANDLER, STORE
        .long      MTBUF
        .long      FIRST
        .long      STALEST,STORE
        .long      FIRST
        .long      PREV,STORE
# Fill user area for single task.
        .long      LIT, USINI
        .long      LIT, USINI+(CW*(1)), FETCH
        .long      LIT, US
        .long      LCMOVE

        .long      LIT, 0, BLINI  #Default, don't write in the library file!
#
        .long      DECA    # FIXME has to go done by ABORT anyway.
        .long      ONLY    # FIXME has to go done by ABORT anyway.
        .long      FORTH   # FIXME has to go done by ABORT anyway.
        .long      DEFIN   # FIXME has to go done by ABORT anyway.
        .long      ONE            # Sign on wanted.

        .long      ZERO, LIT, TCGETS, TERMIO
        .long      LIT, ioctl, LINOS, ZLESS
        .long      ZBRAN
        .long      COLD1-.-CW
        # Not a terminal. Cannot set the terminal, get rid of "OK".
        .long      DROP, ZERO      # Sign on suppressed.
        .long      LIT,NOOP  # Suppress OK for pipes.
        .long      LIT,OK
        .long      LIT, (CW*(3)), LCMOVE
COLD1:
 # 
        .long      OPTIONS
        .long      ZBRAN
        .long      COLD5-.-CW
        .long      SIGNON    # Suppressed for scripting! Or any options.
COLD5:
        .long      ABORT
        .long      BYE     # In case of turnkey programs.
        .long      SEMIS   # Unnecessary, but helpful for decompilation.
#

#  ***********
#  *   S>D   *
#  ***********
#
        .balign    4,0x90
N_STOD:
        .long      3
        .ASCII      "S>D"
        .balign    4,0x90
STOD:
        .long    STOD+HEADSIZE
        .long    STOD+HEADSIZE
        .long    0x0
        .long    COLD
        .long    N_STOD
        .long    0
        .long    0

        POP     %EDX      #S1
        SUB     %EAX,%EAX
        OR      %EDX,%EDX
        JNS     STOD1   #POS
        DEC     %EAX      #NEG
STOD1:
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   ABS   *
#  ***********
#
        .balign    4,0x90
N_LABS:
        .long      3
        .ASCII      "ABS"
        .balign    4,0x90
LABS:
        .long    DOCOL
        .long    LABS+HEADSIZE
        .long    0x0
        .long    STOD
        .long    N_LABS
        .long    0
        .long    0

        .long      LDUP
        .long      ZLESS
        .long      ZBRAN
        .long      PM1-.-CW   #IF
        .long      NEGATE   #THEN
PM1:
        .long      SEMIS
#

#  ************
#  *   DABS   *
#  ************
#
        .balign    4,0x90
N_DABS:
        .long      4
        .ASCII      "DABS"
        .balign    4,0x90
DABS:
        .long    DOCOL
        .long    DABS+HEADSIZE
        .long    0x0
        .long    LABS
        .long    N_DABS
        .long    0
        .long    0

        .long      LDUP
        .long      ZLESS
        .long      ZBRAN
        .long      DPM1-.-CW  #IF
        .long      DNEGA   #THEN
DPM1:
        .long      SEMIS
#

#  ***********
#  *   MIN   *
#  ***********
#
        .balign    4,0x90
N_MIN:
        .long      3
        .ASCII      "MIN"
        .balign    4,0x90
MIN:
        .long    DOCOL
        .long    MIN+HEADSIZE
        .long    0x0
        .long    DABS
        .long    N_MIN
        .long    0
        .long    0

        .long      TDUP
        .long      GREAT
        .long      ZBRAN
        .long      MIN1-.-CW  #IF
        .long      SWAP    #THEN
MIN1:   .long      DROP
        .long      SEMIS
#

#  ***********
#  *   MAX   *
#  ***********
#
        .balign    4,0x90
N_MAX:
        .long      3
        .ASCII      "MAX"
        .balign    4,0x90
MAX:
        .long    DOCOL
        .long    MAX+HEADSIZE
        .long    0x0
        .long    MIN
        .long    N_MAX
        .long    0
        .long    0

        .long      TDUP
        .long      LESS
        .long      ZBRAN
        .long      MAX1-.-CW  #IF
        .long      SWAP    #THEN
MAX1:   .long      DROP
        .long      SEMIS
#

#  **************
#  *   LSHIFT   *
#  **************
#
        .balign    4,0x90
N_LSHIFT:
        .long      6
        .ASCII      "LSHIFT"
        .balign    4,0x90
LSHIFT:
        .long    LSHIFT+HEADSIZE
        .long    LSHIFT+HEADSIZE
        .long    0x0
        .long    MAX
        .long    N_LSHIFT
        .long    0
        .long    0

        POP     %ECX
        POP     %EAX
        SHL     %EAX,%CL
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **************
#  *   RSHIFT   *
#  **************
#
        .balign    4,0x90
N_RSHIFT:
        .long      6
        .ASCII      "RSHIFT"
        .balign    4,0x90
RSHIFT:
        .long    RSHIFT+HEADSIZE
        .long    RSHIFT+HEADSIZE
        .long    0x0
        .long    LSHIFT
        .long    N_RSHIFT
        .long    0
        .long    0

        POP     %ECX
        POP     %EAX
        SHR     %EAX,%CL
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   M*   *
#  **********
#
        .balign    4,0x90
N_MSTAR:
        .long      2
        .ASCII      "M*"
        .balign    4,0x90
MSTAR:
        .long    MSTAR+HEADSIZE
        .long    MSTAR+HEADSIZE
        .long    0x0
        .long    RSHIFT
        .long    N_MSTAR
        .long    0
        .long    0

        POP     %EAX
        POP     %EBX
        IMUL     %EBX      #SIGNED
        XCHG    %EAX,%EDX   #AX NOW = MSW
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             #STORE DOUBLE CELL
#

#  **************
#  *   SM/REM   *
#  **************
#
        .balign    4,0x90
N_MSLAS:
        .long      6
        .ASCII      "SM/REM"
        .balign    4,0x90
MSLAS:
        .long    MSLAS+HEADSIZE
        .long    MSLAS+HEADSIZE
        .long    0x0
        .long    MSTAR
        .long    N_MSLAS
        .long    0
        .long    0

        POP     %EBX      #DIVISOR
        POP     %EDX      #MSW OF DIVIDEND
        POP     %EAX      #LSW OF DIVIDEND
        IDIV     %EBX      #16 BIT DIVIDE
        PUSH    %EDX
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]             #STORE QUOT/REM
#


#  **********
#  *   2/   *
#  **********
#
        .balign    4,0x90
N_TWOSL:
        .long      2
        .ASCII      "2/"
        .balign    4,0x90
TWOSL:
        .long    DOCOL
        .long    TWOSL+HEADSIZE
        .long    0x0
        .long    MSLAS
        .long    N_TWOSL
        .long    0
        .long    0

        .long      STOD, TWO, FMSLAS
        .long      SWAP, DROP
        .long      SEMIS
#

#  **********
#  *   2*   *
#  **********
#
        .balign    4,0x90
N_TWOST:
        .long      2
        .ASCII      "2*"
        .balign    4,0x90
TWOST:
        .long    DOCOL
        .long    TWOST+HEADSIZE
        .long    0x0
        .long    TWOSL
        .long    N_TWOST
        .long    0
        .long    0

        .long      TWO, STAR
        .long      SEMIS
#

#  **********
#  *   1-   *
#  **********
#
        .balign    4,0x90
N_ONEM:
        .long      2
        .ASCII      "1-"
        .balign    4,0x90
ONEM:
        .long    DOCOL
        .long    ONEM+HEADSIZE
        .long    0x0
        .long    TWOST
        .long    N_ONEM
        .long    0
        .long    0

        .long      ONE, LSUB
        .long      SEMIS
#
#

#  **************
#  *   FM/MOD   *
#  **************
#
        .balign    4,0x90
N_FMSLAS:
        .long      6
        .ASCII      "FM/MOD"
        .balign    4,0x90
FMSLAS:
        .long    DOCOL
        .long    FMSLAS+HEADSIZE
        .long    0x0
        .long    ONEM
        .long    N_FMSLAS
        .long    0
        .long    0

        .long      LDUP, TOR
        .long      TDUP, LXOR, TOR
        .long      MSLAS
        .long      FROMR, ZLESS
        .long      ZBRAN
        .long      FMMOD1-.-CW
        .long      OVER
        .long      ZBRAN
        .long      FMMOD1-.-CW
        .long      ONE, LSUB
        .long      SWAP, FROMR, PLUS, SWAP
        .long      BRAN
        .long      FMMOD2-.-CW
FMMOD1:
        .long      RDROP
FMMOD2:
        .long      SEMIS
#

#  *********
#  *   *   *
#  *********
#
        .balign    4,0x90
N_STAR:
        .long      1
        .ASCII      "*"
        .balign    4,0x90
STAR:
        .long    DOCOL
        .long    STAR+HEADSIZE
        .long    0x0
        .long    FMSLAS
        .long    N_STAR
        .long    0
        .long    0

        .long      MSTAR
        .long      DROP
        .long      SEMIS
#

#  ************
#  *   /MOD   *
#  ************
#
        .balign    4,0x90
N_SLMOD:
        .long      4
        .ASCII      "/MOD"
        .balign    4,0x90
SLMOD:
        .long    DOCOL
        .long    SLMOD+HEADSIZE
        .long    0x0
        .long    STAR
        .long    N_SLMOD
        .long    0
        .long    0

        .long      TOR
        .long      STOD
        .long      FROMR
        .long      MSLAS
        .long      SEMIS
#

#  *********
#  *   /   *
#  *********
#
        .balign    4,0x90
N_SLASH:
        .long      1
        .ASCII      "/"
        .balign    4,0x90
SLASH:
        .long    DOCOL
        .long    SLASH+HEADSIZE
        .long    0x0
        .long    SLMOD
        .long    N_SLASH
        .long    0
        .long    0

        .long      SLMOD
        .long      SWAP
        .long      DROP
        .long      SEMIS
#

#  ***********
#  *   MOD   *
#  ***********
#
        .balign    4,0x90
N_LMOD:
        .long      3
        .ASCII      "MOD"
        .balign    4,0x90
LMOD:
        .long    DOCOL
        .long    LMOD+HEADSIZE
        .long    0x0
        .long    SLASH
        .long    N_LMOD
        .long    0
        .long    0

        .long      SLMOD
        .long      DROP
        .long      SEMIS
#

#  *************
#  *   */MOD   *
#  *************
#
        .balign    4,0x90
N_SSMOD:
        .long      5
        .ASCII      "*/MOD"
        .balign    4,0x90
SSMOD:
        .long    DOCOL
        .long    SSMOD+HEADSIZE
        .long    0x0
        .long    LMOD
        .long    N_SSMOD
        .long    0
        .long    0

        .long      TOR
        .long      MSTAR
        .long      FROMR
        .long      MSLAS
        .long      SEMIS
#

#  **********
#  *   */   *
#  **********
#
        .balign    4,0x90
N_SSLA:
        .long      2
        .ASCII      "*/"
        .balign    4,0x90
SSLA:
        .long    DOCOL
        .long    SSLA+HEADSIZE
        .long    0x0
        .long    SSMOD
        .long    N_SSLA
        .long    0
        .long    0

        .long      SSMOD
        .long      SWAP
        .long      DROP
        .long      SEMIS
#

#  *************
#  *   M/MOD   *
#  *************
#
        .balign    4,0x90
N_MSMOD:
        .long      5
        .ASCII      "M/MOD"
        .balign    4,0x90
MSMOD:
        .long    DOCOL
        .long    MSMOD+HEADSIZE
        .long    0x0
        .long    SSLA
        .long    N_MSMOD
        .long    0
        .long    0

        .long      TOR
        .long      ZERO
        .long      RR
        .long      USLAS
        .long      FROMR
        .long      SWAP
        .long      TOR
        .long      USLAS
        .long      FROMR
        .long      SEMIS
#

#  **************
#  *   (LINE)   *
#  **************
#
        .balign    4,0x90
N_PLINE:
        .long      6
        .ASCII      "(LINE)"
        .balign    4,0x90
PLINE:
        .long    DOCOL
        .long    PLINE+HEADSIZE
        .long    0x0
        .long    MSMOD
        .long    N_PLINE
        .long    0
        .long    0

        .long      TOR
        .long      LIT,64
        .long      MSTAR
        .long      BBUF
        .long      FMSLAS
        .long      FROMR # This blocks, so is screens.
        .long      PLUS
        .long      BLOCK
        .long      PLUS
        .long      LIT,63
        .long      SEMIS
#

#  **************
#  *   ERRSCR   *
#  **************
#
        .balign    4,0x90
N_ERRSCR:
        .long      6
        .ASCII      "ERRSCR"
        .balign    4,0x90
ERRSCR:
        .long    DOVAR
        .long    ERRSCR+HEADSIZE
        .long    0x0
        .long    PLINE
        .long    N_ERRSCR
        .long    0
        .long    0

        .long ERRORSCREEN
#

#  ***************
#  *   MESSAGE   *
#  ***************
#
        .balign    4,0x90
N_MESS:
        .long      7
        .ASCII      "MESSAGE"
        .balign    4,0x90
MESS:
        .long    DOCOL
        .long    MESS+HEADSIZE
        .long    0x0
        .long    ERRSCR
        .long    N_MESS
        .long    0
        .long    0

        .long      LWARN
        .long      FETCH
        .long      ZBRAN
        .long      MESS1-.-CW #IF
        .long      ERRSCR, FETCH
        .long      PLINE, ONEP     # Also print the '\n' !
        .long      ETYPE
        .long      X
MESS1:                  #THEN
        .long      DROP
        .long      SEMIS
#

#  ***********
#  *   PC@   *
#  ***********
#
        .balign    4,0x90
N_PCFET:
        .long      3
        .ASCII      "PC@"
        .balign    4,0x90
PCFET:
        .long    PCFET+HEADSIZE
        .long    PCFET+HEADSIZE
        .long    0x0
        .long    MESS
        .long    N_PCFET
        .long    0
        .long    0

# FETCH CHARACTER (BYTE) FROM PORT
        POP     %EDX      # PORT ADDR
        XOR     %EAX,%EAX
        IN      %AL,%DX  # BYTE INPUT
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***********
#  *   PC!   *
#  ***********
#
        .balign    4,0x90
N_PCSTO:
        .long      3
        .ASCII      "PC!"
        .balign    4,0x90
PCSTO:
        .long    PCSTO+HEADSIZE
        .long    PCSTO+HEADSIZE
        .long    0x0
        .long    PCFET
        .long    N_PCSTO
        .long    0
        .long    0

        POP     %EDX      #PORT ADDR
        POP     %EAX      #DATA
        OUT     %DX,%AL   # BYTE OUTPUT
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   P@   *
#  **********
#
        .balign    4,0x90
N_PFET:
        .long      2
        .ASCII      "P@"
        .balign    4,0x90
PFET:
        .long    PFET+HEADSIZE
        .long    PFET+HEADSIZE
        .long    0x0
        .long    PCSTO
        .long    N_PFET
        .long    0
        .long    0

        POP     %EDX      #PORT ADDR
        IN      %EAX,%DX  #WORD INPUT
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  **********
#  *   P!   *
#  **********
#
        .balign    4,0x90
N_PSTO:
        .long      2
        .ASCII      "P!"
        .balign    4,0x90
PSTO:
        .long    PSTO+HEADSIZE
        .long    PSTO+HEADSIZE
        .long    0x0
        .long    PFET
        .long    N_PSTO
        .long    0
        .long    0

        POP     %EDX      #PORT ADDR
        POP     %EAX      #DATA
        OUT     %DX,%EAX   #WORD OUTPUT
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]   
#

#  ***************
#  *   STALEST   *
#  ***************
#
        .balign    4,0x90
N_STALEST:
        .long      7
        .ASCII      "STALEST"
        .balign    4,0x90
STALEST:
        .long    DOVAR
        .long    STALEST+HEADSIZE
        .long    0x0
        .long    PSTO
        .long    N_STALEST
        .long    0
        .long    0

        .long BUF1
#

#  ************
#  *   PREV   *
#  ************
#
        .balign    4,0x90
N_PREV:
        .long      4
        .ASCII      "PREV"
        .balign    4,0x90
PREV:
        .long    DOVAR
        .long    PREV+HEADSIZE
        .long    0x0
        .long    STALEST
        .long    N_PREV
        .long    0
        .long    0

        .long      BUF1
#

#  *************
#  *   #BUFF   *
#  *************
#
        .balign    4,0x90
N_NOBUF:
        .long      5
        .ASCII      "#BUFF"
        .balign    4,0x90
NOBUF:
        .long    DOCON
        .long    NBUF
        .long    0x0
        .long    PREV
        .long    N_NOBUF
        .long    0
        .long    0

#

#  ************
#  *   +BUF   *
#  ************
#
        .balign    4,0x90
N_PBUF:
        .long      4
        .ASCII      "+BUF"
        .balign    4,0x90
PBUF:
        .long    DOCOL
        .long    PBUF+HEADSIZE
        .long    0x0
        .long    NOBUF
        .long    N_PBUF
        .long    0
        .long    0

        .long      LIT,(KBBUF+2*CW)
        .long      PLUS,LDUP
        .long      LIMIT,EQUAL
        .long      ZBRAN
        .long      PBUF1-.-CW
        .long      DROP,FIRST
PBUF1:  .long      LDUP, PREV, FETCH, LSUB
        .long      SEMIS
#

#  **************
#  *   UPDATE   *
#  **************
#
        .balign    4,0x90
N_UPDAT:
        .long      6
        .ASCII      "UPDATE"
        .balign    4,0x90
UPDAT:
        .long    DOCOL
        .long    UPDAT+HEADSIZE
        .long    0x0
        .long    PBUF
        .long    N_UPDAT
        .long    0
        .long    0

        .long      PREV, FETCH
        .long      LDUP, CELLP,CELLP
        .long      SWAP, FETCH
        .long      LOFFSET,  FETCH, PLUS
        .long      ZERO
        .long      RSLW
        .long      SEMIS
#

#  *********************
#  *   EMPTY-BUFFERS   *
#  *********************
#
        .balign    4,0x90
N_MTBUF:
        .long      13
        .ASCII      "EMPTY-BUFFERS"
        .balign    4,0x90
MTBUF:
        .long    DOCOL
        .long    MTBUF+HEADSIZE
        .long    0x0
        .long    UPDAT
        .long    N_MTBUF
        .long    0
        .long    0

        .long      FIRST
        .long      LIMIT,OVER
        .long      LSUB,LERASE
        .long      SEMIS
        #
#

#  ****************
#  *   (BUFFER)   *
#  ****************
#
        .balign    4,0x90
N_BUFFER:
        .long      8
        .ASCII      "(BUFFER)"
        .balign    4,0x90
BUFFER:
        .long    DOCOL
        .long    BUFFER+HEADSIZE
        .long    0x0
        .long    MTBUF
        .long    N_BUFFER
        .long    0
        .long    0

# Find the buffer, if it is already here.
    .long      PREV, FETCH
BUFFER1:
    .long          TOR, RR, FETCH, OVER, EQUAL
    .long      ZBRAN
        .long      BUFFER3-.-CW
    .long        DROP, FROMR, EXIT
BUFFER3:
    .long          FROMR
    .long      PBUF, ZEQU
    .long      ZBRAN
        .long      BUFFER1-.-CW
    .long       DROP
# Just allocate the stalest buffer.
    .long       STALEST,   FETCH, TOR
# Remember the next stalest buffer. 
    .long       RR
BUFFER2:
    .long       PBUF, OVER, CELLP, FETCH
    .long       LIT, -1, GREAT, LAND
    .long      ZBRAN
        .long      BUFFER2-.-CW
    .long       STALEST, STORE
# Fill in the house keeping.
    .long       RR, STORE
    .long       ZERO, RR, CELLP, STORE
    .long       RR, PREV, STORE
    .long       FROMR
    .long  SEMIS
#


#  *************
#  *   BLOCK   *
#  *************
#
        .balign    4,0x90
N_BLOCK:
        .long      5
        .ASCII      "BLOCK"
        .balign    4,0x90
BLOCK:
        .long    DOCOL
        .long    BLOCK+HEADSIZE
        .long    0x0
        .long    BUFFER
        .long    N_BLOCK
        .long    0
        .long    0


        .long      BUFFER
        .long      LDUP, CELLP, FETCH, ZEQU
        .long      ZBRAN
        .long      BLOCK1-.-CW
        .long      LDUP, CELLP, CELLP
        .long      OVER, FETCH
        .long      LOFFSET,  FETCH, PLUS
        .long      ONE
        .long      RSLW
        .long      ONE, OVER, CELLP, STORE
BLOCK1:
        .long      LDUP, PREV, STORE
        .long      CELLP, CELLP
        .long      SEMIS
#

#  *************
#  *   FLUSH   *
#  *************
#
        .balign    4,0x90
N_FLUSH:
        .long      5
        .ASCII      "FLUSH"
        .balign    4,0x90
FLUSH:
        .long    DOCOL
        .long    (MTBUF+HEADSIZE)
        .long    0x0
        .long    BLOCK
        .long    N_FLUSH
        .long    0
        .long    0


# Unlock all buffers
        .long      LIMIT
        .long      FIRST, CELLP
        .long     XDO
        .long      FLUS2-.-CW
FLUS1:  .long      ZERO, IDO, STORE
        .long      LIT,(KBBUF+2*CW)
        .long      PLOOP
        .long      (FLUS1-.)
FLUS2:
        .long      SEMIS
#

#  ************
#  *   SAVE   *
#  ************
#
        .balign    4,0x90
N_SAVE:
        .long      4
        .ASCII      "SAVE"
        .balign    4,0x90
SAVE:
        .long    DOCOL
        .long    SAVE+HEADSIZE
        .long    0x0
        .long    FLUSH
        .long    N_SAVE
        .long    0
        .long    0

        .long      FROMR
        .long      SRC, TFET
        .long      LIN, FETCH
        .long      TOR, TOR, TOR
        .long      TOR
        .long SEMIS
#

#  ***************
#  *   RESTORE   *
#  ***************
#
        .balign    4,0x90
N_RESTO:
        .long      7
        .ASCII      "RESTORE"
        .balign    4,0x90
RESTO:
        .long    DOCOL
        .long    RESTO+HEADSIZE
        .long    0x0
        .long    SAVE
        .long    N_RESTO
        .long    0
        .long    0

        .long      FROMR
        .long      FROMR, FROMR, FROMR
        .long      LIN, STORE
        .long      SRC, TSTOR
        .long      TOR
        .long SEMIS
#


#  ******************
#  *   SAVE-INPUT   *
#  ******************
#
        .balign    4,0x90
N_SAVEI:
        .long      10
        .ASCII      "SAVE-INPUT"
        .balign    4,0x90
SAVEI:
        .long    DOCOL
        .long    SAVEI+HEADSIZE
        .long    0x0
        .long    RESTO
        .long    N_SAVEI
        .long    0
        .long    0

        .long      SRC, TFET
        .long      LIN, FETCH
        .long      LIT, 3
        .long SEMIS
#

#  *********************
#  *   RESTORE-INPUT   *
#  *********************
#
        .balign    4,0x90
N_RESTOI:
        .long      13
        .ASCII      "RESTORE-INPUT"
        .balign    4,0x90
RESTOI:
        .long    DOCOL
        .long    RESTOI+HEADSIZE
        .long    0x0
        .long    SAVEI
        .long    N_RESTOI
        .long    0
        .long    0

        .long      DROP
        .long      LIN, STORE
        .long      SRC, TSTOR
        .long      LIT, -1
        .long SEMIS
#
#

#  ************
#  *   LOCK   *
#  ************
#
        .balign    4,0x90
N_LLOCK:
        .long      4
        .ASCII      "LOCK"
        .balign    4,0x90
LLOCK:
        .long    DOCOL
        .long    LLOCK+HEADSIZE
        .long    0x0
        .long    RESTOI
        .long    N_LLOCK
        .long    0
        .long    0

        .long      BLOCK
        .long      LIT, CW, LSUB
        .long      LIT, -2, SWAP, PSTORE
        .long      SEMIS
#

#  **************
#  *   UNLOCK   *
#  **************
#
        .balign    4,0x90
N_LUNLOCK:
        .long      6
        .ASCII      "UNLOCK"
        .balign    4,0x90
LUNLOCK:
        .long    DOCOL
        .long    LUNLOCK+HEADSIZE
        .long    0x0
        .long    LLOCK
        .long    N_LUNLOCK
        .long    0
        .long    0

        .long      BLOCK
        .long      LIT, CW, LSUB
        .long      TWO, SWAP, PSTORE
        .long      SEMIS
#

#  ************
#  *   LOAD   *
#  ************
#
        .balign    4,0x90
N_LOAD:
        .long      4
        .ASCII      "LOAD"
        .balign    4,0x90
LOAD:
        .long    DOCOL
        .long    LOAD+HEADSIZE
        .long    0x0
        .long    LUNLOCK
        .long    N_LOAD
        .long    0
        .long    0

        .long      LDUP, THRU
        .long      SEMIS
#

#  ************
#  *   THRU   *
#  ************
#
        .balign    4,0x90
N_THRU:
        .long      4
        .ASCII      "THRU"
        .balign    4,0x90
THRU:
        .long    DOCOL
        .long    THRU+HEADSIZE
        .long    0x0
        .long    LOAD
        .long    N_THRU
        .long    0
        .long    0

        .long      SAVE
        .long      ONEP, SWAP
        .long     XDO
        .long      THRU2-.-CW
THRU1:
        .long      IDO, LLOCK
        .long      IDO, BLOCK
        .long      LIT, KBBUF
        .long      SETSRC
        .long      LIT, INTER, CATCH
        .long      IDO, LUNLOCK
        .long      QDUP
        .long      ZBRAN
        .long      THRU3-.-CW
        .long      RDROP, RDROP, RDROP #UNLOOP.
        .long      RESTO
        .long      THROW
THRU3:
        .long     XLOOP
        .long      THRU1-.-CW
THRU2:
        .long      RESTO
        .long      SEMIS
#

#

#  ***********
#  *   BLK   *
#  ***********
#
        .balign    4,0x90
N_BLK:
        .long      3
        .ASCII      "BLK"
        .balign    4,0x90
BLK:
        .long    DOCOL
        .long    BLK+HEADSIZE
        .long    0x0
        .long    THRU
        .long    N_BLK
        .long    0
        .long    0

        .long      LIN, FETCH
        .long      FIRST, LIMIT, WITHIN
        .long      SRC, TFET, LSUB
        .long      LIT, 1024, EQUAL, LAND
        .long      ZBRAN
        .long      BLK1-.-CW
        .long      SRC, FETCH, TWO, LCELLS, LSUB, FETCH
        .long      BRAN
        .long      BLK2-.-CW
BLK1:
        .long      ZERO
BLK2:
        .long      PBLK, STORE
        .long      PBLK
        .long      SEMIS
#

#  ***********
#  *   -->   *
#  ***********
#
        .balign    4,0x90
N_ARROW:
        .long      3
        .ASCII      "-->"
        .balign    4,0x90
ARROW:
        .long    DOCOL
        .long    ARROW+HEADSIZE
        .long    B_IMMED
        .long    BLK
        .long    N_ARROW
        .long    0
        .long    0

        .long      QLOAD
        .long      BLK, FETCH
        .long      LDUP, LUNLOCK
        .long      ONEP
        .long      LDUP, LLOCK
        .long      LDUP, BLK, STORE
        .long      BLOCK
        .long      LIT, KBBUF
        .long      SETSRC
        .long      SEMIS
        #
#
#
# 


#  *************
#  *   LINOS   *
#  *************
#
        .balign    4,0x90
N_LINOS:
        .long      5
        .ASCII      "LINOS"
        .balign    4,0x90
LINOS:
        .long    LINOS+HEADSIZE
        .long    LINOS+HEADSIZE
        .long    0x0
        .long    ARROW
        .long    N_LINOS
        .long    0
        .long    0

        POP     %EAX        # Function number
        POP     %EDX        # Third parameter, if any
        POP     %ECX        # Second parameter, if any
        POP     %EBX        # First parameter.
        INT     0x80        # Generic call on LINUX 
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]        # Positive means okay. Negative means -errno.
#

#  **************
#  *   LINOS5   *
#  **************
#
        .balign    4,0x90
N_LINOS5:
        .long      6
        .ASCII      "LINOS5"
        .balign    4,0x90
LINOS5:
        .long    LINOS5+HEADSIZE
        .long    LINOS5+HEADSIZE
        .long    0x0
        .long    LINOS
        .long    N_LINOS5
        .long    0
        .long    0

        LEA     %EBP,[%EBP - (CW*(1))] #Save HIP on return stack.
        MOV     [%EBP],%ESI
        POP     %EAX        # Function number
        POP     %EDI        # 5th parameter, if any
        POP     %ESI        # 4th parameter, if any
        POP     %EDX        # Third parameter, if any
        POP     %ECX        # Second parameter, if any
        POP     %EBX        # First parameter.
        INT     0x80        # Generic call on LINUX 
        MOV     %ESI,[%EBP]    # Restore
        LEA     %EBP,[%EBP+(CW*(1))]
        PUSH    %EAX
        LODSD                 # NEXT
        JMP     DWORD PTR[%EAX]        # Positive means okay. Negative means -errno.
#

#  **********
#  *   MS   *
#  **********
#
        .balign    4,0x90
N_MS:
        .long      2
        .ASCII      "MS"
        .balign    4,0x90
MS:
        .long    DOCOL
        .long    MS+HEADSIZE
        .long    0x0
        .long    LINOS5
        .long    N_MS
        .long    0
        .long    0

        .long      LIT, 1000, LIT, 1000000, SSMOD # (ms -- us s) 
        .long      LIT, TV, TSTOR
        .long      ZERO, ZERO
        .long      ZERO, ZERO
        .long      LIT, TV
        .long      LIT, _newselect, LINOS5
        .long      QERRUR
        .long      SEMIS
TV:     .SPACE   8 
#
# 
# 
        #
#------------------------------------
#       SYSTEM DEPENDANT CHAR I/O
#------------------------------------
#


# 
# 


#  *****************
#  *   RW-BUFFER   *
#  *****************
#
        .balign    4,0x90
N_RWBUF:
        .long      9
        .ASCII      "RW-BUFFER"
        .balign    4,0x90
RWBUF:
        .long    DOVAR
        .long    RWBUF+HEADSIZE
        .long    0x0
        .long    MS
        .long    N_RWBUF
        .long    0
        .long    0

        .SPACE   0x200
# 
#


#  ***********
#  *   ZEN   *
#  ***********
#
        .balign    4,0x90
N_ZEN:
        .long      3
        .ASCII      "ZEN"
        .balign    4,0x90
ZEN:
        .long    DOCOL
        .long    ZEN+HEADSIZE
        .long    0x0
        .long    RWBUF
        .long    N_ZEN
        .long    0
        .long    0

        .long      RWBUF, SSTOR
        .long      ZERO, RWBUF, CHAPP
        .long      RWBUF, CELLP
         
        .long      SEMIS
# 
# 
# 
#


#  *****************
#  *   OPEN-FILE   *
#  *****************
#
        .balign    4,0x90
N_OFILE:
        .long      9
        .ASCII      "OPEN-FILE"
        .balign    4,0x90
OFILE:
        .long    DOCOL
        .long    OFILE+HEADSIZE
        .long    0x0
        .long    ZEN
        .long    N_OFILE
        .long    0
        .long    0

        .long      TOR, ZEN, FROMR, X
        .long      LIT, open, LINOS
        .long      LDUP, ZERO, MIN
        .long      SEMIS
#
#
#


#  ******************
#  *   CLOSE-FILE   *
#  ******************
#
        .balign    4,0x90
N_CFILE:
        .long      10
        .ASCII      "CLOSE-FILE"
        .balign    4,0x90
CFILE:
        .long    DOCOL
        .long    CFILE+HEADSIZE
        .long    0x0
        .long    OFILE
        .long    N_CFILE
        .long    0
        .long    0

        .long      X, X
        .long      LIT, close, LINOS
        .long      SEMIS
#
#
#


#  *******************
#  *   CREATE-FILE   *
#  *******************
#
        .balign    4,0x90
N_CREATEF:
        .long      11
        .ASCII      "CREATE-FILE"
        .balign    4,0x90
CREATEF:
        .long    DOCOL
        .long    CREATEF+HEADSIZE
        .long    0x0
        .long    CFILE
        .long    N_CREATEF
        .long    0
        .long    0

        .long      TOR, TDUP, DFILE, DROP
        .long      ZEN, FROMR, X
        .long      LIT, creat, LINOS
        .long      LDUP, ZERO, MAX, SWAP, ZERO, MIN
        .long      SEMIS
#
#
#


#  *******************
#  *   DELETE-FILE   *
#  *******************
#
        .balign    4,0x90
N_DFILE:
        .long      11
        .ASCII      "DELETE-FILE"
        .balign    4,0x90
DFILE:
        .long    DOCOL
        .long    DFILE+HEADSIZE
        .long    0x0
        .long    CREATEF
        .long    N_DFILE
        .long    0
        .long    0

        .long      ZEN, X, X
        .long      LIT, unlink, LINOS
        .long      SEMIS
#
#
#


#  *****************
#  *   READ-FILE   *
#  *****************
#
        .balign    4,0x90
N_RFILE:
        .long      9
        .ASCII      "READ-FILE"
        .balign    4,0x90
RFILE:
        .long    DOCOL
        .long    RFILE+HEADSIZE
        .long    0x0
        .long    DFILE
        .long    N_RFILE
        .long    0
        .long    0

        .long      ROT, ROT
        .long      LIT, read, LINOS
        .long      LDUP, ZERO, MAX, SWAP, ZERO, MIN
        .long      SEMIS
 #  
# 
# 
#


#  ***********************
#  *   REPOSITION-FILE   *
#  ***********************
#
        .balign    4,0x90
N_PFILE:
        .long      15
        .ASCII      "REPOSITION-FILE"
        .balign    4,0x90
PFILE:
        .long    DOCOL
        .long    PFILE+HEADSIZE
        .long    0x0
        .long    RFILE
        .long    N_PFILE
        .long    0
        .long    0

        .long      TOR, DROP, FROMR   #Convert to single precision.
        .long      SWAP
        .long      LIT, SEEK_SET
        .long      LIT, lseek, LINOS
        .long      ZERO, MIN
        .long      SEMIS
 # 
#
#


#  ******************
#  *   WRITE-FILE   *
#  ******************
#
        .balign    4,0x90
N_WFILE:
        .long      10
        .ASCII      "WRITE-FILE"
        .balign    4,0x90
WFILE:
        .long    DOCOL
        .long    WFILE+HEADSIZE
        .long    0x0
        .long    PFILE
        .long    N_WFILE
        .long    0
        .long    0

        .long      ROT, ROT
        .long      LIT, write, LINOS
        .long      ZERO, MIN
        .long      SEMIS
 #  
# 
# 
#
# 

#  ****************
#  *   GET-FILE   *
#  ****************
#
        .balign    4,0x90
N_GETFILE:
        .long      8
        .ASCII      "GET-FILE"
        .balign    4,0x90
GETFILE:
        .long    DOCOL
        .long    GETFILE+HEADSIZE
        .long    0x0
        .long    WFILE
        .long    N_GETFILE
        .long    0
        .long    0

        .long      TDUP, SCOMMA, DROP
        .long      LIT, 'F'+(0x100*('i'+0x100*('L'+0x100*'e'))), COMMA #Magic number.
        .long      ZERO, OFILE, THROW, TOR
        .long      HERE, LDUP
        .long      LEM, LIT, 6, SLASH, LDUP, ALLOT
        .long      LIT, 1000, LSUB
        .long      RR, RFILE, THROW
        .long      FROMR, CFILE, THROW
        .long      TDUP, PLUS, LDP, STORE        # No allocation if it fails.
        .long      SEMIS
#

#  ****************
#  *   PUT-FILE   *
#  ****************
#
        .balign    4,0x90
N_PUTFILE:
        .long      8
        .ASCII      "PUT-FILE"
        .balign    4,0x90
PUTFILE:
        .long    DOCOL
        .long    PUTFILE+HEADSIZE
        .long    0x0
        .long    GETFILE
        .long    N_PUTFILE
        .long    0
        .long    0

        .long      LIT, 0755 
        .long      CREATEF, THROW
        .long      LDUP, TOR
        .long      WFILE, THROW
        .long      FROMR, CFILE, THROW
        .long      SEMIS
#

#  ****************
#  *   INCLUDED   *
#  ****************
#
        .balign    4,0x90
N_INCLUD:
        .long      8
        .ASCII      "INCLUDED"
        .balign    4,0x90
INCLUD:
        .long    DOCOL
        .long    INCLUD+HEADSIZE
        .long    0x0
        .long    PUTFILE
        .long    N_INCLUD
        .long    0
        .long    0

        .long      HERE, TOR
        .long      LIT, GETFILE, CATCH
        .long      LDUP
        .long      ZBRAN
        .long      INCLUD1-.-CW
        .long      FROMR, LDP, STORE
        .long      THROW
        .long      BRAN
        .long      INCLUD2-.-CW
INCLUD1:
        .long      RDROP, DROP
INCLUD2:
        .long      EVALUATE
        .long      SEMIS
#

#  ******************
#  *   REFILL-TIB   *
#  ******************
#
        .balign    4,0x90
N_REFTIB:
        .long      10
        .ASCII      "REFILL-TIB"
        .balign    4,0x90
REFTIB:
        .long    DOCOL
        .long    REFTIB+HEADSIZE
        .long    0x0
        .long    INCLUD
        .long    N_REFTIB
        .long    0
        .long    0

        .long      REMAIND, FETCH, TOR
        .long      TIB, FETCH, RR, PLUS
        .long      LIT, RTS/2, RR, LSUB
        .long      ZERO, RFILE
        .long      QERRUR
        .long      LDUP, ZEQU, LIT, -EPIPE, LAND # Presumably end of pipe.
        .long      QERRUR
        .long      TIB, FETCH, SWAP, FROMR, PLUS
        .long      REMAIND, TSTOR
        .long      SEMIS
#
#
#
#

# All I/O goes through the modern device (Unix-standard)
# device I/O. Code fields are filled in during bootup. 
# Lower case labels starting with "c_.." are c-supplied facilities.

#  **************
#  *   ACCEPT   *
#  **************
#
        .balign    4,0x90
N_ACCEP:
        .long      6
        .ASCII      "ACCEPT"
        .balign    4,0x90
ACCEP:
        .long    DOCOL
        .long    ACCEP+HEADSIZE
        .long    0x0
        .long    REFTIB
        .long    N_ACCEP
        .long    0
        .long    0

        .long      PACCEP
        .long      TSWAP, ROT, MIN
        .long      LDUP, TOR, LMOVE, FROMR
        .long      SEMIS
#

#  ****************
#  *   (ACCEPT)   *
#  ****************
#
        .balign    4,0x90
N_PACCEP:
        .long      8
        .ASCII      "(ACCEPT)"
        .balign    4,0x90
PACCEP:
        .long    DOCOL
        .long    PACCEP+HEADSIZE
        .long    0x0
        .long    ACCEP
        .long    N_PACCEP
        .long    0
        .long    0

PACCEP2:
#        .long      NOLF
#        .long       LIT, 'a', EMIT
        .long      REMAIND
        .long      TFET
        .long      LIT, ALF, SINDEX
        .long      ZEQU
        .long      ZBRAN
        .long      PACCEP1-.-CW
#        .long      RETOBO
        .long      REMAIND, TFET
        .long      TIB, FETCH
        .long      SWAP, LMOVE
        .long      TIB, FETCH
        .long      REMAIND, CELLP, STORE
        .long      REFTIB
        .long      BRAN
        .long      PACCEP2-.-CW
PACCEP1:
#        .long      SPLOFF
        .long      REMAIND, TFET
        .long      LIT, ALF, SSPLIT
        .long      TSWAP, REMAIND, TSTOR
                .long      SEMIS


#  ***********
#  *   KEY   *
#  ***********
#
        .balign    4,0x90
N_KEY:
        .long      3
        .ASCII      "KEY"
        .balign    4,0x90
KEY:
        .long    DOCOL
        .long    KEY+HEADSIZE
        .long    0x0
        .long    PACCEP
        .long    N_KEY
        .long    0
        .long    0

        .long      ONE, LIT, RAWIO, STTERM # Do not wait for CR
        .long      ZERO, SPFET     # Expect single key on stack
        .long      ZERO            # Standard input
        .long      SWAP, ONE       # Buffer and length
        .long      LIT, read, LINOS
        .long      LDUP, QERRUR
        .long      ZEQU, LIT, -EPIPE, LAND, QERRUR # Presumably end of pipe.
        .long      ONE, LIT, RAWIO, STTERM       # Toggle back
        .long      SEMIS
#

#  ************
#  *   KEY?   *
#  ************
#
        .balign    4,0x90
N_KEYQ:
        .long      4
        .ASCII      "KEY?"
        .balign    4,0x90
KEYQ:
        .long    DOCOL
        .long    KEYQ+HEADSIZE
        .long    0x0
        .long    KEY
        .long    N_KEYQ
        .long    0
        .long    0

        .long      ZERO, LIT, RAWIO, STTERM
        .long      ONE     # # of highest channel to watch.
        .long      LIT, RFDS   # Waiting for input 
        .long      ONE, OVER, STORE # Waiting for standard in.
        .long      ZERO, ZERO  # Not output, not events.
        .long      ZERO, ZERO
        .long      LIT, TV, TSTOR # Time out of zero. See MS.
        .long      LIT, TV
        .long      LIT, _newselect, LINOS5
        .long      LDUP,  QERRUR
        .long      NEGATE        # 1 -> flag.
        .long      ZERO, LIT, RAWIO, STTERM
        .long      SEMIS
        .balign    4,0x90
RFDS:   .SPACE   128     #32 channels maximum.
#

#  ************
#  *   TYPE   *
#  ************
#
        .balign    4,0x90
N_LTYPE:
        .long      4
        .ASCII      "TYPE"
        .balign    4,0x90
LTYPE:
        .long    DOCOL
        .long    LTYPE+HEADSIZE
        .long    0x0
        .long    KEYQ
        .long    N_LTYPE
        .long    0
        .long    0

        .long      LDUP, LOUT, PSTORE
        .long      ONE, WFILE, DROP
        .long      SEMIS
#

#  *************
#  *   ETYPE   *
#  *************
#
        .balign    4,0x90
N_ETYPE:
        .long      5
        .ASCII      "ETYPE"
        .balign    4,0x90
ETYPE:
        .long    DOCOL
        .long    ETYPE+HEADSIZE
        .long    0x0
        .long    LTYPE
        .long    N_ETYPE
        .long    0
        .long    0

        .long      TWO, WFILE, DROP
        .long      SEMIS
#

#  **************
#  *   TERMIO   *
#  **************
#
        .balign    4,0x90
N_TERMIO:
        .long      6
        .ASCII      "TERMIO"
        .balign    4,0x90
TERMIO:
        .long    DOVAR
        .long    TERMIO+HEADSIZE
        .long    0x0
        .long    ETYPE
        .long    N_TERMIO
        .long    0
        .long    0

        .SPACE   SIZE_TERMIO     # Filled in during cold boot.
#

#  ****************
#  *   SET-TERM   *
#  ****************
#
        .balign    4,0x90
N_STTERM:
        .long      8
        .ASCII      "SET-TERM"
        .balign    4,0x90
STTERM:
        .long    DOCOL
        .long    STTERM+HEADSIZE
        .long    0x0
        .long    TERMIO
        .long    N_STTERM
        .long    0
        .long    0

        .long      LIT, (TERMIO+HEADSIZE)+(CW*(3))
        .long      SWAP, TOGGL
        .long      LIT, (TERMIO+HEADSIZE)+(CW*(4))+7
        .long      CSTOR
        .long      ZERO, LIT, TCSETS, TERMIO
        .long      LIT, ioctl, LINOS, QERRUR
        .long      SEMIS
#
 # 


#  ************
#  *   EMIT   *
#  ************
#
        .balign    4,0x90
N_EMIT:
        .long      4
        .ASCII      "EMIT"
        .balign    4,0x90
EMIT:
        .long    DOCOL
        .long    EMIT+HEADSIZE
        .long    0x0
        .long    STTERM
        .long    N_EMIT
        .long    0
        .long    0

        .long      SPFET, ONE, LTYPE
        .long      DROP
        .long      SEMIS
#
#
#
#
#
#
#

        #
#------------------------------------
#       SYSTEM DEPENDANT DISK I/O
#------------------------------------


#  ******************
#  *   DISK-ERROR   *
#  ******************
#
        .balign    4,0x90
N_DERR:
        .long      10
        .ASCII      "DISK-ERROR"
        .balign    4,0x90
DERR:
        .long    DOVAR
        .long    DERR+HEADSIZE
        .long    0x0
        .long    EMIT
        .long    N_DERR
        .long    0
        .long    0

        .long      -1
#


#  ******************
#  *   BLOCK-FILE   *
#  ******************
#
        .balign    4,0x90
N_BLFL:
        .long      10
        .ASCII      "BLOCK-FILE"
        .balign    4,0x90
BLFL:
        .long    DOVAR
        .long    BLFL+HEADSIZE
        .long    0x0
        .long    DERR
        .long    N_BLFL
        .long    0
        .long    0

        .long      9
        .ASCII      "forth.lab"
        .SPACE   252-9               # Allow for some path

#  ********************
#  *   BLOCK-HANDLE   *
#  ********************
#
        .balign    4,0x90
N_BHAN:
        .long      12
        .ASCII      "BLOCK-HANDLE"
        .balign    4,0x90
BHAN:
        .long    DOVAR
        .long    BHAN+HEADSIZE
        .long    0x0
        .long    BLFL
        .long    N_BHAN
        .long    0
        .long    0

        .long      -1
#

#  *******************
#  *   ?DISK-ERROR   *
#  *******************
#
        .balign    4,0x90
N_QDSKER:
        .long      11
        .ASCII      "?DISK-ERROR"
        .balign    4,0x90
QDSKER:
        .long    DOCOL
        .long    QDSKER+HEADSIZE
        .long    0x0
        .long    BHAN
        .long    N_QDSKER
        .long    0
        .long    0

        .long      LIT, 8, QERR
        .long      SEMIS
#
#


#  ******************
#  *   BLOCK-INIT   *
#  ******************
#
        .balign    4,0x90
N_BLINI:
        .long      10
        .ASCII      "BLOCK-INIT"
        .balign    4,0x90
BLINI:
        .long    DOCOL
        .long    BLINI+HEADSIZE
        .long    0x0
        .long    QDSKER
        .long    N_BLINI
        .long    0
        .long    0

        .long      BLFL, SFET
        .long      ROT
        .long      OFILE
        .long      ZEQU, NEGATE  # 0 if disk problems, 1 if not.
        .long      LWARN, FETCH, MIN # AND but WARNING is 0/1.
        .long      LWARN, STORE
        .long      BHAN, STORE
        .long      SEMIS
#

#  ******************
#  *   BLOCK-EXIT   *
#  ******************
#
        .balign    4,0x90
N_BLEXI:
        .long      10
        .ASCII      "BLOCK-EXIT"
        .balign    4,0x90
BLEXI:
        .long    DOCOL
        .long    BLEXI+HEADSIZE
        .long    0x0
        .long    BLINI
        .long    N_BLEXI
        .long    0
        .long    0

        .long      FLUSH
        .long      BHAN, FETCH
        .long      CFILE
        .long      ZERO, LWARN, STORE
        .long      LIT, -1, BHAN, STORE    #Regardless of close errors.
        .long      QDSKER
        .long      SEMIS
#

#  ************
#  *   SEEK   *
#  ************
#
        .balign    4,0x90
N_SEEK:
        .long      4
        .ASCII      "SEEK"
        .balign    4,0x90
SEEK:
        .long    DOCOL
        .long    SEEK+HEADSIZE
        .long    0x0
        .long    BLEXI
        .long    N_SEEK
        .long    0
        .long    0

        .long      BBUF
        .long      USTAR
        .long      BHAN, FETCH
        .long      PFILE           # Disk position.
        .long      QDSKER
        .long      SEMIS
#

#  ***********
#  *   R\W   *
#  ***********
#
        .balign    4,0x90
N_RSLW:
        .long      3
        .ASCII      "R\\W"
        .balign    4,0x90
RSLW:
        .long    DOCOL
        .long    RSLW+HEADSIZE
        .long    0x0
        .long    SEEK
        .long    N_RSLW
        .long    0
        .long    0

        .long      TOR # blk on top
        .long      SEEK # That's done
        .long      BBUF
        .long      BHAN, FETCH
        .long      FROMR
        .long      ZBRAN
        .long      RSLW1-.-CW
        .long      RFILE           # Disk read 
        .long      SWAP, DROP
        .long      BRAN
        .long      RSLW2-.-CW
RSLW1:  .long      WFILE           # Disk write
RSLW2:
        .long      QDSKER
        .long      SEMIS
#
#

#  *************
#  *   SHELL   *
#  *************
#
        .balign    4,0x90
N_SHELL:
        .long      5
        .ASCII      "SHELL"
        .balign    4,0x90
SHELL:
        .long    DOVAR
        .long    SHELL+HEADSIZE
        .long    0x0
        .long    RSLW
        .long    N_SHELL
        .long    0
        .long    0

                 .long      7
        .ASCII      "/bin/sh"
        
        .SPACE   252-9               # Allow for some path

#


#  **************
#  *   SYSTEM   *
#  **************
#
        .balign    4,0x90
N_SYSTEM:
        .long      6
        .ASCII      "SYSTEM"
        .balign    4,0x90
SYSTEM:
        .long    DOCOL
        .long    SYSTEM+HEADSIZE
        .long    0x0
        .long    SHELL
        .long    N_SYSTEM
        .long    0
        .long    0

        .long      LIT, COMBUF, SSTOR, ZERO, LIT, COMBUF, CHAPP
        .long      ZERO, SHELL, CHAPP, LIT, -1, SHELL, PSTORE
        .long      X, X, X, LIT, fork, LINOS
        .long      LDUP, QERRUR
        .long      LDUP, ZEQU
        .long      ZBRAN
        .long      SYSTEM1-.-CW
        .long      SHELL, CELLP, LIT, SYSARGS
#  Get environment vector
        .long      ARGS, FETCH, SFET, ONEP, LCELLS, PLUS
        .long      LIT, execve, LINOS
        .long      LIT, -127, QERRUR, BYE
SYSTEM1:
        .long      LDUP
        .long      LIT, STATUS, ZERO, LIT, waitpid, LINOS
        .long      LDUP
        .long      LIT, EINTR, EQUAL
        .long      BRAN
        .long      SYSTEM2-.-CW
        .long      DROP
        .long      ZBRAN
        .long      SYSTEM1-.-CW
SYSTEM2:
        .long      QERRUR
        .long      TDROP
        .long      SEMIS
#
STATUS:  .long     0
SYSARG2: .ASCII     "-c"
         .byte      0
COMBUF:  .SPACE   CW+256  #One cell for high level string manipulation.
SYSARGS: .long   (SHELL+HEADSIZE)+CW, SYSARG2, COMBUF + CW, 0
#
 # 
#
#
# 
#
#
#
# 
# 
#


#  *********
#  *   '   *
#  *********
#
        .balign    4,0x90
N_ITICK:
        .long      1
        .ASCII      "'"
        .balign    4,0x90
ITICK:
        .long    DOCOL 
        .long    ITICK+HEADSIZE
        .long    0x0
        .long    SYSTEM
        .long    N_ITICK
        .long    0
        .long    0

        .long      LPWORD, PRESENT
        .long      LDUP, ZEQU
        .long      LIT, 11, QERR
        .long      SEMIS
#

#  ***********
#  *   [']   *
#  ***********
#
        .balign    4,0x90
N_BTICK:
        .long      3
        .ASCII      "[']"
        .balign    4,0x90
BTICK:
        .long    DOCOL
        .long    (TICK+HEADSIZE)
        .long    B_IMMED
        .long    ITICK
        .long    N_BTICK
        .long    0
        .long    0

#
#

#  ******************
#  *   FORGET-VOC   *
#  ******************
#
        .balign    4,0x90
N_FORGV:
        .long      10
        .ASCII      "FORGET-VOC"
        .balign    4,0x90
FORGV:
        .long    DOCOL
        .long    FORGV+HEADSIZE
        .long    0x0
        .long    BTICK
        .long    N_FORGV
        .long    0
        .long    0

        .long      TDUP
        .long      SWAP
        .long      ULESS
        .long      ZBRAN
        .long      FORGV1-.-CW
#  Forget part of contents.
        .long      SWAP
        .long      TOR
        .long      TWID
FORGV0:
        .long      LDUP
        .long      LDUP
FORGV3:
        .long      TLFA,FETCH
        .long      LDUP
        .long      RR
        .long      ULESS
        .long      ZBRAN
        .long      FORGV3-.-CW
        .long      SWAP            #  Not to be forgotten entry found.
        .long      TLFA
        .long      STORE           #  Short other entries out.
        .long      TLFA,FETCH
        .long      LDUP
        .long      ZEQU
        .long      ZBRAN
        .long      FORGV0-.-CW        #  Repeat until end of wordlist.
        .long      DROP
        .long      FROMR
        .long      BRAN
        .long      FORGV2-.-CW
FORGV1:
#        Vocabulary itself is also forgotten.
        .long      TVFA
        .long      FETCH     # Unlink by linking next vocabulary.
        .long      VOCL
        .long      STORE
        .long      ONLY, FORTH
        .long      DEFIN
FORGV2: .long      SEMIS
#

#  **************
#  *   FORGET   *
#  **************
#
        .balign    4,0x90
N_FORG:
        .long      6
        .ASCII      "FORGET"
        .balign    4,0x90
FORG:
        .long    DOCOL
        .long    FORG+HEADSIZE
        .long    0x0
        .long    FORGV
        .long    N_FORG
        .long    0
        .long    0

        .long      TICK
        .long      LDUP
        .long      FENCE
        .long      FETCH
        .long      LESS
        .long      LIT, 21, QERR
        .long      LIT,FORGV
        .long      FORV
        .long      TNFA, FETCH, LDP, STORE
        .long      SEMIS
#

#  *************
#  *   (BACK   *
#  *************
#
        .balign    4,0x90
N_PBACK:
        .long      5
        .ASCII      "(BACK"
        .balign    4,0x90
PBACK:
        .long    DOCOL
        .long    PBACK+HEADSIZE
        .long    0x0
        .long    FORG
        .long    N_PBACK
        .long    0
        .long    0

        .long      HERE
        .long      SEMIS
#

#  *************
#  *   BACK)   *
#  *************
#
        .balign    4,0x90
N_BACKP:
        .long      5
        .ASCII      "BACK)"
        .balign    4,0x90
BACKP:
        .long    DOCOL
        .long    BACKP+HEADSIZE
        .long    0x0
        .long    PBACK
        .long    N_BACKP
        .long    0
        .long    0

        .long      HERE
        .long      CELLP
        .long      LSUB
        .long      COMMA
        .long      SEMIS
#

#  ****************
#  *   (FORWARD   *
#  ****************
#
        .balign    4,0x90
N_PFORWARD:
        .long      8
        .ASCII      "(FORWARD"
        .balign    4,0x90
PFORWARD:
        .long    DOCOL
        .long    PFORWARD+HEADSIZE
        .long    0x0
        .long    BACKP
        .long    N_PFORWARD
        .long    0
        .long    0

        .long      HERE
        .long      X
        .long      COMMA
        .long      SEMIS
#

#  ****************
#  *   FORWARD)   *
#  ****************
#
        .balign    4,0x90
N_FORWARDP:
        .long      8
        .ASCII      "FORWARD)"
        .balign    4,0x90
FORWARDP:
        .long    DOCOL
        .long    FORWARDP+HEADSIZE
        .long    0x0
        .long    PFORWARD
        .long    N_FORWARDP
        .long    0
        .long    0

        .long      HERE
        .long      OVER
        .long      CELLP
        .long      LSUB
        .long      SWAP
        .long      STORE
        .long      SEMIS
#

#  *************
#  *   BEGIN   *
#  *************
#
        .balign    4,0x90
N_BEGIN:
        .long      5
        .ASCII      "BEGIN"
        .balign    4,0x90
BEGIN:
        .long    DOCOL
        .long    BEGIN+HEADSIZE
        .long    B_IMMED
        .long    FORWARDP
        .long    N_BEGIN
        .long    0
        .long    0

        .long      PBACK
        .long      QCOMP, ONE
        .long      SEMIS
#

#  ************
#  *   THEN   *
#  ************
#
        .balign    4,0x90
N_THEN:
        .long      4
        .ASCII      "THEN"
        .balign    4,0x90
THEN:
        .long    DOCOL
        .long    THEN+HEADSIZE
        .long    B_IMMED
        .long    BEGIN
        .long    N_THEN
        .long    0
        .long    0

        .long      QCOMP, TWO, QPAIR
        .long      FORWARDP
        .long      SEMIS
#

#  **********
#  *   DO   *
#  **********
#
        .balign    4,0x90
N_DO:
        .long      2
        .ASCII      "DO"
        .balign    4,0x90
DO:
        .long    DOCOL
        .long    DO+HEADSIZE
        .long    B_IMMED
        .long    THEN
        .long    N_DO
        .long    0
        .long    0

         .long      LIT, XDO, COMMA, PFORWARD, PBACK
        .long      LIT,3    # Magic number
        .long      SEMIS
#

#  ***********
#  *   ?DO   *
#  ***********
#
        .balign    4,0x90
N_QDO:
        .long      3
        .ASCII      "?DO"
        .balign    4,0x90
QDO:
        .long    DOCOL
        .long    QDO+HEADSIZE
        .long    B_IMMED
        .long    DO
        .long    N_QDO
        .long    0
        .long    0

         .long      LIT, XQDO, COMMA, PFORWARD, PBACK
        .long      LIT,3    # Magic number
        .long      SEMIS
#

#  ************
#  *   LOOP   *
#  ************
#
        .balign    4,0x90
N_LLOOP:
        .long      4
        .ASCII      "LOOP"
        .balign    4,0x90
LLOOP:
        .long    DOCOL
        .long    LLOOP+HEADSIZE
        .long    B_IMMED
        .long    QDO
        .long    N_LLOOP
        .long    0
        .long    0

        .long      LIT, 3, QPAIR
        .long      LIT, XLOOP, COMMA, BACKP
        .long      FORWARDP # For DO to push the leave address.
        .long      SEMIS
#

#  *************
#  *   +LOOP   *
#  *************
#
        .balign    4,0x90
N_PLOOP:
        .long      5
        .ASCII      "+LOOP"
        .balign    4,0x90
PLOOP:
        .long    DOCOL
        .long    PLOOP+HEADSIZE
        .long    B_IMMED
        .long    LLOOP
        .long    N_PLOOP
        .long    0
        .long    0

        .long      LIT, 3, QPAIR
        .long      LIT, XPLOO, COMMA, BACKP
        .long      FORWARDP # For DO to push the leave address.
        .long      SEMIS
#

#  *************
#  *   UNTIL   *
#  *************
#
        .balign    4,0x90
N_UNTIL:
        .long      5
        .ASCII      "UNTIL"
        .balign    4,0x90
UNTIL:
        .long    DOCOL
        .long    UNTIL+HEADSIZE
        .long    B_IMMED
        .long    PLOOP
        .long    N_UNTIL
        .long    0
        .long    0

        .long      ONE, QPAIR
        .long      LIT, ZBRAN, COMMA, BACKP
        .long      SEMIS
#

#  *************
#  *   AGAIN   *
#  *************
#
        .balign    4,0x90
N_AGAIN:
        .long      5
        .ASCII      "AGAIN"
        .balign    4,0x90
AGAIN:
        .long    DOCOL
        .long    AGAIN+HEADSIZE
        .long    B_IMMED
        .long    UNTIL
        .long    N_AGAIN
        .long    0
        .long    0

        .long      ONE, QPAIR
        .long      LIT, BRAN, COMMA, BACKP
        .long      SEMIS
#

#  **************
#  *   REPEAT   *
#  **************
#
        .balign    4,0x90
N_REPEA:
        .long      6
        .ASCII      "REPEAT"
        .balign    4,0x90
REPEA:
        .long    DOCOL
        .long    REPEA+HEADSIZE
        .long    B_IMMED
        .long    AGAIN
        .long    N_REPEA
        .long    0
        .long    0

        .long      ONE, QPAIR   # Matches BEGIN ?
        .long      LIT, BRAN, COMMA, BACKP
        .long      QCOMP, LIT, 4, QPAIR # Matches WHILE ?
        .long      FORWARDP # WHILE target. 
        .long      SEMIS
#

#  **********
#  *   IF   *
#  **********
#
        .balign    4,0x90
N_LIF:
        .long      2
        .ASCII      "IF"
        .balign    4,0x90
LIF:
        .long    DOCOL
        .long    LIF+HEADSIZE
        .long    B_IMMED
        .long    REPEA
        .long    N_LIF
        .long    0
        .long    0

        .long      LIT, ZBRAN, COMMA, PFORWARD
        .long      TWO     # Magic number
        .long      SEMIS
#

#  ************
#  *   ELSE   *
#  ************
#
        .balign    4,0x90
N_LELSE:
        .long      4
        .ASCII      "ELSE"
        .balign    4,0x90
LELSE:
        .long    DOCOL
        .long    LELSE+HEADSIZE
        .long    B_IMMED
        .long    LIF
        .long    N_LELSE
        .long    0
        .long    0

        .long      QCOMP, TWO, QPAIR
        .long      LIT, BRAN, COMMA, PFORWARD
        .long      SWAP
        .long      FORWARDP
        .long      TWO     # Magic number
        .long      SEMIS
#

#  *************
#  *   WHILE   *
#  *************
#
        .balign    4,0x90
N_LWHILE:
        .long      5
        .ASCII      "WHILE"
        .balign    4,0x90
LWHILE:
        .long    DOCOL
        .long    LWHILE+HEADSIZE
        .long    B_IMMED
        .long    LELSE
        .long    N_LWHILE
        .long    0
        .long    0

        .long      TOR    #  Save backward target. 
        .long      TOR
        .long      LIT, ZBRAN, COMMA, PFORWARD
        .long      LIT, 4 # Magic number
        .long      FROMR
        .long      FROMR
        .long      SEMIS
#

#  **************
#  *   SPACES   *
#  **************
#
        .balign    4,0x90
N_SPACES:
        .long      6
        .ASCII      "SPACES"
        .balign    4,0x90
SPACES:
        .long    DOCOL
        .long    SPACES+HEADSIZE
        .long    0x0
        .long    LWHILE
        .long    N_SPACES
        .long    0
        .long    0

        .long      ZERO
        .long      MAX
        .long      ZERO
        .long     XQDO
        .long      SPAX1-.-CW
SPAX2:  .long      SPACE
        .long     XLOOP
        .long      SPAX2-.-CW    #LOOP
SPAX1:
        .long      SEMIS
#

#  **********
#  *   <#   *
#  **********
#
        .balign    4,0x90
N_BDIGS:
        .long      2
        .ASCII      "<#"
        .balign    4,0x90
BDIGS:
        .long    DOCOL
        .long    BDIGS+HEADSIZE
        .long    0x0
        .long    SPACES
        .long    N_BDIGS
        .long    0
        .long    0

        .long      PAD
        .long      HLD
        .long      STORE
        .long      SEMIS
#

#  **********
#  *   #>   *
#  **********
#
        .balign    4,0x90
N_EDIGS:
        .long      2
        .ASCII      "#>"
        .balign    4,0x90
EDIGS:
        .long    DOCOL
        .long    EDIGS+HEADSIZE
        .long    0x0
        .long    BDIGS
        .long    N_EDIGS
        .long    0
        .long    0

        .long      DROP
        .long      DROP
        .long      HLD
        .long      FETCH
        .long      PAD
        .long      OVER
        .long      LSUB
        .long      SEMIS
#

#  ************
#  *   SIGN   *
#  ************
#
        .balign    4,0x90
N_SIGN:
        .long      4
        .ASCII      "SIGN"
        .balign    4,0x90
SIGN:
        .long    DOCOL
        .long    SIGN+HEADSIZE
        .long    0x0
        .long    EDIGS
        .long    N_SIGN
        .long    0
        .long    0

        .long      ZLESS
        .long      ZBRAN
        .long      SIGN1-.-CW #IF
        .long      LIT, AMS
        .long      HOLD    #THEN
SIGN1:  .long      SEMIS
#

#  *********
#  *   #   *
#  *********
#
        .balign    4,0x90
N_DIG:
        .long      1
        .ASCII      "#"
        .balign    4,0x90
DIG:
        .long    DOCOL
        .long    DIG+HEADSIZE
        .long    0x0
        .long    SIGN
        .long    N_DIG
        .long    0
        .long    0

        .long      BASE
        .long      FETCH
        .long      MSMOD
        .long      ROT
        .long      LIT,9
        .long      OVER
        .long      LESS
        .long      ZBRAN
        .long      DIG1-.-CW  #IF
        .long      LIT,7
        .long      PLUS    #THEN
DIG1:   .long      LIT,0x30
        .long      PLUS
        .long      HOLD
        .long      SEMIS
#

#  **********
#  *   #S   *
#  **********
#
        .balign    4,0x90
N_DIGS:
        .long      2
        .ASCII      "#S"
        .balign    4,0x90
DIGS:
        .long    DOCOL
        .long    DIGS+HEADSIZE
        .long    0x0
        .long    DIG
        .long    N_DIGS
        .long    0
        .long    0

DIGS1:  .long      DIG     #BEGIN
        .long      OVER
        .long      OVER
        .long      LOR
        .long      ZEQU
        .long      ZBRAN
        .long      DIGS1-.-CW #UNTIL
        .long      SEMIS
#

#  *************
#  *   (D.R)   *
#  *************
#
        .balign    4,0x90
N_PDDOTR:
        .long      5
        .ASCII      "(D.R)"
        .balign    4,0x90
PDDOTR:
        .long    DOCOL
        .long    PDDOTR+HEADSIZE
        .long    0x0
        .long    DIGS
        .long    N_PDDOTR
        .long    0
        .long    0

        .long      TOR
        .long      SWAP
        .long      OVER
        .long      DABS
        .long      BDIGS
        .long      DIGS
        .long      ROT
        .long      SIGN
        .long      EDIGS
        .long      FROMR
        .long      OVER
        .long      LSUB, ZERO, MAX
        .long      ZERO
        .long     XQDO
        .long      PDDOT1-.-CW
PDDOT2:  .long      LBL, HOLD  #WARNING: HOLD outside of #>.
        .long     XLOOP
        .long      PDDOT2-.-CW
PDDOT1:
        .long      EDIGS  #Drop string instead of number.
        .long      SEMIS
#

#  ***********
#  *   D.R   *
#  ***********
#
        .balign    4,0x90
N_DDOTR:
        .long      3
        .ASCII      "D.R"
        .balign    4,0x90
DDOTR:
        .long    DOCOL
        .long    DDOTR+HEADSIZE
        .long    0x0
        .long    PDDOTR
        .long    N_DDOTR
        .long    0
        .long    0

        .long      PDDOTR
        .long      LTYPE
        .long      SEMIS
#

#  **********
#  *   .R   *
#  **********
#
        .balign    4,0x90
N_DOTR:
        .long      2
        .ASCII      ".R"
        .balign    4,0x90
DOTR:
        .long    DOCOL
        .long    DOTR+HEADSIZE
        .long    0x0
        .long    DDOTR
        .long    N_DOTR
        .long    0
        .long    0

        .long      TOR
        .long      STOD
        .long      FROMR
        .long      DDOTR
        .long      SEMIS
#

#  **********
#  *   D.   *
#  **********
#
        .balign    4,0x90
N_DDOT:
        .long      2
        .ASCII      "D."
        .balign    4,0x90
DDOT:
        .long    DOCOL
        .long    DDOT+HEADSIZE
        .long    0x0
        .long    DOTR
        .long    N_DDOT
        .long    0
        .long    0

        .long      ZERO
        .long      DDOTR
        .long      SPACE
        .long      SEMIS
#

#  *********
#  *   .   *
#  *********
#
        .balign    4,0x90
N_DOT:
        .long      1
        .ASCII      "."
        .balign    4,0x90
DOT:
        .long    DOCOL
        .long    DOT+HEADSIZE
        .long    0x0
        .long    DDOT
        .long    N_DOT
        .long    0
        .long    0

        .long      STOD
        .long      DDOT
        .long      SEMIS
#

#  *********
#  *   ?   *
#  *********
#
        .balign    4,0x90
N_QUES:
        .long      1
        .ASCII      "?"
        .balign    4,0x90
QUES:
        .long    DOCOL
        .long    QUES+HEADSIZE
        .long    0x0
        .long    DOT
        .long    N_QUES
        .long    0
        .long    0

        .long      FETCH
        .long      DOT
        .long      SEMIS
#

#  **********
#  *   U.   *
#  **********
#
        .balign    4,0x90
N_UDOT:
        .long      2
        .ASCII      "U."
        .balign    4,0x90
UDOT:
        .long    DOCOL
        .long    UDOT+HEADSIZE
        .long    0x0
        .long    QUES
        .long    N_UDOT
        .long    0
        .long    0

        .long      ZERO
        .long      DDOT
        .long      SEMIS
#

#  *****************
#  *   FOR-WORDS   *
#  *****************
#
        .balign    4,0x90
N_FORW:
        .long      9
        .ASCII      "FOR-WORDS"
        .balign    4,0x90
FORW:
        .long    DOCOL
        .long    FORW+HEADSIZE
        .long    0x0
        .long    UDOT
        .long    N_FORW
        .long    0
        .long    0

        .long      SWAP
        .long      TOR
        .long      TOR
FORW1:  .long      FROMR
        .long      RR
        .long      OVER
        .long      TLFA
        .long      FETCH
        .long      TOR
        .long      EXEC
        .long      RR
        .long      ZEQU
        .long      ZBRAN
        .long      FORW1-.-CW
        .long      RDROP
        .long      RDROP
        .long      SEMIS
#

#  ****************
#  *   FOR-VOCS   *
#  ****************
#
        .balign    4,0x90
N_FORV:
        .long      8
        .ASCII      "FOR-VOCS"
        .balign    4,0x90
FORV:
        .long    DOCOL
        .long    FORV+HEADSIZE
        .long    0x0
        .long    FORW
        .long    N_FORV
        .long    0
        .long    0

        .long      TOR
        .long      VOCL
        .long      FETCH
        .long      TOR
FORV1:  .long      FROMR
        .long      RR
        .long      OVER
        .long      TVFA
        .long      FETCH
        .long      TOR
        .long      EXEC
        .long      RR
        .long      ZEQU
        .long      ZBRAN
        .long      FORV1-.-CW
        .long      RDROP
        .long      RDROP
        .long      SEMIS
#

#  *************
#  *   WORDS   *
#  *************
#
        .balign    4,0x90
N_WORDS:
        .long      5
        .ASCII      "WORDS"
        .balign    4,0x90
WORDS:
        .long    DOCOL
        .long    WORDS+HEADSIZE
        .long    0x0
        .long    FORV
        .long    N_WORDS
        .long    0
        .long    0

        .long      CSLL
        .long      LOUT
        .long      STORE
        .long      LIT, IDDOT
        .long      CONTEXT
        .long      FETCH
        .long      FORW
        .long      SEMIS
#
# 
# 

#  *****************
#  *   EXIT-CODE   *
#  *****************
#
        .balign    4,0x90
N_XCODE:
        .long      9
        .ASCII      "EXIT-CODE"
        .balign    4,0x90
XCODE:
        .long    DOVAR
        .long    XCODE+HEADSIZE
        .long    0x0
        .long    WORDS
        .long    N_XCODE
        .long    0
        .long    0

        .long      0
#


#  ***********
#  *   BYE   *
#  ***********
#
        .balign    4,0x90
N_BYE:
        .long      3
        .ASCII      "BYE"
        .balign    4,0x90
BYE:
        .long    DOCOL
        .long    BYE+HEADSIZE
        .long    0x0
        .long    XCODE
        .long    N_BYE
        .long    0
        .long    0

# Exit to linux, with okay status. 
        .long      XCODE, FETCH, X, X, ONE, LINOS
        .long      SEMIS   #Unnecessary, but helpful for decompilation.
# 
#

#  ************
#  *   LIST   *
#  ************
#
        .balign    4,0x90
N_LLIST:
        .long      4
        .ASCII      "LIST"
        .balign    4,0x90
LLIST:
        .long    DOCOL
        .long    LLIST+HEADSIZE
        .long    0x0
        .long    BYE
        .long    N_LLIST
        .long    0
        .long    0

        .long      SCR,STORE
        .long      SKIP
         .long      6
SB5: .ASCII      "SCR # "
       .balign    4,0x90
        .long      LIT, SB5
        .long      LIT, 6
        .long      LTYPE
        .long      BASE, FETCH
        .long      DECA
        .long      SCR, FETCH, DOT
        .long      BASE, STORE
        .long      SCR, FETCH, BLOCK
        .long      LIT,1024
LLIST1: .long      LIT, ALF, SSPLIT
        .long      CR, LTYPE
        .long      OVER,ZEQU #DUP would not show a last empty line!
        .long      ZBRAN
        .long      LLIST1-.-CW
        .long      TDROP
        .long      SEMIS
#

#  *************
#  *   INDEX   *
#  *************
#
        .balign    4,0x90
N_INDEX:
        .long      5
        .ASCII      "INDEX"
        .balign    4,0x90
INDEX:
        .long    DOCOL
        .long    INDEX+HEADSIZE
        .long    0x0
        .long    LLIST
        .long    N_INDEX
        .long    0
        .long    0

        .long      LIT,AFF
        .long      EMIT,CR
        .long      ONEP,SWAP
        .long     XDO
        .long      INDE9-.-CW
INDE1:  .long      CR,IDO
        .long      LIT,3
        .long      DOTR,SPACE
        .long      ZERO,IDO
        .long      PLINE, LTYPE, KEYQ
        .long      ZBRAN
        .long      INDE2-.-CW
        .long      LLEAV
INDE2:  .long     XLOOP
        .long      INDE1-.-CW
INDE9:
        .long      SEMIS
#

#  **********
#  *   .S   *
#  **********
#
        .balign    4,0x90
N_DOTS:
        .long      2
        .ASCII      ".S"
        .balign    4,0x90
DOTS:
        .long    DOCOL
        .long    DOTS+HEADSIZE
        .long    0x0
        .long    INDEX
        .long    N_DOTS
        .long    0
        .long    0

        .long      CR
        .long      LIT, 'S', EMIT
        .long      LIT, ASO, EMIT
        .long      SPACE
        .long      SPFET, SZERO, FETCH
DOC2:   .long      OVER, OVER,  EQUAL, ZEQU
        .long      ZBRAN
        .long      DOC1-.-CW
        .long      ZERO, CELLP, LSUB, LDUP, FETCH, DOT
        .long      BRAN
        .long      DOC2-.-CW
DOC1:    .long DROP, DROP
        .long      LIT, ASC, EMIT
        .long SEMIS
#

#  ********************
#  *   ENVIRONMENT?   *
#  ********************
#
        .balign    4,0x90
N_ENVQ:
        .long      12
        .ASCII      "ENVIRONMENT?"
        .balign    4,0x90
ENVQ:
        .long    DOCOL
        .long    ENVQ+HEADSIZE
        .long    0x0
        .long    DOTS
        .long    N_ENVQ
        .long    0
        .long    0

        .long      LIT, ENV, TWID, PFIND
        .long      TOR, TDROP, FROMR
        .long      LDUP
        .long      ZBRAN
        .long      ENVQ1-.-CW
        .long      EXEC
        .long      LIT, -1
ENVQ1:
        .long      SEMIS
#


#  *************
#  *   TRIAD   *
#  *************
#
        .balign    4,0x90
N_TRIAD:
        .long      5
        .ASCII      "TRIAD"
        .balign    4,0x90
TRIAD:
        .long    DOCOL
        .long    TRIAD+HEADSIZE
        .long    0x0
        .long    ENVQ
        .long    N_TRIAD
        .long    0
        .long    0

        .long      LIT,AFF
        .long      EMIT
        .long      LIT,3
        .long      SLASH
        .long      LIT,3
        .long      STAR
        .long      LIT,3
        .long      OVER,PLUS
        .long      SWAP
        .long     XDO
        .long      TRIA9-.-CW
TRIA1:  .long      CR,IDO
        .long      LLIST
        .long      KEYQ
        .long      ZBRAN
        .long      TRIA2-.-CW
        .long      LLEAV   #LEAVE
TRIA2:  .long     XLOOP
        .long      TRIA1-.-CW    #THEN
TRIA9:
        .long      CR
        .long      ZERO, MESS
        .long      SEMIS
#
#
# This word is not even fig!

#  ***************
#  *   .SIGNON   *
#  ***************
#
        .balign    4,0x90
N_SIGNON:
        .long      7
        .ASCII      ".SIGNON"
        .balign    4,0x90
SIGNON:
        .long    DOCOL
        .long    SIGNON+HEADSIZE
        .long    0x0
        .long    TRIAD
        .long    N_SIGNON
        .long    0
        .long    0

# PRINT CPU TYPE (8088)
        .long      CR
        .long      BASE,FETCH
        .long      LIT,36, BASE,STORE
        .long      LCPU, DDOT
        .long      BASE,STORE
#
        .long      LNAME, LTYPE, SPACE
        .long      LVERSION, LTYPE, SPACE
        .long      CR
        .long      SEMIS
#
# 
#
#**** LAST DICTIONARY WORD ****

#  ************
#  *   TASK   *
#  ************
#
        .balign    4,0x90
N_TASK:
        .long      4
        .ASCII      "TASK"
        .balign    4,0x90
TASK:
        .long    DOCOL
        .long    TASK+HEADSIZE
        .long    0x0
        .long    SIGNON
        .long    N_TASK
        .long    0
        .long    0

        .long      SEMIS
#
 #  

 /* 

The remaining memory ( up to 'EM' ) is
used for:

        1. EXTENSION DICTIONARY
        2. PARAMETER STACK
        3. TERMINAL INPUT BUFFER
        4. RETURN STACK
        5. USER VARIABLE AREA
        6. DISK BUFFERS (UNLESS REQUIRED <1 MBYTE)


 */ 


#       This is the proper way to do it.
#       No memory addresses should be arrived at through equates.
#       However now we must teach the linker to keep the
#       two sections together.

FORTHSIZE       =     . - _start
        .section dictionary,"awx",@nobits

INITDP:                 #  It may be that it is not consecutive with TASK.
                        #  Because of bad linking, resulting in a unusable Forth.
        BUFFERSIZE      =  (KBBUF+2*CW)*NBUF

       .SPACE   EM - FORTHSIZE - RTS - US - BUFFERSIZE 
INITS0:                         # Grows down
STRTIB: .SPACE   RTS             # Start return stack area
INITR0:                         # Grows down
STRUSA: .SPACE   US              # User area
BUF1:   .SPACE   BUFFERSIZE      # FIRST DISK BUFFER
ACTUAL_EM:  # Differs from EM if code is relocated.
# 
#

 #    ENDS
        #
 /* 

  MISC. NOTES AND SCATTERED THOUGHTS

- Remember that all the FORTH words in this version are
  upper case letters.  Use <CAPS LOCK> when in FORTH.

# 

- Subscribe to FORTH Dimensions.  It is a valuable source
  of system and application ideas.  Talking with fellow
  FORTH programmers is sure to stir up some exciting ideas.
  Consider joining a FIG chapter.  See the back of FORTH
  Dimensions for more info.

 */ 

# Define the entry point, not valid for auto booting.
        #     ORIG

























#




