






















;         ciforth : a generic I86 ISO FORTH by HCC FIG
; $Id: ci86.gnr,v 5.190 2022/04/06 14:41:12 albert Exp $
; Copyright (2012): Albert van der Horst by GNU Public License
;
;HCC FIG Holland : Hobby Computer Club, Forth Interest Group  Holland
        ;  66,106
 ;   ciforth $Revision: 5.190 $
;
; 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
;
; The following configuration information should agree with the configuration
; on the frontpage of your docmentation (texinfo, ps, pdf.)
; WITHOUT FITTING DOCUMENTATION YOU MIGHT AS WELL GIVE UP! 
;
; Configuration of this particular version:
; 64-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.
;

 use64          ; Assembler directive

;
; FASM version of ciforth created by ``m4'' from generic listing.
; This source can be assembled using the Flat Assembler,
;  available from the Net.
; Default for fasm: one section, which is called segment (!)
; 

;      fasm forth.asm forth


        ; fam generates executable, no separate linking.
        FORMAT  ELF64 EXECUTABLE
;
 ;  
;
;
;        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
;
;                with
;        direct contributions for OSX from Robert Spykerman.
;
;              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  =     5       ; FIG RELEASE #
FIGREV  =     0       ; FIG REVISION #
USRVER  =     0      ; USER VERSION NUMBER, a digit now
;
;      VERY ELEMENTARY .
CW      =     8    ; 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    =     16   ; No. of buffers, or screens 
KBBUF   =     1024      ; Data bytes per disk buffer
US      =     0x40*CW  ; User variable space, eats into next data stack, if any.
EM      =     (0x4000000)     ; Where the memory ends w.r.t. ORIG. 1) 
EMP     =     (EM-1)/0x1000+1 ; Number of pages.
TAS     =     0x10000    ;Size of unitialised area per task.
STACKSIZE   = TAS/4  ;For both stacks. 
TIBSIZE     = TAS/4  ;TIB size. 
;
; NOTE 1:
;Nothing tricky on 64 bits systems


;
;      ASCII CHARACTER EQUIVALENTS
;
ABL     =     ' '     ; SPACE
ACR     =     0x0D     ; CR
AMS     =     '-'          ; MINUS SIGN 
ASO     =     '['          ; SQUARE BRACKET OPEN 
ASC     =     ']'          ; SQUARE BRACKET CLOSE 
ADOT    =     '.'          ; PERIOD
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 namespace 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
;
;
;
;
;
; 



; ------------------------------------------------------------ 
;   syscalls are copied from                                            
;https://github.com/torvalds/linux/blob/master/arch/x86/entry/syscalls/syscall_64.tbl 
; ------------------------------------------------------------ 
; https://github.com/torvalds/linux/tree/master/arch/x86/entry/syscalls
; you may benefit from the program stealconstant 
; https://github.com/albertvanderhorst/stealconstant 

SEEK_SET        =     0x0    
SEEK_CUR	=     0x1     
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    =       0x3c
open    =       0x2
close   =       0x3
creat   =       0x55
unlink  =       0x57
chdir   =       0x50
read    =       0x0
select  =       0x17
write   =       0x1
ioctl   =       0x10
ioperm  =       0xad
iopl    =       0xac
lseek   =       0x8
execve  =       0x3b
fork    =       0x39
waitpid =       0x3d
pipe    =       0x16

_newselect = select

wait4   =     waitpid
;RAWIO           EQU     (ECHO _OR_ ICANON)

; ------------------------------------------------------------  
;   End of constants stolen from C in linux 64 bit environment.        
; ------------------------------------------------------------  
 
RAWIO           =     (ECHO OR ICANON)

; 
; 
; 


               SEGMENT executable readable writable
        ;
        ;  _start       ; Entry point's guesses.
        ;  start        ; Entry point.
        ;  _main        ; Entry point.
_ORIG:
_start:      ; Entry point.
; 
; 

; 
    
    

; 

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

; 
ENDBOOT:


;
; 

; 
; 

; 
;
;

;


; 
;


; 4.15.3.2
_main:
start:
;
COLD_ENTRY:
        CLD                     ; DIR = INC

        MOV     RAX, QWORD[USINI+(CW*(1))]
        MOV     RBX, RAX
        DEC     RBX
        OR      RBX,  STACKSIZE-1    ;Requires it is power of 2.
        INC     RBX
        SUB     RBX,RAX
        ADD     QWORD[USINI+(CW*(0))], RBX
        ADD     QWORD[USINI+(CW*(1))], RBX
        ADD     QWORD[USINI+(CW*(2))], RBX
        ADD     QWORD[USINI+(CW*(3))], RBX
        ADD     QWORD[USINI+(CW*(4))], RBX

 ; 
       MOV     QWORD[USINI+(CW*(31))],RSP ;Remember ARGS.
;
        MOV     RSP,QWORD[USINI+(CW*(2))]    ;Parameter stack
        MOV     RBP,QWORD[USINI+(CW*(3))]    ;Return stack
        MOV     RSI, COLD+(CW*(PH_OFFSET)) ;Interpreter pointer
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;
; ########################################################################################
;                       FORTH ITSELF
; ########################################################################################
;
;
;   FORTH REGISTERS
;   The names under FORTH are used in the generic source.
;
;   FORTH   Intel    FORTH PRESERVATION RULES
;   -----   ----     ----- ------------ -----
;;   HIP   RSI      High level Interpreter Pointer.  Must be preserved
;                    across FORTH words.
;
;   WOR   RAX      Working register.  When entering a word
;                    via its code field the dea is passed in WOR.
;
;   SPO   RSP      Parameter stack pointer.  Must be preserved
;                    across FORTH words.
;
;   RPO   RBP      Return stack pointer.  Must be preserved across
;                    FORTH words.
;
;            RAX      General register.  Used to pass data from
;                    FORTH words, see label APUSH or macro _APUSH
;
;            RDX      General register.  Used to pass more data from
;                    FORTH words, see label DPUSH or macro _DPUSH
;
;            RBX      General purpose register.
;
;            RCX      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.
;            The remaining registers are free to use.
;            Within assembler words RAX can be used too,
;            as it has served its purpose.
;
;            Here are some  useful code sequences.
;            For next:
;                    LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;            For push single and next:
;                    PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;            For push double and next:
;                    PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;
;----------------------------------------------------------
;
        ;
;
;---------------------------------------------
;
;   COMMENT CONVENTIONS
;   ------- -----------
;
;   =       IS EQUAL TO
;   <-      ASSIGNMENT
;
;  NAME        =  Address of name
;  (NAME)      =  Contents of name
;  DEA         =  DICTIONARY ENTRY ADDRESS
;                 fields have fixed offsets from DEA
;  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 to the next DEA
;  NFA         =  NAME FIELD ADDRESS: a pointer to a name buffer
;  SFA         =  SOURCE FIELD ADDRESS: a pointer into source code
;  PHA         =  POST HEADER ADDRESS: Afterall fields
;
;  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
;  LC          =  Low  cell
;  HC          =  High cell
;
;------------------------------------------------------------
;
; 
        ;
; 
;
; 
; In 32 bit versions there may be no jumps to NEXT at all 
; The label NEXT1 is rarely relevant (for _OLDDEBUG_) 
DPUSH:  PUSH    RDX      ; Fall through.
APUSH:  PUSH    RAX
NEXT:
;
        LODSQ           ;AX <- (IP)
NEXT1:  MOV     RAX,RAX   ; (WOR) <- (IP)

        JMP     QWORD[RAX]    ; TO `CFA'
;
;       Dictionary starts here.

DP0:
; End of ONLY namespace. Namespaces all end in a link to 0.

;  *********
;  *   '   *
;  *********
;
        ALIGN    8
N_TICK:
        DQ      1
        DB      "'"
        ALIGN    8
TICK:
        DQ    DOCOL
        DQ    TICK+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    0
        DQ    N_TICK
        DQ    0
        DQ    0

        DQ      ITICK
        DQ      LITER
        DQ      SEMIS
;

;  *********
;  *   &   *
;  *********
;
        ALIGN    8
N_DCHAR:
        DQ      1
        DB      "&"
        ALIGN    8
DCHAR:
        DQ    DOCOL
        DQ    DCHAR+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    TICK
        DQ    N_DCHAR
        DQ    0
        DQ    0

        DQ      PPFET
        DQ      NIP
        DQ      LDUP, QBL
        DQ      LIT, 10, QERR
        DQ      LITER
        DQ      QDELIM
        DQ      SEMIS

;

;  *********
;  *   ^   *
;  *********
;
        ALIGN    8
N_DCTL:
        DQ      1
        DB      "^"
        ALIGN    8
DCTL:
        DQ    DOCOL
        DQ    DCTL+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    DCHAR
        DQ    N_DCTL
        DQ    0
        DQ    0

        DQ      PPFET
        DQ      NIP
        DQ      LDUP, QBL
        DQ      LIT, 10, QERR
        DQ      LIT, '@', LSUB
        DQ      LITER
        DQ      QDELIM
        DQ      SEMIS
;

;  *********
;  *   0   *
;  *********
;
        ALIGN    8
N_DEN0:
        DQ      1
        DB      "0"
        ALIGN    8
DEN0:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DCTL
        DQ    N_DEN0
        DQ    0
        DQ    0

;  *********
;  *   1   *
;  *********
;
        ALIGN    8
N_DEN1:
        DQ      1
        DB      "1"
        ALIGN    8
DEN1:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN0
        DQ    N_DEN1
        DQ    0
        DQ    0

;  *********
;  *   2   *
;  *********
;
        ALIGN    8
N_DEN2:
        DQ      1
        DB      "2"
        ALIGN    8
DEN2:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN1
        DQ    N_DEN2
        DQ    0
        DQ    0

;  *********
;  *   3   *
;  *********
;
        ALIGN    8
N_DEN3:
        DQ      1
        DB      "3"
        ALIGN    8
DEN3:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN2
        DQ    N_DEN3
        DQ    0
        DQ    0

;  *********
;  *   4   *
;  *********
;
        ALIGN    8
N_DEN4:
        DQ      1
        DB      "4"
        ALIGN    8
DEN4:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN3
        DQ    N_DEN4
        DQ    0
        DQ    0

;  *********
;  *   5   *
;  *********
;
        ALIGN    8
N_DEN5:
        DQ      1
        DB      "5"
        ALIGN    8
DEN5:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN4
        DQ    N_DEN5
        DQ    0
        DQ    0

;  *********
;  *   6   *
;  *********
;
        ALIGN    8
N_DEN6:
        DQ      1
        DB      "6"
        ALIGN    8
DEN6:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN5
        DQ    N_DEN6
        DQ    0
        DQ    0


;  *********
;  *   7   *
;  *********
;
        ALIGN    8
N_DEN7:
        DQ      1
        DB      "7"
        ALIGN    8
DEN7:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN6
        DQ    N_DEN7
        DQ    0
        DQ    0

;  *********
;  *   8   *
;  *********
;
        ALIGN    8
N_DEN8:
        DQ      1
        DB      "8"
        ALIGN    8
DEN8:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN7
        DQ    N_DEN8
        DQ    0
        DQ    0

;  *********
;  *   9   *
;  *********
;
        ALIGN    8
N_DEN9:
        DQ      1
        DB      "9"
        ALIGN    8
DEN9:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN8
        DQ    N_DEN9
        DQ    0
        DQ    0

;  *********
;  *   A   *
;  *********
;
        ALIGN    8
N_DENA:
        DQ      1
        DB      "A"
        ALIGN    8
DENA:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEN9
        DQ    N_DENA
        DQ    0
        DQ    0

;  *********
;  *   B   *
;  *********
;
        ALIGN    8
N_DENB:
        DQ      1
        DB      "B"
        ALIGN    8
DENB:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DENA
        DQ    N_DENB
        DQ    0
        DQ    0


;  *********
;  *   C   *
;  *********
;
        ALIGN    8
N_DENC:
        DQ      1
        DB      "C"
        ALIGN    8
DENC:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DENB
        DQ    N_DENC
        DQ    0
        DQ    0

;  *********
;  *   D   *
;  *********
;
        ALIGN    8
N_DEND:
        DQ      1
        DB      "D"
        ALIGN    8
DEND:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DENC
        DQ    N_DEND
        DQ    0
        DQ    0

;  *********
;  *   E   *
;  *********
;
        ALIGN    8
N_DENE:
        DQ      1
        DB      "E"
        ALIGN    8
DENE:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DEND
        DQ    N_DENE
        DQ    0
        DQ    0

;  *********
;  *   F   *
;  *********
;
        ALIGN    8
N_DENF:
        DQ      1
        DB      "F"
        ALIGN    8
DENF:
        DQ    DOCOL
        DQ    LNUMB
        DQ    B_IMMED + B_DENOT
        DQ    DENE
        DQ    N_DENF
        DQ    0
        DQ    0

;

;  *********
;  *   -   *
;  *********
;
        ALIGN    8
N_DENM:
        DQ      1
        DB      "-"
        ALIGN    8
DENM:
        DQ    DOCOL
        DQ    DENM+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    DENF
        DQ    N_DENM
        DQ    0
        DQ    0

        DQ      PNUMB, DNEGA, SDLITE
        DQ      SEMIS
;

;  *********
;  *   +   *
;  *********
;
        ALIGN    8
N_DENP:
        DQ      1
        DB      "+"
        ALIGN    8
DENP:
        DQ    DOCOL
        DQ    DENP+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    DENM
        DQ    N_DENP
        DQ    0
        DQ    0

        DQ      PNUMB, SDLITE
        DQ      SEMIS
;

;  *********
;  *   "   *
;  *********
;
        ALIGN    8
N_DENQ:
        DQ      1
        DB      '"'
        ALIGN    8
DENQ:
        DQ    DOCOL
        DQ    DENQ+HEADSIZE
        DQ    B_IMMED + B_DENOT
        DQ    DENP
        DQ    N_DENQ
        DQ    0
        DQ    0

        DQ      LIT, SKIP, COMMA        ;  'SKIP , HERE >R 0 ,
        DQ      HERE, TOR, ZERO, COMMA
DENQ1:
        DQ      LIT, '"', PARSE         ;           BEGIN &" PARSE
        DQ      PPFET, LDUP, LIT, '"', EQUAL ;           PP@@ DUP &" =
        DQ      ZBRAN
        DQ      DENQ2-$-CW                 ;           WHILE
        DQ      TDROP, ONEP             ;           2DROP 1+ R@ $+!
        DQ      LDUP, ALLOT, RR, SADD
        DQ      BRAN
        DQ      DENQ1-$-CW                  ;           REPEAT
DENQ2:
        DQ      QBL, ZEQU
        DQ      LIT, 10, QERR           ;           ?BLANK 0= 10 ?ERROR
        DQ      DROP                    ;                DROP 
        DQ      LDUP, ALLOT, RR, SADD     ;         DUP ALLOT R@ $+!
    ;          0 HERE ! 
    DQ LALIGN
        DQ      FROMR, SFET, DLITE      ;           R> $@ POSTPONE DLITERAL ;
        DQ      SEMIS
;

; The FORTH word is the only non-denotation in the ONLY namespace.
;  *************
;  *   FORTH   *
;  *************
;
        ALIGN    8
N_FORTH:
        DQ      5
        DB      "FORTH"
        ALIGN    8
FORTH:
        DQ    DODOE
        DQ    FORTH+HEADSIZE
        DQ    0x0
        DQ    DENQ
        DQ    N_FORTH
        DQ    0
        DQ    0

        DQ      DOVOC
        DQ      0       ; END OF NAMESPACE LIST

        ALIGN    8

        DQ    0x0
        DQ    0
        DQ    B_DUMMY
        DQ    TASK
        DQ    (ZERO+(CW*(D_HOFFSET)))
        DQ    0
        DQ    0

;
;
;

;  ************
;  *   CORE   *
;  ************
;
        ALIGN    8
N_CORE:
        DQ      4
        DB      "CORE"
        ALIGN    8
CORE:
        DQ    DOCOL
        DQ    CORE+HEADSIZE
        DQ    0x0
        DQ    0
        DQ    N_CORE
        DQ    0
        DQ    0

        DQ      ZERO    ; Not (fully) present.
        DQ      SEMIS
;

;  ***********
;  *   CPU   *
;  ***********
;
        ALIGN    8
N_LCPU:
        DQ      3
        DB      "CPU"
        ALIGN    8
LCPU:
        DQ    DOCOL
        DQ    LCPU+HEADSIZE
        DQ    0x0
        DQ    CORE
        DQ    N_LCPU
        DQ    0
        DQ    0


       DQ      LIT, 0x26482776, ZERO     ; 'AMDX86'
             ; '80386'
           ; '80386'
; 

        DQ      SEMIS
;
;       If M4_VERSION exists and contains a . it is an official release
;

;  ***************
;  *   VERSION   *
;  ***************
;
        ALIGN    8
N_LVERSION:
        DQ      7
        DB      "VERSION"
        ALIGN    8
LVERSION:
        DQ    DOCOL
        DQ    LVERSION+HEADSIZE
        DQ    0x0
        DQ    LCPU
        DQ    N_LVERSION
        DQ    0
        DQ    0

;
;;       If this is there it is an official release
;        DQ      SKIP
;        DQ      22
;IBMPC:  DB      'IBM-PC ciforth'
;        DB      FIGREL+0x40,ADOT,FIGREV+0x30,ADOT,USRVER+0x30
;        DQ      LIT, IBMPC, LIT, 22
;
        DQ      SKIP
         DQ      5
SB0: DB      "5.4.1"
       ALIGN    8
        DQ      LIT, SB0
        DQ      LIT, 5
        DQ      SEMIS
;

;  ************
;  *   NAME   *
;  ************
;
        ALIGN    8
N_LENAME:
        DQ      4
        DB      "NAME"
        ALIGN    8
LENAME:
        DQ    DOCOL
        DQ    LENAME+HEADSIZE
        DQ    0x0
        DQ    LVERSION
        DQ    N_LENAME
        DQ    0
        DQ    0

        DQ      SKIP
         DQ      7
SB1: DB      "ciforth"
       ALIGN    8
        DQ      LIT, SB1
        DQ      LIT, 7
        DQ      SEMIS
;

;  ****************
;  *   SUPPLIER   *
;  ****************
;
        ALIGN    8
N_SUPPLIER:
        DQ      8
        DB      "SUPPLIER"
        ALIGN    8
SUPPLIER:
        DQ    DOCOL
        DQ    SUPPLIER+HEADSIZE
        DQ    0x0
        DQ    LENAME
        DQ    N_SUPPLIER
        DQ    0
        DQ    0

        DQ      SKIP
         DQ      20
SB2: DB      "Albert van der Horst"
       ALIGN    8
        DQ      LIT, SB2
        DQ      LIT, 20
        DQ      SEMIS
;
;

;  ************
;  *   ONLY   *
;  ************
;
        ALIGN    8
N_ONLY:
        DQ      4
        DB      "ONLY"
        ALIGN    8
ONLY:
        DQ    DODOE
        DQ    ONLY+HEADSIZE
        DQ    0x0
        DQ    0
        DQ    N_ONLY
        DQ    0
        DQ    0

        DQ      DOVOC
        DQ      FORTH     ; NEXT NAMESPACE 
ONLYBODY:

        ALIGN    8

        DQ    0x0
        DQ    0
        DQ    B_DUMMY
        DQ    FORTH
        DQ    (ZERO+(CW*(D_HOFFSET)))
        DQ    0
        DQ    0

;

;  *******************
;  *   ENVIRONMENT   *
;  *******************
;
        ALIGN    8
N_ENV:
        DQ      11
        DB      "ENVIRONMENT"
        ALIGN    8
ENV:
        DQ    DODOE
        DQ    ENV+HEADSIZE
        DQ    0x0
        DQ    ONLY
        DQ    N_ENV
        DQ    0
        DQ    0

        DQ      DOVOC
        DQ      ONLY       ; NEXT NAMESPACE 

        ALIGN    8

        DQ    0x0
        DQ    0
        DQ    B_DUMMY
        DQ    SUPPLIER
        DQ    (ZERO+(CW*(D_HOFFSET)))
        DQ    0
        DQ    0

;

;  ************
;  *   NOOP   *
;  ************
;
        ALIGN    8
N_NOOP:
        DQ      4
        DB      "NOOP"
        ALIGN    8
NOOP:
        DQ    NOOP+HEADSIZE
        DQ    NOOP+HEADSIZE
        DQ    0x0
        DQ    ENV
        DQ    N_NOOP
        DQ    0
        DQ    0

       LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
; 
;

;  ***********
;  *   LIT   *
;  ***********
;
        ALIGN    8
N_LIT:
        DQ      3
        DB      "LIT"
        ALIGN    8
LIT:
        DQ    LIT+HEADSIZE
        DQ    LIT+HEADSIZE
        DQ    0x0
        DQ    NOOP
        DQ    N_LIT
        DQ    0
        DQ    0

        LODSQ           ; AX <- LITERAL
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ; TO TOP OF STACK
;

;  ***************
;  *   EXECUTE   *
;  ***************
;
        ALIGN    8
N_EXEC:
        DQ      7
        DB      "EXECUTE"
        ALIGN    8
EXEC:
        DQ    EXEC+HEADSIZE
        DQ    EXEC+HEADSIZE
        DQ    0x0
        DQ    LIT
        DQ    N_EXEC
        DQ    0
        DQ    0

        POP     RAX      ; GET XT
        JMP     QWORD[RAX]  ;(IP) <- (PFA)
;


;  ***************
;  *   RECURSE   *
;  ***************
;
        ALIGN    8
N_RECURSE:
        DQ      7
        DB      "RECURSE"
        ALIGN    8
RECURSE:
        DQ    DOCOL
        DQ    RECURSE+HEADSIZE
        DQ    B_IMMED
        DQ    EXEC
        DQ    N_RECURSE
        DQ    0
        DQ    0

        DQ      LATEST, COMMA
        DQ      SEMIS
;
;

;  **************
;  *   BRANCH   *
;  **************
;
        ALIGN    8
N_BRAN:
        DQ      6
        DB      "BRANCH"
        ALIGN    8
BRAN:
        DQ    (SKIP+HEADSIZE)
        DQ    BRAN+HEADSIZE
        DQ    0x0
        DQ    RECURSE
        DQ    N_BRAN
        DQ    0
        DQ    0

;

;  ************
;  *   SKIP   *
;  ************
;
        ALIGN    8
N_SKIP:
        DQ      4
        DB      "SKIP"
        ALIGN    8
SKIP:
        DQ    SKIP+HEADSIZE
        DQ    SKIP+HEADSIZE
        DQ    0x0
        DQ    BRAN
        DQ    N_SKIP
        DQ    0
        DQ    0

BRAN1:  LODSQ

        DEC     RAX
        OR      AL,  8 - 1
        INC     RAX
;
        ADD     RSI,RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***************
;  *   0BRANCH   *
;  ***************
;
        ALIGN    8
N_ZBRAN:
        DQ      7
        DB      "0BRANCH"
        ALIGN    8
ZBRAN:
        DQ    ZBRAN+HEADSIZE
        DQ    ZBRAN+HEADSIZE
        DQ    0x0
        DQ    SKIP
        DQ    N_ZBRAN
        DQ    0
        DQ    0

        POP     RAX      ; GET STACK VALUE
        OR      RAX,RAX   ; ZERO?
        JZ      BRAN1   ; YES, BRANCH
        LEA     RSI,[RSI+(CW*(1))]
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***************
;  *   (+LOOP)   *
;  ***************
;
        ALIGN    8
N_XPLOOP:
        DQ      7
        DB      "(+LOOP)"
        ALIGN    8
XPLOOP:
        DQ    XPLOOP+HEADSIZE
        DQ    XPLOOP+HEADSIZE
        DQ    0x0
        DQ    ZBRAN
        DQ    N_XPLOOP
        DQ    0
        DQ    0

        POP     RBX      ; GET INCREMENT
        ADD     [RBP],RBX ; INDEX = INDEX + INCR
        MOV     RCX,[RBP] ; GET NEW INDEX
        SUB     RCX,[RBP+(CW*(1))]        ; COMPARE WITH LIMIT
        XOR     RCX,RBX   ; compare sign
        SETNS    AL      ;different signs?
        MOVZX   RAX,AL
        NEG     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   

;

;  ************
;  *   (DO)   *
;  ************
;
        ALIGN    8
N_XDO:
        DQ      4
        DB      "(DO)"
        ALIGN    8
XDO:
        DQ    XDO+HEADSIZE
        DQ    XDO+HEADSIZE
        DQ    0x0
        DQ    XPLOOP
        DQ    N_XDO
        DQ    0
        DQ    0

        LODSQ
        ADD     RAX,RSI  ;Make absolute
        POP     RDX      ; INITIAL INDEX VALUE
        POP     RBX      ; LIMIT VALUE
        XCHG    RBP,RSP   ; GET RETURN STACK
        PUSH    RAX      ; Target location.
        PUSH    RBX
        PUSH    RDX
        XCHG    RBP,RSP   ; GET PARAMETER STACK
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   (?DO)   *
;  *************
;
        ALIGN    8
N_XQDO:
        DQ      5
        DB      "(?DO)"
        ALIGN    8
XQDO:
        DQ    XQDO+HEADSIZE
        DQ    XQDO+HEADSIZE
        DQ    0x0
        DQ    XDO
        DQ    N_XQDO
        DQ    0
        DQ    0

        LODSQ
        ADD     RAX,RSI  ;Make absolute
        POP     RDX      ; INITIAL INDEX VALUE
        POP     RBX      ; LIMIT VALUE
        CMP     RDX,RBX
        JGE     QXDO1
        XCHG    RBP,RSP   ; GET RETURN STACK
        PUSH    RAX      ; Target location.
        PUSH    RBX
        PUSH    RDX
        XCHG    RBP,RSP   ; GET PARAMETER STACK
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
QXDO1:  MOV     RSI,RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   I   *
;  *********
;
        ALIGN    8
N_IDO:
        DQ      1
        DB      "I"
        ALIGN    8
IDO:
        DQ    IDO+HEADSIZE
        DQ    IDO+HEADSIZE
        DQ    0x0
        DQ    XQDO
        DQ    N_IDO
        DQ    0
        DQ    0

        MOV     RAX,[RBP] ; GET INDEX VALUE
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ; TO PARAMETER STACK
;

;  *********
;  *   J   *
;  *********
;
        ALIGN    8
N_JDO:
        DQ      1
        DB      "J"
        ALIGN    8
JDO:
        DQ    JDO+HEADSIZE
        DQ    JDO+HEADSIZE
        DQ    0x0
        DQ    IDO
        DQ    N_JDO
        DQ    0
        DQ    0

        MOV     RAX,[RBP+(CW*(3))] ; GET INDEX VALUE
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ; TO PARAMETER STACK
;

;  **************
;  *   UNLOOP   *
;  **************
;
        ALIGN    8
N_UNLOOP:
        DQ      6
        DB      "UNLOOP"
        ALIGN    8
UNLOOP:
        DQ    UNLOOP+HEADSIZE
        DQ    UNLOOP+HEADSIZE
        DQ    0x0
        DQ    JDO
        DQ    N_UNLOOP
        DQ    0
        DQ    0

        LEA     RBP,[RBP+(CW*(3))]
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***************
;  *   +ORIGIN   *
;  ***************
;
        ALIGN    8
N_PORIG:
        DQ      7
        DB      "+ORIGIN"
        ALIGN    8
PORIG:
        DQ    DOCOL
        DQ    PORIG+HEADSIZE
        DQ    0x0
        DQ    UNLOOP
        DQ    N_PORIG
        DQ    0
        DQ    0

        DQ      LIT
        DQ      USINI
        DQ      PLUS
        DQ      SEMIS
;
;      Initialisation block for user variables through DOC-LINK
;       <<<<< must be in same order as user variables >>>>>
; Still fig-compatible! Both entries take two cells.
;
        LEA     RAX,[COLD]
        JMP     QWORD[RAX]          ;Hope stacks are still okay.
        ALIGN    8
; Make it possible to revector WARM. You can even make it low level. 
        LEA     RAX,[WARM]
        JMP     QWORD[RAX]          ;Hope stacks are still okay.
        ALIGN    8
USINI:  DQ      STRUSA   ; user area, copied before use in this threading Forth. ; 
        DQ      STRUSA  ; INIT (U0) user area of the main task 1
        DQ      INITS0  ; INIT (S0)         2
; RSP@ must not be divisible by TASK-SIZE, to serve as user pointer. 
        DQ      INITR0   - (CW*(1)) 
                        ; INIT (R0)         3
        DQ      STRTIB  ; INIT (TIB)        4
        DQ      BSIN    ; RUBOUT: get rid of latest char 5
        DQ      0       ; AVAILABLE         6
        DQ      1       ; INIT (WARNING)     7
        DQ      INITDP  ;      INIT (FENCE)  8
DPA:    DQ      INITDP  ;      INIT (DP)     9
        DQ      ENV ;       INIT (VOC-LINK) 10
        DQ      39+16  ; INIT (MAX-USER) 11
;
;
;
;
        DQ      0, 0            ; WHERE             12 13 
        DQ      0, 0            ;REMAINDER   14 15 
; 
        RB  (US-($ - USINI))         ; All user can be initialised.
;
;      <<<<< end of data used by cold start >>>>>

;  *************
;  *   DIGIT   *
;  *************
;
        ALIGN    8
N_DIGIT:
        DQ      5
        DB      "DIGIT"
        ALIGN    8
DIGIT:
        DQ    DIGIT+HEADSIZE
        DQ    DIGIT+HEADSIZE
        DQ    0x0
        DQ    PORIG
        DQ    N_DIGIT
        DQ    0
        DQ    0

        POP     RDX      ;NUMBER BASE
        POP     RAX      ;ASCII DIGIT
        SUB     AL, '0'
        JB      DIGI2   ;NUMBER ERROR
        CMP     AL, 9
        JBE     DIGI1   ;NUMBER = 0 THRU 9
        SUB     AL, 7
        CMP     AL, 10   ;NUMBER 'A' THRU 'Z'?
        JB      DIGI2   ;NO
DIGI1:  CMP     AL,DL   ; COMPARE NUMBER TO BASE
        JAE     DIGI2   ;NUMBER ERROR
        SUB     RDX,RDX   ;ZERO
        MOV     DL,AL   ;NEW BINARY NUMBER
        MOV     AL, 1    ;TRUE FLAG
        NEG     RAX
        JMP     DIGI3
;   NUMBER ERROR
DIGI2:  SUB     RAX,RAX   ;FALSE FLAG
DIGI3:
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   ~MATCH   *
;  **************
;
        ALIGN    8
N_NMATCH:
        DQ      6
        DB      "~MATCH"
        ALIGN    8
NMATCH:
        DQ    DOCOL
        DQ    NMATCH+HEADSIZE
        DQ    0x0
        DQ    DIGIT
        DQ    N_NMATCH
        DQ    0
        DQ    0

;
        DQ      TOR                           ; Remember dea
        DQ      OVER
        DQ      RR, TNFA, FETCH, SFET
        DQ      CORA
        DQ      FROMR, SWAP                   ; Leave flag on top of dea.
        DQ      SEMIS                            ;
;

;  **************
;  *   ?BLANK   *
;  **************
;
        ALIGN    8
N_QBL:
        DQ      6
        DB      "?BLANK"
        ALIGN    8
QBL:
        DQ    DOCOL
        DQ    QBL+HEADSIZE
        DQ    0x0
        DQ    NMATCH
        DQ    N_QBL
        DQ    0
        DQ    0

        DQ      LBL, ONEP, LESS
        DQ      SEMIS
;

;  ************
;  *   PP@@   *
;  ************
;
        ALIGN    8
N_PPFET:
        DQ      4
        DB      "PP@@"
        ALIGN    8
PPFET:
        DQ    DOCOL
        DQ    PPFET+HEADSIZE
        DQ    0x0
        DQ    QBL
        DQ    N_PPFET
        DQ    0
        DQ    0

        DQ      SRC, CELLP, TFET
        DQ      OVER, EQUAL
        DQ      ZBRAN
        DQ      PPFET1-$-CW
        DQ      ZERO
        DQ      BRAN
        DQ      PPFET2-$-CW
PPFET1:
        DQ      LDUP
        
        DQ      CFET
        DQ      ONE, PP, PSTOR
PPFET2:
        DQ      SEMIS
;

;  ************
;  *   NAME   *
;  ************
;
        ALIGN    8
N_LNAME:
        DQ      4
        DB      "NAME"
        ALIGN    8
LNAME:
        DQ    DOCOL
        DQ    LNAME+HEADSIZE
        DQ    0x0
        DQ    PPFET
        DQ    N_LNAME
        DQ    0
        DQ    0

        DQ      X
PWORD0: DQ      DROP
        DQ      PPFET, QBL
        DQ      OVER, SRC, CELLP, FETCH, LSUB ; At end?
        DQ      LAND, ZEQU
        DQ      ZBRAN
        DQ      PWORD0-$-CW

        DQ      X
PWORD1: DQ      DROP
        DQ      PPFET, QBL
        DQ      ZBRAN
        DQ      PWORD1-$-CW

        DQ      OVER, LSUB
        
        DQ      SEMIS
;

;  *************
;  *   PARSE   *
;  *************
;
        ALIGN    8
N_PARSE:
        DQ      5
        DB      "PARSE"
        ALIGN    8
PARSE:
        DQ    DOCOL
        DQ    PARSE+HEADSIZE
        DQ    0x0
        DQ    LNAME
        DQ    N_PARSE
        DQ    0
        DQ    0

        DQ      SRC, CELLP, TFET
        DQ      OVER, LSUB
        
        DQ      ROT, SSLAS, TSWAP
        DQ      ZEQU
        DQ      ZBRAN
        DQ      PARSE8-$-CW
        DQ      DROP, SRC, CELLP, FETCH
PARSE8: 
        DQ      PP, STOR
        DQ SEMIS
;

;  ***********
;  *   SRC   *
;  ***********
;
        ALIGN    8
N_SRC:
        DQ      3
        DB      "SRC"
        ALIGN    8
SRC:
        DQ    DOUSE
        DQ    (CW*(27))
        DQ    0x0
        DQ    PARSE
        DQ    N_SRC
        DQ    0
        DQ    0
      ; And 28 and 29.
;


;  **************
;  *   SOURCE   *
;  **************
;
        ALIGN    8
N_SOURCE:
        DQ      6
        DB      "SOURCE"
        ALIGN    8
SOURCE:
        DQ    DOCOL
        DQ    SOURCE+HEADSIZE
        DQ    0x0
        DQ    SRC
        DQ    N_SOURCE
        DQ    0
        DQ    0

        DQ      SRC, TFET
        DQ      SWAP, OVER, LSUB
        DQ      SEMIS
;
; 
;

;  **********
;  *   CR   *
;  **********
;
        ALIGN    8
N_CR:
        DQ      2
        DB      "CR"
        ALIGN    8
CR:
        DQ    DOCOL
        DQ    CR+HEADSIZE
        DQ    0x0
        DQ    SOURCE
        DQ    N_CR
        DQ    0
        DQ    0

        DQ      LIT,ALF
        DQ      EMIT
        DQ      ZERO, LOUT, STOR
        DQ      SEMIS
;

;  *************
;  *   CMOVE   *
;  *************
;
        ALIGN    8
N_LCMOVE:
        DQ      5
        DB      "CMOVE"
        ALIGN    8
LCMOVE:
        DQ    LCMOVE+HEADSIZE
        DQ    LCMOVE+HEADSIZE
        DQ    0x0
        DQ    CR
        DQ    N_LCMOVE
        DQ    0
        DQ    0

        CLD             ;direction
        MOV     RBX,RSI   ;save 
        POP     RCX      ;count
        POP     RDI      ;dest
        POP     RSI      ;source
        REP     MOVSB
        MOV     RSI,RBX   ;get back 
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   MOVE   *
;  ************
;
        ALIGN    8
N_LMOVE:
        DQ      4
        DB      "MOVE"
        ALIGN    8
LMOVE:
        DQ    LMOVE+HEADSIZE
        DQ    LMOVE+HEADSIZE
        DQ    0x0
        DQ    LCMOVE
        DQ    N_LMOVE
        DQ    0
        DQ    0

        MOV     RBX,RSI   ;SAVE 
        POP     RCX      ;count
        POP     RDI      ;dest
        POP     RSI      ;source
        CMP     RSI,RDI
        JC    MOVE1
        CLD             ;INC DIRECTION
        JMP SHORT MOVE2
MOVE1:  STD
        ADD     RDI,RCX
        DEC     RDI
        ADD     RSI,RCX
        DEC     RSI
MOVE2:
        REP     MOVSB   ;THAT'S THE MOVE
        CLD             ;INC DIRECTION
        MOV     RSI,RBX   ;GET BACK 
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;

;  ***********
;  *   UM*   *
;  ***********
;
        ALIGN    8
N_USTAR:
        DQ      3
        DB      "UM*"
        ALIGN    8
USTAR:
        DQ    USTAR+HEADSIZE
        DQ    USTAR+HEADSIZE
        DQ    0x0
        DQ    LMOVE
        DQ    N_USTAR
        DQ    0
        DQ    0

        POP     RAX
        POP     RBX
        MUL     RBX      ;UNSIGNED
        XCHG    RAX,RDX   ;AX NOW = MSW
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ;STORE DOUBLE CELL
;

;  **************
;  *   UM/MOD   *
;  **************
;
        ALIGN    8
N_USLAS:
        DQ      6
        DB      "UM/MOD"
        ALIGN    8
USLAS:
        DQ    USLAS+HEADSIZE
        DQ    USLAS+HEADSIZE
        DQ    0x0
        DQ    USTAR
        DQ    N_USLAS
        DQ    0
        DQ    0

        POP     RBX      ;DIVISOR
        POP     RDX      ;MSW OF DIVIDEND
        POP     RAX      ;LSW OF DIVIDEND
        DIV     RBX      ;16 BIT DIVIDE
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ;STORE QUOT/REM
;

;  ***********
;  *   AND   *
;  ***********
;
        ALIGN    8
N_LAND:
        DQ      3
        DB      "AND"
        ALIGN    8
LAND:
        DQ    LAND+HEADSIZE
        DQ    LAND+HEADSIZE
        DQ    0x0
        DQ    USLAS
        DQ    N_LAND
        DQ    0
        DQ    0

        POP     RAX
        POP     RBX
        AND     RAX,RBX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   OR   *
;  **********
;
        ALIGN    8
N_LOR:
        DQ      2
        DB      "OR"
        ALIGN    8
LOR:
        DQ    LOR+HEADSIZE
        DQ    LOR+HEADSIZE
        DQ    0x0
        DQ    LAND
        DQ    N_LOR
        DQ    0
        DQ    0

        POP     RAX      ; (S1) <- (S1) OR (S2)
        POP     RBX
        OR      RAX,RBX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   XOR   *
;  ***********
;
        ALIGN    8
N_LXOR:
        DQ      3
        DB      "XOR"
        ALIGN    8
LXOR:
        DQ    LXOR+HEADSIZE
        DQ    LXOR+HEADSIZE
        DQ    0x0
        DQ    LOR
        DQ    N_LXOR
        DQ    0
        DQ    0

        POP     RAX      ; (S1) <- (S1) XOR (S2)
        POP     RBX
        XOR     RAX,RBX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   INVERT   *
;  **************
;
        ALIGN    8
N_INVERT:
        DQ      6
        DB      "INVERT"
        ALIGN    8
INVERT:
        DQ    INVERT+HEADSIZE
        DQ    INVERT+HEADSIZE
        DQ    0x0
        DQ    LXOR
        DQ    N_INVERT
        DQ    0
        DQ    0

        POP     RAX      ; (S1) <- (S1) XOR (S2)
        NOT     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   DSP@   *
;  ************
;
        ALIGN    8
N_SPFET:
        DQ      4
        DB      "DSP@"
        ALIGN    8
SPFET:
        DQ    SPFET+HEADSIZE
        DQ    SPFET+HEADSIZE
        DQ    0x0
        DQ    INVERT
        DQ    N_SPFET
        DQ    0
        DQ    0

        MOV     RAX,RSP   ; (S1) <- (SP)
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   DSP!   *
;  ************
;
        ALIGN    8
N_SPSTO:
        DQ      4
        DB      "DSP!"
        ALIGN    8
SPSTO:
        DQ    SPSTO+HEADSIZE
        DQ    SPSTO+HEADSIZE
        DQ    0x0
        DQ    SPFET
        DQ    N_SPSTO
        DQ    0
        DQ    0

        POP     RAX
        MOV     RSP,RAX        ;RESET PARAM STACK POINTER
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   DEPTH   *
;  *************
;
        ALIGN    8
N_DEPTH:
        DQ      5
        DB      "DEPTH"
        ALIGN    8
DEPTH:
        DQ    DOCOL
        DQ    DEPTH+HEADSIZE
        DQ    0x0
        DQ    SPSTO
        DQ    N_DEPTH
        DQ    0
        DQ    0

        DQ      SZERO, FETCH
        DQ      SPFET
        DQ      LSUB
        DQ      LIT, CW, SLASH
        DQ      ONEM
        DQ      SEMIS
;

;  ***********
;  *   CLS   *
;  ***********
;
        ALIGN    8
N_CLS:
        DQ      3
        DB      "CLS"
        ALIGN    8
CLS:
        DQ    DOCOL
        DQ    CLS+HEADSIZE
        DQ    0x0
        DQ    DEPTH
        DQ    N_CLS
        DQ    0
        DQ    0

        DQ      SZERO, FETCH
        DQ      SPSTO
        DQ      SEMIS
;

;  ************
;  *   RSP@   *
;  ************
;
        ALIGN    8
N_RPFET:
        DQ      4
        DB      "RSP@"
        ALIGN    8
RPFET:
        DQ    RPFET+HEADSIZE
        DQ    RPFET+HEADSIZE
        DQ    0x0
        DQ    CLS
        DQ    N_RPFET
        DQ    0
        DQ    0
      ;(S1) <- (RP)
        PUSH    RBP
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   RSP!   *
;  ************
;
        ALIGN    8
N_RPSTO:
        DQ      4
        DB      "RSP!"
        ALIGN    8
RPSTO:
        DQ    RPSTO+HEADSIZE
        DQ    RPSTO+HEADSIZE
        DQ    0x0
        DQ    RPFET
        DQ    N_RPSTO
        DQ    0
        DQ    0

        POP     RBP
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   EXIT   *
;  ************
;
        ALIGN    8
N_EXIT:
        DQ      4
        DB      "EXIT"
        ALIGN    8
EXIT:
        DQ    EXIT+HEADSIZE
        DQ    EXIT+HEADSIZE
        DQ    0x0
        DQ    RPSTO
        DQ    N_EXIT
        DQ    0
        DQ    0

        MOV     RSI,[RBP] ;(IP) <- (R1)
        LEA     RBP,[RBP+(CW*(1))]
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   CO   *
;  **********
;
        ALIGN    8
N_CO:
        DQ      2
        DB      "CO"
        ALIGN    8
CO:
        DQ    CO+HEADSIZE
        DQ    CO+HEADSIZE
        DQ    0x0
        DQ    EXIT
        DQ    N_CO
        DQ    0
        DQ    0

        XCHG    RSI,[RBP]
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   (;)   *
;  ***********
;
        ALIGN    8
N_SEMIS:
        DQ      3
        DB      "(;)"
        ALIGN    8
SEMIS:
        DQ    (EXIT+HEADSIZE)
        DQ    SEMIS+HEADSIZE
        DQ    0x0
        DQ    CO
        DQ    N_SEMIS
        DQ    0
        DQ    0

;

;  *************
;  *   LEAVE   *
;  *************
;
        ALIGN    8
N_LLEAV:
        DQ      5
        DB      "LEAVE"
        ALIGN    8
LLEAV:
        DQ    DOCOL
        DQ    LLEAV+HEADSIZE
        DQ    0x0
        DQ    SEMIS
        DQ    N_LLEAV
        DQ    0
        DQ    0
  ;LIMIT <- INDEX
        DQ      UNLOOP
        DQ      SEMIS
;

;  **********
;  *   >R   *
;  **********
;
        ALIGN    8
N_TOR:
        DQ      2
        DB      ">R"
        ALIGN    8
TOR:
        DQ    TOR+HEADSIZE
        DQ    TOR+HEADSIZE
        DQ    0x0
        DQ    LLEAV
        DQ    N_TOR
        DQ    0
        DQ    0
        ; (R1) <- (S1)
        POP     RBX      ;GET STACK PARAMETER
        LEA     RBP,[RBP - (CW*(1))]    ;MOVE RETURN STACK DOWN
        MOV     [RBP],RBX ;ADD TO RETURN STACK
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   R>   *
;  **********
;
        ALIGN    8
N_FROMR:
        DQ      2
        DB      "R>"
        ALIGN    8
FROMR:
        DQ    FROMR+HEADSIZE
        DQ    FROMR+HEADSIZE
        DQ    0x0
        DQ    TOR
        DQ    N_FROMR
        DQ    0
        DQ    0
      ;(S1) <- (R1)
        MOV     RAX,[RBP] ; GET RETURN STACK VALUE
        LEA     RBP,[RBP + (CW*(1))]
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   RDROP   *
;  *************
;
        ALIGN    8
N_RDROP:
        DQ      5
        DB      "RDROP"
        ALIGN    8
RDROP:
        DQ    RDROP+HEADSIZE
        DQ    RDROP+HEADSIZE
        DQ    0x0
        DQ    FROMR
        DQ    N_RDROP
        DQ    0
        DQ    0
      ;(S1) <- (R1)
        LEA     RBP,[RBP+(CW*(1))]
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   R@   *
;  **********
;
        ALIGN    8
N_RR:
        DQ      2
        DB      "R@"
        ALIGN    8
RR:
        DQ    (IDO+HEADSIZE)
        DQ    RR+HEADSIZE
        DQ    0x0
        DQ    RDROP
        DQ    N_RR
        DQ    0
        DQ    0

;

;  **********
;  *   0=   *
;  **********
;
        ALIGN    8
N_ZEQU:
        DQ      2
        DB      "0="
        ALIGN    8
ZEQU:
        DQ    ZEQU+HEADSIZE
        DQ    ZEQU+HEADSIZE
        DQ    0x0
        DQ    RR
        DQ    N_ZEQU
        DQ    0
        DQ    0

        POP     RAX      ;S2
        AND     RAX,RAX
        SETZ    AL
        MOVZX   RAX,AL
        NEG     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
        POP     RAX
;

;  **********
;  *   0<   *
;  **********
;
        ALIGN    8
N_ZLESS:
        DQ      2
        DB      "0<"
        ALIGN    8
ZLESS:
        DQ    ZLESS+HEADSIZE
        DQ    ZLESS+HEADSIZE
        DQ    0x0
        DQ    ZEQU
        DQ    N_ZLESS
        DQ    0
        DQ    0

        POP     RAX
        AND     RAX,RAX
        SETS    AL
        MOVZX   RAX,AL
        NEG     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   +   *
;  *********
;
        ALIGN    8
N_PLUS:
        DQ      1
        DB      "+"
        ALIGN    8
PLUS:
        DQ    PLUS+HEADSIZE
        DQ    PLUS+HEADSIZE
        DQ    0x0
        DQ    ZLESS
        DQ    N_PLUS
        DQ    0
        DQ    0

        POP     RAX      ;(S1) <- (S1) + (S2)
        POP     RBX
        ADD     RAX,RBX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   D+   *
;  **********
;
        ALIGN    8
N_DPLUS:
        DQ      2
        DB      "D+"
        ALIGN    8
DPLUS:
        DQ    DPLUS+HEADSIZE
        DQ    DPLUS+HEADSIZE
        DQ    0x0
        DQ    PLUS
        DQ    N_DPLUS
        DQ    0
        DQ    0

        POP     RAX      ; YHC
        POP     RDX      ; YLC
        POP     RBX      ; XHC
        POP     RCX      ; XLC
        ADD     RDX,RCX   ; SLC
        ADC     RAX,RBX   ; SHC
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   NEGATE   *
;  **************
;
        ALIGN    8
N_NEGATE:
        DQ      6
        DB      "NEGATE"
        ALIGN    8
NEGATE:
        DQ    NEGATE+HEADSIZE
        DQ    NEGATE+HEADSIZE
        DQ    0x0
        DQ    DPLUS
        DQ    N_NEGATE
        DQ    0
        DQ    0

        POP     RAX
        NEG     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***************
;  *   DNEGATE   *
;  ***************
;
        ALIGN    8
N_DNEGA:
        DQ      7
        DB      "DNEGATE"
        ALIGN    8
DNEGA:
        DQ    DNEGA+HEADSIZE
        DQ    DNEGA+HEADSIZE
        DQ    0x0
        DQ    NEGATE
        DQ    N_DNEGA
        DQ    0
        DQ    0

        POP     RBX
        POP     RCX
        SUB     RAX,RAX
        MOV     RDX,RAX
        SUB     RDX,RCX   ; MAKE 2'S COMPLEMENT
        SBB     RAX,RBX   ; HIGH CELL
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
        ;
;

;  ************
;  *   OVER   *
;  ************
;
        ALIGN    8
N_OVER:
        DQ      4
        DB      "OVER"
        ALIGN    8
OVER:
        DQ    OVER+HEADSIZE
        DQ    OVER+HEADSIZE
        DQ    0x0
        DQ    DNEGA
        DQ    N_OVER
        DQ    0
        DQ    0

        POP     RDX
        POP     RAX
        PUSH    RAX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   DROP   *
;  ************
;
        ALIGN    8
N_DROP:
        DQ      4
        DB      "DROP"
        ALIGN    8
DROP:
        DQ    DROP+HEADSIZE
        DQ    DROP+HEADSIZE
        DQ    0x0
        DQ    OVER
        DQ    N_DROP
        DQ    0
        DQ    0

        POP     RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   NIP   *
;  ***********
;
        ALIGN    8
N_NIP:
        DQ      3
        DB      "NIP"
        ALIGN    8
NIP:
        DQ    NIP+HEADSIZE
        DQ    NIP+HEADSIZE
        DQ    0x0
        DQ    DROP
        DQ    N_NIP
        DQ    0
        DQ    0

        POP     RAX
        POP     RBX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   2DROP   *
;  *************
;
        ALIGN    8
N_TDROP:
        DQ      5
        DB      "2DROP"
        ALIGN    8
TDROP:
        DQ    TDROP+HEADSIZE
        DQ    TDROP+HEADSIZE
        DQ    0x0
        DQ    NIP
        DQ    N_TDROP
        DQ    0
        DQ    0

        POP     RAX
        POP     RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   SWAP   *
;  ************
;
        ALIGN    8
N_SWAP:
        DQ      4
        DB      "SWAP"
        ALIGN    8
SWAP:
        DQ    SWAP+HEADSIZE
        DQ    SWAP+HEADSIZE
        DQ    0x0
        DQ    TDROP
        DQ    N_SWAP
        DQ    0
        DQ    0

        POP     RDX
        POP     RAX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   DUP   *
;  ***********
;
        ALIGN    8
N_LDUP:
        DQ      3
        DB      "DUP"
        ALIGN    8
LDUP:
        DQ    LDUP+HEADSIZE
        DQ    LDUP+HEADSIZE
        DQ    0x0
        DQ    SWAP
        DQ    N_LDUP
        DQ    0
        DQ    0

        POP     RAX
        PUSH    RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   2DUP   *
;  ************
;
        ALIGN    8
N_TDUP:
        DQ      4
        DB      "2DUP"
        ALIGN    8
TDUP:
        DQ    TDUP+HEADSIZE
        DQ    TDUP+HEADSIZE
        DQ    0x0
        DQ    LDUP
        DQ    N_TDUP
        DQ    0
        DQ    0

        POP     RAX
        POP     RDX
        PUSH    RDX
        PUSH    RAX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   2SWAP   *
;  *************
;
        ALIGN    8
N_TSWAP:
        DQ      5
        DB      "2SWAP"
        ALIGN    8
TSWAP:
        DQ    TSWAP+HEADSIZE
        DQ    TSWAP+HEADSIZE
        DQ    0x0
        DQ    TDUP
        DQ    N_TSWAP
        DQ    0
        DQ    0

        POP     RBX
        POP     RCX
        POP     RAX
        POP     RDX
        PUSH     RCX
        PUSH     RBX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   2OVER   *
;  *************
;
        ALIGN    8
N_TOVER:
        DQ      5
        DB      "2OVER"
        ALIGN    8
TOVER:
        DQ    TOVER+HEADSIZE
        DQ    TOVER+HEADSIZE
        DQ    0x0
        DQ    TSWAP
        DQ    N_TOVER
        DQ    0
        DQ    0

        POP     RBX
        POP     RCX
        POP     RAX
        POP     RDX
        PUSH     RDX
        PUSH     RAX
        PUSH     RCX
        PUSH     RBX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   +!   *
;  **********
;
        ALIGN    8
N_PSTOR:
        DQ      2
        DB      "+!"
        ALIGN    8
PSTOR:
        DQ    PSTOR+HEADSIZE
        DQ    PSTOR+HEADSIZE
        DQ    0x0
        DQ    TOVER
        DQ    N_PSTOR
        DQ    0
        DQ    0

        POP     RBX      ;ADDRESS
        POP     RAX      ;INCREMENT
        ADD     [RBX],RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   TOGGLE   *
;  **************
;
        ALIGN    8
N_TOGGL:
        DQ      6
        DB      "TOGGLE"
        ALIGN    8
TOGGL:
        DQ    TOGGL+HEADSIZE
        DQ    TOGGL+HEADSIZE
        DQ    0x0
        DQ    PSTOR
        DQ    N_TOGGL
        DQ    0
        DQ    0

        POP     RAX      ;BIT PATTERN
        POP     RBX      ;ADDR
        XOR     [RBX],RAX ;
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   @   *
;  *********
;
        ALIGN    8
N_FETCH:
        DQ      1
        DB      "@"
        ALIGN    8
FETCH:
        DQ    FETCH+HEADSIZE
        DQ    FETCH+HEADSIZE
        DQ    0x0
        DQ    TOGGL
        DQ    N_FETCH
        DQ    0
        DQ    0

        POP     RBX
        MOV     RAX,[RBX]
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;


;  **********
;  *   L@   *
;  **********
;
        ALIGN    8
N_LFETCH:
        DQ      2
        DB      "L@"
        ALIGN    8
LFETCH:
        DQ    LFETCH+HEADSIZE
        DQ    LFETCH+HEADSIZE
        DQ    0x0
        DQ    FETCH
        DQ    N_LFETCH
        DQ    0
        DQ    0

        POP     RBX
        XOR     RAX,RAX
        MOV     EAX,[RBX]
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;

;  **********
;  *   C@   *
;  **********
;
        ALIGN    8
N_CFET:
        DQ      2
        DB      "C@"
        ALIGN    8
CFET:
        DQ    CFET+HEADSIZE
        DQ    CFET+HEADSIZE
        DQ    0x0
        DQ    LFETCH
        DQ    N_CFET
        DQ    0
        DQ    0

        POP     RBX
        XOR     RAX,RAX
        MOV     AL,[RBX]
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   2@   *
;  **********
;
        ALIGN    8
N_TFET:
        DQ      2
        DB      "2@"
        ALIGN    8
TFET:
        DQ    TFET+HEADSIZE
        DQ    TFET+HEADSIZE
        DQ    0x0
        DQ    CFET
        DQ    N_TFET
        DQ    0
        DQ    0

        POP     RBX      ;ADDR
        MOV     RAX,[RBX] ;MSW
        MOV     RDX,[RBX+(CW*(1))]        ;LSW
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   !   *
;  *********
;
        ALIGN    8
N_STOR:
        DQ      1
        DB      "!"
        ALIGN    8
STOR:
        DQ    STOR+HEADSIZE
        DQ    STOR+HEADSIZE
        DQ    0x0
        DQ    TFET
        DQ    N_STOR
        DQ    0
        DQ    0

        POP     RBX      ;ADDR
        POP     RAX      ;DATA
        MOV     [RBX],RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;


;  **********
;  *   L!   *
;  **********
;
        ALIGN    8
N_LSTOR:
        DQ      2
        DB      "L!"
        ALIGN    8
LSTOR:
        DQ    LSTOR+HEADSIZE
        DQ    LSTOR+HEADSIZE
        DQ    0x0
        DQ    STOR
        DQ    N_LSTOR
        DQ    0
        DQ    0

        POP     RBX      ;ADDR
        POP     RAX      ;DATA
        MOV     [RBX],EAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;

;  **********
;  *   C!   *
;  **********
;
        ALIGN    8
N_CSTOR:
        DQ      2
        DB      "C!"
        ALIGN    8
CSTOR:
        DQ    CSTOR+HEADSIZE
        DQ    CSTOR+HEADSIZE
        DQ    0x0
        DQ    LSTOR
        DQ    N_CSTOR
        DQ    0
        DQ    0

        POP     RBX      ;ADDR
        POP     RAX      ;DATA
        MOV     [RBX],AL
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   2!   *
;  **********
;
        ALIGN    8
N_TSTOR:
        DQ      2
        DB      "2!"
        ALIGN    8
TSTOR:
        DQ    TSTOR+HEADSIZE
        DQ    TSTOR+HEADSIZE
        DQ    0x0
        DQ    CSTOR
        DQ    N_TSTOR
        DQ    0
        DQ    0

        POP     RBX      ;ADDR
        POP     RAX      ;MSW
        MOV     [RBX],RAX
        POP     RAX      ;LSW
        MOV     [RBX+(CW*(1))],RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   WITHIN   *
;  **************
;
        ALIGN    8
N_WITHIN:
        DQ      6
        DB      "WITHIN"
        ALIGN    8
WITHIN:
        DQ    DOCOL
        DQ    WITHIN+HEADSIZE
        DQ    0x0
        DQ    TSTOR
        DQ    N_WITHIN
        DQ    0
        DQ    0

        DQ      OVER, LSUB, TOR
        DQ      LSUB, FROMR
        DQ      ULESS
        DQ      SEMIS
;
;
;

;  *********
;  *   :   *
;  *********
;
        ALIGN    8
N_COLON:
        DQ      1
        DB      ":"
        ALIGN    8
COLON:
        DQ    DOCOL
        DQ    COLON+HEADSIZE
        DQ    0x0
        DQ    WITHIN
        DQ    N_COLON
        DQ    0
        DQ    0

        DQ      SCSP
        DQ      LNAME
        DQ      PCREAT
        DQ      LATEST, HIDDEN
        DQ      RBRAC
        DQ      PSCOD
DOCOL:  LEA     RBP,[RBP - (CW*(1))]  ;Push HIP
        MOV     [RBP],RSI ;R1 <- (IP)
         MOV     RSI,[RAX+(CW*(D_HOFFSET - C_HOFFSET))]  ;(IP) <- (PFA)
;        CALL    DISPLAYSI
; 
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   ;   *
;  *********
;
        ALIGN    8
N_SEMI:
        DQ      1
        DB      ";"
        ALIGN    8
SEMI:
        DQ    DOCOL
        DQ    SEMI+HEADSIZE
        DQ    B_IMMED
        DQ    COLON
        DQ    N_SEMI
        DQ    0
        DQ    0

        DQ      QCSP
        DQ      LIT, SEMIS, COMMA
        DQ      LATEST, HIDDEN
        DQ      LBRAC
        DQ      SEMIS
;

;  ****************
;  *   CONSTANT   *
;  ****************
;
        ALIGN    8
N_LCONST:
        DQ      8
        DB      "CONSTANT"
        ALIGN    8
LCONST:
        DQ    DOCOL
        DQ    LCONST+HEADSIZE
        DQ    0x0
        DQ    SEMI
        DQ    N_LCONST
        DQ    0
        DQ    0

        DQ      LNAME
        DQ      PCREAT
        DQ      LATEST, TDFA, STOR
        DQ      PSCOD
DOCON:  MOV     RAX,[RAX+(CW*((D_HOFFSET)))] ;GET DATA FROM PFA
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ****************
;  *   VARIABLE   *
;  ****************
;
        ALIGN    8
N_VAR:
        DQ      8
        DB      "VARIABLE"
        ALIGN    8
VAR:
        DQ    DOCOL
        DQ    VAR+HEADSIZE
        DQ    0x0
        DQ    LCONST
        DQ    N_VAR
        DQ    0
        DQ    0

        DQ      LDATA
        DQ      ZERO, COMMA
        DQ      SEMIS
;

;  ************
;  *   DATA   *
;  ************
;
        ALIGN    8
N_LDATA:
        DQ      4
        DB      "DATA"
        ALIGN    8
LDATA:
        DQ    DOCOL
        DQ    LDATA+HEADSIZE
        DQ    0x0
        DQ    VAR
        DQ    N_LDATA
        DQ    0
        DQ    0

        DQ      LNAME
        DQ      PCREAT
        DQ      PSCOD
DOVAR:  MOV     RAX,[RAX+(CW*((D_HOFFSET)))] ;(AX) <- PFA
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   USER   *
;  ************
;
        ALIGN    8
N_USER:
        DQ      4
        DB      "USER"
        ALIGN    8
USER:
        DQ    DOCOL
        DQ    USER+HEADSIZE
        DQ    0x0
        DQ    LDATA
        DQ    N_USER
        DQ    0
        DQ    0

        DQ      LCONST
        DQ      PSCOD
DOUSE:  MOV     RBX,[RAX+(CW*((D_HOFFSET)))] ;PFA  
       MOV     RAX, RBP
        OR      RAX,  STACKSIZE-1  ;Requires it is power of 2.
        INC     RAX
         ADD     RAX,RBX      ;ADDR OF VARIABLE
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;
;

;  *********
;  *   _   *
;  *********
;
        ALIGN    8
N_X:
        DQ      1
        DB      "_"
        ALIGN    8
X:
        DQ    X+HEADSIZE
        DQ    X+HEADSIZE
        DQ    0x0
        DQ    USER
        DQ    N_X
        DQ    0
        DQ    0

        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]    ;Whatever happens to be in RAX, i.e. the dea of ``_''.
;

;  *********
;  *   0   *
;  *********
;
        ALIGN    8
N_ZERO:
        DQ      1
        DB      "0"
        ALIGN    8
ZERO:
        DQ    DOCON
        DQ    0
        DQ    0x0
        DQ    X
        DQ    N_ZERO
        DQ    0
        DQ    0

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

;  *********
;  *   1   *
;  *********
;
        ALIGN    8
N_ONE:
        DQ      1
        DB      "1"
        ALIGN    8
ONE:
        DQ    DOCON
        DQ    1
        DQ    0x0
        DQ    ZERO
        DQ    N_ONE
        DQ    0
        DQ    0

;

;  *********
;  *   2   *
;  *********
;
        ALIGN    8
N_TWO:
        DQ      1
        DB      "2"
        ALIGN    8
TWO:
        DQ    DOCON
        DQ    2
        DQ    0x0
        DQ    ONE
        DQ    N_TWO
        DQ    0
        DQ    0

;

;  **********
;  *   BL   *
;  **********
;
        ALIGN    8
N_LBL:
        DQ      2
        DB      "BL"
        ALIGN    8
LBL:
        DQ    DOCON
        DQ    ABL
        DQ    0x0
        DQ    TWO
        DQ    N_LBL
        DQ    0
        DQ    0

;

;
;  **********
;  *   $@   *
;  **********
;
        ALIGN    8
N_SFET:
        DQ      2
        DB      "$@"
        ALIGN    8
SFET:
        DQ    SFET+HEADSIZE
        DQ    SFET+HEADSIZE
        DQ    0x0
        DQ    LBL
        DQ    N_SFET
        DQ    0
        DQ    0

        POP   RBX
        MOV   RAX,[RBX]
        LEA   RDX, [RBX+(CW*(1))]
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   $!   *
;  **********
;
        ALIGN    8
N_SSTOR:
        DQ      2
        DB      "$!"
        ALIGN    8
SSTOR:
        DQ    DOCOL
        DQ    SSTOR+HEADSIZE
        DQ    0x0
        DQ    SFET
        DQ    N_SSTOR
        DQ    0
        DQ    0

        DQ TDUP, STOR, CELLP, SWAP, LMOVE
        DQ SEMIS
;

; 

;  ***********
;  *   $+!   *
;  ***********
;
        ALIGN    8
N_SADD:
        DQ      3
        DB      "$+!"
        ALIGN    8
SADD:
        DQ    DOCOL
        DQ    SADD+HEADSIZE
        DQ    0x0
        DQ    SSTOR
        DQ    N_SADD
        DQ    0
        DQ    0

        DQ   LDUP, FETCH, TOR ; Remember old count.
        DQ   TDUP, PSTOR
        DQ   CELLP, FROMR, PLUS, SWAP, LMOVE
        DQ SEMIS
;

;  ***********
;  *   $C+   *
;  ***********
;
        ALIGN    8
N_CHAPP:
        DQ      3
        DB      "$C+"
        ALIGN    8
CHAPP:
        DQ    DOCOL
        DQ    CHAPP+HEADSIZE
        DQ    0x0
        DQ    SADD
        DQ    N_CHAPP
        DQ    0
        DQ    0

        DQ   LDUP, TOR
        DQ   LDUP, FETCH, PLUS, CELLP, CSTOR
        DQ   ONE, FROMR, PSTOR
        DQ SEMIS
;

;  **********
;  *   $,   *
;  **********
;
        ALIGN    8
N_SCOMMA:
        DQ      2
        DB      "$,"
        ALIGN    8
SCOMMA:
        DQ    DOCOL
        DQ    SCOMMA+HEADSIZE
        DQ    0x0
        DQ    CHAPP
        DQ    N_SCOMMA
        DQ    0
        DQ    0

        DQ HERE, TOR
        DQ LDUP, CELLP, ALLOT
        DQ RR, SSTOR, FROMR
 DQ LALIGN
        DQ SEMIS
;

;  ***********
;  *   C/L   *
;  ***********
;
        ALIGN    8
N_CSLL:
        DQ      3
        DB      "C/L"
        ALIGN    8
CSLL:
        DQ    DOCON
        DQ    64
        DQ    0x0
        DQ    SCOMMA
        DQ    N_CSLL
        DQ    0
        DQ    0

;


;  **************
;  *   _FIRST   *
;  **************
;
        ALIGN    8
N__FIRST:
        DQ      6
        DB      "_FIRST"
        ALIGN    8
_FIRST:
        DQ    DOCON
        DQ    BUF1
        DQ    0x0
        DQ    CSLL
        DQ    N__FIRST
        DQ    0
        DQ    0

 ;  
;
; 
;

;  **************
;  *   _LIMIT   *
;  **************
;
        ALIGN    8
N__LIMIT:
        DQ      6
        DB      "_LIMIT"
        ALIGN    8
_LIMIT:
        DQ    DOCON
        DQ    BUF1+(KBBUF+2*CW)*NBUF
        DQ    0x0
        DQ    _FIRST
        DQ    N__LIMIT
        DQ    0
        DQ    0

; THE END  OF THE MEMORY 

;  **********
;  *   EM   *
;  **********
;
        ALIGN    8
N_LEM:
        DQ      2
        DB      "EM"
        ALIGN    8
LEM:
        DQ    DOCON
        DQ    ACTUAL_EM
        DQ    0x0
        DQ    _LIMIT
        DQ    N_LEM
        DQ    0
        DQ    0

;

;  **********
;  *   BM   *
;  **********
;
        ALIGN    8
N_LBM:
        DQ      2
        DB      "BM"
        ALIGN    8
LBM:
        DQ    DOCON
        DQ    _ORIG
        DQ    0x0
        DQ    LEM
        DQ    N_LBM
        DQ    0
        DQ    0

;


;  *****************
;  *   TASK-SIZE   *
;  *****************
;
        ALIGN    8
N_LTAS:
        DQ      9
        DB      "TASK-SIZE"
        ALIGN    8
LTAS:
        DQ    DOCON
        DQ    TAS
        DQ    0x0
        DQ    LBM
        DQ    N_LTAS
        DQ    0
        DQ    0

;
 
;  *************
;  *   B/BUF   *
;  *************
;
        ALIGN    8
N_BBUF:
        DQ      5
        DB      "B/BUF"
        ALIGN    8
BBUF:
        DQ    DOCON
        DQ    KBBUF
        DQ    0x0
        DQ    LTAS
        DQ    N_BBUF
        DQ    0
        DQ    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   *
;  **********
;
        ALIGN    8
N_UZERO:
        DQ      2
        DB      "U0"
        ALIGN    8
UZERO:
        DQ    DOUSE
        DQ    (CW*(1))
        DQ    0x0
        DQ    BBUF
        DQ    N_UZERO
        DQ    0
        DQ    0

;

;  **********
;  *   S0   *
;  **********
;
        ALIGN    8
N_SZERO:
        DQ      2
        DB      "S0"
        ALIGN    8
SZERO:
        DQ    DOUSE
        DQ    (CW*(2))
        DQ    0x0
        DQ    UZERO
        DQ    N_SZERO
        DQ    0
        DQ    0

;

;  **********
;  *   R0   *
;  **********
;
        ALIGN    8
N_RZERO:
        DQ      2
        DB      "R0"
        ALIGN    8
RZERO:
        DQ    DOUSE
        DQ    (CW*(3))
        DQ    0x0
        DQ    SZERO
        DQ    N_RZERO
        DQ    0
        DQ    0

;

;  ***********
;  *   TIB   *
;  ***********
;
        ALIGN    8
N_TIB:
        DQ      3
        DB      "TIB"
        ALIGN    8
TIB:
        DQ    DOUSE
        DQ    (CW*(4))
        DQ    0x0
        DQ    RZERO
        DQ    N_TIB
        DQ    0
        DQ    0

;

;  **************
;  *   RUBOUT   *
;  **************
;
        ALIGN    8
N_RUBOUT:
        DQ      6
        DB      "RUBOUT"
        ALIGN    8
RUBOUT:
        DQ    DOUSE
        DQ    (CW*(5))
        DQ    0x0
        DQ    TIB
        DQ    N_RUBOUT
        DQ    0
        DQ    0

;

;  ***************
;  *   WARNING   *
;  ***************
;
        ALIGN    8
N_LWARN:
        DQ      7
        DB      "WARNING"
        ALIGN    8
LWARN:
        DQ    DOUSE
        DQ    (CW*(7))
        DQ    0x0
        DQ    RUBOUT
        DQ    N_LWARN
        DQ    0
        DQ    0

;

;  *************
;  *   FENCE   *
;  *************
;
        ALIGN    8
N_FENCE:
        DQ      5
        DB      "FENCE"
        ALIGN    8
FENCE:
        DQ    DOUSE
        DQ    (CW*(8))
        DQ    0x0
        DQ    LWARN
        DQ    N_FENCE
        DQ    0
        DQ    0

;

;  **********
;  *   DP   *
;  **********
;
        ALIGN    8
N_LDP:
        DQ      2
        DB      "DP"
        ALIGN    8
LDP:
        DQ    DOUSE
        DQ    (CW*(9))
        DQ    0x0
        DQ    FENCE
        DQ    N_LDP
        DQ    0
        DQ    0

;

;  ****************
;  *   VOC-LINK   *
;  ****************
;
        ALIGN    8
N_VOCL:
        DQ      8
        DB      "VOC-LINK"
        ALIGN    8
VOCL:
        DQ    DOUSE
        DQ    (CW*(10))
        DQ    0x0
        DQ    LDP
        DQ    N_VOCL
        DQ    0
        DQ    0

;

;  ****************
;  *   MAX-USER   *
;  ****************
;
        ALIGN    8
N_MAXUSER:
        DQ      8
        DB      "MAX-USER"
        ALIGN    8
MAXUSER:
        DQ    DOUSE
        DQ    (CW*(11))
        DQ    0x0
        DQ    VOCL
        DQ    N_MAXUSER
        DQ    0
        DQ    0

;
;
;

;  *************
;  *   WHERE   *
;  *************
;
        ALIGN    8
N_LWHERE:
        DQ      5
        DB      "WHERE"
        ALIGN    8
LWHERE:
        DQ    DOUSE
        DQ    (CW*(12))
        DQ    0x0
        DQ    MAXUSER
        DQ    N_LWHERE
        DQ    0
        DQ    0
    ;  Occupies two CELLS! 
;

;  ***********
;  *   SCR   *
;  ***********
;
        ALIGN    8
N_SCR:
        DQ      3
        DB      "SCR"
        ALIGN    8
SCR:
        DQ    DOUSE
        DQ    (CW*(33))
        DQ    0x0
        DQ    LWHERE
        DQ    N_SCR
        DQ    0
        DQ    0

;

;  *************
;  *   STATE   *
;  *************
;
        ALIGN    8
N_STATE:
        DQ      5
        DB      "STATE"
        ALIGN    8
STATE:
        DQ    DOUSE
        DQ    (CW*(18))
        DQ    0x0
        DQ    SCR
        DQ    N_STATE
        DQ    0
        DQ    0

;

;  ************
;  *   BASE   *
;  ************
;
        ALIGN    8
N_BASE:
        DQ      4
        DB      "BASE"
        ALIGN    8
BASE:
        DQ    DOUSE
        DQ    (CW*(19))
        DQ    0x0
        DQ    STATE
        DQ    N_BASE
        DQ    0
        DQ    0

;

;  ***********
;  *   DPL   *
;  ***********
;
        ALIGN    8
N_DPL:
        DQ      3
        DB      "DPL"
        ALIGN    8
DPL:
        DQ    DOUSE
        DQ    (CW*(20))
        DQ    0x0
        DQ    BASE
        DQ    N_DPL
        DQ    0
        DQ    0

;

;  ***********
;  *   ECL   *
;  ***********
;
        ALIGN    8
N_ECL:
        DQ      3
        DB      "ECL"
        ALIGN    8
ECL:
        DQ    DOUSE
        DQ    (CW*(38))
        DQ    0x0
        DQ    DPL
        DQ    N_ECL
        DQ    0
        DQ    0

;

;  ***********
;  *   FLD   *
;  ***********
;
        ALIGN    8
N_LFLD:
        DQ      3
        DB      "FLD"
        ALIGN    8
LFLD:
        DQ    DOUSE
        DQ    (CW*(21))
        DQ    0x0
        DQ    ECL
        DQ    N_LFLD
        DQ    0
        DQ    0

;


;  ***********
;  *   CSP   *
;  ***********
;
        ALIGN    8
N_LCSP:
        DQ      3
        DB      "CSP"
        ALIGN    8
LCSP:
        DQ    DOUSE
        DQ    (CW*(22))
        DQ    0x0
        DQ    LFLD
        DQ    N_LCSP
        DQ    0
        DQ    0

;
;

;  **********
;  *   R#   *
;  **********
;
        ALIGN    8
N_RNUM:
        DQ      2
        DB      "R#"
        ALIGN    8
RNUM:
        DQ    DOUSE
        DQ    (CW*(23))
        DQ    0x0
        DQ    LCSP
        DQ    N_RNUM
        DQ    0
        DQ    0

;

;  ***********
;  *   HLD   *
;  ***********
;
        ALIGN    8
N_HLD:
        DQ      3
        DB      "HLD"
        ALIGN    8
HLD:
        DQ    DOUSE
        DQ    (CW*(24))
        DQ    0x0
        DQ    RNUM
        DQ    N_HLD
        DQ    0
        DQ    0

;

;  ***********
;  *   OUT   *
;  ***********
;
        ALIGN    8
N_LOUT:
        DQ      3
        DB      "OUT"
        ALIGN    8
LOUT:
        DQ    DOUSE
        DQ    (CW*(25))
        DQ    0x0
        DQ    HLD
        DQ    N_LOUT
        DQ    0
        DQ    0

;

;  *************
;  *   (BLK)   *
;  *************
;
        ALIGN    8
N_PBLK:
        DQ      5
        DB      "(BLK)"
        ALIGN    8
PBLK:
        DQ    DOUSE
        DQ    (CW*(26))
        DQ    0x0
        DQ    LOUT
        DQ    N_PBLK
        DQ    0
        DQ    0

;

;  **********
;  *   PP   *
;  **********
;
        ALIGN    8
N_PP:
        DQ      2
        DB      "PP"
        ALIGN    8
PP:
        DQ    DOUSE
        DQ    (CW*(29))
        DQ    0x0
        DQ    PBLK
        DQ    N_PP
        DQ    0
        DQ    0

;


;  *************
;  *   (>IN)   *
;  *************
;
        ALIGN    8
N_PIIN:
        DQ      5
        DB      "(>IN)"
        ALIGN    8
PIIN:
        DQ    DOUSE
        DQ    (CW*(30))
        DQ    0x0
        DQ    PP
        DQ    N_PIIN
        DQ    0
        DQ    0

;
;

;  ************
;  *   ARGS   *
;  ************
;
        ALIGN    8
N_ARGS:
        DQ      4
        DB      "ARGS"
        ALIGN    8
ARGS:
        DQ    DOUSE
        DQ    (CW*(31))
        DQ    0x0
        DQ    PIIN
        DQ    N_ARGS
        DQ    0
        DQ    0

;

;  ***************
;  *   HANDLER   *
;  ***************
;
        ALIGN    8
N_HANDLER:
        DQ      7
        DB      "HANDLER"
        ALIGN    8
HANDLER:
        DQ    DOUSE
        DQ    (CW*(32))
        DQ    0x0
        DQ    ARGS
        DQ    N_HANDLER
        DQ    0
        DQ    0

;

;  ***************
;  *   CURRENT   *
;  ***************
;
        ALIGN    8
N_CURR:
        DQ      7
        DB      "CURRENT"
        ALIGN    8
CURR:
        DQ    DOUSE
        DQ    (CW*(34))
        DQ    0x0
        DQ    HANDLER
        DQ    N_CURR
        DQ    0
        DQ    0

;

;  *****************
;  *   REMAINDER   *
;  *****************
;
        ALIGN    8
N_REMAIND:
        DQ      9
        DB      "REMAINDER"
        ALIGN    8
REMAIND:
        DQ    DOUSE
        DQ    (CW*(14))
        DQ    0x0
        DQ    CURR
        DQ    N_REMAIND
        DQ    0
        DQ    0

;      IMPORTANT
; REQUIRES ONE MORE CELL!
;
;

;  **************
;  *   OFFSET   *
;  **************
;
        ALIGN    8
N_LOFFSET:
        DQ      6
        DB      "OFFSET"
        ALIGN    8
LOFFSET:
        DQ    DOUSE
        DQ    (CW*(37))
        DQ    0x0
        DQ    REMAIND
        DQ    N_LOFFSET
        DQ    0
        DQ    0

;
;
;

;  ***************
;  *   CONTEXT   *
;  ***************
;
        ALIGN    8
N_CONTEXT:
        DQ      7
        DB      "CONTEXT"
        ALIGN    8
CONTEXT:
        DQ    DOUSE
        DQ    (CW*(39))
        DQ    0x0
        DQ    LOFFSET
        DQ    N_CONTEXT
        DQ    0
        DQ    0
 ; Up to  39+16
;      IMPORTANT
;     16 USER SPACE CELLS MUST BE KEPT FREE
;     IN ADDITION TO THE ONE FOR CONTEXT
;
;========== END USER VARIABLES =============
;

;  **********
;  *   1+   *
;  **********
;
        ALIGN    8
N_ONEP:
        DQ      2
        DB      "1+"
        ALIGN    8
ONEP:
        DQ    DOCOL
        DQ    ONEP+HEADSIZE
        DQ    0x0
        DQ    CONTEXT
        DQ    N_ONEP
        DQ    0
        DQ    0

        DQ      ONE
        DQ      PLUS
        DQ      SEMIS
;

;  *************
;  *   CELL+   *
;  *************
;
        ALIGN    8
N_CELLP:
        DQ      5
        DB      "CELL+"
        ALIGN    8
CELLP:
        DQ    DOCOL
        DQ    CELLP+HEADSIZE
        DQ    0x0
        DQ    ONEP
        DQ    N_CELLP
        DQ    0
        DQ    0

        DQ      LIT, CW
        DQ      PLUS
        DQ      SEMIS
;

;
;  *************
;  *   CELLS   *
;  *************
;
        ALIGN    8
N_LCELLS:
        DQ      5
        DB      "CELLS"
        ALIGN    8
LCELLS:
        DQ    DOCOL
        DQ    LCELLS+HEADSIZE
        DQ    0x0
        DQ    CELLP
        DQ    N_LCELLS
        DQ    0
        DQ    0

        DQ        LIT, 3
        DQ      LSHIFT
        DQ      SEMIS
;

;  *************
;  *   CHAR+   *
;  *************
;
        ALIGN    8
N_CHARP:
        DQ      5
        DB      "CHAR+"
        ALIGN    8
CHARP:
        DQ    DOCOL
        DQ    (ONEP+HEADSIZE)
        DQ    0x0
        DQ    LCELLS
        DQ    N_CHARP
        DQ    0
        DQ    0

;

;  *************
;  *   CHARS   *
;  *************
;
        ALIGN    8
N_CHARS:
        DQ      5
        DB      "CHARS"
        ALIGN    8
CHARS:
        DQ    DOCOL 
        DQ    CHARS+HEADSIZE
        DQ    0x0
        DQ    CHARP
        DQ    N_CHARS
        DQ    0
        DQ    0

        DQ      SEMIS
;

;  *************
;  *   ALIGN   *
;  *************
;
        ALIGN    8
N_LALIGN:
        DQ      5
        DB      "ALIGN"
        ALIGN    8
LALIGN:
        DQ    DOCOL 
        DQ    LALIGN+HEADSIZE
        DQ    0x0
        DQ    CHARS
        DQ    N_LALIGN
        DQ    0
        DQ    0


        DQ      LDP, FETCH
        DQ      ALIGNED
        DQ      LDP, STOR
;
        DQ      SEMIS
;

;  ***************
;  *   ALIGNED   *
;  ***************
;
        ALIGN    8
N_ALIGNED :
        DQ      7
        DB      "ALIGNED"
        ALIGN    8
ALIGNED :
        DQ    ALIGNED +HEADSIZE
        DQ    ALIGNED +HEADSIZE
        DQ    0x0
        DQ    LALIGN
        DQ    N_ALIGNED 
        DQ    0
        DQ    0


        POP     RAX
        DEC     RAX
        OR      RAX,  (CW*(1))-1
        INC     RAX
        PUSH    RAX
;
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   HERE   *
;  ************
;
        ALIGN    8
N_HERE:
        DQ      4
        DB      "HERE"
        ALIGN    8
HERE:
        DQ    DOCOL
        DQ    HERE+HEADSIZE
        DQ    0x0
        DQ    ALIGNED 
        DQ    N_HERE
        DQ    0
        DQ    0

        DQ      LDP
        DQ      FETCH
        DQ      SEMIS
;

;  *************
;  *   ALLOT   *
;  *************
;
        ALIGN    8
N_ALLOT:
        DQ      5
        DB      "ALLOT"
        ALIGN    8
ALLOT:
        DQ    DOCOL
        DQ    ALLOT+HEADSIZE
        DQ    0x0
        DQ    HERE
        DQ    N_ALLOT
        DQ    0
        DQ    0

        DQ      LDP
        DQ      PSTOR
        DQ      SEMIS
;

;  *********
;  *   ,   *
;  *********
;
        ALIGN    8
N_COMMA:
        DQ      1
        DB      ","
        ALIGN    8
COMMA:
        DQ    DOCOL
        DQ    COMMA+HEADSIZE
        DQ    0x0
        DQ    ALLOT
        DQ    N_COMMA
        DQ    0
        DQ    0

        DQ      HERE
        DQ      LIT
        DQ      CW
        DQ      ALLOT
        DQ      STOR
        DQ      SEMIS
;

;  **********
;  *   C,   *
;  **********
;
        ALIGN    8
N_CCOMM:
        DQ      2
        DB      "C,"
        ALIGN    8
CCOMM:
        DQ    DOCOL
        DQ    CCOMM+HEADSIZE
        DQ    0x0
        DQ    COMMA
        DQ    N_CCOMM
        DQ    0
        DQ    0

        DQ      HERE
        DQ      ONE
        DQ      ALLOT
        DQ      CSTOR
        DQ      SEMIS
;

;  **********
;  *   2,   *
;  **********
;
        ALIGN    8
N_TCOMM:
        DQ      2
        DB      "2,"
        ALIGN    8
TCOMM:
        DQ    DOCOL
        DQ    TCOMM+HEADSIZE
        DQ    0x0
        DQ    CCOMM
        DQ    N_TCOMM
        DQ    0
        DQ    0

        DQ      HERE
        DQ      LIT
        DQ      CW*2
        DQ      ALLOT
        DQ      TSTOR
        DQ      SEMIS
;

;  *********
;  *   -   *
;  *********
;
        ALIGN    8
N_LSUB:
        DQ      1
        DB      "-"
        ALIGN    8
LSUB:
        DQ    LSUB+HEADSIZE
        DQ    LSUB+HEADSIZE
        DQ    0x0
        DQ    TCOMM
        DQ    N_LSUB
        DQ    0
        DQ    0

        POP     RDX      ;S1
        POP     RAX
        SUB     RAX,RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]      ;S1 = S2 - S1
;

;  *********
;  *   =   *
;  *********
;
        ALIGN    8
N_EQUAL:
        DQ      1
        DB      "="
        ALIGN    8
EQUAL:
        DQ    EQUAL+HEADSIZE
        DQ    EQUAL+HEADSIZE
        DQ    0x0
        DQ    LSUB
        DQ    N_EQUAL
        DQ    0
        DQ    0

         POP     RAX
         POP     RBX
         CMP     RAX,RBX
         SETZ    AL
         MOVZX   RAX,AL
         NEG     RAX
         PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   <   *
;  *********
;
        ALIGN    8
N_LESS:
        DQ      1
        DB      "<"
        ALIGN    8
LESS:
        DQ    LESS+HEADSIZE
        DQ    LESS+HEADSIZE
        DQ    0x0
        DQ    EQUAL
        DQ    N_LESS
        DQ    0
        DQ    0

        POP     RAX
        POP     RBX
        CMP     RBX,RAX
        SETL    AL
        MOVZX   RAX,AL
        NEG     RAX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   U<   *
;  **********
;
        ALIGN    8
N_ULESS:
        DQ      2
        DB      "U<"
        ALIGN    8
ULESS:
        DQ    ULESS+HEADSIZE
        DQ    ULESS+HEADSIZE
        DQ    0x0
        DQ    LESS
        DQ    N_ULESS
        DQ    0
        DQ    0

       POP     RAX
               POP     RDX
               SUB     RDX,RAX
               SBB     RAX,RAX
               PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *********
;  *   >   *
;  *********
;
        ALIGN    8
N_GREAT:
        DQ      1
        DB      ">"
        ALIGN    8
GREAT:
        DQ    DOCOL
        DQ    GREAT+HEADSIZE
        DQ    0x0
        DQ    ULESS
        DQ    N_GREAT
        DQ    0
        DQ    0

        DQ      SWAP
        DQ      LESS
        DQ      SEMIS
;

;  **********
;  *   <>   *
;  **********
;
        ALIGN    8
N_UNEQ:
        DQ      2
        DB      "<>"
        ALIGN    8
UNEQ:
        DQ    UNEQ+HEADSIZE
        DQ    UNEQ+HEADSIZE
        DQ    0x0
        DQ    GREAT
        DQ    N_UNEQ
        DQ    0
        DQ    0

         POP     RAX
         POP     RBX
         CMP     RAX,RBX
         SETNZ    AL
         MOVZX   RAX,AL
         NEG     RAX
         PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   ROT   *
;  ***********
;
        ALIGN    8
N_ROT:
        DQ      3
        DB      "ROT"
        ALIGN    8
ROT:
        DQ    ROT+HEADSIZE
        DQ    ROT+HEADSIZE
        DQ    0x0
        DQ    UNEQ
        DQ    N_ROT
        DQ    0
        DQ    0

        POP     RDX      ;S1
        POP     RBX      ;S2
        POP     RAX      ;S3
        PUSH    RBX
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   SPACE   *
;  *************
;
        ALIGN    8
N_SPACE:
        DQ      5
        DB      "SPACE"
        ALIGN    8
SPACE:
        DQ    DOCOL
        DQ    SPACE+HEADSIZE
        DQ    0x0
        DQ    ROT
        DQ    N_SPACE
        DQ    0
        DQ    0

        DQ      LBL
        DQ      EMIT
        DQ      SEMIS
;

;  ************
;  *   ?DUP   *
;  ************
;
        ALIGN    8
N_QDUP:
        DQ      4
        DB      "?DUP"
        ALIGN    8
QDUP:
        DQ    DOCOL
        DQ    QDUP+HEADSIZE
        DQ    0x0
        DQ    SPACE
        DQ    N_QDUP
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ZBRAN
        DQ      QDUP1-$-CW ; IF
        DQ      LDUP    ;THEN
QDUP1:  DQ      SEMIS
;

;  **************
;  *   LATEST   *
;  **************
;
        ALIGN    8
N_LATEST:
        DQ      6
        DB      "LATEST"
        ALIGN    8
LATEST:
        DQ    DOCOL
        DQ    LATEST+HEADSIZE
        DQ    0x0
        DQ    QDUP
        DQ    N_LATEST
        DQ    0
        DQ    0

        DQ      CURR
        DQ      FETCH
        DQ      TLFA
        DQ      FETCH
        DQ      SEMIS
;

;  ************
;  *   >CFA   *
;  ************
;
        ALIGN    8
N_TCFA:
        DQ      4
        DB      ">CFA"
        ALIGN    8
TCFA:
        DQ    DOCOL
        DQ    TCFA+HEADSIZE
        DQ    0x0
        DQ    LATEST
        DQ    N_TCFA
        DQ    0
        DQ    0

        DQ      LIT, (CW*(C_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;

;  ************
;  *   >DFA   *
;  ************
;
        ALIGN    8
N_TDFA:
        DQ      4
        DB      ">DFA"
        ALIGN    8
TDFA:
        DQ    DOCOL
        DQ    TDFA+HEADSIZE
        DQ    0x0
        DQ    TCFA
        DQ    N_TDFA
        DQ    0
        DQ    0

        DQ      LIT, (CW*(D_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;

;  ************
;  *   >FFA   *
;  ************
;
        ALIGN    8
N_TFFA:
        DQ      4
        DB      ">FFA"
        ALIGN    8
TFFA:
        DQ    DOCOL
        DQ    TFFA+HEADSIZE
        DQ    0x0
        DQ    TDFA
        DQ    N_TFFA
        DQ    0
        DQ    0

        DQ      LIT, (CW*(F_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;

;  ************
;  *   >LFA   *
;  ************
;
        ALIGN    8
N_TLFA:
        DQ      4
        DB      ">LFA"
        ALIGN    8
TLFA:
        DQ    DOCOL
        DQ    TLFA+HEADSIZE
        DQ    0x0
        DQ    TFFA
        DQ    N_TLFA
        DQ    0
        DQ    0

        DQ      LIT, (CW*(L_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;

;  ************
;  *   >NFA   *
;  ************
;
        ALIGN    8
N_TNFA:
        DQ      4
        DB      ">NFA"
        ALIGN    8
TNFA:
        DQ    DOCOL
        DQ    TNFA+HEADSIZE
        DQ    0x0
        DQ    TLFA
        DQ    N_TNFA
        DQ    0
        DQ    0

        DQ      LIT,(CW*(N_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;


;
;  ************
;  *   >SFA   *
;  ************
;
        ALIGN    8
N_TSFA:
        DQ      4
        DB      ">SFA"
        ALIGN    8
TSFA:
        DQ    DOCOL
        DQ    TSFA+HEADSIZE
        DQ    0x0
        DQ    TNFA
        DQ    N_TSFA
        DQ    0
        DQ    0

        DQ      LIT,(CW*(S_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;
;


;
;  ************
;  *   >XFA   *
;  ************
;
        ALIGN    8
N_TXFA:
        DQ      4
        DB      ">XFA"
        ALIGN    8
TXFA:
        DQ    DOCOL
        DQ    TXFA+HEADSIZE
        DQ    0x0
        DQ    TSFA
        DQ    N_TXFA
        DQ    0
        DQ    0

        DQ      LIT,(CW*(X_HOFFSET))
        DQ      PLUS
        DQ      SEMIS
;
;

;  ************
;  *   >PHA   *
;  ************
;
        ALIGN    8
N_TPHA:
        DQ      4
        DB      ">PHA"
        ALIGN    8
TPHA:
        DQ    DOCOL
        DQ    TPHA+HEADSIZE
        DQ    0x0
        DQ    TXFA
        DQ    N_TPHA
        DQ    0
        DQ    0

        DQ      LIT,(CW*(PH_OFFSET))
        DQ      PLUS
        DQ      SEMIS
;

;  *************
;  *   >BODY   *
;  *************
;
        ALIGN    8
N_TOBODY:
        DQ      5
        DB      ">BODY"
        ALIGN    8
TOBODY:
        DQ    DOCOL
        DQ    TOBODY+HEADSIZE
        DQ    0x0
        DQ    TPHA
        DQ    N_TOBODY
        DQ    0
        DQ    0

        DQ      TDFA, FETCH
        DQ      CELLP           ; Skip DOES> pointer.
        DQ      SEMIS
;

;  *************
;  *   BODY>   *
;  *************
;
        ALIGN    8
N_BODYF:
        DQ      5
        DB      "BODY>"
        ALIGN    8
BODYF:
        DQ    DOCOL
        DQ    BODYF+HEADSIZE
        DQ    0x0
        DQ    TOBODY
        DQ    N_BODYF
        DQ    0
        DQ    0

        DQ      LIT,(CW*(BD_OFFSET))
        DQ      LSUB
        DQ      SEMIS
;

;  ************
;  *   >WID   *
;  ************
;
        ALIGN    8
N_TWID:
        DQ      4
        DB      ">WID"
        ALIGN    8
TWID:
        DQ    DOCOL
        DQ    TWID+HEADSIZE
        DQ    0x0
        DQ    BODYF
        DQ    N_TWID
        DQ    0
        DQ    0

        DQ      TOBODY
        DQ      CELLP ; Skip vfa link.
        DQ      SEMIS
;

;  ************
;  *   >VFA   *
;  ************
;
        ALIGN    8
N_TVFA:
        DQ      4
        DB      ">VFA"
        ALIGN    8
TVFA:
        DQ    DOCOL
        DQ    TVFA+HEADSIZE
        DQ    0x0
        DQ    TWID
        DQ    N_TVFA
        DQ    0
        DQ    0

        DQ      TOBODY
        DQ      SEMIS
;


;  ************
;  *   !CSP   *
;  ************
;
        ALIGN    8
N_SCSP:
        DQ      4
        DB      "!CSP"
        ALIGN    8
SCSP:
        DQ    DOCOL
        DQ    SCSP+HEADSIZE
        DQ    0x0
        DQ    TVFA
        DQ    N_SCSP
        DQ    0
        DQ    0

        DQ      SPFET
        DQ      LCSP
        DQ      STOR
        DQ      SEMIS
;
;

;  **************
;  *   ?ERROR   *
;  **************
;
        ALIGN    8
N_QERR:
        DQ      6
        DB      "?ERROR"
        ALIGN    8
QERR:
        DQ    DOCOL
        DQ    QERR+HEADSIZE
        DQ    0x0
        DQ    SCSP
        DQ    N_QERR
        DQ    0
        DQ    0

        DQ      SWAP
        DQ      ZBRAN
        DQ      QERR1-$-CW ;IF
        DQ      PP, FETCH
        DQ      SRC, FETCH
        DQ      LWHERE, TSTOR
        DQ      THROW
        DQ      BRAN
        DQ      QERR2-$-CW  ;ELSE
QERR1:  DQ      DROP    ;THEN
QERR2:  DQ      SEMIS
;

;  **************
;  *   ?ERRUR   *
;  **************
;
        ALIGN    8
N_QERRUR:
        DQ      6
        DB      "?ERRUR"
        ALIGN    8
QERRUR:
        DQ    DOCOL
        DQ    QERRUR+HEADSIZE
        DQ    0x0
        DQ    QERR
        DQ    N_QERRUR
        DQ    0
        DQ    0

        DQ      ZERO, MIN, LDUP, QERR
        DQ      SEMIS
;


;  **************
;  *   ?DELIM   *
;  **************
;
        ALIGN    8
N_QDELIM:
        DQ      6
        DB      "?DELIM"
        ALIGN    8
QDELIM:
        DQ    DOCOL
        DQ    QDELIM+HEADSIZE
        DQ    0x0
        DQ    QERRUR
        DQ    N_QDELIM
        DQ    0
        DQ    0

        DQ      PPFET
        DQ      QBL
        DQ      ZEQU
        DQ      LIT, 10, QERR
        DQ      DROP
        DQ      SEMIS
;

;  ************
;  *   ?CSP   *
;  ************
;
        ALIGN    8
N_QCSP:
        DQ      4
        DB      "?CSP"
        ALIGN    8
QCSP:
        DQ    DOCOL
        DQ    QCSP+HEADSIZE
        DQ    0x0
        DQ    QDELIM
        DQ    N_QCSP
        DQ    0
        DQ    0

        DQ      SPFET
        DQ      LCSP
        DQ      FETCH
        DQ      LSUB
        DQ      LIT, 20, QERR
        DQ      SEMIS
;

;  *************
;  *   ?COMP   *
;  *************
;
        ALIGN    8
N_QCOMP:
        DQ      5
        DB      "?COMP"
        ALIGN    8
QCOMP:
        DQ    DOCOL
        DQ    QCOMP+HEADSIZE
        DQ    0x0
        DQ    QCSP
        DQ    N_QCOMP
        DQ    0
        DQ    0

        DQ      STATE
        DQ      FETCH
        DQ      ZEQU
        DQ      LIT, 17, QERR
        DQ      SEMIS
;

; 

;  **************
;  *   ?PAIRS   *
;  **************
;
        ALIGN    8
N_QPAIR:
        DQ      6
        DB      "?PAIRS"
        ALIGN    8
QPAIR:
        DQ    DOCOL
        DQ    QPAIR+HEADSIZE
        DQ    0x0
        DQ    QCOMP
        DQ    N_QPAIR
        DQ    0
        DQ    0

        DQ      LSUB
        DQ      LIT, 19, QERR
        DQ      SEMIS
;


; 
;
;
;
;

;  *********
;  *   [   *
;  *********
;
        ALIGN    8
N_LBRAC:
        DQ      1
        DB      "["
        ALIGN    8
LBRAC:
        DQ    DOCOL
        DQ    LBRAC+HEADSIZE
        DQ    B_IMMED
        DQ    QPAIR
        DQ    N_LBRAC
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      STATE
        DQ      STOR
        DQ      SEMIS
;

;  *********
;  *   ]   *
;  *********
;
        ALIGN    8
N_RBRAC:
        DQ      1
        DB      "]"
        ALIGN    8
RBRAC:
        DQ    DOCOL
        DQ    RBRAC+HEADSIZE
        DQ    0x0
        DQ    LBRAC
        DQ    N_RBRAC
        DQ    0
        DQ    0

        DQ      ONE
        DQ      STATE
        DQ      STOR
        DQ      SEMIS
;

;  **************
;  *   HIDDEN   *
;  **************
;
        ALIGN    8
N_HIDDEN:
        DQ      6
        DB      "HIDDEN"
        ALIGN    8
HIDDEN:
        DQ    DOCOL
        DQ    HIDDEN+HEADSIZE
        DQ    0x0
        DQ    RBRAC
        DQ    N_HIDDEN
        DQ    0
        DQ    0

        DQ      TFFA
        DQ      LIT,B_INVIS
        DQ      TOGGL
        DQ      SEMIS
;

;  ***********
;  *   HEX   *
;  ***********
;
        ALIGN    8
N_HEX:
        DQ      3
        DB      "HEX"
        ALIGN    8
HEX:
        DQ    DOCOL
        DQ    HEX+HEADSIZE
        DQ    0x0
        DQ    HIDDEN
        DQ    N_HEX
        DQ    0
        DQ    0

        DQ      LIT,16
        DQ      BASE
        DQ      STOR
        DQ      SEMIS
;

;  ***************
;  *   DECIMAL   *
;  ***************
;
        ALIGN    8
N_DECA:
        DQ      7
        DB      "DECIMAL"
        ALIGN    8
DECA:
        DQ    DOCOL
        DQ    DECA+HEADSIZE
        DQ    0x0
        DQ    HEX
        DQ    N_DECA
        DQ    0
        DQ    0

        DQ      LIT,10
        DQ      BASE
        DQ      STOR
        DQ      SEMIS
;

;  ***************
;  *   (;CODE)   *
;  ***************
;
        ALIGN    8
N_PSCOD:
        DQ      7
        DB      "(;CODE)"
        ALIGN    8
PSCOD:
        DQ    DOCOL
        DQ    PSCOD+HEADSIZE
        DQ    0x0
        DQ    DECA
        DQ    N_PSCOD
        DQ    0
        DQ    0

        DQ      FROMR
        DQ      LATEST
        DQ      TCFA
        DQ      STOR
        DQ      SEMIS
;
; 

;  **************
;  *   CREATE   *
;  **************
;
        ALIGN    8
N_LCREATE:
        DQ      6
        DB      "CREATE"
        ALIGN    8
LCREATE:
        DQ    DOCOL
        DQ    LCREATE+HEADSIZE
        DQ    0x0
        DQ    PSCOD
        DQ    N_LCREATE
        DQ    0
        DQ    0

        DQ      LNAME
        DQ      PCREAT
        DQ      LIT, HLNOOP, COMMA
        DQ      PSCOD
DODOE:  LEA     RBP,[RBP - (CW*(1))] ;Push HIP.
        MOV     [RBP],RSI
        MOV     RSI,[RAX+(CW*((D_HOFFSET)))] ;NEW IP 
        LEA     RAX,[RSI+(CW*(1))]
        MOV     RSI,[RSI]
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
        DQ      0       ; In behalf of FIND-HEAD in decompilation
HLNOOP: DQ      SEMIS
;

;  *************
;  *   DOES>   *
;  *************
;
        ALIGN    8
N_DOES:
        DQ      5
        DB      "DOES>"
        ALIGN    8
DOES:
        DQ    DOCOL
        DQ    DOES+HEADSIZE
        DQ    0x0
        DQ    LCREATE
        DQ    N_DOES
        DQ    0
        DQ    0

        DQ      FROMR
        DQ      LATEST
        DQ      TDFA
        DQ      FETCH
        DQ      STOR
        DQ      SEMIS
;

;  *************
;  *   COUNT   *
;  *************
;
        ALIGN    8
N_COUNT:
        DQ      5
        DB      "COUNT"
        ALIGN    8
COUNT:
        DQ    DOCOL
        DQ    COUNT+HEADSIZE
        DQ    0x0
        DQ    DOES
        DQ    N_COUNT
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ONEP
        DQ      SWAP
        DQ      CFET
        DQ      SEMIS
;

;  *****************
;  *   -TRAILING   *
;  *****************
;
        ALIGN    8
N_DTRAI:
        DQ      9
        DB      "-TRAILING"
        ALIGN    8
DTRAI:
        DQ    DOCOL
        DQ    DTRAI+HEADSIZE
        DQ    0x0
        DQ    COUNT
        DQ    N_DTRAI
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ZERO
        DQ     XQDO
        DQ      DTRA4-$-CW
DTRA1:  DQ      OVER
        DQ      OVER
        DQ      PLUS
        DQ      ONE
        DQ      LSUB
        DQ      CFET
        DQ      QBL
        DQ      ZEQU
        DQ      ZBRAN
        DQ      DTRA2-$-CW ;IF
        DQ      LLEAV
DTRA2:  DQ      ONE
        DQ      LSUB    ; THEN
        DQ     ONE, XPLOOP, ZBRAN
        DQ      DTRA1-$-CW
        DQ      UNLOOP     ; LOOP
DTRA4:
        DQ      SEMIS
;


;  **********
;  *   S"   *
;  **********
;
        ALIGN    8
N_SQUOT:
        DQ      2
        DB      'S"'
        ALIGN    8
SQUOT:
        DQ    DOCOL
        DQ    SQUOT+HEADSIZE
        DQ    B_IMMED
        DQ    DTRAI
        DQ    N_SQUOT
        DQ    0
        DQ    0

        DQ      DENQ
        DQ      SEMIS
;
;

;  **********
;  *   ."   *
;  **********
;
        ALIGN    8
N_DOTQ:
        DQ      2
        DB      '."'
        ALIGN    8
DOTQ:
        DQ    DOCOL
        DQ    DOTQ+HEADSIZE
        DQ    B_IMMED
        DQ    SQUOT
        DQ    N_DOTQ
        DQ    0
        DQ    0

        DQ      DENQ
        DQ      STATE
        DQ      FETCH
        DQ      ZBRAN
        DQ      DOTQ1-$-CW ; IF
        DQ      LIT, LTYPE, COMMA
        DQ      BRAN
        DQ      DOTQ2-$-CW
DOTQ1:
        DQ      LTYPE
DOTQ2:
        DQ      SEMIS   ; THEN
;

;  **********
;  *   .(   *
;  **********
;
        ALIGN    8
N_DOTP:
        DQ      2
        DB      ".("
        ALIGN    8
DOTP:
        DQ    DOCOL
        DQ    DOTP+HEADSIZE
        DQ    B_IMMED
        DQ    DOTQ
        DQ    N_DOTP
        DQ    0
        DQ    0

        DQ      LIT, ')'
        DQ      PARSE
        DQ      LTYPE
        DQ      SEMIS
;

;  ***************
;  *   SET-SRC   *
;  ***************
;
        ALIGN    8
N_SETSRC:
        DQ      7
        DB      "SET-SRC"
        ALIGN    8
SETSRC:
        DQ    DOCOL
        DQ    SETSRC+HEADSIZE
        DQ    0x0
        DQ    DOTP
        DQ    N_SETSRC
        DQ    0
        DQ    0

        DQ      OVER, PLUS
        DQ      OVER, SRC, TSTOR
        DQ      PP, STOR ;  IN

;       DC      DOTS
        DQ      SEMIS
;

;  ****************
;  *   EVALUATE   *
;  ****************
;
        ALIGN    8
N_EVALUATE:
        DQ      8
        DB      "EVALUATE"
        ALIGN    8
EVALUATE:
        DQ    DOCOL
        DQ    EVALUATE+HEADSIZE
        DQ    0x0
        DQ    SETSRC
        DQ    N_EVALUATE
        DQ    0
        DQ    0

        DQ      SAVE
        DQ      SETSRC
        DQ      LIT, INTER, CATCH
        DQ      RESTO
        DQ      THROW
        DQ      SEMIS
;

;  ************
;  *   FILL   *
;  ************
;
        ALIGN    8
N_FILL:
        DQ      4
        DB      "FILL"
        ALIGN    8
FILL:
        DQ    FILL+HEADSIZE
        DQ    FILL+HEADSIZE
        DQ    0x0
        DQ    EVALUATE
        DQ    N_FILL
        DQ    0
        DQ    0

;       Assume the extra segment points to the data segment 
        POP     RAX      ; FILL CHAR
        POP     RCX      ; FILL COUNT
        POP     RDI      ; BEGIN ADDR
        CLD             ; INC DIRECTION
        REP     STOSB   ;STORE BYTE
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ************
;  *   CORA   *
;  ************
;
        ALIGN    8
N_CORA:
        DQ      4
        DB      "CORA"
        ALIGN    8
CORA:
        DQ    CORA+HEADSIZE
        DQ    CORA+HEADSIZE
        DQ    0x0
        DQ    FILL
        DQ    N_CORA
        DQ    0
        DQ    0

;       Assume the extra segment points to the data segment 
        MOV     RDX,RSI   ;SAVE
        XOR     RAX,RAX   ; Result
        POP     RCX      ; count
        POP     RDI      ; addr2
        POP     RSI      ; addr1
        CLD             ; INC DIRECTION
        REPZ    CMPSB   ; Compare BYTE
        JZ      CORA3
        MOV     AL,1    ;Remainder is already 0
        JNC     CORA3
        NEG     RAX
CORA3:
        MOV     RSI,RDX  ;Restore
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   $^   *
;  **********
;
        ALIGN    8
N_SINDEX:
        DQ      2
        DB      "$^"
        ALIGN    8
SINDEX:
        DQ    SINDEX+HEADSIZE
        DQ    SINDEX+HEADSIZE
        DQ    0x0
        DQ    CORA
        DQ    N_SINDEX
        DQ    0
        DQ    0

;       Assume the extra segment points to the data segment 
        POP     RAX      ; char
        POP     RCX      ; count
        POP     RDI      ; addr
        OR      RSI,RSI   ;Clear zero flag.
        CLD             ; INC DIRECTION
        REPNZ     SCASB   ; Compare BYTE
        JZ      SINDEX1
        XOR     RDI,RDI    ;Not found: 0
        INC     RDI
SINDEX1:
        DEC     RDI
        PUSH    RDI
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   $/   *
;  **********
;
        ALIGN    8
N_SSLAS:
        DQ      2
        DB      "$/"
        ALIGN    8
SSLAS:
        DQ    SSLAS+HEADSIZE
        DQ    SSLAS+HEADSIZE
        DQ    0x0
        DQ    SINDEX
        DQ    N_SSLAS
        DQ    0
        DQ    0

;       Assume the extra segment points to the data segment 
        POP     RAX      ; char
        POP     RCX      ; count
        MOV     RBX,RCX
        POP     RDI      ; addr
        OR      RDI,RDI   ;Clear zero flag.
        MOV     RDX,RDI   ; Copy
        CLD             ; INC DIRECTION
        REPNZ     SCASB   ; Compare BYTE
        JZ      SSLAS1
; Not present.
        PUSH    RCX   ; Nil pointer.
        JMP SHORT SSLAS2
SSLAS1:
        PUSH    RDI
        SUB     RBX,RCX
        DEC     RBX      ;Delimiter is not part of first string.
SSLAS2:
        PUSH    RCX   ;Remaining length
        PUSH    RDX   ;Start of first string.
        PUSH    RBX   ;Skipped length.
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   $\   *
;  **********
;
        ALIGN    8
N_BSLAS:
        DQ      2
        DB      "$\"
        ALIGN    8
BSLAS:
        DQ    BSLAS+HEADSIZE
        DQ    BSLAS+HEADSIZE
        DQ    0x0
        DQ    SSLAS
        DQ    N_BSLAS
        DQ    0
        DQ    0

;       Assume the extra segment points to the data segment 
        POP     RAX      ; char
        POP     RCX      ; count
        MOV     RBX,RCX
        POP     RDI      ; addr
        MOV     RDX,RDI   ; Copy
        ADD     RDI,RCX
        DEC     RDI      ;Last char & clear zero flag.
        STD    ; DEC DIRECTION
        REPNZ     SCASB   ; Compare BYTE
        JZ      BSLAS1
; Not present.
        PUSH    RCX   ; Nil pointer.
        INC     RDI   ;Start of end string
        JMP SHORT BSLAS2
BSLAS1:
        PUSH    RDX   ;Start of start string.
        INC     RDI
        INC     RDI   ;Start of end string
        SUB     RBX,RCX
        DEC     RBX      ;Delimiter is not part of ending string.
BSLAS2:
        PUSH    RCX   ;Remaining length
        PUSH    RDI
        PUSH    RBX
        CLD
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   ERASE   *
;  *************
;
        ALIGN    8
N_LERASE:
        DQ      5
        DB      "ERASE"
        ALIGN    8
LERASE:
        DQ    DOCOL
        DQ    LERASE+HEADSIZE
        DQ    0x0
        DQ    BSLAS
        DQ    N_LERASE
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      FILL
        DQ      SEMIS
;


;  *************
;  *   BLANK   *
;  *************
;
        ALIGN    8
N_BLANK:
        DQ      5
        DB      "BLANK"
        ALIGN    8
BLANK:
        DQ    DOCOL
        DQ    BLANK+HEADSIZE
        DQ    0x0
        DQ    LERASE
        DQ    N_BLANK
        DQ    0
        DQ    0

        DQ      LBL
        DQ      FILL
        DQ      SEMIS
;
;

;  ************
;  *   HOLD   *
;  ************
;
        ALIGN    8
N_HOLD:
        DQ      4
        DB      "HOLD"
        ALIGN    8
HOLD:
        DQ    DOCOL
        DQ    HOLD+HEADSIZE
        DQ    0x0
        DQ    BLANK
        DQ    N_HOLD
        DQ    0
        DQ    0

        DQ      LIT,-1
        DQ      HLD
        DQ      PSTOR
        DQ      HLD
        DQ      FETCH
        DQ      CSTOR
        DQ      SEMIS
;

;  ***********
;  *   PAD   *
;  ***********
;
        ALIGN    8
N_PAD:
        DQ      3
        DB      "PAD"
        ALIGN    8
PAD:
        DQ    DOCOL
        DQ    PAD+HEADSIZE
        DQ    0x0
        DQ    HOLD
        DQ    N_PAD
        DQ    0
        DQ    0

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


; 
;
;

;  ************
;  *   CHAR   *
;  ************
;
        ALIGN    8
N_LCHAR:
        DQ      4
        DB      "CHAR"
        ALIGN    8
LCHAR:
        DQ    DOCOL
        DQ    LCHAR+HEADSIZE
        DQ    0x0
        DQ    PAD
        DQ    N_LCHAR
        DQ    0
        DQ    0

        DQ      LNAME, DROP, CFET
        DQ      SEMIS
;

;  **************
;  *   [CHAR]   *
;  **************
;
        ALIGN    8
N_BCHAR:
        DQ      6
        DB      "[CHAR]"
        ALIGN    8
BCHAR:
        DQ    DOCOL
        DQ    BCHAR+HEADSIZE
        DQ    B_IMMED
        DQ    LCHAR
        DQ    N_BCHAR
        DQ    0
        DQ    0

        DQ      LCHAR, LITER
        DQ      SEMIS
;

;  ****************
;  *   (NUMBER)   *
;  ****************
;
        ALIGN    8
N_PNUMB:
        DQ      8
        DB      "(NUMBER)"
        ALIGN    8
PNUMB:
        DQ    DOCOL
        DQ    PNUMB+HEADSIZE
        DQ    0x0
        DQ    BCHAR
        DQ    N_PNUMB
        DQ    0
        DQ    0

        DQ      ZERO, ZERO
        DQ      ZERO, DPL, STOR
NPNUM1:  DQ      PPFET   ; BEGIN
        DQ      LDUP, LIT, ADOT, EQUAL
        DQ      ZBRAN
        DQ      NPNUM2-$-CW ; case 1 
        DQ      DROP, DPL, STOR
        DQ      BRAN
        DQ      NPNUM1-$-CW ; continue 
NPNUM2:
        DQ      LDUP, LIT, ',', EQUAL
        DQ      ZBRAN
        DQ      NPNUM3-$-CW ; case 2 
        DQ      TDROP
        DQ      BRAN
        DQ      NPNUM1-$-CW ; continue 
NPNUM3:
        DQ      LDUP, QBL, ZEQU
        DQ      ZBRAN
        DQ      NPNUM5-$-CW  ; while 
        DQ      NIP
        DQ      BASE, FETCH, DIGIT
        DQ      ZEQU
        DQ      LIT, 10, QERR

        DQ      SWAP
        DQ      BASE
        DQ      FETCH
        DQ      USTAR
        DQ      DROP
        DQ      ROT
        DQ      BASE
        DQ      FETCH
        DQ      USTAR
        DQ      DPLUS
        DQ      BRAN
        DQ      NPNUM1-$-CW ; repeat 
NPNUM5:
        DQ      DROP, PP, STOR
        DQ      SEMIS
;

;  **************
;  *   NUMBER   *
;  **************
;
        ALIGN    8
N_NUMB:
        DQ      6
        DB      "NUMBER"
        ALIGN    8
NUMB:
        DQ    DOCOL
        DQ    NUMB+HEADSIZE
        DQ    0x0
        DQ    PNUMB
        DQ    N_NUMB
        DQ    0
        DQ    0

LNUMB:
        DQ      LIT, -1, PP, PSTOR
        DQ      PNUMB, SDLITE
        DQ      SEMIS
;


;  ***************
;  *   >NUMBER   *
;  ***************
;
        ALIGN    8
N_TONUMB:
        DQ      7
        DB      ">NUMBER"
        ALIGN    8
TONUMB:
        DQ    DOCOL
        DQ    TONUMB+HEADSIZE
        DQ    0x0
        DQ    NUMB
        DQ    N_TONUMB
        DQ    0
        DQ    0

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

;  *************
;  *   FOUND   *
;  *************
;
        ALIGN    8
N_FOUND:
        DQ      5
        DB      "FOUND"
        ALIGN    8
FOUND:
        DQ    DOCOL
        DQ    FOUND+HEADSIZE
        DQ    0x0
        DQ    TONUMB
        DQ    N_FOUND
        DQ    0
        DQ    0

        DQ      CONTEXT, TOR
FOUND1: DQ      RR, FETCH
;        DC      DOTS
        DQ      PFIND, LDUP, ZEQU
        DQ      ZBRAN
        DQ      FOUND3-$-CW
        DQ      DROP
        DQ      RR, FETCH, LIT, ONLYBODY, LSUB ;Was this ONLY?
        DQ      ZBRAN
        DQ      FOUND2-$-CW
        DQ      FROMR, CELLP, TOR
        DQ      BRAN
        DQ      FOUND1-$-CW
FOUND2: DQ      ZERO
FOUND3: DQ      RDROP
        DQ      NIP,NIP
        DQ      SEMIS
;

;  ***************
;  *   PRESENT   *
;  ***************
;
        ALIGN    8
N_PRESENT:
        DQ      7
        DB      "PRESENT"
        ALIGN    8
PRESENT:
        DQ    DOCOL
        DQ    PRESENT+HEADSIZE
        DQ    0x0
        DQ    FOUND
        DQ    N_PRESENT
        DQ    0
        DQ    0

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


; 
;


;  ***********
;  *   OPT   *
;  ***********
;
        ALIGN    8
N_OPT:
        DQ      3
        DB      "OPT"
        ALIGN    8
OPT:
        DQ    DOCOL
        DQ    OPT+HEADSIZE
        DQ    0x0
        DQ    PRESENT
        DQ    N_OPT
        DQ    0
        DQ    0

        DQ      SEMIS

;

;  **************
;  *   (FIND)   *
;  **************
;
        ALIGN    8
N_PFIND:
        DQ      6
        DB      "(FIND)"
        ALIGN    8
PFIND:
        DQ    DOCOL
        DQ    PFIND+HEADSIZE
        DQ    0x0
        DQ    OPT
        DQ    N_PFIND
        DQ    0
        DQ    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
; PFCONTINUE : dea is disapproved, go on
; PFEXIT : dea is the match, or null.

PFIND0:                       ;Start of loop.
        DQ      NMATCH
        DQ      ZEQU
        DQ      ZBRAN
        DQ      PFCONTINUE-$-CW
; ~MATCH is sure in determining a no-match,
; a possible match must be investigated closely.
;
; dea's name and sc have equal length
        DQ      TDUP, TNFA, FETCH, FETCH
        DQ      EQUAL
; dea is a prefix 
        DQ      OVER, TFFA, FETCH
        DQ      LIT, B_DENOT, LAND
        DQ      LOR             ; One of those must apply.
        DQ      ZBRAN
        DQ      PFCONTINUE-$-CW

; Discard still, if invisible ("smudged") or dummy.
        DQ      LDUP, TFFA, FETCH
        DQ      LIT, B_INVIS OR B_DUMMY, LAND
        DQ      ZEQU
        DQ      ZBRAN
        DQ      PFCONTINUE-$-CW
        DQ      BRAN
        DQ      PFEXIT-$-CW         ; Match! 
PFCONTINUE:
        DQ      TLFA, FETCH
        DQ      LDUP, ZEQU
        DQ      ZBRAN
        DQ      PFIND0-$-CW      ;End of loop.
; Fall through leaves zero, as required.

PFEXIT:
        DQ      SEMIS
;

;  *************
;  *   ERROR   *
;  *************
;
        ALIGN    8
N_LERROR:
        DQ      5
        DB      "ERROR"
        ALIGN    8
LERROR:
        DQ    DOCOL
        DQ    LERROR+HEADSIZE
        DQ    0x0
        DQ    PFIND
        DQ    N_LERROR
        DQ    0
        DQ    0

; Make sure the whole word is shown in case of denotations. 
        DQ      LWHERE, TFET
        DQ      OVER
        DQ      ZBRAN
        DQ      ERR2-$-CW      ; Virgin: print empty string.
        DQ      OVER, LIT, 20, LSUB
        DQ      MAX
        DQ      SWAP
        DQ      ONEM         ;Backup for if we are at next word.
ERR1:   DQ      LDUP, CFET, QBL, ZEQU  ;Show whole word!
        DQ      ZBRAN
        DQ      ERR2 -$-CW
        DQ      ONEP
        DQ      BRAN
        DQ      ERR1 -$-CW
ERR2:
        DQ      OVER, LSUB
        DQ      ETYPE
        DQ      SKIP
         DQ      19
SB3: DB      " ? ciforth ERROR # "
       ALIGN    8
        DQ      LIT, SB3
        DQ      LIT, 19
        DQ      ETYPE
        DQ      BASE, FETCH
        DQ      DECA
        DQ      OVER
        DQ      STOD, ZERO, PDDOTR      ;This is about (.) 
        DQ      ETYPE
        DQ      BASE, STOR
        DQ      LIT, -256, MAX
        DQ      LIT, 63, MIN
        DQ      LIT, MESS, CATCH, DROP  ;Prevent error loops 
        DQ      SEMIS
;

;  *************
;  *   CATCH   *
;  *************
;
        ALIGN    8
N_CATCH:
        DQ      5
        DB      "CATCH"
        ALIGN    8
CATCH:
        DQ    DOCOL
        DQ    CATCH+HEADSIZE
        DQ    0x0
        DQ    LERROR
        DQ    N_CATCH
        DQ    0
        DQ    0

        DQ      SPFET, CELLP, TOR
        DQ      HANDLER, FETCH, TOR
        DQ      RPFET, HANDLER, STOR
        DQ      EXEC
        DQ      FROMR, HANDLER, STOR
        DQ      RDROP, ZERO
        DQ      SEMIS
;

;  *************
;  *   THROW   *
;  *************
;
        ALIGN    8
N_THROW:
        DQ      5
        DB      "THROW"
        ALIGN    8
THROW:
        DQ    DOCOL
        DQ    THROW+HEADSIZE
        DQ    0x0
        DQ    CATCH
        DQ    N_THROW
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ZBRAN
        DQ      THROW1-$-CW
        DQ      HANDLER, FETCH, ZEQU
        DQ      ZBRAN
        DQ      THROW2-$-CW
        DQ      LERROR
        DQ      CLS
        DQ      QUIT
THROW2:
        DQ      HANDLER, FETCH, RPSTO
        DQ      FROMR, HANDLER, STOR
        DQ      FROMR, SWAP, TOR
        DQ      SPSTO
        DQ      FROMR
        DQ      X
THROW1:
        DQ      DROP
        DQ      SEMIS
;


; 
;

; 

;

;  ***********
;  *   ID.   *
;  ***********
;
        ALIGN    8
N_IDDOT:
        DQ      3
        DB      "ID."
        ALIGN    8
IDDOT:
        DQ    DOCOL
        DQ    IDDOT+HEADSIZE
        DQ    0x0
        DQ    THROW
        DQ    N_IDDOT
        DQ    0
        DQ    0

        DQ      LDUP, TFFA, FETCH
        DQ      LIT, B_DUMMY, LAND
        DQ      ZBRAN
        DQ      IDDOT1-$-CW
        DQ      DROP
        DQ      BRAN
        DQ      IDDOT2-$-CW
IDDOT1:
        DQ      TNFA
        DQ      FETCH
        DQ      SFET
        DQ      LTYPE
        DQ      SPACE
        DQ      SPACE
        DQ      SPACE
IDDOT2:
        DQ      SEMIS
;
;

;  **************
;  *   HEADER   *
;  **************
;
        ALIGN    8
N_LHEAD:
        DQ      6
        DB      "HEADER"
        ALIGN    8
LHEAD:
        DQ    DOCOL
        DQ    LHEAD+HEADSIZE
        DQ    0x0
        DQ    IDDOT
        DQ    N_LHEAD
        DQ    0
        DQ    0

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

        DQ      RR, TPHA, COMMA         ;Code field.
        DQ      RR, TPHA, COMMA         ;Data field.
        DQ      ZERO, COMMA ;Flag field.
        DQ      ZERO, COMMA ;Link field.
        DQ      COMMA   ;Name field.


        DQ      BLK, FETCH, LDUP, ZEQU
        DQ      ZBRAN
        DQ      CREA2-$-CW
        DQ      DROP, PP, FETCH
CREA2:  DQ      COMMA  ;Source field.

        DQ      ZERO, COMMA
        DQ      FROMR
        DQ      SEMIS
;

;  ************
;  *   LINK   *
;  ************
;
        ALIGN    8
N_LLINK:
        DQ      4
        DB      "LINK"
        ALIGN    8
LLINK:
        DQ    DOCOL
        DQ    LLINK+HEADSIZE
        DQ    0x0
        DQ    LHEAD
        DQ    N_LLINK
        DQ    0
        DQ    0

        DQ      TLFA
        DQ      TDUP
        DQ      FETCH
        DQ      SWAP, TLFA, STOR
        DQ      STOR
        DQ      SEMIS
;

;  ****************
;  *   (CREATE)   *
;  ****************
;
        ALIGN    8
N_PCREAT:
        DQ      8
        DB      "(CREATE)"
        ALIGN    8
PCREAT:
        DQ    DOCOL
        DQ    PCREAT+HEADSIZE
        DQ    0x0
        DQ    LLINK
        DQ    N_PCREAT
        DQ    0
        DQ    0

        DQ      LHEAD
        DQ      CURR, FETCH
        DQ      LLINK
        DQ      SEMIS
;

;  *****************
;  *   [COMPILE]   *
;  *****************
;
        ALIGN    8
N_BCOMP:
        DQ      9
        DB      "[COMPILE]"
        ALIGN    8
BCOMP:
        DQ    DOCOL
        DQ    BCOMP+HEADSIZE
        DQ    B_IMMED
        DQ    PCREAT
        DQ    N_BCOMP
        DQ    0
        DQ    0

        DQ      LNAME
        DQ      PRESENT
        DQ      LDUP
        DQ      ZEQU
        DQ      LIT, 16, QERR
        DQ      TCFA
        DQ      COMMA
        DQ      SEMIS
;

;  ****************
;  *   POSTPONE   *
;  ****************
;
        ALIGN    8
N_POSTP:
        DQ      8
        DB      "POSTPONE"
        ALIGN    8
POSTP:
        DQ    DOCOL
        DQ    POSTP+HEADSIZE
        DQ    B_IMMED
        DQ    BCOMP
        DQ    N_POSTP
        DQ    0
        DQ    0

        DQ      LNAME
        DQ      PRESENT
        DQ      LDUP
        DQ      ZEQU
        DQ      LIT, 15, QERR
        DQ      LDUP, TFFA, FETCH
        DQ      LIT, B_IMMED, LAND, ZEQU
        DQ      ZBRAN
        DQ      POSTP1-$-CW
         DQ      LIT, LIT, COMMA
         DQ      COMMA
         DQ      LIT, COMMA
POSTP1:
         DQ      COMMA
        DQ      SEMIS
;

;  ***************
;  *   LITERAL   *
;  ***************
;
        ALIGN    8
N_LITER:
        DQ      7
        DB      "LITERAL"
        ALIGN    8
LITER:
        DQ    DOCOL
        DQ    LITER+HEADSIZE
        DQ    B_IMMED
        DQ    POSTP
        DQ    N_LITER
        DQ    0
        DQ    0

        DQ      STATE
        DQ      FETCH
        DQ      ZBRAN
        DQ      LITE1-$-CW ;IF
        DQ      LIT, LIT, COMMA
        DQ      COMMA   ;THEN
LITE1:  DQ      SEMIS
;

;  ****************
;  *   DLITERAL   *
;  ****************
;
        ALIGN    8
N_DLITE:
        DQ      8
        DB      "DLITERAL"
        ALIGN    8
DLITE:
        DQ    DOCOL
        DQ    DLITE+HEADSIZE
        DQ    B_IMMED
        DQ    LITER
        DQ    N_DLITE
        DQ    0
        DQ    0

        DQ      STATE
        DQ      FETCH
        DQ      ZBRAN
        DQ      DLIT1-$-CW ; IF
        DQ      SWAP
        DQ      LITER
        DQ      LITER   ; THEN
DLIT1:  DQ      SEMIS
;
;

;  *****************
;  *   SDLITERAL   *
;  *****************
;
        ALIGN    8
N_SDLITE:
        DQ      9
        DB      "SDLITERAL"
        ALIGN    8
SDLITE:
        DQ    DOCOL
        DQ    SDLITE+HEADSIZE
        DQ    B_IMMED
        DQ    DLITE
        DQ    N_SDLITE
        DQ    0
        DQ    0

        DQ      DPL
        DQ      FETCH
        DQ      ZBRAN
        DQ      SDLIT1-$-CW ; IF
        DQ      DLITE
        DQ      BRAN
        DQ      SDLIT2-$-CW ; IF
SDLIT1:
        DQ      DROP, LITER
SDLIT2:
        DQ      SEMIS
;


;  **************
;  *   ?STACK   *
;  **************
;
        ALIGN    8
N_QSTAC:
        DQ      6
        DB      "?STACK"
        ALIGN    8
QSTAC:
        DQ    DOCOL
        DQ    QSTAC+HEADSIZE
        DQ    0x0
        DQ    SDLITE
        DQ    N_QSTAC
        DQ    0
        DQ    0

        DQ      SPFET
        DQ      SZERO
        DQ      FETCH
        DQ      SWAP
        DQ      ULESS
        DQ      ONE, QERR
        DQ      SPFET
        DQ      HERE
        DQ      LIT,0x80
        DQ      PLUS
        DQ      ULESS
        DQ      LIT, 7, QERR
        DQ      SEMIS
        ;
;
;

;  *****************
;  *   INTERPRET   *
;  *****************
;
        ALIGN    8
N_INTER:
        DQ      9
        DB      "INTERPRET"
        ALIGN    8
INTER:
        DQ    DOCOL
        DQ    INTER+HEADSIZE
        DQ    0x0
        DQ    QSTAC
        DQ    N_INTER
        DQ    0
        DQ    0

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

;  *****************
;  *   IMMEDIATE   *
;  *****************
;
        ALIGN    8
N_IMMED:
        DQ      9
        DB      "IMMEDIATE"
        ALIGN    8
IMMED:
        DQ    DOCOL
        DQ    IMMED+HEADSIZE
        DQ    0x0
        DQ    INTER
        DQ    N_IMMED
        DQ    0
        DQ    0

        DQ      LATEST
        DQ      TFFA
        DQ      LIT, B_IMMED
        DQ      TOGGL
        DQ      SEMIS
;

;  **************
;  *   PREFIX   *
;  **************
;
        ALIGN    8
N_PREFX:
        DQ      6
        DB      "PREFIX"
        ALIGN    8
PREFX:
        DQ    DOCOL
        DQ    PREFX+HEADSIZE
        DQ    0x0
        DQ    IMMED
        DQ    N_PREFX
        DQ    0
        DQ    0

        DQ      LATEST
        DQ      TFFA
        DQ      LIT, B_DENOT
        DQ      TOGGL
        DQ      SEMIS
;

;  *****************
;  *   NAMESPACE   *
;  *****************
;
        ALIGN    8
N_VOCAB:
        DQ      9
        DB      "NAMESPACE"
        ALIGN    8
VOCAB:
        DQ    DOCOL
        DQ    VOCAB+HEADSIZE
        DQ    0x0
        DQ    PREFX
        DQ    N_VOCAB
        DQ    0
        DQ    0

        DQ      LCREATE
        DQ      LATEST   ; Link this DEA into VOC-LINK chain.
        DQ      VOCL
        DQ      FETCH
        DQ      COMMA
        DQ      VOCL
        DQ      STOR
        DQ      WORDLIST, DROP
        DQ      DOES
DOVOC:
        DQ      ALSO
        DQ      CELLP   ; Now points to WID. 
        DQ      CONTEXT
        DQ      STOR
        DQ      SEMIS
        ;
;
;   The link to task is a cold start value only.
;   It is updated each time a definition is
;   appended to the 'FORTH' namespace.
;

;  ****************
;  *   WORDLIST   *
;  ****************
;
        ALIGN    8
N_WORDLIST:
        DQ      8
        DB      "WORDLIST"
        ALIGN    8
WORDLIST:
        DQ    DOCOL
        DQ    WORDLIST+HEADSIZE
        DQ    0x0
        DQ    VOCAB
        DQ    N_WORDLIST
        DQ    0
        DQ    0

        DQ      HERE
        DQ      ZERO, COMMA   ; Dummy code field
        DQ      ZERO, COMMA   ; Dummy data field
        DQ      LIT, B_DUMMY, COMMA ; Dummy flag field
        DQ      ZERO, COMMA ;Link field: empty chain
        DQ      LIT, (ZERO+(CW*(D_HOFFSET))), COMMA ;Empty string for name.
        DQ      ZERO, COMMA
        DQ      ZERO, COMMA
        DQ      SEMIS
        ;
;

;

;  *******************
;  *   DEFINITIONS   *
;  *******************
;
        ALIGN    8
N_DEFIN:
        DQ      11
        DB      "DEFINITIONS"
        ALIGN    8
DEFIN:
        DQ    DOCOL
        DQ    DEFIN+HEADSIZE
        DQ    0x0
        DQ    WORDLIST
        DQ    N_DEFIN
        DQ    0
        DQ    0

        DQ      CONTEXT
        DQ      FETCH
        DQ      CURR
        DQ      STOR
        DQ      SEMIS
;

;  ************
;  *   ALSO   *
;  ************
;
        ALIGN    8
N_ALSO:
        DQ      4
        DB      "ALSO"
        ALIGN    8
ALSO:
        DQ    DOCOL
        DQ    ALSO+HEADSIZE
        DQ    0x0
        DQ    DEFIN
        DQ    N_ALSO
        DQ    0
        DQ    0

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

;  ****************
;  *   PREVIOUS   *
;  ****************
;
        ALIGN    8
N_PREVI:
        DQ      8
        DB      "PREVIOUS"
        ALIGN    8
PREVI:
        DQ    DOCOL
        DQ    PREVI+HEADSIZE
        DQ    0x0
        DQ    ALSO
        DQ    N_PREVI
        DQ    0
        DQ    0

        DQ      CONTEXT, LDUP, CELLP, SWAP
        DQ      LIT, (CW*(16))
        DQ      LMOVE
        DQ      SEMIS
;

;  *********
;  *   (   *
;  *********
;
        ALIGN    8
N_PAREN:
        DQ      1
        DB      "("
        ALIGN    8
PAREN:
        DQ    DOCOL
        DQ    PAREN+HEADSIZE
        DQ    B_IMMED
        DQ    PREVI
        DQ    N_PAREN
        DQ    0
        DQ    0

        DQ      LIT,')'
        DQ      PARSE
        DQ      TDROP
        DQ      SEMIS
;
;

;  *********
;  *   \   *
;  *********
;
        ALIGN    8
N_BACKS:
        DQ      1
        DB      "\"
        ALIGN    8
BACKS:
        DQ    DOCOL
        DQ    BACKS+HEADSIZE
        DQ    B_IMMED
        DQ    PAREN
        DQ    N_BACKS
        DQ    0
        DQ    0

; Backup one character, just in case we are at the end of a line.
        DQ      LIT, -1, PP, PSTOR
        DQ      LIT,ALF
        DQ      PARSE
        DQ      TDROP
        DQ      SEMIS
;

;  ************
;  *   QUIT   *
;  ************
;
        ALIGN    8
N_QUIT:
        DQ      4
        DB      "QUIT"
        ALIGN    8
QUIT:
        DQ    DOCOL
        DQ    QUIT+HEADSIZE
        DQ    0x0
        DQ    BACKS
        DQ    N_QUIT
        DQ    0
        DQ    0

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

;  **********
;  *   OK   *
;  **********
;
        ALIGN    8
N_OK:
        DQ      2
        DB      "OK"
        ALIGN    8
OK:
        DQ    DOCOL
        DQ    OK+HEADSIZE
        DQ    0x0
        DQ    QUIT
        DQ    N_OK
        DQ    0
        DQ    0

        DQ      STATE
        DQ      FETCH
        DQ      ZEQU
        DQ      ZBRAN
        DQ      OK2-$-CW ;IF
        DQ      SKIP
         DQ      3
SB4: DB      " OK"
       ALIGN    8
        DQ      LIT, SB4
        DQ      LIT, 3
        DQ      LTYPE
        DQ      CR
OK2:
        DQ      SEMIS
;

;  *************
;  *   ABORT   *
;  *************
;
        ALIGN    8
N_ABORT:
        DQ      5
        DB      "ABORT"
        ALIGN    8
ABORT:
        DQ    DOCOL
        DQ    ABORT+HEADSIZE
        DQ    0x0
        DQ    OK
        DQ    N_ABORT
        DQ    0
        DQ    0

        DQ      SZERO, FETCH, SPSTO
        DQ      ZERO, HANDLER, STOR
        DQ      QUIT
        DQ      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:
; 

        
        JMP USINI+(CW*(-2))
;

;  ************
;  *   WARM   *
;  ************
;
        ALIGN    8
N_WARM:
        DQ      4
        DB      "WARM"
        ALIGN    8
WARM:
        DQ    DOCOL
        DQ    WARM+HEADSIZE
        DQ    0x0
        DQ    ABORT
        DQ    N_WARM
        DQ    0
        DQ    0

        DQ      INIT
        DQ      SIGNON
        DQ      ABORT
        DQ      SEMIS   ;Unnecessary, but helpful for decompilation.
;


;  ***************
;  *   OPTIONS   *
;  ***************
;
        ALIGN    8
N_OPTIONS:
        DQ      7
        DB      "OPTIONS"
        ALIGN    8
OPTIONS:
        DQ    DOCOL
        DQ    OPTIONS+HEADSIZE
        DQ    0x0
        DQ    WARM
        DQ    N_OPTIONS
        DQ    0
        DQ    0

;       Execute option.
        DQ      ARGS, FETCH, CELLP, CELLP, FETCH, LDUP
        DQ      ZBRAN
        DQ      OPT4-$-CW ; No options  



;Supposedly on the stack is now a pointer to the option.
        DQ      COUNT

        DQ      LIT, '-', UNEQ
        DQ      ZBRAN
        DQ      OPT3-$-CW
        DQ      LIT, 3, LDUP, LERROR
        DQ      XCODE, STOR, BYE
OPT3:
        DQ      CFET
        DQ      LIT, 0x1F, LAND
        DQ      LLOAD       ;Supposedly stack-neutral.
        DQ      ZERO, SWAP ; Sign on suppressed.
OPT4:
        DQ      DROP
        DQ      SEMIS
;


;  ************
;  *   COLD   *
;  ************
;
        ALIGN    8
N_COLD:
        DQ      4
        DB      "COLD"
        ALIGN    8
COLD:
        DQ    DOCOL
        DQ    COLD5
        DQ    0x0
        DQ    OPTIONS
        DQ    N_COLD
        DQ    0
        DQ    0

; Fill user area for single task.
        DQ      LIT, USINI      ; Fails if SP/RP are not usable!
        DQ      LIT, USINI+(CW*(1)), FETCH
        DQ      LIT, US
        DQ      LCMOVE
        DQ      INIT
COLD0:  DQ      ONE            ; Sign on wanted.
;

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

;  *************
;  *   _INIT   *
;  *************
;
        ALIGN    8
N_INIT:
        DQ      5
        DB      "_INIT"
        ALIGN    8
INIT:
        DQ    DOCOL
        DQ    INIT+HEADSIZE
        DQ    0x0
        DQ    COLD
        DQ    N_INIT
        DQ    0
        DQ    0

        DQ      SZERO, FETCH, SPSTO
        DQ      ZERO, HANDLER, STOR
        DQ      DECA
        DQ      ONLY, FORTH, DEFIN

        DQ      LIT, 0, BLINI  ;Default, open library file read-only!;
;
        DQ      SEMIS
;
;

;  ***********
;  *   S>D   *
;  ***********
;
        ALIGN    8
N_STOD:
        DQ      3
        DB      "S>D"
        ALIGN    8
STOD:
        DQ    STOD+HEADSIZE
        DQ    STOD+HEADSIZE
        DQ    0x0
        DQ    INIT
        DQ    N_STOD
        DQ    0
        DQ    0

        POP     RDX      ;S1
        SUB     RAX,RAX
        OR      RDX,RDX
        JNS     STOD1   ;POS
        DEC     RAX      ;NEG
STOD1:
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   ABS   *
;  ***********
;
        ALIGN    8
N_LABS:
        DQ      3
        DB      "ABS"
        ALIGN    8
LABS:
        DQ    DOCOL
        DQ    LABS+HEADSIZE
        DQ    0x0
        DQ    STOD
        DQ    N_LABS
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ZLESS
        DQ      ZBRAN
        DQ      PM1-$-CW   ;IF
        DQ      NEGATE   ;THEN
PM1:
        DQ      SEMIS
;

;  ************
;  *   DABS   *
;  ************
;
        ALIGN    8
N_DABS:
        DQ      4
        DB      "DABS"
        ALIGN    8
DABS:
        DQ    DOCOL
        DQ    DABS+HEADSIZE
        DQ    0x0
        DQ    LABS
        DQ    N_DABS
        DQ    0
        DQ    0

        DQ      LDUP
        DQ      ZLESS
        DQ      ZBRAN
        DQ      DPM1-$-CW  ;IF
        DQ      DNEGA   ;THEN
DPM1:
        DQ      SEMIS
;

;  ***********
;  *   MIN   *
;  ***********
;
        ALIGN    8
N_MIN:
        DQ      3
        DB      "MIN"
        ALIGN    8
MIN:
        DQ    DOCOL
        DQ    MIN+HEADSIZE
        DQ    0x0
        DQ    DABS
        DQ    N_MIN
        DQ    0
        DQ    0

        DQ      TDUP
        DQ      GREAT
        DQ      ZBRAN
        DQ      MIN1-$-CW  ;IF
        DQ      SWAP    ;THEN
MIN1:   DQ      DROP
        DQ      SEMIS
;

;  ***********
;  *   MAX   *
;  ***********
;
        ALIGN    8
N_MAX:
        DQ      3
        DB      "MAX"
        ALIGN    8
MAX:
        DQ    DOCOL
        DQ    MAX+HEADSIZE
        DQ    0x0
        DQ    MIN
        DQ    N_MAX
        DQ    0
        DQ    0

        DQ      TDUP
        DQ      LESS
        DQ      ZBRAN
        DQ      MAX1-$-CW  ;IF
        DQ      SWAP    ;THEN
MAX1:   DQ      DROP
        DQ      SEMIS
;

;  **************
;  *   LSHIFT   *
;  **************
;
        ALIGN    8
N_LSHIFT:
        DQ      6
        DB      "LSHIFT"
        ALIGN    8
LSHIFT:
        DQ    LSHIFT+HEADSIZE
        DQ    LSHIFT+HEADSIZE
        DQ    0x0
        DQ    MAX
        DQ    N_LSHIFT
        DQ    0
        DQ    0

        POP     RCX
        POP     RAX
        SHL     RAX,CL
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **************
;  *   RSHIFT   *
;  **************
;
        ALIGN    8
N_RSHIFT:
        DQ      6
        DB      "RSHIFT"
        ALIGN    8
RSHIFT:
        DQ    RSHIFT+HEADSIZE
        DQ    RSHIFT+HEADSIZE
        DQ    0x0
        DQ    LSHIFT
        DQ    N_RSHIFT
        DQ    0
        DQ    0

        POP     RCX
        POP     RAX
        SHR     RAX,CL
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   M*   *
;  **********
;
        ALIGN    8
N_MSTAR:
        DQ      2
        DB      "M*"
        ALIGN    8
MSTAR:
        DQ    MSTAR+HEADSIZE
        DQ    MSTAR+HEADSIZE
        DQ    0x0
        DQ    RSHIFT
        DQ    N_MSTAR
        DQ    0
        DQ    0

        POP     RAX
        POP     RBX
        IMUL     RBX      ;SIGNED
        XCHG    RAX,RDX   ;AX NOW = MSW
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ;STORE DOUBLE CELL
;

;  **************
;  *   SM/REM   *
;  **************
;
        ALIGN    8
N_MSLAS:
        DQ      6
        DB      "SM/REM"
        ALIGN    8
MSLAS:
        DQ    MSLAS+HEADSIZE
        DQ    MSLAS+HEADSIZE
        DQ    0x0
        DQ    MSTAR
        DQ    N_MSLAS
        DQ    0
        DQ    0

        POP     RBX      ;DIVISOR
        POP     RDX      ;MSW OF DIVIDEND
        POP     RAX      ;LSW OF DIVIDEND
        IDIV     RBX      ; 64 BIT DIVIDE
        PUSH    RDX
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]             ;STORE QUOT/REM
;

;
;  **********
;  *   2/   *
;  **********
;
        ALIGN    8
N_TWOSL:
        DQ      2
        DB      "2/"
        ALIGN    8
TWOSL:
        DQ    TWOSL+HEADSIZE
        DQ    TWOSL+HEADSIZE
        DQ    0x0
        DQ    MSLAS
        DQ    N_TWOSL
        DQ    0
        DQ    0

        POP     RAX      ;(S1) <- (S1) + (S2)
        SAR     RAX,1
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   

;

;
;  **********
;  *   2*   *
;  **********
;
        ALIGN    8
N_TWOST:
        DQ      2
        DB      "2*"
        ALIGN    8
TWOST:
        DQ    TWOST+HEADSIZE
        DQ    TWOST+HEADSIZE
        DQ    0x0
        DQ    TWOSL
        DQ    N_TWOST
        DQ    0
        DQ    0

        POP     RAX      ;(S1) <- (S1) + (S2)
        SAL     RAX,1
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  **********
;  *   1-   *
;  **********
;
        ALIGN    8
N_ONEM:
        DQ      2
        DB      "1-"
        ALIGN    8
ONEM:
        DQ    DOCOL
        DQ    ONEM+HEADSIZE
        DQ    0x0
        DQ    TWOST
        DQ    N_ONEM
        DQ    0
        DQ    0

        DQ      ONE, LSUB
        DQ      SEMIS
;

;  **************
;  *   FM/MOD   *
;  **************
;
        ALIGN    8
N_FMSLAS:
        DQ      6
        DB      "FM/MOD"
        ALIGN    8
FMSLAS:
        DQ    DOCOL
        DQ    FMSLAS+HEADSIZE
        DQ    0x0
        DQ    ONEM
        DQ    N_FMSLAS
        DQ    0
        DQ    0

        DQ      LDUP, TOR
        DQ      TDUP, LXOR, TOR
        DQ      MSLAS
        DQ      FROMR, ZLESS
        DQ      ZBRAN
        DQ      FMMOD1-$-CW
        DQ      OVER
        DQ      ZBRAN
        DQ      FMMOD1-$-CW
        DQ      ONE, LSUB
        DQ      SWAP, FROMR, PLUS, SWAP
        DQ      BRAN
        DQ      FMMOD2-$-CW
FMMOD1:
        DQ      RDROP
FMMOD2:
        DQ      SEMIS
;

;  *********
;  *   *   *
;  *********
;
        ALIGN    8
N_STAR:
        DQ      1
        DB      "*"
        ALIGN    8
STAR:
        DQ    DOCOL
        DQ    STAR+HEADSIZE
        DQ    0x0
        DQ    FMSLAS
        DQ    N_STAR
        DQ    0
        DQ    0

        DQ      MSTAR
        DQ      DROP
        DQ      SEMIS
;

;  ************
;  *   /MOD   *
;  ************
;
        ALIGN    8
N_SLMOD:
        DQ      4
        DB      "/MOD"
        ALIGN    8
SLMOD:
        DQ    DOCOL
        DQ    SLMOD+HEADSIZE
        DQ    0x0
        DQ    STAR
        DQ    N_SLMOD
        DQ    0
        DQ    0

        DQ      TOR
        DQ      STOD
        DQ      FROMR
        DQ      MSLAS
        DQ      SEMIS
;

;  *********
;  *   /   *
;  *********
;
        ALIGN    8
N_SLASH:
        DQ      1
        DB      "/"
        ALIGN    8
SLASH:
        DQ    DOCOL
        DQ    SLASH+HEADSIZE
        DQ    0x0
        DQ    SLMOD
        DQ    N_SLASH
        DQ    0
        DQ    0

        DQ      SLMOD
        DQ      NIP
        DQ      SEMIS
;

;  ***********
;  *   MOD   *
;  ***********
;
        ALIGN    8
N_LMOD:
        DQ      3
        DB      "MOD"
        ALIGN    8
LMOD:
        DQ    DOCOL
        DQ    LMOD+HEADSIZE
        DQ    0x0
        DQ    SLASH
        DQ    N_LMOD
        DQ    0
        DQ    0

        DQ      SLMOD
        DQ      DROP
        DQ      SEMIS
;

;  *************
;  *   */MOD   *
;  *************
;
        ALIGN    8
N_SSMOD:
        DQ      5
        DB      "*/MOD"
        ALIGN    8
SSMOD:
        DQ    DOCOL
        DQ    SSMOD+HEADSIZE
        DQ    0x0
        DQ    LMOD
        DQ    N_SSMOD
        DQ    0
        DQ    0

        DQ      TOR
        DQ      MSTAR
        DQ      FROMR
        DQ      MSLAS
        DQ      SEMIS
;

;  **********
;  *   */   *
;  **********
;
        ALIGN    8
N_SSLA:
        DQ      2
        DB      "*/"
        ALIGN    8
SSLA:
        DQ    DOCOL
        DQ    SSLA+HEADSIZE
        DQ    0x0
        DQ    SSMOD
        DQ    N_SSLA
        DQ    0
        DQ    0

        DQ      SSMOD
        DQ      NIP
        DQ      SEMIS
;


;  *************
;  *   M/MOD   *
;  *************
;
        ALIGN    8
N_MSMOD1:
        DQ      5
        DB      "M/MOD"
        ALIGN    8
MSMOD1:
        DQ    DOCOL
        DQ    UDMSMOD 
        DQ    0x0
        DQ    SSLA
        DQ    N_MSMOD1
        DQ    0
        DQ    0

;  ***************
;  *   UDM/MOD   *
;  ***************
;
        ALIGN    8
N_MSMOD:
        DQ      7
        DB      "UDM/MOD"
        ALIGN    8
MSMOD:
        DQ    DOCOL
        DQ    MSMOD+HEADSIZE
        DQ    0x0
        DQ    MSMOD1
        DQ    N_MSMOD
        DQ    0
        DQ    0

UDMSMOD:
        DQ      TOR
        DQ      ZERO
        DQ      RR
        DQ      USLAS
        DQ      FROMR
        DQ      SWAP
        DQ      TOR
        DQ      USLAS
        DQ      FROMR
        DQ      SEMIS
;

;  **************
;  *   (LINE)   *
;  **************
;
        ALIGN    8
N_PLINE:
        DQ      6
        DB      "(LINE)"
        ALIGN    8
PLINE:
        DQ    DOCOL
        DQ    PLINE+HEADSIZE
        DQ    0x0
        DQ    MSMOD
        DQ    N_PLINE
        DQ    0
        DQ    0

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

;  **************
;  *   ERRSCR   *
;  **************
;
        ALIGN    8
N_ERRSCR:
        DQ      6
        DB      "ERRSCR"
        ALIGN    8
ERRSCR:
        DQ    DOVAR
        DQ    ERRSCR+HEADSIZE
        DQ    0x0
        DQ    PLINE
        DQ    N_ERRSCR
        DQ    0
        DQ    0

        DQ ERRORSCREEN
;

;  ***************
;  *   MESSAGE   *
;  ***************
;
        ALIGN    8
N_MESS:
        DQ      7
        DB      "MESSAGE"
        ALIGN    8
MESS:
        DQ    DOCOL
        DQ    MESS+HEADSIZE
        DQ    0x0
        DQ    ERRSCR
        DQ    N_MESS
        DQ    0
        DQ    0

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

;  ***********
;  *   PC@   *
;  ***********
;
        ALIGN    8
N_PCFET:
        DQ      3
        DB      "PC@"
        ALIGN    8
PCFET:
        DQ    PCFET+HEADSIZE
        DQ    PCFET+HEADSIZE
        DQ    0x0
        DQ    MESS
        DQ    N_PCFET
        DQ    0
        DQ    0

; FETCH CHARACTER (BYTE) FROM PORT
        POP     RDX      ; PORT ADDR
        XOR     RAX,RAX
        IN      AL,DX  ; BYTE INPUT
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   PC!   *
;  ***********
;
        ALIGN    8
N_PCSTO:
        DQ      3
        DB      "PC!"
        ALIGN    8
PCSTO:
        DQ    PCSTO+HEADSIZE
        DQ    PCSTO+HEADSIZE
        DQ    0x0
        DQ    PCFET
        DQ    N_PCSTO
        DQ    0
        DQ    0

        POP     RDX      ;PORT ADDR
        POP     RAX      ;DATA
        OUT     DX,AL   ; BYTE OUTPUT
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   PW@   *
;  ***********
;
        ALIGN    8
N_PFET:
        DQ      3
        DB      "PW@"
        ALIGN    8
PFET:
        DQ    PFET+HEADSIZE
        DQ    PFET+HEADSIZE
        DQ    0x0
        DQ    PCSTO
        DQ    N_PFET
        DQ    0
        DQ    0

        POP     RDX      ;PORT ADDR
        IN      AX,DX  ;WORD INPUT
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  ***********
;  *   PW!   *
;  ***********
;
        ALIGN    8
N_PSTO:
        DQ      3
        DB      "PW!"
        ALIGN    8
PSTO:
        DQ    PSTO+HEADSIZE
        DQ    PSTO+HEADSIZE
        DQ    0x0
        DQ    PFET
        DQ    N_PSTO
        DQ    0
        DQ    0

        POP     RDX      ;PORT ADDR
        POP     RAX      ;DATA
        OUT     DX,AX   ;WORD OUTPUT
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]   
;

;  *************
;  *   _PREV   *
;  *************
;
        ALIGN    8
N__PREV:
        DQ      5
        DB      "_PREV"
        ALIGN    8
_PREV:
        DQ    DOVAR
        DQ    _PREV+HEADSIZE
        DQ    0x0
        DQ    PSTO
        DQ    N__PREV
        DQ    0
        DQ    0

        DQ      BUF1
;

;  *************
;  *   #BUFF   *
;  *************
;
        ALIGN    8
N_NOBUF:
        DQ      5
        DB      "#BUFF"
        ALIGN    8
NOBUF:
        DQ    DOCON
        DQ    NBUF
        DQ    0x0
        DQ    _PREV
        DQ    N_NOBUF
        DQ    0
        DQ    0

;

;  ************
;  *   +BUF   *
;  ************
;
        ALIGN    8
N_PBUF:
        DQ      4
        DB      "+BUF"
        ALIGN    8
PBUF:
        DQ    DOCOL
        DQ    PBUF+HEADSIZE
        DQ    0x0
        DQ    NOBUF
        DQ    N_PBUF
        DQ    0
        DQ    0

        DQ      BBUF, CELLP, CELLP
        DQ      PLUS,LDUP
        DQ      _LIMIT,EQUAL
        DQ      ZBRAN
        DQ      PBUF1-$-CW
        DQ      DROP,_FIRST
PBUF1:  DQ      LDUP, _PREV, FETCH, LSUB
        DQ      SEMIS
;

;  **************
;  *   UPDATE   *
;  **************
;
        ALIGN    8
N_UPDAT:
        DQ      6
        DB      "UPDATE"
        ALIGN    8
UPDAT:
        DQ    DOCOL
        DQ    UPDAT+HEADSIZE
        DQ    0x0
        DQ    PBUF
        DQ    N_UPDAT
        DQ    0
        DQ    0

        DQ      _PREV, FETCH
        DQ      LDUP, CELLP,CELLP
        DQ      SWAP, FETCH
        DQ      LOFFSET,  FETCH, PLUS
        DQ      BLWRITE
        DQ      SEMIS
;

;  *********************
;  *   EMPTY-BUFFERS   *
;  *********************
;
        ALIGN    8
N_MTBUF:
        DQ      13
        DB      "EMPTY-BUFFERS"
        ALIGN    8
MTBUF:
        DQ    DOCOL
        DQ    MTBUF+HEADSIZE
        DQ    0x0
        DQ    UPDAT
        DQ    N_MTBUF
        DQ    0
        DQ    0

        DQ      _FIRST
        DQ      _LIMIT,OVER
        DQ      LSUB,LERASE
        DQ      _FIRST, _PREV, STOR
        DQ      SEMIS
        ;
;

;  ****************
;  *   (BUFFER)   *
;  ****************
;
        ALIGN    8
N_BUFFER:
        DQ      8
        DB      "(BUFFER)"
        ALIGN    8
BUFFER:
        DQ    DOCOL
        DQ    BUFFER+HEADSIZE
        DQ    0x0
        DQ    MTBUF
        DQ    N_BUFFER
        DQ    0
        DQ    0

; Find the buffer, if it is already here.
    DQ      _PREV, FETCH
BUFFER1:
    DQ          TOR, RR, FETCH, OVER, EQUAL
    DQ      ZBRAN
        DQ      BUFFER3-$-CW
    DQ        DROP, FROMR, EXIT
BUFFER3:
    DQ          FROMR
    DQ      PBUF, ZEQU
    DQ      ZBRAN
        DQ      BUFFER1-$-CW
; We are left with the previous buffer.
BUFFER2:
    DQ       PBUF, ZEQU, LIT, 48, QERR  ; No free buffers available.
    DQ       LDUP, CELLP, FETCH
    DQ       LIT, -1, GREAT        ; Unlocked buffer?
    DQ      ZBRAN
        DQ      BUFFER2-$-CW
    DQ       TOR
; Fill in the house keeping.
    DQ       RR, STOR
    DQ       ZERO, RR, CELLP, STOR

    DQ       RR, _PREV, STOR
    DQ       FROMR
    DQ  SEMIS
;


;  *************
;  *   BLOCK   *
;  *************
;
        ALIGN    8
N_BLOCK:
        DQ      5
        DB      "BLOCK"
        ALIGN    8
BLOCK:
        DQ    DOCOL
        DQ    BLOCK+HEADSIZE
        DQ    0x0
        DQ    BUFFER
        DQ    N_BLOCK
        DQ    0
        DQ    0


        DQ      BUFFER
        DQ      LDUP, CELLP, FETCH, ONE, LAND, ZEQU
        DQ      ZBRAN
        DQ      BLOCK1-$-CW
        DQ      LDUP, CELLP, CELLP
        DQ      OVER, FETCH
        DQ      LOFFSET,  FETCH, PLUS
        DQ      BLREAD
        DQ      LDUP, CELLP , ONE, TOGGL
BLOCK1:
        DQ      LDUP, _PREV, STOR
        DQ      CELLP, CELLP
        DQ      SEMIS
;

;  *************
;  *   FLUSH   *
;  *************
;
        ALIGN    8
N_FLUSH:
        DQ      5
        DB      "FLUSH"
        ALIGN    8
FLUSH:
        DQ    DOCOL
        DQ    (MTBUF+HEADSIZE)
        DQ    0x0
        DQ    BLOCK
        DQ    N_FLUSH
        DQ    0
        DQ    0


; Unlock all buffers
        DQ      _LIMIT
        DQ      _FIRST, CELLP
        DQ     XDO
        DQ      FLUS2-$-CW
FLUS1:  DQ      ZERO, IDO, STOR
        DQ      LIT,(KBBUF+2*CW)
        DQ      PLOOP
        DQ      (FLUS1-$)
FLUS2:
        DQ      SEMIS
;

;  ************
;  *   SAVE   *
;  ************
;
        ALIGN    8
N_SAVE:
        DQ      4
        DB      "SAVE"
        ALIGN    8
SAVE:
        DQ    DOCOL
        DQ    SAVE+HEADSIZE
        DQ    0x0
        DQ    FLUSH
        DQ    N_SAVE
        DQ    0
        DQ    0

        DQ      FROMR
        DQ      SRC, TFET
        DQ      PP, FETCH
        DQ      TOR, TOR, TOR
        DQ      TOR
        DQ SEMIS
;

;  ***************
;  *   RESTORE   *
;  ***************
;
        ALIGN    8
N_RESTO:
        DQ      7
        DB      "RESTORE"
        ALIGN    8
RESTO:
        DQ    DOCOL
        DQ    RESTO+HEADSIZE
        DQ    0x0
        DQ    SAVE
        DQ    N_RESTO
        DQ    0
        DQ    0

        DQ      FROMR
        DQ      FROMR, FROMR, FROMR
        DQ      PP, STOR
        DQ      SRC, TSTOR
        DQ      TOR
        DQ SEMIS
;


; 
;

; 
;
;

;  ************
;  *   LOCK   *
;  ************
;
        ALIGN    8
N_LLOCK:
        DQ      4
        DB      "LOCK"
        ALIGN    8
LLOCK:
        DQ    DOCOL
        DQ    LLOCK+HEADSIZE
        DQ    0x0
        DQ    RESTO
        DQ    N_LLOCK
        DQ    0
        DQ    0

        DQ      BUFFER
        DQ      CELLP
        DQ      LIT, -2, SWAP, PSTOR
        DQ      SEMIS
;

;  **************
;  *   UNLOCK   *
;  **************
;
        ALIGN    8
N_LUNLOCK:
        DQ      6
        DB      "UNLOCK"
        ALIGN    8
LUNLOCK:
        DQ    DOCOL
        DQ    LUNLOCK+HEADSIZE
        DQ    0x0
        DQ    LLOCK
        DQ    N_LUNLOCK
        DQ    0
        DQ    0

        DQ      BUFFER
        DQ      CELLP
        DQ      TWO, SWAP, PSTOR
        DQ      SEMIS
;

;  ************
;  *   LOAD   *
;  ************
;
        ALIGN    8
N_LLOAD:
        DQ      4
        DB      "LOAD"
        ALIGN    8
LLOAD:
        DQ    DOCOL
        DQ    LLOAD+HEADSIZE
        DQ    0x0
        DQ    LUNLOCK
        DQ    N_LLOAD
        DQ    0
        DQ    0

        DQ      SAVE
        DQ      TOR
        DQ      RR, LIT, LLOCK, CATCH  ; Be careful about always unlocking.
        DQ      LDUP, ZEQU
        DQ      ZBRAN
        DQ      LOAD5-$-CW
        DQ      DROP
        DQ      RR, BLOCK     ; Can't fail anymore. 
        DQ      BBUF
        DQ      SETSRC
        DQ      LIT, INTER, CATCH
        DQ      RR, LUNLOCK
LOAD5:
        DQ      RDROP
        DQ      RESTO
        DQ      THROW
        DQ      SEMIS
;

;  ************
;  *   THRU   *
;  ************
;
        ALIGN    8
N_THRU:
        DQ      4
        DB      "THRU"
        ALIGN    8
THRU:
        DQ    DOCOL
        DQ    THRU+HEADSIZE
        DQ    0x0
        DQ    LLOAD
        DQ    N_THRU
        DQ    0
        DQ    0

        DQ      ONEP, SWAP
        DQ     XDO
        DQ      THRU2-$-CW
THRU1:
        DQ      IDO, LLOAD
        DQ     ONE, XPLOOP, ZBRAN
        DQ      THRU1-$-CW
        DQ      UNLOOP 
THRU2:
        DQ      SEMIS
;

;

;  ***********
;  *   BLK   *
;  ***********
;
        ALIGN    8
N_BLK:
        DQ      3
        DB      "BLK"
        ALIGN    8
BLK:
        DQ    DOCOL
        DQ    BLK+HEADSIZE
        DQ    0x0
        DQ    THRU
        DQ    N_BLK
        DQ    0
        DQ    0

        DQ      PP, FETCH
        DQ      _FIRST, _LIMIT, WITHIN
        DQ      SRC, TFET, LSUB
        DQ      LIT, 1024, EQUAL, LAND
        DQ      ZBRAN
        DQ      BLK1-$-CW
        DQ      SRC, FETCH, TWO, LCELLS, LSUB, FETCH
        DQ      BRAN
        DQ      BLK2-$-CW
BLK1:
        DQ      ZERO
BLK2:
        DQ      PBLK, STOR
        DQ      PBLK
        DQ      SEMIS
;

;
;
; 



;  ***********
;  *   XOS   *
;  ***********
;
        ALIGN    8
N_XOS:
        DQ      3
        DB      "XOS"
        ALIGN    8
XOS:
        DQ    XOS+HEADSIZE
        DQ    XOS+HEADSIZE
        DQ    0x0
        DQ    BLK
        DQ    N_XOS
        DQ    0
        DQ    0

;

;
;
        MOV     R15,RSI   ; HIP is SI 
        POP     RAX       ; Function number              
        POP     RDX       ; Third parameter, or dummy    
        POP     RSI       ; Second parameter, or dummy   
        POP     RDI       ; First parameter.             
        SYSCALL          ;  Generic call on LINUX       
        MOV     RSI,R15
;
        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]        ; Positive means okay. Negative means -errno.
;
 ; 
;


;  ************
;  *   XOS5   *
;  ************
;
        ALIGN    8
N_XOS5:
        DQ      4
        DB      "XOS5"
        ALIGN    8
XOS5:
        DQ    XOS5+HEADSIZE
        DQ    XOS5+HEADSIZE
        DQ    0x0
        DQ    XOS
        DQ    N_XOS5
        DQ    0
        DQ    0

;

        MOV     R15,RSI   ; HIP is SI 
        POP     RAX        ; Function number            
        POP     R8       ; 5th parameter, or dummy    
        POP     R10      ; 4th parameter, or dummy    
        POP     RDX        ; Third parameter, or dummy  
        POP     RSI        ; Second parameter, or dummy 
        POP     RDI        ; First parameter.           
        SYSCALL           ; Generic call on LINUX      
        MOV     RSI,R15
;

        PUSH    RAX
        LODSQ                  ; NEXT
        JMP     QWORD[RAX]        ; Positive means okay. Negative means -errno.
;
 ; 
;

;  **********
;  *   MS   *
;  **********
;
        ALIGN    8
N_MS:
        DQ      2
        DB      "MS"
        ALIGN    8
MS:
        DQ    DOCOL
        DQ    MS+HEADSIZE
        DQ    0x0
        DQ    XOS5
        DQ    N_MS
        DQ    0
        DQ    0

; Use select because nanosleep has a 20 MS resolution. 
        DQ      LIT, 1000, LIT, 1000000, SSMOD ; (ms -- us s) 
        DQ      LIT, TV, TSTOR
        DQ      ZERO, ZERO
        DQ      ZERO, ZERO
        DQ      LIT, TV
       DQ      LIT, _newselect, XOS5

        DQ      QERRUR
        DQ      SEMIS
TV:     RB  ((CW*(2)) )    ; A time_t and a long, both cells.
;
; 
; 
        ;
;------------------------------------
;       CONSOLE RELEATED I/O         
;------------------------------------
;


; 
; 


;  *****************
;  *   RW-BUFFER   *
;  *****************
;
        ALIGN    8
N_RWBUF:
        DQ      9
        DB      "RW-BUFFER"
        ALIGN    8
RWBUF:
        DQ    DOVAR
        DQ    RWBUF+HEADSIZE
        DQ    0x0
        DQ    MS
        DQ    N_RWBUF
        DQ    0
        DQ    0

        RB  (0x1000) 
; 
; 
;


;  ***********
;  *   ZEN   *
;  ***********
;
        ALIGN    8
N_ZEN:
        DQ      3
        DB      "ZEN"
        ALIGN    8
ZEN:
        DQ    DOCOL
        DQ    ZEN+HEADSIZE
        DQ    0x0
        DQ    RWBUF
        DQ    N_ZEN
        DQ    0
        DQ    0

        DQ      RWBUF, SSTOR
        DQ      ZERO, RWBUF, CHAPP
        DQ      RWBUF, CELLP
        DQ      SEMIS
; 
; 
; 
; 
;
;


;  ******************
;  *   WRITE-FILE   *
;  ******************
;
        ALIGN    8
N_WFILE:
        DQ      10
        DB      "WRITE-FILE"
        ALIGN    8
WFILE:
        DQ    DOCOL
        DQ    WFILE+HEADSIZE
        DQ    0x0
        DQ    ZEN
        DQ    N_WFILE
        DQ    0
        DQ    0

        DQ      ROT, ROT
        DQ      LIT, write, XOS
        DQ      ZERO, MIN
        DQ      SEMIS
; 
; 
; 
; 
;


;  *****************
;  *   OPEN-FILE   *
;  *****************
;
        ALIGN    8
N_OFILE:
        DQ      9
        DB      "OPEN-FILE"
        ALIGN    8
OFILE:
        DQ    DOCOL
        DQ    OFILE+HEADSIZE
        DQ    0x0
        DQ    WFILE
        DQ    N_OFILE
        DQ    0
        DQ    0

        DQ      TOR, ZEN, FROMR
;
        DQ      X
        DQ      LIT, open, XOS
        DQ      LDUP, ZERO, MIN
        DQ      SEMIS
;
;
;
;


;  ******************
;  *   CLOSE-FILE   *
;  ******************
;
        ALIGN    8
N_CFILE:
        DQ      10
        DB      "CLOSE-FILE"
        ALIGN    8
CFILE:
        DQ    DOCOL
        DQ    CFILE+HEADSIZE
        DQ    0x0
        DQ    OFILE
        DQ    N_CFILE
        DQ    0
        DQ    0

        DQ      X, X
        DQ      LIT, close, XOS
        DQ      SEMIS
;
;
;
;
;


;  *******************
;  *   CREATE-FILE   *
;  *******************
;
        ALIGN    8
N_CREATEF:
        DQ      11
        DB      "CREATE-FILE"
        ALIGN    8
CREATEF:
        DQ    DOCOL
        DQ    CREATEF+HEADSIZE
        DQ    0x0
        DQ    CFILE
        DQ    N_CREATEF
        DQ    0
        DQ    0

        DQ      TOR, TDUP, DFILE, DROP, ZEN
        DQ      LIT, 755O, FROMR, LIT, 8, RSHIFT, LXOR
        DQ      X
        DQ      LIT, creat, XOS
        DQ      LDUP, ZERO, MAX, SWAP, ZERO, MIN
        DQ      SEMIS
;
;
;
;


;  *******************
;  *   DELETE-FILE   *
;  *******************
;
        ALIGN    8
N_DFILE:
        DQ      11
        DB      "DELETE-FILE"
        ALIGN    8
DFILE:
        DQ    DOCOL
        DQ    DFILE+HEADSIZE
        DQ    0x0
        DQ    CREATEF
        DQ    N_DFILE
        DQ    0
        DQ    0

        DQ      ZEN, X, X
        DQ      LIT, unlink, XOS
        DQ      SEMIS
;
;
;
;


;  *****************
;  *   READ-FILE   *
;  *****************
;
        ALIGN    8
N_RFILE:
        DQ      9
        DB      "READ-FILE"
        ALIGN    8
RFILE:
        DQ    DOCOL
        DQ    RFILE+HEADSIZE
        DQ    0x0
        DQ    DFILE
        DQ    N_RFILE
        DQ    0
        DQ    0

        DQ      ROT, ROT
        DQ      LIT, read, XOS
        DQ      LDUP, ZERO, MAX, SWAP, ZERO, MIN
        DQ      SEMIS
; 
; 
; 
; 
;

;

;  *********************
;  *   FILE-POSITION   *
;  *********************
;
        ALIGN    8
N_FPFILE:
        DQ      13
        DB      "FILE-POSITION"
        ALIGN    8
FPFILE:
        DQ    DOCOL
        DQ    FPFILE+HEADSIZE
        DQ    0x0
        DQ    RFILE
        DQ    N_FPFILE
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      LIT, SEEK_CUR
        DQ      LIT, lseek, XOS
        DQ      ZERO     ;Double precision return result
        DQ      OVER, LDUP
        DQ      NEGATE, LIT, 256, ULESS, LAND ; Heuristic 
        DQ      SEMIS
 ; 
;
;
;


;  ***********************
;  *   REPOSITION-FILE   *
;  ***********************
;
        ALIGN    8
N_PFILE:
        DQ      15
        DB      "REPOSITION-FILE"
        ALIGN    8
PFILE:
        DQ    DOCOL
        DQ    PFILE+HEADSIZE
        DQ    0x0
        DQ    FPFILE
        DQ    N_PFILE
        DQ    0
        DQ    0

        DQ      TOR, DROP, FROMR   ;Convert to single precision.
        DQ      SWAP
        DQ      LIT, SEEK_SET
        DQ      LIT, lseek, XOS
        DQ      ZERO, MIN
        DQ      SEMIS
 ; 
;
;
;
;
; 

;  ****************
;  *   GET-FILE   *
;  ****************
;
        ALIGN    8
N_GETFILE:
        DQ      8
        DB      "GET-FILE"
        ALIGN    8
GETFILE:
        DQ    DOCOL
        DQ    GETFILE+HEADSIZE
        DQ    0x0
        DQ    PFILE
        DQ    N_GETFILE
        DQ    0
        DQ    0

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

;  ****************
;  *   PUT-FILE   *
;  ****************
;
        ALIGN    8
N_PUTFILE:
        DQ      8
        DB      "PUT-FILE"
        ALIGN    8
PUTFILE:
        DQ    DOCOL
        DQ    PUTFILE+HEADSIZE
        DQ    0x0
        DQ    GETFILE
        DQ    N_PUTFILE
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      CREATEF, THROW
        DQ      LDUP, TOR
        DQ      WFILE, THROW
        DQ      FROMR, CFILE, THROW
        DQ      SEMIS
;

;  ****************
;  *   INCLUDED   *
;  ****************
;
        ALIGN    8
N_INCLUDED:
        DQ      8
        DB      "INCLUDED"
        ALIGN    8
INCLUDED:
        DQ    DOCOL
        DQ    INCLUDED+HEADSIZE
        DQ    0x0
        DQ    PUTFILE
        DQ    N_INCLUDED
        DQ    0
        DQ    0

        DQ      HERE, TOR
        DQ      LIT, GETFILE, CATCH
        DQ      LDUP
        DQ      ZBRAN
        DQ      INCLUD1-$-CW
        DQ      FROMR, LDP, STOR
        DQ      THROW
        DQ      BRAN
        DQ      INCLUD2-$-CW
INCLUD1:
        DQ      RDROP, DROP
INCLUD2:
        DQ      EVALUATE
        DQ      SEMIS
;

;  ***************
;  *   INCLUDE   *
;  ***************
;
        ALIGN    8
N_LINCLUD:
        DQ      7
        DB      "INCLUDE"
        ALIGN    8
LINCLUD:
        DQ    DOCOL
        DQ    LINCLUD+HEADSIZE
        DQ    0x0
        DQ    INCLUDED
        DQ    N_LINCLUD
        DQ    0
        DQ    0

        DQ      LNAME, INCLUDED
        DQ      SEMIS
;

;  ******************
;  *   REFILL-TIB   *
;  ******************
;
        ALIGN    8
N_REFTIB:
        DQ      10
        DB      "REFILL-TIB"
        ALIGN    8
REFTIB:
        DQ    DOCOL
        DQ    REFTIB+HEADSIZE
        DQ    0x0
        DQ    LINCLUD
        DQ    N_REFTIB
        DQ    0
        DQ    0

        DQ      REMAIND, FETCH, TOR
        DQ      TIB, FETCH, RR, PLUS
        DQ      LIT, TIBSIZE, RR, LSUB
        DQ      ZERO
        DQ      RFILE
        DQ      QERRUR
        DQ      LDUP, ZEQU, LIT, -EPIPE, LAND ; Presumably end of pipe.
        DQ      QERRUR
        DQ      TIB, FETCH, SWAP, FROMR, PLUS
        DQ      REMAIND, TSTOR
        DQ      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   *
;  **************
;
        ALIGN    8
N_ACCEP:
        DQ      6
        DB      "ACCEPT"
        ALIGN    8
ACCEP:
        DQ    DOCOL
        DQ    ACCEP+HEADSIZE
        DQ    0x0
        DQ    REFTIB
        DQ    N_ACCEP
        DQ    0
        DQ    0

        DQ      PACCEP
        DQ      TSWAP, ROT, MIN
        DQ      LDUP, TOR, LMOVE, FROMR
        DQ      SEMIS
;

;  ****************
;  *   (ACCEPT)   *
;  ****************
;
        ALIGN    8
N_PACCEP:
        DQ      8
        DB      "(ACCEPT)"
        ALIGN    8
PACCEP:
        DQ    DOCOL
        DQ    PACCEP+HEADSIZE
        DQ    0x0
        DQ    ACCEP
        DQ    N_PACCEP
        DQ    0
        DQ    0

PACCEP2:
;        DC      NOLF
;        DC       LIT, 'a', EMIT
        DQ      REMAIND
        DQ      TFET
        DQ      LIT, ALF, SINDEX
        DQ      ZEQU
        DQ      ZBRAN
        DQ      PACCEP1-$-CW
;        DC      RETOBO
        DQ      REMAIND, TFET
        DQ      TIB, FETCH
        DQ      SWAP, LMOVE
        DQ      TIB, FETCH
        DQ      REMAIND, CELLP, STOR
        DQ      REFTIB
        DQ      BRAN
        DQ      PACCEP2-$-CW
PACCEP1:
;        DC      SPLOFF
        DQ      REMAIND, TFET
        DQ      LIT, ALF, SSLAS
        DQ      TSWAP, REMAIND, TSTOR
        DQ      SEMIS


;  ***********
;  *   KEY   *
;  ***********
;
        ALIGN    8
N_KEY:
        DQ      3
        DB      "KEY"
        ALIGN    8
KEY:
        DQ    DOCOL
        DQ    KEY+HEADSIZE
        DQ    0x0
        DQ    PACCEP
        DQ    N_KEY
        DQ    0
        DQ    0

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

;  ************
;  *   KEY?   *
;  ************
;
        ALIGN    8
N_KEYQ:
        DQ      4
        DB      "KEY?"
        ALIGN    8
KEYQ:
        DQ    DOCOL
        DQ    KEYQ+HEADSIZE
        DQ    0x0
        DQ    KEY
        DQ    N_KEYQ
        DQ    0
        DQ    0

        DQ      ZERO, LIT, RAWIO, STTERM
        DQ      ZERO, ZERO     ; Time out of zero. See MS.
        DQ    LIT, TV, LSTOR, LIT, TV+4, LSTOR
        
        DQ      ONE ; Waiting for standard in.
        DQ      LIT, RFDS, LSTOR
        DQ      ONE     ; # of highest channel to watch.
        DQ      LIT, RFDS
        DQ      ZERO, ZERO  ; Not output, not events.
        DQ      LIT, TV
        DQ      LIT, _newselect, XOS5
        DQ      LDUP,  QERRUR
        DQ      NEGATE        ; 1 -> flag.
        DQ      ZERO, LIT, RAWIO, STTERM
        DQ      SEMIS
        ALIGN    8
RFDS:   RB  ((CW*(32)))      ;32 channels maximum.
;

;  ************
;  *   TYPE   *
;  ************
;
        ALIGN    8
N_LTYPE:
        DQ      4
        DB      "TYPE"
        ALIGN    8
LTYPE:
        DQ    DOCOL
        DQ    LTYPE+HEADSIZE
        DQ    0x0
        DQ    KEYQ
        DQ    N_LTYPE
        DQ    0
        DQ    0

        DQ      LDUP, LOUT, PSTOR
        DQ      ONE, WFILE, THROW
        DQ      SEMIS
;

;  *************
;  *   ETYPE   *
;  *************
;
        ALIGN    8
N_ETYPE:
        DQ      5
        DB      "ETYPE"
        ALIGN    8
ETYPE:
        DQ    DOCOL
        DQ    ETYPE+HEADSIZE
        DQ    0x0
        DQ    LTYPE
        DQ    N_ETYPE
        DQ    0
        DQ    0

        DQ      TWO, WFILE, THROW
        DQ      SEMIS
;

;  ************
;  *   EMIT   *
;  ************
;
        ALIGN    8
N_EMIT:
        DQ      4
        DB      "EMIT"
        ALIGN    8
EMIT:
        DQ    DOCOL
        DQ    EMIT+HEADSIZE
        DQ    0x0
        DQ    ETYPE
        DQ    N_EMIT
        DQ    0
        DQ    0

        DQ      SPFET, ONE, LTYPE
        DQ      DROP
        DQ      SEMIS
;

;  **************
;  *   TERMIO   *
;  **************
;
        ALIGN    8
N_TERMIO:
        DQ      6
        DB      "TERMIO"
        ALIGN    8
TERMIO:
        DQ    DOVAR
        DQ    TERMIO+HEADSIZE
        DQ    0x0
        DQ    EMIT
        DQ    N_TERMIO
        DQ    0
        DQ    0

        RB  (SIZE_TERMIO)      ; Filled in during cold boot.
;

;  ****************
;  *   SET-TERM   *
;  ****************
;
        ALIGN    8
N_STTERM:
        DQ      8
        DB      "SET-TERM"
        ALIGN    8
STTERM:
        DQ    DOCOL
        DQ    STTERM+HEADSIZE
        DQ    0x0
        DQ    TERMIO
        DQ    N_STTERM
        DQ    0
        DQ    0

SIZEL   = 4     ; Also for 64 bits. 
        DQ      LIT, (TERMIO+HEADSIZE)+SIZEL*3
        DQ      SWAP, TOGGL
        DQ      LIT, (TERMIO+HEADSIZE)+SIZEL*4+7
        DQ      CSTOR
        DQ      ZERO, LIT, TCSETS, TERMIO
        DQ      LIT, ioctl, XOS, QERRUR
        DQ      SEMIS
;
; 
;
;
;
;
;
;

        ;
;------------------------------------
;       SYSTEM DEPENDANT DISK I/O
;------------------------------------

;  ******************
;  *   DISK-ERROR   *
;  ******************
;
        ALIGN    8
N_DERR:
        DQ      10
        DB      "DISK-ERROR"
        ALIGN    8
DERR:
        DQ    DOVAR
        DQ    DERR+HEADSIZE
        DQ    0x0
        DQ    STTERM
        DQ    N_DERR
        DQ    0
        DQ    0

        DQ      -1
;


;  ******************
;  *   BLOCK-FILE   *
;  ******************
;
        ALIGN    8
N_BLFL:
        DQ      10
        DB      "BLOCK-FILE"
        ALIGN    8
BLFL:
        DQ    DOVAR
        DQ    BLFL+HEADSIZE
        DQ    0x0
        DQ    DERR
        DQ    N_BLFL
        DQ    0
        DQ    0

        ; Allow for some path, at most 80 char's
        DQ      80
        DB      "forth.lab                                                                       "

;  ********************
;  *   BLOCK-HANDLE   *
;  ********************
;
        ALIGN    8
N_BHAN:
        DQ      12
        DB      "BLOCK-HANDLE"
        ALIGN    8
BHAN:
        DQ    DOVAR
        DQ    BHAN+HEADSIZE
        DQ    0x0
        DQ    BLFL
        DQ    N_BHAN
        DQ    0
        DQ    0

        DQ      -1
;

;  *******************
;  *   ?DISK-ERROR   *
;  *******************
;
        ALIGN    8
N_QDSKER:
        DQ      11
        DB      "?DISK-ERROR"
        ALIGN    8
QDSKER:
        DQ    DOCOL
        DQ    QDSKER+HEADSIZE
        DQ    0x0
        DQ    BHAN
        DQ    N_QDSKER
        DQ    0
        DQ    0

        DQ      LIT, 8, QERR
        DQ      SEMIS
;
;


;  ******************
;  *   BLOCK-INIT   *
;  ******************
;
        ALIGN    8
N_BLINI:
        DQ      10
        DB      "BLOCK-INIT"
        ALIGN    8
BLINI:
        DQ    DOCOL
        DQ    BLINI+HEADSIZE
        DQ    0x0
        DQ    QDSKER
        DQ    N_BLINI
        DQ    0
        DQ    0

        DQ      BLFL, SFET, DTRAI
        DQ      ROT
        DQ      OFILE
        DQ      ZEQU, NEGATE  ; 0 if disk problems, 1 if not.
        DQ      LWARN, FETCH, MIN ; AND but WARNING is 0/1.
        DQ      LWARN, STOR
        DQ      BHAN, STOR
        DQ      MTBUF
        DQ      SEMIS
;

;  ******************
;  *   BLOCK-EXIT   *
;  ******************
;
        ALIGN    8
N_BLEXI:
        DQ      10
        DB      "BLOCK-EXIT"
        ALIGN    8
BLEXI:
        DQ    DOCOL
        DQ    BLEXI+HEADSIZE
        DQ    0x0
        DQ    BLINI
        DQ    N_BLEXI
        DQ    0
        DQ    0

        DQ      FLUSH
        DQ      BHAN, FETCH
        DQ      CFILE
        DQ      ZERO, LWARN, STOR
        DQ      LIT, -1, BHAN, STOR    ;Regardless of close errors.
        DQ      QDSKER
        DQ      SEMIS
;

;  **************
;  *   BLSEEK   *
;  **************
;
        ALIGN    8
N_BLSEEK:
        DQ      6
        DB      "BLSEEK"
        ALIGN    8
BLSEEK:
        DQ    DOCOL
        DQ    BLSEEK+HEADSIZE
        DQ    0x0
        DQ    BLEXI
        DQ    N_BLSEEK
        DQ    0
        DQ    0

        DQ      BBUF
        DQ      USTAR
        DQ      BHAN, FETCH
        DQ      PFILE           ; Disk position.
        DQ      QDSKER
        DQ      SEMIS
;

;  ******************
;  *   BLOCK-READ   *
;  ******************
;
        ALIGN    8
N_BLREAD:
        DQ      10
        DB      "BLOCK-READ"
        ALIGN    8
BLREAD:
        DQ    DOCOL
        DQ    BLREAD+HEADSIZE
        DQ    0x0
        DQ    BLSEEK
        DQ    N_BLREAD
        DQ    0
        DQ    0

        DQ      BLSEEK ; That's done
        DQ      BBUF
        DQ      BHAN, FETCH
        DQ      RFILE           ; Disk read 
        DQ      SWAP, BBUF, UNEQ
        DQ      LOR, QDSKER
        DQ      SEMIS
;

;  *******************
;  *   BLOCK-WRITE   *
;  *******************
;
        ALIGN    8
N_BLWRITE:
        DQ      11
        DB      "BLOCK-WRITE"
        ALIGN    8
BLWRITE:
        DQ    DOCOL
        DQ    BLWRITE+HEADSIZE
        DQ    0x0
        DQ    BLREAD
        DQ    N_BLWRITE
        DQ    0
        DQ    0

        DQ      BLSEEK ; That's done
        DQ      BBUF
        DQ      BHAN, FETCH
        DQ      WFILE           ; Disk write
        DQ      QDSKER
        DQ      SEMIS
;
;

;  *************
;  *   SHELL   *
;  *************
;
        ALIGN    8
N_SHELL:
        DQ      5
        DB      "SHELL"
        ALIGN    8
SHELL:
        DQ    DOVAR
        DQ    SHELL+HEADSIZE
        DQ    0x0
        DQ    BLWRITE
        DQ    N_SHELL
        DQ    0
        DQ    0

         DQ      7
        DB      "/bin/sh"
        
        
        ALIGN    8
        RB  (252) ; Allow for some path

;
;


;  **************
;  *   SYSTEM   *
;  **************
;
        ALIGN    8
N_SYSTEM:
        DQ      6
        DB      "SYSTEM"
        ALIGN    8
SYSTEM:
        DQ    DOCOL
        DQ    SYSTEM+HEADSIZE
        DQ    0x0
        DQ    SHELL
        DQ    N_SYSTEM
        DQ    0
        DQ    0

        DQ      LIT, COMBUF, SSTOR, ZERO, LIT, COMBUF, CHAPP
        DQ      ZERO, SHELL, CHAPP, LIT, -1, SHELL, PSTOR
        DQ      X, X, X, LIT, fork, XOS
        DQ      LDUP, QERRUR
        DQ      LDUP, ZEQU
        DQ      ZBRAN
        DQ      SYSTEM1-$-CW
        DQ      SHELL, CELLP, LIT, SYSARGS
;  Get environment vector
      DQ      ARGS, FETCH, SFET, ONEP, LCELLS, PLUS
        DQ      LIT, execve, XOS
        DQ      LIT, 49, LERROR, BYE   ; Returned, this is always wrong.
SYSTEM1:
        DQ      LDUP
        DQ      LIT, STATUS, ZERO, LIT, waitpid, XOS
        DQ      LDUP
        DQ      LIT, EINTR, EQUAL
        DQ      BRAN
        DQ      SYSTEM2-$-CW
        DQ      DROP
        DQ      ZBRAN
        DQ      SYSTEM1-$-CW
SYSTEM2:
        DQ      QERRUR
        DQ      TDROP
        DQ      SEMIS
;
        ALIGN    8
STATUS:  DQ     0
SYSARG2: DB     "-c"
         DB      0
        ALIGN    8
COMBUF:  RB  (CW+256)   ;One cell for high level string manipulation.
        ALIGN    8
SYSARGS:DQ   (SHELL+HEADSIZE)+CW, SYSARG2, COMBUF + CW, 0
;
 ; 
;
;
;
;
; 
;
;
;
; 
; 
;


;  *********
;  *   '   *
;  *********
;
        ALIGN    8
N_ITICK:
        DQ      1
        DB      "'"
        ALIGN    8
ITICK:
        DQ    DOCOL 
        DQ    ITICK+HEADSIZE
        DQ    0x0
        DQ    SYSTEM
        DQ    N_ITICK
        DQ    0
        DQ    0

        DQ      LNAME, PRESENT
        DQ      LDUP, ZEQU
        DQ      LIT, 11, QERR
        DQ      SEMIS
;

;  ***********
;  *   [']   *
;  ***********
;
        ALIGN    8
N_BTICK:
        DQ      3
        DB      "[']"
        ALIGN    8
BTICK:
        DQ    DOCOL
        DQ    (TICK+HEADSIZE)
        DQ    B_IMMED
        DQ    ITICK
        DQ    N_BTICK
        DQ    0
        DQ    0

;
;

;  ******************
;  *   FORGET-VOC   *
;  ******************
;
        ALIGN    8
N_FORGV:
        DQ      10
        DB      "FORGET-VOC"
        ALIGN    8
FORGV:
        DQ    DOCOL
        DQ    FORGV+HEADSIZE
        DQ    0x0
        DQ    BTICK
        DQ    N_FORGV
        DQ    0
        DQ    0

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

;  **************
;  *   FORGET   *
;  **************
;
        ALIGN    8
N_FORG:
        DQ      6
        DB      "FORGET"
        ALIGN    8
FORG:
        DQ    DOCOL
        DQ    FORG+HEADSIZE
        DQ    0x0
        DQ    FORGV
        DQ    N_FORG
        DQ    0
        DQ    0

        DQ      TICK
        DQ      LDUP
        DQ      FENCE
        DQ      FETCH
        DQ      LESS
        DQ      LIT, 21, QERR
        DQ      LIT,FORGV
        DQ      FORV
        DQ      TNFA, FETCH, LDP, STOR
        DQ      SEMIS
;

;  *************
;  *   (BACK   *
;  *************
;
        ALIGN    8
N_PBACK:
        DQ      5
        DB      "(BACK"
        ALIGN    8
PBACK:
        DQ    DOCOL
        DQ    PBACK+HEADSIZE
        DQ    0x0
        DQ    FORG
        DQ    N_PBACK
        DQ    0
        DQ    0

        DQ      HERE
        DQ      SEMIS
;

;  *************
;  *   BACK)   *
;  *************
;
        ALIGN    8
N_BACKP:
        DQ      5
        DB      "BACK)"
        ALIGN    8
BACKP:
        DQ    DOCOL
        DQ    BACKP+HEADSIZE
        DQ    0x0
        DQ    PBACK
        DQ    N_BACKP
        DQ    0
        DQ    0

        DQ      HERE
        DQ      CELLP
        DQ      LSUB
        DQ      COMMA
        DQ      SEMIS
;

;  ****************
;  *   (FORWARD   *
;  ****************
;
        ALIGN    8
N_PFORWARD:
        DQ      8
        DB      "(FORWARD"
        ALIGN    8
PFORWARD:
        DQ    DOCOL
        DQ    PFORWARD+HEADSIZE
        DQ    0x0
        DQ    BACKP
        DQ    N_PFORWARD
        DQ    0
        DQ    0

        DQ      HERE
        DQ      X
        DQ      COMMA
        DQ      SEMIS
;

;  ****************
;  *   FORWARD)   *
;  ****************
;
        ALIGN    8
N_FORWARDP:
        DQ      8
        DB      "FORWARD)"
        ALIGN    8
FORWARDP:
        DQ    DOCOL
        DQ    FORWARDP+HEADSIZE
        DQ    0x0
        DQ    PFORWARD
        DQ    N_FORWARDP
        DQ    0
        DQ    0

        DQ      HERE
        DQ      OVER
        DQ      CELLP
        DQ      LSUB
        DQ      SWAP
        DQ      STOR
        DQ      SEMIS
;

;  *************
;  *   BEGIN   *
;  *************
;
        ALIGN    8
N_BEGIN:
        DQ      5
        DB      "BEGIN"
        ALIGN    8
BEGIN:
        DQ    DOCOL
        DQ    BEGIN+HEADSIZE
        DQ    B_IMMED
        DQ    FORWARDP
        DQ    N_BEGIN
        DQ    0
        DQ    0

        DQ      PBACK
        DQ      QCOMP, ONE
        DQ      SEMIS
;

;  ************
;  *   THEN   *
;  ************
;
        ALIGN    8
N_THEN:
        DQ      4
        DB      "THEN"
        ALIGN    8
THEN:
        DQ    DOCOL
        DQ    THEN+HEADSIZE
        DQ    B_IMMED
        DQ    BEGIN
        DQ    N_THEN
        DQ    0
        DQ    0

        DQ      QCOMP, TWO, QPAIR
        DQ      FORWARDP
        DQ      SEMIS
;

;  **********
;  *   DO   *
;  **********
;
        ALIGN    8
N_DO:
        DQ      2
        DB      "DO"
        ALIGN    8
DO:
        DQ    DOCOL
        DQ    DO+HEADSIZE
        DQ    B_IMMED
        DQ    THEN
        DQ    N_DO
        DQ    0
        DQ    0

         DQ      LIT, XDO, COMMA, PFORWARD, PBACK
        DQ      QCOMP, LIT,3    ; Magic number
        DQ      SEMIS
;

;  ***********
;  *   ?DO   *
;  ***********
;
        ALIGN    8
N_QDO:
        DQ      3
        DB      "?DO"
        ALIGN    8
QDO:
        DQ    DOCOL
        DQ    QDO+HEADSIZE
        DQ    B_IMMED
        DQ    DO
        DQ    N_QDO
        DQ    0
        DQ    0

         DQ      LIT, XQDO, COMMA, PFORWARD, PBACK
        DQ      QCOMP, LIT,3    ; Magic number
        DQ      SEMIS
;

;  ************
;  *   LOOP   *
;  ************
;
        ALIGN    8
N_LLOOP:
        DQ      4
        DB      "LOOP"
        ALIGN    8
LLOOP:
        DQ    DOCOL
        DQ    LLOOP+HEADSIZE
        DQ    B_IMMED
        DQ    QDO
        DQ    N_LLOOP
        DQ    0
        DQ    0

        DQ      LIT, ONE, COMMA
        DQ      PLOOP
        DQ      SEMIS
;

;  *************
;  *   +LOOP   *
;  *************
;
        ALIGN    8
N_PLOOP:
        DQ      5
        DB      "+LOOP"
        ALIGN    8
PLOOP:
        DQ    DOCOL
        DQ    PLOOP+HEADSIZE
        DQ    B_IMMED
        DQ    LLOOP
        DQ    N_PLOOP
        DQ    0
        DQ    0

        DQ      QCOMP, LIT, 3, QPAIR
        DQ      LIT, XPLOOP, COMMA
        DQ      LIT, ZBRAN, COMMA, BACKP     ; Until 
        DQ      LIT, UNLOOP, COMMA
        DQ      FORWARDP ; For DO to push the leave address.
        DQ      SEMIS
;

;  *************
;  *   UNTIL   *
;  *************
;
        ALIGN    8
N_UNTIL:
        DQ      5
        DB      "UNTIL"
        ALIGN    8
UNTIL:
        DQ    DOCOL
        DQ    UNTIL+HEADSIZE
        DQ    B_IMMED
        DQ    PLOOP
        DQ    N_UNTIL
        DQ    0
        DQ    0

        DQ      QCOMP, ONE, QPAIR
        DQ      LIT, ZBRAN, COMMA, BACKP
        DQ      SEMIS
;

;  *************
;  *   AGAIN   *
;  *************
;
        ALIGN    8
N_AGAIN:
        DQ      5
        DB      "AGAIN"
        ALIGN    8
AGAIN:
        DQ    DOCOL
        DQ    AGAIN+HEADSIZE
        DQ    B_IMMED
        DQ    UNTIL
        DQ    N_AGAIN
        DQ    0
        DQ    0

        DQ      QCOMP, ONE, QPAIR
        DQ      LIT, BRAN, COMMA, BACKP
        DQ      SEMIS
;

;  **************
;  *   REPEAT   *
;  **************
;
        ALIGN    8
N_REPEA:
        DQ      6
        DB      "REPEAT"
        ALIGN    8
REPEA:
        DQ    DOCOL
        DQ    REPEA+HEADSIZE
        DQ    B_IMMED
        DQ    AGAIN
        DQ    N_REPEA
        DQ    0
        DQ    0

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

;  **********
;  *   IF   *
;  **********
;
        ALIGN    8
N_LIF:
        DQ      2
        DB      "IF"
        ALIGN    8
LIF:
        DQ    DOCOL
        DQ    LIF+HEADSIZE
        DQ    B_IMMED
        DQ    REPEA
        DQ    N_LIF
        DQ    0
        DQ    0

        DQ      LIT, ZBRAN, COMMA, PFORWARD
        DQ      QCOMP, TWO     ; Magic number
        DQ      SEMIS
;

;  ************
;  *   ELSE   *
;  ************
;
        ALIGN    8
N_LELSE:
        DQ      4
        DB      "ELSE"
        ALIGN    8
LELSE:
        DQ    DOCOL
        DQ    LELSE+HEADSIZE
        DQ    B_IMMED
        DQ    LIF
        DQ    N_LELSE
        DQ    0
        DQ    0

        DQ      QCOMP, TWO, QPAIR
        DQ      LIT, BRAN, COMMA, PFORWARD
        DQ      SWAP
        DQ      FORWARDP
        DQ      TWO     ; Magic number
        DQ      SEMIS
;

;  *************
;  *   WHILE   *
;  *************
;
        ALIGN    8
N_LWHILE:
        DQ      5
        DB      "WHILE"
        ALIGN    8
LWHILE:
        DQ    DOCOL
        DQ    LWHILE+HEADSIZE
        DQ    B_IMMED
        DQ    LELSE
        DQ    N_LWHILE
        DQ    0
        DQ    0

        DQ      QCOMP, LDUP, ONE, QPAIR
        DQ      TOR    ;  Save backward target. 
        DQ      TOR
        DQ      LIT, ZBRAN, COMMA, PFORWARD
        DQ      LIT, 4 ; Magic number
        DQ      FROMR
        DQ      FROMR
        DQ      SEMIS
;

;  **************
;  *   SPACES   *
;  **************
;
        ALIGN    8
N_SPACES:
        DQ      6
        DB      "SPACES"
        ALIGN    8
SPACES:
        DQ    DOCOL
        DQ    SPACES+HEADSIZE
        DQ    0x0
        DQ    LWHILE
        DQ    N_SPACES
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      MAX
        DQ      ZERO
        DQ     XQDO
        DQ      SPAX1-$-CW
SPAX2:  DQ      SPACE
        DQ     ONE, XPLOOP, ZBRAN
        DQ      SPAX2-$-CW
        DQ      UNLOOP     ;LOOP
SPAX1:
        DQ      SEMIS
;

;  **********
;  *   <#   *
;  **********
;
        ALIGN    8
N_BDIGS:
        DQ      2
        DB      "<#"
        ALIGN    8
BDIGS:
        DQ    DOCOL
        DQ    BDIGS+HEADSIZE
        DQ    0x0
        DQ    SPACES
        DQ    N_BDIGS
        DQ    0
        DQ    0

        DQ      PAD
        DQ      HLD
        DQ      STOR
        DQ      SEMIS
;

;  **********
;  *   #>   *
;  **********
;
        ALIGN    8
N_EDIGS:
        DQ      2
        DB      "#>"
        ALIGN    8
EDIGS:
        DQ    DOCOL
        DQ    EDIGS+HEADSIZE
        DQ    0x0
        DQ    BDIGS
        DQ    N_EDIGS
        DQ    0
        DQ    0

        DQ      DROP
        DQ      DROP
        DQ      HLD
        DQ      FETCH
        DQ      PAD
        DQ      OVER
        DQ      LSUB
        DQ      SEMIS
;

;  ************
;  *   SIGN   *
;  ************
;
        ALIGN    8
N_SIGN:
        DQ      4
        DB      "SIGN"
        ALIGN    8
SIGN:
        DQ    DOCOL
        DQ    SIGN+HEADSIZE
        DQ    0x0
        DQ    EDIGS
        DQ    N_SIGN
        DQ    0
        DQ    0

        DQ      ZLESS
        DQ      ZBRAN
        DQ      SIGN1-$-CW ;IF
        DQ      LIT, AMS
        DQ      HOLD    ;THEN
SIGN1:  DQ      SEMIS
;

;  *********
;  *   #   *
;  *********
;
        ALIGN    8
N_DIG:
        DQ      1
        DB      "#"
        ALIGN    8
DIG:
        DQ    DOCOL
        DQ    DIG+HEADSIZE
        DQ    0x0
        DQ    SIGN
        DQ    N_DIG
        DQ    0
        DQ    0

        DQ      BASE
        DQ      FETCH
        DQ      MSMOD
        DQ      ROT
        DQ      LIT,9
        DQ      OVER
        DQ      LESS
        DQ      ZBRAN
        DQ      DIG1-$-CW  ;IF
        DQ      LIT,7
        DQ      PLUS    ;THEN
DIG1:   DQ      LIT,0x30
        DQ      PLUS
        DQ      HOLD
        DQ      SEMIS
;

;  **********
;  *   #S   *
;  **********
;
        ALIGN    8
N_DIGS:
        DQ      2
        DB      "#S"
        ALIGN    8
DIGS:
        DQ    DOCOL
        DQ    DIGS+HEADSIZE
        DQ    0x0
        DQ    DIG
        DQ    N_DIGS
        DQ    0
        DQ    0

DIGS1:  DQ      DIG     ;BEGIN
        DQ      OVER
        DQ      OVER
        DQ      LOR
        DQ      ZEQU
        DQ      ZBRAN
        DQ      DIGS1-$-CW ;UNTIL
        DQ      SEMIS
;

;  *************
;  *   (D.R)   *
;  *************
;
        ALIGN    8
N_PDDOTR:
        DQ      5
        DB      "(D.R)"
        ALIGN    8
PDDOTR:
        DQ    DOCOL
        DQ    PDDOTR+HEADSIZE
        DQ    0x0
        DQ    DIGS
        DQ    N_PDDOTR
        DQ    0
        DQ    0

        DQ      TOR
        DQ      SWAP
        DQ      OVER
        DQ      DABS
        DQ      BDIGS
        DQ      DIGS
        DQ      ROT
        DQ      SIGN
        DQ      EDIGS
        DQ      FROMR
        DQ      OVER
        DQ      LSUB, ZERO, MAX
        DQ      ZERO
        DQ     XQDO
        DQ      PDDOT1-$-CW
PDDOT2:  DQ      LBL, HOLD  ;WARNING: HOLD outside of #>.
        DQ     ONE, XPLOOP, ZBRAN
        DQ      PDDOT2-$-CW
        DQ      UNLOOP 
PDDOT1:
        DQ      EDIGS  ;Drop string instead of number.
        DQ      SEMIS
;

;  ***********
;  *   D.R   *
;  ***********
;
        ALIGN    8
N_DDOTR:
        DQ      3
        DB      "D.R"
        ALIGN    8
DDOTR:
        DQ    DOCOL
        DQ    DDOTR+HEADSIZE
        DQ    0x0
        DQ    PDDOTR
        DQ    N_DDOTR
        DQ    0
        DQ    0

        DQ      PDDOTR
        DQ      LTYPE
        DQ      SEMIS
;

;  **********
;  *   .R   *
;  **********
;
        ALIGN    8
N_DOTR:
        DQ      2
        DB      ".R"
        ALIGN    8
DOTR:
        DQ    DOCOL
        DQ    DOTR+HEADSIZE
        DQ    0x0
        DQ    DDOTR
        DQ    N_DOTR
        DQ    0
        DQ    0

        DQ      TOR
        DQ      STOD
        DQ      FROMR
        DQ      DDOTR
        DQ      SEMIS
;

;  **********
;  *   D.   *
;  **********
;
        ALIGN    8
N_DDOT:
        DQ      2
        DB      "D."
        ALIGN    8
DDOT:
        DQ    DOCOL
        DQ    DDOT+HEADSIZE
        DQ    0x0
        DQ    DOTR
        DQ    N_DDOT
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      DDOTR
        DQ      SPACE
        DQ      SEMIS
;

;  *********
;  *   .   *
;  *********
;
        ALIGN    8
N_DOT:
        DQ      1
        DB      "."
        ALIGN    8
DOT:
        DQ    DOCOL
        DQ    DOT+HEADSIZE
        DQ    0x0
        DQ    DDOT
        DQ    N_DOT
        DQ    0
        DQ    0

        DQ      STOD
        DQ      DDOT
        DQ      SEMIS
;

;  *********
;  *   ?   *
;  *********
;
        ALIGN    8
N_QUES:
        DQ      1
        DB      "?"
        ALIGN    8
QUES:
        DQ    DOCOL
        DQ    QUES+HEADSIZE
        DQ    0x0
        DQ    DOT
        DQ    N_QUES
        DQ    0
        DQ    0

        DQ      FETCH
        DQ      DOT
        DQ      SEMIS
;

;  **********
;  *   U.   *
;  **********
;
        ALIGN    8
N_UDOT:
        DQ      2
        DB      "U."
        ALIGN    8
UDOT:
        DQ    DOCOL
        DQ    UDOT+HEADSIZE
        DQ    0x0
        DQ    QUES
        DQ    N_UDOT
        DQ    0
        DQ    0

        DQ      ZERO
        DQ      DDOT
        DQ      SEMIS
;

;  *****************
;  *   FOR-WORDS   *
;  *****************
;
        ALIGN    8
N_FORW:
        DQ      9
        DB      "FOR-WORDS"
        ALIGN    8
FORW:
        DQ    DOCOL
        DQ    FORW+HEADSIZE
        DQ    0x0
        DQ    UDOT
        DQ    N_FORW
        DQ    0
        DQ    0

        DQ      SWAP
        DQ      TOR
        DQ      TOR
FORW1:  DQ      FROMR
        DQ      RR
        DQ      OVER
        DQ      TLFA
        DQ      FETCH
        DQ      TOR
        DQ      EXEC
        DQ      RR
        DQ      ZEQU
        DQ      ZBRAN
        DQ      FORW1-$-CW
        DQ      RDROP
        DQ      RDROP
        DQ      SEMIS
;

;  ****************
;  *   FOR-VOCS   *
;  ****************
;
        ALIGN    8
N_FORV:
        DQ      8
        DB      "FOR-VOCS"
        ALIGN    8
FORV:
        DQ    DOCOL
        DQ    FORV+HEADSIZE
        DQ    0x0
        DQ    FORW
        DQ    N_FORV
        DQ    0
        DQ    0

        DQ      TOR
        DQ      VOCL
        DQ      FETCH
        DQ      TOR
FORV1:  DQ      FROMR
        DQ      RR
        DQ      OVER
        DQ      TVFA
        DQ      FETCH
        DQ      TOR
        DQ      EXEC
        DQ      RR
        DQ      ZEQU
        DQ      ZBRAN
        DQ      FORV1-$-CW
        DQ      RDROP
        DQ      RDROP
        DQ      SEMIS
;

;  *************
;  *   WORDS   *
;  *************
;
        ALIGN    8
N_WORDS:
        DQ      5
        DB      "WORDS"
        ALIGN    8
WORDS:
        DQ    DOCOL
        DQ    WORDS+HEADSIZE
        DQ    0x0
        DQ    FORV
        DQ    N_WORDS
        DQ    0
        DQ    0

        DQ      CSLL
        DQ      LOUT
        DQ      STOR
        DQ      ZERO            ; End sentinel. 
        DQ      LIT, NOOP
        DQ      CONTEXT
        DQ      FETCH
        DQ      FORW
WORDS1:
        DQ      LDUP
        DQ      ZBRAN
        DQ      WORDS2-$-CW
        DQ      IDDOT
        DQ      BRAN
        DQ      WORDS1-$-CW
WORDS2:
        DQ DROP
        DQ      SEMIS
;
; 

;  *****************
;  *   EXIT-CODE   *
;  *****************
;
        ALIGN    8
N_XCODE:
        DQ      9
        DB      "EXIT-CODE"
        ALIGN    8
XCODE:
        DQ    DOVAR
        DQ    XCODE+HEADSIZE
        DQ    0x0
        DQ    WORDS
        DQ    N_XCODE
        DQ    0
        DQ    0

        DQ      0
;
; 
; 


;  ***********
;  *   BYE   *
;  ***********
;
        ALIGN    8
N_BYE:
        DQ      3
        DB      "BYE"
        ALIGN    8
BYE:
        DQ    DOCOL
        DQ    BYE+HEADSIZE
        DQ    0x0
        DQ    XCODE
        DQ    N_BYE
        DQ    0
        DQ    0

; Exit to linux, with status as stored. 
        DQ      XCODE, FETCH, X, X, LIT, exit, XOS
        DQ      SEMIS   ;Unnecessary, but helpful for decompilation.
; 
;

;  ************
;  *   LIST   *
;  ************
;
        ALIGN    8
N_LLIST:
        DQ      4
        DB      "LIST"
        ALIGN    8
LLIST:
        DQ    DOCOL
        DQ    LLIST+HEADSIZE
        DQ    0x0
        DQ    BYE
        DQ    N_LLIST
        DQ    0
        DQ    0

        DQ      BASE, FETCH, TOR
        DQ      DECA
        DQ      SCR,STOR

        DQ      SKIP
         DQ      6
SB5: DB      "SCR # "
       ALIGN    8
        DQ      LIT, SB5
        DQ      LIT, 6
        DQ      LTYPE
        DQ      SCR, FETCH, DOT
        DQ      SCR, FETCH, BLOCK, BBUF

        DQ      LIT, 16, ZERO
        DQ     XDO
        DQ      LLIST9-$-CW
LLIST1: DQ      LIT, ALF, SSLAS
        DQ      CR, IDO, LIT, 2, DOTR
        DQ      SPACE, LTYPE
        DQ     ONE, XPLOOP, ZBRAN
        DQ      LLIST1-$-CW
        DQ      UNLOOP 
LLIST9:
        DQ      TDROP
        DQ      FROMR, BASE, STOR
        DQ      SEMIS
;

;  *************
;  *   INDEX   *
;  *************
;
        ALIGN    8
N_INDEX:
        DQ      5
        DB      "INDEX"
        ALIGN    8
INDEX:
        DQ    DOCOL
        DQ    INDEX+HEADSIZE
        DQ    0x0
        DQ    LLIST
        DQ    N_INDEX
        DQ    0
        DQ    0

        DQ      LIT,AFF
        DQ      EMIT,CR
        DQ      ONEP,SWAP
        DQ     XDO
        DQ      INDE9-$-CW
INDE1:  DQ      CR,IDO
        DQ      LIT,3
        DQ      DOTR,SPACE
        DQ      ZERO,IDO
        DQ      PLINE, LTYPE
        DQ     ONE, XPLOOP, ZBRAN
        DQ      INDE1-$-CW
        DQ      UNLOOP 
INDE9:
        DQ      SEMIS
;

;  **********
;  *   .S   *
;  **********
;
        ALIGN    8
N_DOTS:
        DQ      2
        DB      ".S"
        ALIGN    8
DOTS:
        DQ    DOCOL
        DQ    DOTS+HEADSIZE
        DQ    0x0
        DQ    INDEX
        DQ    N_DOTS
        DQ    0
        DQ    0

        DQ      CR
        DQ      LIT, 'S', EMIT
        DQ      LIT, ASO, EMIT
        DQ      SPACE
        DQ      SPFET, SZERO, FETCH
DOC2:   DQ      OVER, OVER,  LSUB, ZLESS
        DQ      ZBRAN
        DQ      DOC1-$-CW
        DQ      ZERO, CELLP, LSUB, LDUP, FETCH, DOT
        DQ      BRAN
        DQ      DOC2-$-CW
DOC1:    DQ DROP, DROP
        DQ      LIT, ASC, EMIT
        DQ SEMIS
;

;  ********************
;  *   ENVIRONMENT?   *
;  ********************
;
        ALIGN    8
N_ENVQ:
        DQ      12
        DB      "ENVIRONMENT?"
        ALIGN    8
ENVQ:
        DQ    DOCOL
        DQ    ENVQ+HEADSIZE
        DQ    0x0
        DQ    DOTS
        DQ    N_ENVQ
        DQ    0
        DQ    0

        DQ      LIT, ENV, TWID, PFIND
        DQ      TOR, TDROP, FROMR
        DQ      LDUP
        DQ      ZBRAN
        DQ      ENVQ1-$-CW
        DQ      EXEC
        DQ      LIT, -1
ENVQ1:
        DQ      SEMIS
;


; 
;
;
; This word is not even fig!

;  ***************
;  *   .SIGNON   *
;  ***************
;
        ALIGN    8
N_SIGNON:
        DQ      7
        DB      ".SIGNON"
        ALIGN    8
SIGNON:
        DQ    DOCOL
        DQ    SIGNON+HEADSIZE
        DQ    0x0
        DQ    ENVQ
        DQ    N_SIGNON
        DQ    0
        DQ    0

; PRINT CPU TYPE (8088)
        DQ      CR
        DQ      BASE,FETCH
        DQ      LIT,36, BASE,STOR
        DQ      LCPU, DDOT
        DQ      BASE,STOR
;
        DQ      LENAME, LTYPE, SPACE
        DQ      LVERSION, LTYPE, SPACE
        DQ      CR
        DQ      SEMIS
;
; 
;
;**** LAST DICTIONARY WORD ****

;  ************
;  *   TASK   *
;  ************
;
        ALIGN    8
N_TASK:
        DQ      4
        DB      "TASK"
        ALIGN    8
TASK:
        DQ    DOCOL
        DQ    TASK+HEADSIZE
        DQ    0x0
        DQ    SIGNON
        DQ    N_TASK
        DQ    0
        DQ    0

        DQ      SEMIS
;
 ;  

;
;
;The remaining memory ( up to 'EM' ) is
;used for:
;
;        1. EXTENSION DICTIONARY
;        2. DATA STACK
;        3. TERMINAL INPUT BUFFER
;        4. RETURN STACK
;        5. USER VARIABLE AREA
;        6. BUFFERS FOR SCREENS/FILES
;
;
;


;       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       =     $ - _main
        

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

; For more task the TAS area is duplicated; the remainder is the same.
        RB  (EM - FORTHSIZE - TAS - BUFFERSIZE ) 
; INITR1:                         Return stack for next task
;          RB  (US )              ;  For next task, if present. 
; The following framework may be repeated for more tasks.
; It is floating, i.e. it may be shifted up and down, in order
; to have INITR0 at a STACKSIZE boundary. 
        RB  (STACKSIZE)    ; Data stack, only limited if more tasks present.
INITS0:                         ; Grows down.
STRTIB: RB  (TIBSIZE )     ; Terminal input buffer.
        RB  (STACKSIZE )       ; Return stack, grows down.
INITR0:                         ; Grows down
STRUSA: RB  (US )              ; User area
        RB  (STACKSIZE - US )   ; Spare user area 
        RB  (STACKSIZE )             ; Possibly the framework is shifted up by this.
 BUF1:   RB  (BUFFERSIZE )      ; FIRST DISK BUFFER
ACTUAL_EM:  ; Differs from EM if code is relocated.

; 
;

; 
        ;
;
;
;  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.
        
; 


























;





