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