jumpforth/jumpforth.S

/* gcc -m32 -nostdlib -static -o jumpforth jumpforth.S */

#include <asm/unistd.h>

.code32

.set JUMPFORTH_VERSION,1

.set BUFFER_SIZE,4096
.set RETURN_STACK_SIZE,8192

.set DATA_SEGMENT_ALLOC_SIZE,65536

.macro NEXT
   lodsl
   jmp *(%eax)
.endm

.macro PUSHRSP reg
   lea -4(%ebp),%ebp
   movl \reg ,(%ebp)
.endm

.macro POPRSP reg
   mov (%ebp),\reg
   lea 4(%ebp),%ebp
.endm

   .text
   .align 4
   .globl _start
_start:
   cld
   mov %esp,param_S0
   mov $return_stack_top,%ebp
   xor %ebx,%ebx
   movl $__NR_brk,%eax
   int $0x80
   movl %eax,param_C0
   movl %eax,var_CP
   movl %eax,var_BRK
   mov $cold_start,%esi
   NEXT

   .text
   .align 4
   .globl DOCOL
DOCOL:
   PUSHRSP %esi
   addl $4,%eax
   movl (%eax),%esi
   NEXT

.set F_IMMED,0x80
.set F_HIDDEN,0x40
.set F_LENMASK,0x3f
.set link,0

.macro defname label:req,codeword:req,dataword:req,name="",flags=0
   .section .rodata
   .align 4
   .globl \label
\label :
   .int \codeword
   .int \dataword
   .int link
   .set link,\label
   .byte \flags+(9f-8f)
.ifeqs "\name",""
8: .ascii "\label"
.else
8: .ascii "\name"
.endif
9: .align 4
.endm

.macro defword label:req,name="",flags=0
defname \label,DOCOL,data_\label,"\name",\flags
   .section .rodata
   .align 4
   .globl data_\label
data_\label :
.endm

.macro defcode label:req,name="",dataword=0,flags=0
defname \label,code_\label,\dataword,"\name",\flags
   .text
   .globl code_\label
code_\label :
.endm

.macro defvar label:req,initial=0,name="",flags=0
defcode \label,"\name",0,\flags
   push $var_\label
   NEXT
   .data
   .align 4
var_\label :
   .int \initial
.endm

.macro defconst label:req,value,name="",flags=0
defcode \label,"\name",0,\flags
   push $\value
   NEXT
.endm

/* Parameters are stored like variables but produce a value, not an address. */
/* Use this for data which is read-only after initialization. */
.macro defparam label:req,initial=0,name="",flags=0
defcode \label,"\name",0,\flags
   pushl param_\label
   NEXT
   .data
   .align 4
param_\label :
   .int \initial
.endm

defconst VERSION,JUMPFORTH_VERSION

defconst R0,return_stack_top

defconst BUFFER,buffer
defconst __BUFFER_SIZE,BUFFER_SIZE,"BUFFER_SIZE"

defconst __DOCOL,DOCOL,"DOCOL"
defconst __SELF,SELF,"SELF"

defconst FALSE,0
defconst TRUE,-1

defconst CELL,4

defconst __F_IMMED,F_IMMED,"F_IMMED"
defconst __F_HIDDEN,F_HIDDEN,"F_HIDDEN"
defconst __F_LENMASK,F_LENMASK,"F_LENMASK"

defconst SYS_EXIT,__NR_exit
defconst SYS_OPEN,__NR_open
defconst SYS_CLOSE,__NR_close
defconst SYS_READ,__NR_read
defconst SYS_WRITE,__NR_write
defconst SYS_CREAT,__NR_creat
defconst SYS_BRK,__NR_brk
defconst SYS_GETPID,__NR_getpid
defconst SYS_GETTID,__NR_gettid
defconst SYS_TGKILL,__NR_tgkill

defconst SIGABRT,6

defconst __O_RDONLY,0,"O_RDONLY"
defconst __O_WRONLY,1,"O_WRONLY"
defconst __O_RDWR,2,"O_RDWR"
defconst __O_CREAT,0100,"O_CREAT"
defconst __O_EXCL,0200,"O_EXCL"
defconst __O_TRUNC,01000,"O_TRUNC"
defconst __O_APPEND,02000,"O_APPEND"
defconst __O_NONBLOCK,04000,"O_NONBLOCK"

/* NOTE: These are initialized in _start and read-only thereafter. */
defparam C0     /* first byte of the heap */
defparam S0     /* initial (empty) data stack pointer */

/* STATE controls whether we are currently executing code (0) or compiling (1) */
defvar STATE,0  /* default to executing code */

/* Initially the KEY function "reads" the embedded file "startup.4th". */
/* When this is exhausted the pointers are reset to point to the input buffer. */
defvar CURRKEY,startup_defs
defvar BUFFTOP,startup_defs_end

/* NOTE: These are initialized in _start but vary during runtime. */
defvar CP       /* "compilation pointer", next free byte in the heap */
defvar BRK      /* the (current) end of the heap */

defvar LATEST,last_word

/* ( a -- ) */
defcode DROP
   addl $4,%esp
   NEXT

/* ( a b -- b a ) */
defcode SWAP
   pop %ebx
   pop %eax
   push %ebx
   push %eax
   NEXT

/* ( a -- a a ) */
defcode DUP
   mov (%esp),%eax
   push %eax
   NEXT

/* ( a b -- a b a ) */
defcode OVER
   mov 4(%esp),%eax
   push %eax
   NEXT

/* ( a b -- b ) */
defcode NIP
   pop %ebx
   movl %ebx,(%esp)
   NEXT

/* ( a b -- b a b ) */
defcode TUCK
   pop %ebx
   pop %eax
   push %ebx
   push %eax
   push %ebx
   NEXT

/* ( a b c -- b c a ) */
defcode ROT
   pop %ecx
   pop %ebx
   pop %eax
   push %ebx
   push %ecx
   push %eax
   NEXT

/* ( a b c -- c a b ) */
defcode NROT,"-ROT"
   pop %ecx
   pop %ebx
   pop %eax
   push %ecx
   push %eax
   push %ebx
   NEXT

/* ( a b -- ) */
defcode TWODROP,"2DROP"
   addl $8,%esp
   NEXT

/* ( a b -- a b a b ) */
defcode TWODUP,"2DUP"
   mov (%esp),%ebx
   mov 4(%esp),%eax
   push %eax
   push %ebx
   NEXT

/* ( a b c d -- a b c d a b ) */
defcode TWOOVER,"2OVER"
   mov 8(%esp),%ebx
   mov 12(%esp),%eax
   push %eax
   push %ebx
   NEXT

/* ( a b c d -- c d a b ) */
defcode TWOSWAP,"2SWAP"
   pop %edx
   pop %ecx
   pop %ebx
   pop %eax
   push %ecx
   push %edx
   push %eax
   push %ebx
   NEXT

/* ( 0 -- 0 ) */
/* ( a -- a a ) */
defcode QDUP,"?DUP"
   movl (%esp),%eax
   test %eax,%eax
   jz 1f
   push %eax
1: NEXT

/* ( a b -- a+b ) */
defcode ADD,"+"
   pop %eax
   addl %eax,(%esp)
   NEXT

/* ( a b -- a-b ) */
defcode SUB,"-"
   pop %eax
   subl %eax,(%esp)
   NEXT

/* ( a -- a+1 ) */
defcode ADD1,"1+"
   incl (%esp)
   NEXT

/* ( a -- a-1 ) */
defcode SUB1,"1-"
   decl (%esp)
   NEXT

defcode NEGATE
   negl (%esp)
   NEXT

/* ( n1 n2 -- n1*n2 ) ( ignores overflow ) */
defcode MUL,"*"
   pop %eax
   pop %ebx
   imull %ebx,%eax
   push %eax
   NEXT

/* ( u1 u2 -- u1*u2 ) ( ignores overflow ) */
defcode UMUL,"U*"
   pop %eax
   pop %ebx
   mull %ebx
   push %eax
   NEXT

/* ( n1 n2 -- n1%n2 n1/n2 ) */
defcode DIVMOD,"/MOD"
   xor %edx,%edx
   pop %ebx
   pop %eax
   idivl %ebx
   push %edx
   push %eax
   NEXT

/* ( u1 u2 -- u1%u2 u1/u2 ) */
defcode UDIVMOD,"U/MOD"
   xor %edx,%edx
   pop %ebx
   pop %eax
   divl %ebx
   push %edx
   push %eax
   NEXT

.macro defcmp label,opcode,name="\label",flags=0
defcode \label,"\name",0,\flags
   pop %eax
   pop %ebx
   cmp %eax,%ebx
   \opcode %al
   movzbl %al,%eax
   neg %eax
   push %eax
   NEXT
.endm

/* ( a b -- flag ) ( various comparison operators, e.g. flag=a<b ) */
defcmp EQU,sete,"="
defcmp NEQU,setne,"<>"
defcmp LT,setl,"<"
defcmp GT,setg,">"
defcmp LE,setle,"<="
defcmp GE,setge,">="

/* unsigned variants */
defcmp ULT,setb,"U<"
defcmp UGT,seta,"U>"
defcmp ULE,setbe,"U<="
defcmp UGE,setae,"U>="

defcode AND
   pop %eax
   andl %eax,(%esp)
   NEXT

defcode OR
   pop %eax
   orl %eax,(%esp)
   NEXT

defcode XOR
   pop %eax
   xorl %eax,(%esp)
   NEXT

defcode INVERT
   notl (%esp)
   NEXT

defcode STORE,"!"
   pop %ebx
   pop %eax
   mov %eax,(%ebx)
   NEXT

defcode FETCH,"@"
   pop %ebx
   mov (%ebx),%eax
   push %eax
   NEXT

defcode STOREBYTE,"C!"
   pop %ebx
   pop %eax
   movb %al,(%ebx)
   NEXT

defcode FETCHBYTE,"C@"
   pop %ebx
   xor %eax,%eax
   movb (%ebx),%al
   push %eax
   NEXT

/* ( src dst n -- ) ( block copy n bytes from src to dst ) */
defcode CMOVE
   mov %esi,%edx
   pop %ecx
   pop %edi
   pop %esi
   rep movsb
   mov %edx,%esi
   NEXT

defcode TOR,">R"
   pop %eax
   PUSHRSP %eax
   NEXT

defcode FROMR,"R>"
   POPRSP %eax
   push %eax
   NEXT

defcode RSPFETCH,"RSP@"
   push %ebp
   NEXT

defcode RSPSTORE,"RSP!"
   pop %ebp
   NEXT

defcode RDROP
   addl $4,%ebp
   NEXT

defcode SPFETCH,"SP@"
   mov %esp,%eax
   push %eax
   NEXT

defcode SPSTORE,"SP!"
   pop %esp
   NEXT

defcode LIT
   lodsl
   push %eax
   NEXT

defcode LITSTRING
   xor %eax,%eax
   lodsb
   push %esi
   push %eax
   addl %eax,%esi
   addl $3,%esi
   andl $0xfffffffc,%esi
   NEXT

.macro litstring text:req
   .int LITSTRING
   .byte (9f - 8f)
8: .ascii "\text"
9: .align 4
.endm

defcode BRANCH
   add (%esi),%esi
   NEXT

defcode ZBRANCH,"0BRANCH"
   pop %eax
   test %eax,%eax
   jz code_BRANCH
   lodsl
   NEXT

defcode EXIT
   POPRSP %esi
   NEXT

defcode EXECUTE
   pop %eax
   jmp *(%eax)

/* ( ebx ecx edx esi edi ebp eax/sc -- eax/result ) */
defcode SYSCALL6
   pop %eax
   movl 16(%esp),%ecx
   movl %ebp,16(%esp)
   pop %ebp
   pop %edi
   movl 12(%esp),%ebx
   movl %esi,12(%esp)
   pop %esi
   pop %edx
   int $0x80
   pop %ebp
   pop %esi
   push %eax
   NEXT

/* ( ebx ecx edx esi edi eax/sc -- eax/result ) */
defcode SYSCALL5
   pop %eax
   pop %edi
   movl 12(%esp),%ebx
   movl %esi,12(%esp)
   pop %esi
   pop %edx
   pop %ecx
   int $0x80
   pop %esi
   push %eax
   NEXT

/* ( ebx ecx edx esi eax/sc -- eax/result ) */
defcode SYSCALL4
   pop %eax
   movl 12(%esp),%ebx
   movl %esi,12(%esp)
   pop %esi
   pop %edx
   pop %ecx
   int $0x80
   pop %esi
   push %eax
   NEXT

/* ( ebx ecx edx eax/sc -- eax/result ) */
defcode SYSCALL3
   pop %eax
   pop %edx
   pop %ecx
   pop %ebx
   int $0x80
   push %eax
   NEXT

/* ( ebx ecx eax/sc -- eax/result ) */
defcode SYSCALL2
   pop %eax
   pop %ecx
   pop %ebx
   int $0x80
   push %eax
   NEXT

/* ( ebx eax/sc -- eax/result ) */
defcode SYSCALL1
   pop %eax
   pop %ebx
   int $0x80
   push %eax
   NEXT

/* ( eax/sc -- eax/result ) */
defcode SYSCALL0
   pop %eax
   int $0x80
   push %eax
   NEXT

defword HERE
   .int CP,FETCH,EXIT

defword KEY
0: .int CURRKEY,FETCH,DUP,BUFFTOP,FETCH,GE,ZBRANCH,(3f - .)  /* ( -- currkey ) */
   .int DROP,BUFFER,LIT,0,OVER,__BUFFER_SIZE,SYS_READ,SYSCALL3
   .int   DUP,LIT,0,LE,ZBRANCH,(2f - .)  /* ( currkey -- buffer read-result ) */
   .int TWODROP  /* ( buffer read-result -- ) */
1: .int LIT,0,SYS_EXIT,SYSCALL1,DROP,BRANCH,(1b - .)  /* ( -- ) */
2: .int OVER,ADD,BUFFTOP,STORE  /* ( buffer read-result -- buffer ) */
3: .int DUP,ADD1,CURRKEY,STORE,FETCHBYTE,EXIT  /* ( currkey -- currkey-C@ ) */

/* Puts the most recently read key back in the input buffer */
/* CAUTION: Can only safely be used ONCE after each call to KEY! */
defword PUTBACK
   .int CURRKEY,FETCH,SUB1,CURRKEY,STORE,EXIT

defword ISSPACE,"SPACE?"
   .int DUP,LIT,' ',NEQU,ZBRANCH,(0f - .)
   .int DUP,LIT,'\t',NEQU,ZBRANCH,(0f - .)
   .int DUP,LIT,'\n',NEQU,ZBRANCH,(0f - .)
   .int DUP,LIT,'\r',NEQU,ZBRANCH,(0f - .)
   .int DUP,LIT,'\v',NEQU,ZBRANCH,(0f - .)
   .int DROP,FALSE,EXIT
0: .int DROP,TRUE,EXIT

defword SKIPSPACE
0: .int KEY,ISSPACE,INVERT,ZBRANCH,(0b - .),PUTBACK,EXIT

defword EMIT
   .int SPFETCH,TWODUP,STOREBYTE,LIT,0,SWAP,LIT,1,SYS_WRITE,SYSCALL3,TWODROP,EXIT

/* ( c-addr u -- ) */
defword DOTS,".S"
0: .int QDUP,ZBRANCH,(1f - .),SWAP,DUP,FETCHBYTE,EMIT
   .int ADD1,SWAP,SUB1,BRANCH,(0b - .)
1: .int DROP,EXIT

defword ABORT
0: .int SYS_GETPID,SYSCALL0,SYS_GETTID,SYSCALL0,SIGABRT,SYS_TGKILL,SYSCALL3,DROP,EXIT
   .int BRANCH,(0b - .)

defword ALLOT
   .int DUP,LIT,0,LT,ZBRANCH,(0f - .)
   .int DUP,C0,FETCH,HERE,SUB,LT,ZBRANCH,(1f - .),BRANCH,(6f - .)
0: .int DUP,HERE,INVERT,UGT,ZBRANCH,(1f - .),BRANCH,(6f - .)
1: .int HERE,ADD,DUP,BRK,FETCH,UGT,ZBRANCH,(3f - .)
   .int LIT,DATA_SEGMENT_ALLOC_SIZE-1,TWODUP,ADD,SWAP,INVERT,AND
   .int DUP,SYS_BRK,SYSCALL1,OVER,NEQU,ZBRANCH,(2f - .)
   .int TWODROP
   litstring "Out of memory\n"
   .int DOTS,ABORT
2: .int BRK,STORE
3: .int CP,STORE,EXIT
6: litstring "Allocation out of bounds\n"
   .int DOTS,ABORT

defword COMMA,","
   .int HERE,CELL,ALLOT,STORE,EXIT

defword COMMABYTE,"C,"
   .int HERE,LIT,1,ALLOT,STOREBYTE,EXIT

/* ( addr -- a-addr ) Round up to next cell-aligned address */
defword ALIGNED
   .int LIT,3,ADD,LIT,-4,AND,EXIT

defword ALIGN
   .int HERE,ALIGNED,HERE,SUB
   .int QDUP,ZBRANCH,(0f - .),LIT,0,COMMABYTE,SUB1
   .int QDUP,ZBRANCH,(0f - .),LIT,0,COMMABYTE,SUB1
   .int      ZBRANCH,(0f - .),LIT,0,COMMABYTE
0: .int EXIT

/* ( c-addr-1 u-1 c-addr-2 u-2 -- flag ) */
defword STREQU,"S="
   .int ROT,OVER,EQU,ZBRANCH,(1f - .)         /* c-addr-1 c-addr-2 u-2  R:           */
0: .int DUP,ZBRANCH,(2f - .)                  /* c-addr-1 c-addr-2 u    R:           */
   .int SUB1                                  /* c-addr-1 c-addr-2 u'   R:           */
   .int ROT,DUP,FETCHBYTE,TOR,ADD1            /* c-addr-2 u' c-addr-1'  R: ch-1      */
   .int ROT,DUP,FETCHBYTE,TOR,ADD1            /* u' c-addr-1' c-addr-2' R: ch-1 ch-2 */
   .int ROT,FROMR,FROMR,NEQU,ZBRANCH,(0b - .) /* c-addr-1' c-addr-2' u' R:           */
1: .int TWODROP,DROP,FALSE,EXIT               /* FALSE                  R:           */
2: .int TWODROP,DROP,TRUE,EXIT                /* TRUE                   R:           */

/* ( entry -- cfa-addr ) Address of the codeword field */
defword TCFA,">CFA"
   .int EXIT

/* ( entry -- dfa-addr ) Address of the dataword field */
defword TDFA,">DFA"
   .int CELL,ADD,EXIT

/* ( entry -- dfa-addr ) Address of the dataword field */
defword TLINK,">LINK"
   .int LIT,8,ADD,EXIT

/* ( entry -- flags-addr ) Address of the flag/length byte */
defword TFLAGS,">FLAGS"
   .int LIT,12,ADD,EXIT

/* ( entry -- name-addr name-len ) Address and length of the name field */
defword TNAME,">NAME"
   .int TFLAGS,DUP,ADD1,SWAP,FETCHBYTE,__F_LENMASK,AND,EXIT

/* ( entry -- a-addr ) Data-field address (next cell after the name) */
defword TBODY,">BODY"
   .int TNAME,ADD,ALIGNED,EXIT

/* ( entry -- flag ) Is the F_IMMED flag set? */
defword ISIMMEDIATE,"IMMEDIATE?"
   .int LIT,12,ADD,FETCHBYTE,__F_IMMED,AND,LIT,0,NEQU,EXIT

/* ( entry -- flag ) Is the F_HIDDEN flag set? */
defword ISHIDDEN,"HIDDEN?"
   .int LIT,12,ADD,FETCHBYTE,__F_HIDDEN,AND,LIT,0,NEQU,EXIT

defword FIND
   .int LATEST,FETCH                          /* c-addr u entry */
0: .int DUP,ZBRANCH,(4f - .)                  /* c-addr u entry */
   .int DUP,ISHIDDEN,ZBRANCH,(2f - .)         /* c-addr u entry */
1: .int TLINK,FETCH,BRANCH,(0b - .)           /* c-addr u link */
2: .int DUP,TOR,NROT,FROMR,TNAME,TWOOVER      /* entry c-addr u n-addr n-len c-addr u */
   .int STREQU,ZBRANCH,(3f - .)               /* entry c-addr u */
   .int TWODROP,EXIT                          /* entry */
3: .int ROT,BRANCH,(1b - .)                   /* c-addr u entry */
4: .int NROT,TWODROP,EXIT                     /* entry (= 0) */

defword FINDERR
   .int TWODUP,FIND,QDUP,ZBRANCH,(0f - .),NROT,TWODROP,EXIT
0: litstring "UNKNOWN WORD: "
   .int DOTS,DOTS,LIT,'\n',EMIT,ABORT

defword QUOTE,"'"
   .int WORD,FINDERR,EXIT

   .text
   .align 4
   .globl SELF
SELF:
   addl $4,%eax
   pushl (%eax)
   NEXT

defword CREATE
   .int ALIGN,HERE,LIT,SELF,COMMA,LIT,0,COMMA,LATEST,FETCH,COMMA,LIT,0,COMMABYTE
   .int WORD,NIP,DUP,ALLOT,ALIGN
   .int OVER,TFLAGS,STOREBYTE
   .int HERE,OVER,TDFA,STORE
   .int LATEST,STORE,EXIT

defword DOES,"DOES>"
   .int LATEST,FETCH
   .int LIT,DOCOL,OVER,TCFA,STORE
   .int ALIGN,HERE,OVER,TDFA,STORE
   .int LIT,LIT,COMMA,TBODY,COMMA
   .int TRUE,STATE,STORE
   .int EXIT

defword COLON,":"
   .int CREATE
   .int LATEST,FETCH
   .int DUP,TFLAGS,DUP,FETCHBYTE,__F_HIDDEN,OR,SWAP,STOREBYTE
   .int LIT,DOCOL,OVER,TCFA,STORE
   .int HERE,SWAP,TDFA,STORE
   .int TRUE,STATE,STORE,EXIT

defword SEMI,";",F_IMMED
   .int LIT,EXIT,COMMA,LATEST,FETCH,TFLAGS
   .int DUP,FETCHBYTE,DUP,__F_HIDDEN,AND,ZBRANCH,(0f - .)
   .int __F_HIDDEN,SUB,SWAP,STOREBYTE,BRANCH,(1f - .)
0: .int TWODROP
1: .int FALSE,STATE,STORE
   .int ALIGN,EXIT

defword IMMEDIATE,,F_IMMED
   .int LATEST,FETCH,LIT,12,ADD,DUP,FETCHBYTE,__F_IMMED,OR,SWAP,STOREBYTE,EXIT

defword DOT,"."
   .int DUP,LIT,0x80000000,EQU,ZBRANCH,(0f - .)
   litstring "-2147483648"  /* special case; can't negate */
   .int DOTS,DROP,EXIT
0: .int DUP,LIT,0,LT,ZBRANCH,(1f - .)           /* n */
   .int LIT,'-',EMIT,LIT,0,SWAP,SUB             /* n | n>0 */
1: .int LIT,1000000000                          /* n pv */
2: .int TWODUP,LT,ZBRANCH,(3f - .)              /* n pv */
   .int DUP,LIT,1,GT,ZBRANCH,(3f - .)           /* n pv */
   /* n < pv && pv > 1, so divide pv by 10 */
   .int LIT,10,DIVMOD,NIP,BRANCH,(2b - .)       /* n pv/10 */
   /* emit quotient+'0'; while pv > 1, divide pv by 10 and repeat with n%pv */
3: .int SWAP,OVER,DIVMOD,LIT,'0',ADD,EMIT,SWAP  /* n%pv pv */
   .int DUP,LIT,1,LE,ZBRANCH,(4f - .),TWODROP,EXIT
4: .int LIT,10,DIVMOD,NIP,BRANCH,(3b - .)       /* n%pv pv/10 */

defword DOTDS,".DS"
   .int SPFETCH,S0
.Ldotds_loop:
   .int CELL,SUB,TWODUP,LE,ZBRANCH,(1f - .)
   .int DUP,FETCH,DOT
0: .int CELL,SUB,TWODUP,LE,ZBRANCH,(1f - .)
   .int DUP,FETCH,LIT,' ',EMIT,DOT,BRANCH,(0b - .)
1: .int TWODROP,EXIT

defword DOTRS,".RS"
   .int RSPFETCH,CELL,ADD,R0,BRANCH,(.Ldotds_loop - .)

defword WORD
   .int SKIPSPACE,HERE
0: .int KEY,DUP,ISSPACE,ZBRANCH,(1f - .)
   .int DROP,PUTBACK,HERE,OVER,SUB,OVER,CP,STORE,EXIT
1: .int COMMABYTE,BRANCH,(0b - .)

defword READSTRING
   .int HERE
0: .int KEY,DUP,LIT,'\\',EQU,ZBRANCH,(1f - .)
   .int DROP,KEY,BRANCH,(2f - .)
1: .int DUP,LIT,'"',EQU,ZBRANCH,(2f - .)
   .int DROP,HERE,OVER,SUB,ALIGN,EXIT
2: .int COMMABYTE,BRANCH,(0b - .)

defword PARSENUMBER
   .int DUP,LIT,0,GT,ZBRANCH,(6f - .)
   .int OVER,FETCHBYTE,LIT,'-',EQU,DUP,TOR,LIT,0,TOR,ZBRANCH,(0f - .)
   .int DUP,LIT,1,GT,ZBRANCH,(6f - .),BRANCH,(1f - .)
0: .int OVER,FETCHBYTE,LIT,'0',SUB
   .int DUP,LIT,0,GE,ZBRANCH,(5f - .)
   .int DUP,LIT,9,LE,ZBRANCH,(5f - .)
   .int FROMR,LIT,10,MUL,ADD,TOR
1: .int SUB1,QDUP,ZBRANCH,(8f - .)
   .int SWAP,ADD1,SWAP,BRANCH,(0b - .)
5: .int DROP
6: .int TWODROP,RDROP,RDROP,FALSE,EXIT
8: .int DROP,FROMR,FROMR,ZBRANCH,(9f - .)
   .int NEGATE
9: .int TRUE,EXIT

defword INTERPRET
   .int SKIPSPACE,KEY,LIT,'"',EQU,ZBRANCH,(0f - .),READSTRING,EXIT
0: .int PUTBACK,WORD,TWODUP,PARSENUMBER,ZBRANCH,(1f - .),NROT,TWODROP,EXIT
1: .int FINDERR,EXECUTE,EXIT

defword COMPILE
   .int SKIPSPACE,KEY,LIT,'"',EQU,ZBRANCH,(0f - .)
   .int LIT,LITSTRING,COMMA,HERE,LIT,0,COMMABYTE
   .int READSTRING,ROT,STOREBYTE,DROP,ALIGN,EXIT
0: .int PUTBACK,WORD,TWODUP,PARSENUMBER,ZBRANCH,(1f - .)
   .int NROT,TWODROP,LIT,LIT,COMMA,COMMA,EXIT
1: .int FINDERR,DUP,ISIMMEDIATE,ZBRANCH,(2f - .)
   .int EXECUTE,EXIT
2: .int COMMA,EXIT

defword QUIT
   .int R0,RSPSTORE
0: .int STATE,FETCH,ZBRANCH,(1f - .)
   .int COMPILE,BRANCH,(0b - .)
1: .int INTERPRET,BRANCH,(0b - .)

/* This is the initial value of the LATEST variable */
.set last_word,QUIT

   .section .rodata
   .align 4
cold_start:
   .int QUIT

   .section .startup,"a"
startup_defs:
   .incbin "startup.4th"
startup_defs_end:

   .bss
   .align 4096
return_stack:
   .space RETURN_STACK_SIZE
return_stack_top:

   .bss
   .align 4096
buffer:
   .space BUFFER_SIZE