initial commit
This commit is contained in:
commit
df89a30338
|
|
@ -0,0 +1,4 @@
|
|||
jumpforth
|
||||
.*.swp
|
||||
.*.swo
|
||||
*~
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
jumpforth: jumpforth.S startup.4th
|
||||
gcc -m32 -nostdlib -static -o $@ $<
|
||||
|
|
@ -0,0 +1,852 @@
|
|||
/* 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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue