From df89a30338d495ff26ea1d0c1e7f9189795ed675 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 20 Sep 2020 06:45:27 -0500 Subject: [PATCH] initial commit --- .gitignore | 4 + Makefile | 2 + jumpforth.S | 852 ++++++++++++++++++++++++++++++++++++++++++++++++++++ startup.4th | 33 ++ 4 files changed, 891 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 jumpforth.S create mode 100644 startup.4th diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..36e2836 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +jumpforth +.*.swp +.*.swo +*~ diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..a3a3b64 --- /dev/null +++ b/Makefile @@ -0,0 +1,2 @@ +jumpforth: jumpforth.S startup.4th + gcc -m32 -nostdlib -static -o $@ $< diff --git a/jumpforth.S b/jumpforth.S new file mode 100644 index 0000000..955b961 --- /dev/null +++ b/jumpforth.S @@ -0,0 +1,852 @@ +/* gcc -m32 -nostdlib -static -o jumpforth jumpforth.S */ + +#include + +.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" +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 diff --git a/startup.4th b/startup.4th new file mode 100644 index 0000000..d506034 --- /dev/null +++ b/startup.4th @@ -0,0 +1,33 @@ +: CHAR WORD DROP C@ ; + +: TAB 9 EMIT ; +: LF 10 EMIT ; +: SPACE 32 EMIT ; + +: BANNER "JumpForth version " .S VERSION . ", by Jesse McDonald" .S LF ; + +: [ FALSE STATE ! ; IMMEDIATE +: ] TRUE STATE ! ; IMMEDIATE + +: POSTPONE WORD FINDERR , ; IMMEDIATE + +: COMPILE, , ; + +: ['] [ ' LIT , ' LIT , ] , ' , ; IMMEDIATE + +: LITERAL ['] LIT , , ; IMMEDIATE + +: IF ['] 0BRANCH , HERE 0 , ; IMMEDIATE +: THEN HERE OVER - SWAP ! ; IMMEDIATE +: ELSE POSTPONE THEN ['] BRANCH , HERE 0 , ; IMMEDIATE + +: BEGIN HERE ; IMMEDIATE +: AGAIN ['] BRANCH , HERE - , ; IMMEDIATE + +: \ BEGIN KEY 10 = IF EXIT THEN AGAIN ; IMMEDIATE +: ( BEGIN KEY [ CHAR ) ] LITERAL = IF EXIT THEN AGAIN ; IMMEDIATE + +CREATE VAR 123 , DOES> @ ; +: VAR! [ ' VAR >BODY ] LITERAL ! ; + +BANNER