ref: 0644f16baa668188060a03a5585bf7ea3443364a
parent: 516446e1bcb10e1f527fb550ed1206178cb6d0a7
author: 9ferno <gophone2015@gmail.com>
date: Fri Nov 19 04:39:53 EST 2021
compiling forth code
--- a/os/pc64/bindings.s
+++ b/os/pc64/bindings.s
@@ -17,71 +17,71 @@
*/
TEXT ff_to_c(SB), 1, $-4 /* ( argn .. arg2 arg1 nargs -- ) (G move args to C stack) */
POPQ SI /* get the return PC from the stack */
- MOVQ TOS, CX /* check nargs */
- POP(TOS)
+ MOVQ TOP, CX /* check nargs */
+ POP(TOP)
TESTQ $0, CX
JZ .ff_to_c_done /* no args */
- MOVQ TOS, RARG /* 1st argument is put in RARG also */
+ MOVQ TOP, RARG /* 1st argument is put in RARG also */
.ff_to_c_again:
- PUSHQ TOS
- POP(TOS)
+ PUSHQ TOP
+ POP(TOP)
LOOP .ff_to_c_again
.ff_to_c_done:
- PUSH(TOS)
+ PUSH(TOP)
PUSH(RSP)
PUSH(IP)
PUSH(W)
- MOVQ PSP, ffsp(SB);
+ MOVQ PSP, forthsp(SB);
JMP* SI /* go back to the caller */
TEXT c_to_ff_0(SB), 1, $-4 /* no returned argument */
- MOVQ ffsp(SB), PSP
+ MOVQ forthsp(SB), PSP
POP(W)
POP(IP)
POP(RSP)
- POP(TOS)
+ POP(TOP)
RET
TEXT c_to_ff_1(SB), 1, $-4 /* there is a returned argument */
CALL c_to_ff_0(SB)
- PUSH(TOS)
- MOVQ AX, TOS /* C puts the return value in AX */
+ PUSH(TOP)
+ MOVQ AX, TOP /* C puts the return value in AX */
RET
-TEXT open(SB), 1, $-4 /* ( mode cstr -- fd ) */
- PUSH(TOS)
- MOVQ $2, TOS
+TEXT fthopen(SB), 1, $-4 /* ( mode cstr -- fd ) */
+ PUSH(TOP)
+ MOVQ $2, TOP
CALL ff_to_c(SB)
CALL kopen(SB)
CALL c_to_ff_1(SB)
NEXT
-TEXT close(SB), 1, $-4 /* ( fd -- n ) */
- PUSH(TOS)
- MOVQ $1, TOS
+TEXT fthclose(SB), 1, $-4 /* ( fd -- n ) */
+ PUSH(TOP)
+ MOVQ $1, TOP
CALL ff_to_c(SB)
CALL kclose(SB)
CALL c_to_ff_1(SB)
NEXT
-TEXT read(SB), 1, $-4 /* ( n a fd -- n2 ) */
- PUSH(TOS)
- MOVQ $3, TOS
+TEXT fthread(SB), 1, $-4 /* ( n a fd -- n2 ) */
+ PUSH(TOP)
+ MOVQ $3, TOP
CALL ff_to_c(SB)
CALL kread(SB)
CALL c_to_ff_1(SB)
NEXT
-TEXT write(SB), 1, $-4 /* ( n a fd -- n2 ) */
- PUSH(TOS)
- MOVQ $3, TOS
+TEXT fthwrite(SB), 1, $-4 /* ( n a fd -- n2 ) */
+ PUSH(TOP)
+ MOVQ $3, TOP
CALL ff_to_c(SB)
CALL kwrite(SB)
CALL c_to_ff_1(SB)
NEXT
-TEXT seek(SB), 1, $-4 /* ( type pos fd -- n ) */
- PUSH(TOS)
- MOVQ $3, TOS
+TEXT fthseek(SB), 1, $-4 /* ( type pos fd -- n ) */
+ PUSH(TOP)
+ MOVQ $3, TOP
CALL ff_to_c(SB)
CALL kseek(SB)
CALL c_to_ff_1(SB)
--- a/os/pc64/forth.s
+++ b/os/pc64/forth.s
@@ -23,7 +23,7 @@
plan9 assembler puts the first argument in BP (RARG), return value in AX.
Changed to
- Leaving AX, SP, BP (RARG) alone to not mess with the C environment
+ Leaving AX, SP, BP (RARG), R14, R15 alone to not mess with the C environment
TOS: BX top of stack register
PSP: DX parameter stack pointer, grows towards lower memory (downwards)
@@ -31,7 +31,7 @@
IP: R9 instruction pointer
W: R10 work register (holds CFA)
H0: R11 register holding the start of this process's heap memory
- CX, SI, DI, R12-R15 temporary registers
+ CX, SI, DI, R12-R13 temporary registers
coding standard
: <name> (S input-stack --- output-stack) (R --- )
@@ -72,50 +72,39 @@
#define RSTACK_SIZE BY2PG
#define HEAPSTART (0ull)
-#define HEAPSIZE (HEAPSTART+8)
+#define HEAPEND (HEAPSTART+8)
#define FORTHSP (HEAPSTART+16)
#define DTOP (HEAPSTART+24)
-#define ERRSTR (HEAPSTART+32)
-#define WORDB (HEAPSTART+160) /* word buffer */
-#define TIB (HEAPSTART+672) /* text input buffer */
+ /* variables used by the core words */
+#define TOIN (HEAPSTART+32)
+#define TOLIMIT (HEAPSTART+40)
+#define FINDADR (HEAPSTART+48)
+#define BLK (HEAPSTART+56)
+#define ARGS (HEAPSTART+64)
+#define IOBUF (HEAPSTART+72)
+#define SEARCHLEN (HEAPSTART+80)
+#define BASE (HEAPSTART+88)
+#define TONUM (HEAPSTART+96)
+#define STATE (HEAPSTART+104)
+#define ABORTVEC (HEAPSTART+112)
+#define SOURCEBUF (HEAPSTART+120)
+#define WORDBUF (HEAPSTART+128)
+#define INFD (HEAPSTART+136)
+#define OUTFD (HEAPSTART+144)
+#define ERRFD (HEAPSTART+152)
+
+#define ERRSTR (HEAPSTART+160)
+#define WORDB (HEAPSTART+288) /* word buffer */
+#define TIB (HEAPSTART+792) /* text input buffer */
#define DICTIONARY (HEAPSTART+2048)
#define DICTIONARY_END (HEAPSTART+(6*BY2PG))
#define RSTACK (HEAPSTART+(6*BY2PG))
#define PSTACK_END (RSTACK+(2*BY2PG))
#define FORTHEND PSTACK_END
+#define HEAPSIZE FORTHEND
#define LAST $centry_c_boot(SB) /* last defined word, should generate this */
-TEXT tib(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $TIB, TOP
- NEXT
-
-TEXT wordb(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $WORDB, TOP
- NEXT
-
-TEXT h(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $DTOP, TOP
- NEXT
-
-TEXT dp(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $DTOP, TOP
- NEXT
-
-TEXT s0(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $FORTHEND, TOP
- NEXT
-
-TEXT forthsp(SB), 1, $-4
- MOVQ H0, TOP
- ADDQ $FORTHSP, TOP
- NEXT
-
/* putting this above the asm code as the v_dp define is needed by _main */
/* m_ for primitive/macro word cfa
mc_ for primtive/macro word constants
@@ -122,6 +111,10 @@
c_ for colon word cfa
ci_ for colon immediate word cfa
v_ for colon variable word cfa
+
+ CONSTANTS - capital letters
+ Variables - initial capital case
+ words - lower case
*/
#include "primitives.s"
@@ -130,47 +123,23 @@
MOVQ RARG, H0 /* start of heap memory */
MOVQ H0, RSP
- ADDQ $RSTACK, RSP /* return stack pointer */
+ ADDQ $RSTACK, RSP /* return stack pointer, reset */
MOVQ H0, PSP
- ADDQ $FORTHEND, PSP /* parameter stack pointer - stack setup */
+ ADDQ $FORTHEND, PSP /* parameter stack pointer - stack setup, clear */
MOVQ H0, TOP
ADDQ $HEAPSTART, TOP
MOVQ TOP, (H0) /* store the start address at that address too - magic check */
- ADDQ $FORTHEND, TOP
- MOVQ TOP, $HEAPSIZE
+ ADDQ $(HEAPSIZE-1), TOP
+ MOVQ TOP, 8(H0) /* heap end */
- /* The last dictionary entry address is stored in dtop.
- * The location of dtop is stored in the variable dp.
- * To get the location of dtop, get the value in the parameter field
- * (link + name(1+2) + code field address = 24 bytes) of the dp
- * dictionary entry.
- */
- /*
- * dtop address is stored in the parameter field address(24-32 bytes) of mventry_dp
- */
- MOVQ mventry_dp+24(SB), SI /* now, SI = dtop address */
- MOVQ (SI), TOP /* TOP = *CX = $LAST = boot word address (defined last, stored at dtop) */
- /* if 6a allows multiple symbols per address, then
- the above 3 instructions would have been
- MOVQ (($mventry_dp+24(SB))), TOP */
- /*
- * Could do this instead of the calculations below
- * LEAQ 24(TOP), IP
- */
- ADDQ $16, TOP /* TOP += link (8 bytes) + len (1 byte) + minimum for align to 8 bytes */
- XORQ CX, CX
- MOVB 8(SI), CL /* CL = length of boot name */
- ADDQ CX, TOP /* TOP += len */
- ANDQ $~7, TOP /* TOP = address of boot's code - 8 bytes */
- LEAQ 8(TOP), IP /* IP = L257 = start of boot code = has docol address there
- * skipping over docol as we do not need to save the IP
- */
+ MOVQ PSP, 16(H0) /* parameter stack pointer */
+ MOVQ $centry_c_boot(SB), 24(H0) /* Last dictionary entry address */
+ /* execute boot */
MOVQ $centry_c_boot(SB), IP
ADDQ $24, IP /* to get to the parameter field address of boot word */
-
/* lodsl could make this simpler. But, this is more comprehensible
why not JMP* (W)?
@@ -197,11 +166,13 @@
NEXT
TEXT reset(SB), 1, $-4
- MOVQ $FFSTART, RSP
+ MOVQ H0, RSP
+ ADDQ $RSTACK, RSP
NEXT
TEXT clear(SB), 1, $-4
- MOVQ $FFEND, PSP
+ MOVQ H0, PSP
+ ADDQ $FFEND, PSP
NEXT
TEXT colon(SB), 1, $-4
@@ -268,16 +239,8 @@
/* TODO fix this */
TEXT terminate(SB), 1, $-4 /* ( n -- ) */
- XORQ CX, CX
- TESTQ TOP, TOP
- JZ .l2
- MOVQ $failtext(SB), TOP
-.l2:
- /* PUSHQ CX */
- /* SUBQ $8, PSP */ /* dummy retaddr */
- MOVQ CX, a0+0(FP) /* address of exit status? status = nil? */
- MOVQ $8, RARG /* EXITS */
- SYSCALL /* TODO syscall for exit */
+ POP(TOP)
+ NEXT
#include "bindings.s"
@@ -560,6 +523,46 @@
XORQ TOP, TOP
/* pause -- no equivalent in 6a ? */
NEXT
+
+TEXT s0(SB), 1, $-4 /* S0 needs a calculation to come up with the value */
+ MOVQ H0, TOP
+ ADDQ $FORTHEND, TOP
+ NEXT
+
+/* store the forth sp here when going to C */
+TEXT forthsp(SB), 1, $-4
+ MOVQ H0, TOP
+ ADDQ $FORTHSP, TOP
+ NEXT
+
+/* variables used by the core words */
+
+#define VARIABLE(name, location) TEXT name(SB), 1, $-4 ;\
+ MOVQ H0, TOP ;\
+ ADDQ location, TOP ;\
+ NEXT;
+
+VARIABLE(Tib, $TIB)
+VARIABLE(Wordb, $WORDB)
+VARIABLE(Hzero, $HEAPSTART)
+VARIABLE(Dp, $DTOP)
+VARIABLE(toIn, $TOIN)
+VARIABLE(toLimit, $TOLIMIT)
+VARIABLE(Findadr, $FINDADR)
+VARIABLE(Blk, $BLK)
+VARIABLE(Args, $ARGS)
+VARIABLE(Iobuf, $IOBUF)
+VARIABLE(Searchlen, $SEARCHLEN)
+VARIABLE(Base, $BASE)
+VARIABLE(toNum, $TONUM)
+VARIABLE(State, $STATE)
+VARIABLE(Abortvec, $ABORTVEC)
+VARIABLE(Sourcebuf, $SOURCEBUF)
+VARIABLE(Wordbuf, $WORDBUF)
+VARIABLE(Errstr, $ERRSTR)
+VARIABLE(Infd, $INFD)
+VARIABLE(Outfd, $OUTFD)
+VARIABLE(Errfd, $ERRFD)
TEXT forthend(SB), 1, $-4
--- a/os/pc64/mem.h
+++ b/os/pc64/mem.h
@@ -20,8 +20,8 @@
#define BI2WD 32 /* bits per word */
#define BY2WD 8 /* bytes per word */
#define BY2V 8 /* bytes per double word */
-#define BY2PG (0x1000ull) /* bytes per page */
-#define WD2PG (BY2PG/BY2WD) /* words per page */
+#define BY2PG (0x1000ull) /* bytes per page */
+#define WD2PG (BY2PG/BY2WD) /* words per page */
#define PGSHIFT 12 /* log(BY2PG) */
#define ROUND(s, sz) (((s)+((sz)-1))&~((sz)-1))
#define PGROUND(s) ROUND(s, BY2PG)
@@ -205,3 +205,5 @@
#define RMACH R15 /* m-> */
#define RUSER R14 /* up-> */
+
+#define FORTHHEAPSIZE (8*BY2PG)
--- a/os/pc64/memory.c
+++ b/os/pc64/memory.c
@@ -778,8 +778,8 @@
print("meminit: conf.mem entries\n");for(i = 0; i < nelem(conf.mem); i++)
if(conf.mem[i].base != 0)
- print("%d base 0x%zx 0x%zp npage 0x%zx %zd\n",- i, conf.mem[i].base, conf.mem[i].base,
+ print("%d base 0x%zx npage 0x%zx %zd\n",+ i, conf.mem[i].base,
conf.mem[i].npage, conf.mem[i].npage);
/* memmapdump(); */
--- a/os/pc64/primitives-nasm.s
+++ b/os/pc64/primitives-nasm.s
@@ -3,17 +3,15 @@
MENTRY "!", store, 1
MENTRY "c@", cfetch, 2
MENTRY "c!", cstore, 2
- MENTRY "read", read, 4
- MENTRY "write", write, 5
- MENTRY "seek", seek, 4
- MENTRY "open", open, 4
- MENTRY "close", close, 5
+ MENTRY "read", fthread, 4
+ MENTRY "write", fthwrite, 5
+ MENTRY "seek", fthseek, 4
+ MENTRY "open", fthopen, 4
+ MENTRY "close", fthclose, 5
MENTRY "mmap", mmap, 4
MENTRY "halt", terminate, 4
MENTRY "clear", clear, 5
MENTRY "reset", reset, 5
- MENTRY "h", h, 1
- MENTRY "dp", dp, 2
MENTRY "exitcolon", exitcolon, 4
MENTRY "(literal)", literal, 9
MENTRY "(sliteral)", sliteral, 10
@@ -42,9 +40,6 @@
MENTRY "=", equal, 1
MENTRY ">", greater, 1
MENTRY "<", less, 1
- MENTRY "tib", tib, 3
- MENTRY "wordb", wordb, 5
- MENTRY "s@", stackptr, 2
MENTRY "lshift", lshift, 6
MENTRY "rshift", rshift, 6
MENTRY "rshifta", rshifta, 7
@@ -52,6 +47,35 @@
MENTRY "unloop", unloop, 6
MENTRY "cmove", cmove, 5
MENTRY "cmove>", cmoveb, 6
+
+ MENTRY "Tib", Tib, 3 ; variables from here, puts address on stack, mixed case
+ MENTRY "Wordb", Wordb, 5
+ MENTRY "Hzero", Hzero, 5
+ MENTRY "Dp", Dp, 2
+ MENTRY `>In`, toIn, 3
+ MENTRY `>Limit`, toLimit, 6
+ MENTRY `Findadr`, Findadr, 7
+ MENTRY `Blk`, Blk, 3
+ MENTRY `Args`, Args, 4
+ MENTRY `Iobuf`, Iobuf, 5
+ MENTRY `Searchlen`, Searchlen, 9
+ MENTRY `Base`, Base, 4
+ MENTRY `>Num`, toNum, 4
+ MENTRY `State`, State, 5
+ MENTRY `Abortvec`, Abortvec, 8 ; not sure if these 3 can be constants instead?
+ MENTRY `Sourcebuf`, Sourcebuf, 9
+ MENTRY `Wordbuf`, Wordbuf, 7
+ MENTRY `Infd`, Infd, 7
+ MENTRY `Outfd`, Outfd, 7
+ MENTRY `Errfd`, Errfd, 7
+
+ MVENTRY "STDIN", STDIN, 0, 5 ; 4 constants from here, CAPITALS
+ MVENTRY "STDOUT", STDOUT, 1, 6
+ MVENTRY "STDERR", STDERR, 2, 6
+ MVENTRY "EOF", EOF, 0, 3
+
+ MENTRY "s0", s0, 2
+ MENTRY "s@", stackptr, 2 ; puts PSP on stack
MENTRY "(variable)", variable, 10
MENTRY "(constant)", constant, 10
MENTRY "(:)", colon, 3
--- a/os/pc64/primitives.awk
+++ b/os/pc64/primitives.awk
@@ -63,7 +63,7 @@
lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/8, $constant(SB)\n", label, tot); lines[++nlines]=sprintf("#define mc_%s(SB) mventry_%s+%d(SB)\n", label, label, tot);tot += 8;
- lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/8, $%s(SB)\n", label, tot, $5);+ lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/8, $%s\n", label, tot, $5);tot += 8;
addrlabel = sprintf("mventry_%s", label)}
--- a/os/pc64/words-nasm.s
+++ b/os/pc64/words-nasm.s
@@ -10,15 +10,13 @@
dd m_literal
dd 32
dd m_exitcolon
- VENTRY `s0`, v_s0, 2
- VENTRY `args`, v_args, 4
- CENTRY `on`, c_on, 2
+ CENTRY `on`, c_on, 2 ; ( a -- ) (G stores -1 at a )
dd m_literal
dd -1
dd m_xswap
dd m_store
dd m_exitcolon
- CENTRY `off`, c_off, 3
+ CENTRY `off`, c_off, 3 ; ( a -- ) (G stores 0 at a )
dd m_literal
dd 0
dd m_xswap
@@ -49,8 +47,7 @@
dd m_plus
dd m_exitcolon
CENTRY `depth`, c_depth, 5
- dd v_s0
- dd m_fetch
+ dd m_s0
dd m_stackptr
dd m_minus
dd m_literal
@@ -260,22 +257,17 @@
dd c_negate
L52:
dd m_exitcolon
- VENTRY `iobuf`, v_iobuf, 5
- VENTRY `stdin`, v_stdin, 5
- VENTRY `stdout`, v_stdout, 6
- VENTRY `eof`, v_eof, 3
CENTRY `key`, c_key, 3
- dd v_iobuf ; variable iobuf
+ dd m_Iobuf ; variable iobuf
dd m_literal
dd 1
- dd v_stdin ; variable stdin
- dd m_fetch ; ( iobuf 1 0 -- )
- dd m_read
+ dd m_Infd ; constant stdin
+ dd m_fthread
dd c_0eq
dd m_cjump
dd L78
- dd v_eof
+ dd mc_EOF
dd c_on
dd m_literal
dd -1
@@ -282,21 +274,21 @@
dd m_jump
dd L79
L78:
- dd v_iobuf
+ dd m_Iobuf
dd m_cfetch
L79:
dd m_exitcolon
CENTRY `emit`, c_emit, 4 ; ( character -- )
- dd v_iobuf ; variable iobuf address
+ dd m_Iobuf ; variable iobuf address
dd m_cstore ; variable iobuf has character
- dd v_iobuf ; variable iobuf address
+ dd m_Iobuf ; variable iobuf address
dd m_literal
dd 1
dd m_xswap ; ( iobuf 1 -- 1 iobuf )
dd m_literal
dd 1 ; stdout
- dd m_write ; ( 1 iobuf 1 -- )
+ dd m_fthwrite ; ( 1 iobuf 1 -- )
dd m_exitcolon
CENTRY `type`, c_type, 4 ; ( addr n -- )
@@ -303,7 +295,7 @@
dd m_xswap ; ( addr n -- n addr )
dd m_literal
dd 1 ; stdout
- dd m_write ; ( n addr 1 -- )
+ dd m_fthwrite ; ( n addr 1 -- )
dd m_exitcolon
CENTRY `cr`, c_cr, 2
@@ -408,14 +400,13 @@
dd c_bl
dd c_fill
dd m_exitcolon
- VENTRY `searchlen`, v_searchlen, 9
CENTRY `search`, c_search, 6
- dd v_searchlen
+ dd m_Searchlen
dd m_store
dd m_xswap
dd m_dup
dd m_rpush
- dd v_searchlen
+ dd m_Searchlen
dd m_fetch
dd m_minus
dd c_1plus
@@ -427,10 +418,10 @@
dd m_i
dd m_plus
dd m_over
- dd v_searchlen
+ dd m_Searchlen
dd m_fetch
dd m_xswap
- dd v_searchlen
+ dd m_Searchlen
dd m_fetch
dd c_compare
dd c_0eq
@@ -454,7 +445,7 @@
dd c_false
dd m_exitcolon
CENTRY `here`, c_here, 4
- dd mc_h
+ dd m_Hzero
dd m_fetch
dd m_exitcolon
CENTRY `,`, c_comma, 1
@@ -462,7 +453,7 @@
dd m_store
dd m_literal
dd 8
- dd mc_h
+ dd m_Hzero
dd c_plusstore
dd m_exitcolon
CENTRY `c,`, c_c, 2
@@ -470,11 +461,11 @@
dd m_cstore
dd m_literal
dd 1
- dd mc_h
+ dd m_Hzero
dd c_plusstore
dd m_exitcolon
CENTRY `allot`, c_allot, 5
- dd mc_h
+ dd m_Hzero
dd c_plusstore
dd m_exitcolon
CENTRY `pad`, c_pad, 3
@@ -486,27 +477,25 @@
CENTRY `align`, c_align, 5
dd c_here
dd c_aligned
- dd mc_h
+ dd m_Hzero
dd m_store
dd m_exitcolon
CENTRY `unused`, c_unused, 6
- dd mc_heaptop
+ dd m_Hzero
dd m_fetch
dd c_here
dd m_minus
dd m_exitcolon
- VENTRY `base`, v_base, 4
- VENTRY `>num`, v_tonum, 4
CENTRY `<#`, c_fromhash, 2
dd c_pad
dd m_literal
dd 1024
dd m_plus
- dd v_tonum
+ dd m_toNum
dd m_store
dd m_exitcolon
CENTRY `#`, c_hash, 1
- dd v_base
+ dd m_Base
dd m_fetch
dd m_uslashmod
dd m_xswap
@@ -529,11 +518,11 @@
dd 48
dd m_plus
L93:
- dd v_tonum
+ dd m_toNum
dd m_fetch
dd c_1minus
dd m_dup
- dd v_tonum
+ dd m_toNum
dd m_store
dd m_cstore
dd m_exitcolon
@@ -549,7 +538,7 @@
dd m_exitcolon
CENTRY `#>`, c_hashfrom, 2
dd m_drop
- dd v_tonum
+ dd m_toNum
dd m_fetch
dd m_dup
dd c_pad
@@ -560,7 +549,7 @@
dd m_minus
dd m_exitcolon
CENTRY `hold`, c_hold, 4
- dd v_tonum
+ dd m_toNum
dd m_fetch
dd c_1minus
dd m_dup
@@ -567,7 +556,7 @@
dd m_rpush
dd m_cstore
dd m_rpop
- dd v_tonum
+ dd m_toNum
dd m_store
dd m_exitcolon
CENTRY `sign`, c_sign, 4
@@ -611,13 +600,13 @@
CENTRY `hex`, c_hex, 3
dd m_literal
dd 16
- dd v_base
+ dd m_Base
dd m_store
dd m_exitcolon
CENTRY `decimal`, c_decimal, 7
dd m_literal
dd 10
- dd v_base
+ dd m_Base
dd m_store
dd m_exitcolon
CENTRY `digit`, c_digit, 5
@@ -670,7 +659,7 @@
L109:
L107:
dd m_dup
- dd v_base
+ dd m_Base
dd m_fetch
dd m_less
dd m_cjump
@@ -715,7 +704,7 @@
dd 0
dd m_doinit
L117:
- dd v_base
+ dd m_Base
dd m_fetch
dd m_multiply
dd m_over
@@ -746,24 +735,17 @@
dd m_multiply
dd c_true
dd m_exitcolon
- VENTRY `>in`, v_toin, 3
- VENTRY `>limit`, v_tolimit, 6
- VENTRY `wordbuf`, v_wordbuf, 7
- VENTRY `abortvec`, v_abortvec, 8
- VENTRY `findadr`, v_findadr, 7
- VENTRY `sourcebuf`, v_sourcebuf, 9
- VENTRY `blk`, v_blk, 3
CENTRY `abort`, c_abort, 5
- dd v_abortvec
+ dd m_Abortvec
dd m_fetch
dd m_execute
dd m_exitcolon
CENTRY `source`, c_source, 6
- dd v_sourcebuf
+ dd m_Sourcebuf
dd m_fetch
dd m_exitcolon
CENTRY `current-input`, c_current_input, 13
- dd v_toin
+ dd m_toIn
dd m_fetch
dd c_source
dd m_plus
@@ -770,34 +752,32 @@
dd m_cfetch
dd m_exitcolon
CENTRY `save-input`, c_save_input, 10
- dd v_stdin
+ dd m_Infd
+ dd m_toIn
dd m_fetch
- dd v_toin
+ dd m_toLimit
dd m_fetch
- dd v_tolimit
+ dd m_Sourcebuf
dd m_fetch
- dd v_sourcebuf
+ dd m_Blk
dd m_fetch
- dd v_blk
- dd m_fetch
dd m_literal
dd 5
dd m_exitcolon
CENTRY `default-input`, c_default_input, 13
- dd v_stdin
+ dd mc_STDIN
+ dd m_toIn
dd c_off
- dd v_toin
+ dd m_toLimit
dd c_off
- dd v_tolimit
- dd c_off
- dd mc_tib
- dd v_sourcebuf
+ dd m_Tib
+ dd m_Sourcebuf
dd m_store
- dd v_blk
+ dd m_Blk
dd c_off
dd m_exitcolon
CENTRY `restore-input`, c_restore_input, 13
- dd v_eof
+ dd mc_EOF
dd c_off
dd m_literal
dd 5
@@ -809,15 +789,15 @@
dd m_jump
dd L134
L133:
- dd v_blk
+ dd m_Blk
dd m_store
- dd v_sourcebuf
+ dd m_Sourcebuf
dd m_store
- dd v_tolimit
+ dd m_toLimit
dd m_store
- dd v_toin
+ dd m_toIn
dd m_store
- dd v_stdin
+ dd m_Infd
dd m_store
dd c_true
L134:
@@ -838,9 +818,9 @@
L136:
dd m_exitcolon
CENTRY `next-input`, c_next_input, 10
- dd v_toin
+ dd m_toIn
dd m_fetch
- dd v_tolimit
+ dd m_toLimit
dd m_fetch
dd m_less
dd m_cjump
@@ -857,7 +837,7 @@
dd m_exitcolon
CENTRY `parse`, c_parse, 5
dd m_rpush
- dd v_wordbuf
+ dd m_Wordbuf
dd m_fetch
dd c_1plus
L142:
@@ -873,7 +853,7 @@
dd c_1plus
dd m_literal
dd 1
- dd v_toin
+ dd m_toIn
dd c_plusstore
dd m_jump
dd L142
@@ -880,11 +860,11 @@
L143:
dd m_literal
dd 1
- dd v_toin
+ dd m_toIn
dd c_plusstore
dd m_rpop
dd m_drop
- dd v_wordbuf
+ dd m_Wordbuf
dd m_fetch
dd m_dup
dd m_rpush
@@ -905,7 +885,7 @@
dd L146
dd m_literal
dd 1
- dd v_toin
+ dd m_toIn
dd c_plusstore
dd m_jump
dd L145
@@ -956,15 +936,15 @@
dd m_exitcolon
CENTRY `query`, c_query, 5
- dd v_eof ; variable eof
+ dd mc_EOF ; variable eof
dd c_off ; off sets variable eof = 0
- dd mc_tib ; constant puts address of tibuffer on the top
+ dd m_Tib ; constant puts address of tibuffer on the top
dd m_literal
dd 1024 ; ( tibuffer -- tibuffer 1024 )
dd c_accept ; ( tibuffer 1024 -- n )
dd m_dup
dd c_0eq
- dd v_eof
+ dd mc_EOF
dd m_fetch
dd m_binand
dd m_cjump
@@ -974,15 +954,15 @@
dd m_jump
dd L153
L152:
- dd v_tolimit
+ dd m_toLimit
dd m_store
- dd v_toin
+ dd m_toIn
dd c_off
L153:
dd m_exitcolon
CENTRY `refill`, c_refill, 6
- dd v_blk
+ dd m_Blk
dd m_fetch
dd m_cjump
dd L155
@@ -994,10 +974,11 @@
dd c_true
L156:
dd m_exitcolon
+
CENTRY `findname`, c_findname, 8 ; ( a1 -- a2 f ) ; loop through the dictionary names
- dd v_findadr
+ dd m_Findadr
dd m_store
- dd mc_dp
+ dd m_Dp
dd m_fetch ; get dictionary link
L158:
dd c_qdup
@@ -1021,7 +1002,7 @@
dd m_literal
dd 63
dd m_binand ; ( a1 a1+8+1 n 63 -- a1 a1+8+1 n&63 )
- dd v_findadr
+ dd m_Findadr
dd m_fetch
dd c_count ; ( a1 a1+8+1 n&63 a2 n2 -- a1 a1+8+1 n&63 a2+1 n2 )
dd c_compare ; ( -- a1 n ) compare dictionary entry with name
@@ -1037,7 +1018,7 @@
dd m_jump
dd L158
L159:
- dd v_findadr
+ dd m_Findadr
dd m_fetch
dd c_false
dd m_exitcolon
@@ -1097,8 +1078,7 @@
dd m_exitcolon
CENTRY `?stack`, c_qstack, 6
dd m_stackptr
- dd v_s0
- dd m_fetch
+ dd m_s0
dd m_greater
dd m_cjump
dd L172
@@ -1153,7 +1133,7 @@
dd c_align
dd c_here
dd m_rpush
- dd mc_dp
+ dd m_Dp
dd m_fetch
dd c_comma
dd c_bl
@@ -1174,7 +1154,7 @@
dd m_fetch
dd c_comma
dd m_rpop
- dd mc_dp
+ dd m_Dp
dd m_store
dd m_exitcolon
CENTRY `variable`, c_variable, 8
@@ -1196,9 +1176,8 @@
dd m_store
dd c_comma
dd m_exitcolon
- VENTRY `state`, v_state, 5
CENTRY `immediate`, c_immediate, 9
- dd mc_dp
+ dd m_Dp
dd m_fetch
dd c_cellplus
dd m_dup
@@ -1265,7 +1244,7 @@
L191:
dd m_exitcolon
CENTRY `]`, c_close_bracket, 1
- dd v_state
+ dd m_State
dd c_on
L196:
dd c_bl
@@ -1281,7 +1260,7 @@
dd L198
L197:
dd c_compile
- dd v_state
+ dd m_State
dd m_fetch
L198:
dd m_cjump
@@ -1291,11 +1270,11 @@
L199:
dd m_exitcolon
CIENTRY `[`, ci_open_bracket, 1
- dd v_state
+ dd m_State
dd c_off
dd m_exitcolon
CENTRY `smudge`, c_smudge, 6
- dd mc_dp
+ dd m_Dp
dd m_fetch
dd c_cellplus
dd m_dup
@@ -1307,7 +1286,7 @@
dd m_cstore
dd m_exitcolon
CENTRY `reveal`, c_reveal, 6
- dd mc_dp
+ dd m_Dp
dd m_fetch
dd c_cellplus
dd m_dup
@@ -1337,12 +1316,12 @@
dd m_literal
dd m_exitcolon
dd c_comma
- dd v_state
+ dd m_State
dd c_off
dd c_reveal
dd m_exitcolon
CIENTRY `recurse`, ci_recurse, 7
- dd mc_dp
+ dd m_Dp
dd m_fetch
dd c_cellplus
dd c_tocfa
@@ -1409,11 +1388,11 @@
dd m_drop
dd m_exitcolon
CIENTRY `\`, ci_backslash, 1
- dd v_blk
+ dd m_Blk
dd m_fetch
dd m_cjump
dd L214
- dd v_toin
+ dd m_toIn
dd m_fetch
dd m_literal
dd 63
@@ -1422,19 +1401,19 @@
dd 63
dd c_invert
dd m_binand
- dd v_toin
+ dd m_toIn
dd m_store
dd m_jump
dd L215
L214:
- dd v_tolimit
+ dd m_toLimit
dd m_fetch
- dd v_toin
+ dd m_toIn
dd m_store
L215:
dd m_exitcolon
CENTRY `(?abort)`, c_qabort_parens, 8
- dd v_state
+ dd m_State
dd m_cjump
dd L217
dd c_space
@@ -1631,7 +1610,7 @@
dd m_rpop
dd m_literal
dd 420
- dd m_open
+ dd m_fthopen
dd m_dup
dd m_literal
dd -1
@@ -1638,11 +1617,11 @@
dd m_greater
dd m_exitcolon
CENTRY `close-file`, c_close_file, 10
- dd m_close
+ dd m_fthclose
dd c_0eq
dd m_exitcolon
CENTRY `read-file`, c_read_file, 9
- dd m_read
+ dd m_fthread
dd m_dup
dd m_literal
dd -1
@@ -1649,13 +1628,13 @@
dd c_neq
dd m_exitcolon
CENTRY `write-file`, c_write_file, 10
- dd m_write
+ dd m_fthwrite
dd m_literal
dd -1
dd c_neq
dd m_exitcolon
CENTRY `reposition-file`, c_reposition_file, 15
- dd m_seek
+ dd m_fthseek
dd m_literal
dd -1
dd c_neq
@@ -1683,9 +1662,9 @@
dd c_bl
dd c_word
dd m_rpush
- dd v_tolimit
+ dd m_toLimit
dd m_fetch
- dd v_toin
+ dd m_toIn
dd m_store
dd c_save_input
dd m_rpop
@@ -1693,7 +1672,7 @@
dd c_ro
dd c_open_file
dd c_qfcheck
- dd v_stdin
+ dd m_Infd
dd m_store
dd m_exitcolon
CENTRY `crash`, c_crash, 5
@@ -1712,7 +1691,7 @@
L253:
dd c_query
dd c_interpret
- dd v_stdin
+ dd m_Infd
dd m_fetch ; ( 0 -- )
dd c_0eq
dd m_cjump
@@ -1729,29 +1708,29 @@
dd m_exitcolon
CENTRY `(abort)`, c_parenabort, 7 ; TODO correct below stack notations
- dd v_state ; ( v_state -- )
+ dd m_State ; ( m_State -- )
dd c_off ; off sets variable state = 0
- dd mc_tib ; constant puts address of tibuffer on the top of stack
- dd v_sourcebuf ; variable sourcebuf
+ dd m_Tib ; constant puts address of tibuffer on the top of stack
+ dd m_Sourcebuf ; variable sourcebuf
dd m_store ; variable sourcebuf = address of tibuffer
- dd v_blk ; variable blk
+ dd m_Blk ; variable blk
dd c_off ; off variable blk = 0
- dd v_stdin ; variable stdin
- dd c_off ; off variable stdin = 0
- dd m_literal
- dd 1 ; ( 1 -- )
- dd v_stdout ; variable stdout
- dd m_store ; variable stdout = 1
+ dd mc_STDIN ; stdin
+ dd m_Infd ; variable
+ dd m_store ; variable Infd = STDIN
+ dd mc_STDOUT
+ dd m_Outfd ; variable
+ dd m_store ; variable Outfd = STDOUT
dd c_quit ; quit resets return stack and data stack
dd m_exitcolon
- CENTRY `oldboot`, c_oldboot, 7 ; TODO correct below stack notations
+ CENTRY `oldboot`, c_oldboot, 7 ; TODO correct below stack notations and this is obsolete. leaving it here for reference until it all works well
dd m_reset
dd m_clear ; SP = sstack_end
dd m_stackptr ; (D -- FFEND)
- dd v_s0
+ dd m_s0
dd m_store ; s0 = FFEND
- dd mc_heaptop ; heaptop = heapend
+ dd m_Hzero ; heaptop = heapend
dd m_fetch ; ( heapend -- )
dd m_literal
dd 1 ; ( heapend 1 -- )
@@ -1758,54 +1737,65 @@
dd c_cells ; cells ( heapend 8 -- )
dd m_minus ; ( heapend-8 -- )
dd m_fetch ; ( contents_from_heapend-8 -- )
- dd v_args ; variable args
+ dd m_Args ; variable args
dd m_store ; args = contents_from_heapend-8
dd m_literal
dd c_parenabort ; ( (abort) -- )
- dd v_abortvec ; variable abortvec
+ dd m_Abortvec ; variable abortvec
dd m_store ; variable abortvec = (abort) code address
- dd mc_wordb ; constant puts address of wordbuffer on the top of stack
- dd v_wordbuf ; variable wordbuf
+ dd m_Wordb ; constant puts address of wordbuffer on the top of stack
+ dd m_Wordbuf ; variable wordbuf
dd m_store ; variable wordbuf = address of wordbuffer
- dd mc_tib ; constant puts address of tibuffer on the top of stack
- dd v_sourcebuf ; variable sourcebuf
+ dd m_Tib ; constant puts address of tibuffer on the top of stack
+ dd m_Sourcebuf ; variable sourcebuf
dd m_store ; variable sourcebuf = address of tibuffer
dd m_literal
dd 0
- dd v_stdin
+ dd m_Infd
dd m_store ; stdin = 0
dd m_literal
dd 1
- dd v_stdout
+ dd m_Outfd
dd m_store ; stdout = 1
- dd v_state
+ dd m_State
dd c_off ; off stores 0 at state
dd c_decimal ; decimal setting base = 0
dd c_quit ; quit
dd m_exitcolon
+
CENTRY `boot`, c_boot, 4
dd m_reset ; initialize return stack
dd m_clear ; SP = sstack_end, initialize data stack
- dd m_stackptr ; ( -- FFEND)
- dd v_s0
- dd m_store ; s0 = FFEND
+ ; s0 puts FFEND on the stack
; no args
+
dd m_literal
dd c_parenabort ; ( (abort) -- )
- dd v_abortvec ; variable abortvec
+ dd m_Abortvec ; constant that puts (abort) code address on the stack
dd m_store ; variable abortvec = (abort) code address
- dd mc_wordb ; constant puts address of wordbuffer on the top of stack
- dd v_wordbuf ; variable wordbuf
+
+ dd m_Wordb ; constant puts address of wordbuffer on the top of stack
+ dd m_Wordbuf ; variable wordbuf
dd m_store ; variable wordbuf = address of wordbuffer
- dd mc_tib ; constant puts address of tibuffer on the top of stack
- dd v_sourcebuf ; variable sourcebuf
+
+ dd m_Tib ; constant puts address of tibuffer on the top of stack
+ dd m_Sourcebuf ; variable sourcebuf
dd m_store ; variable sourcebuf = address of tibuffer
- ; no stdin or stdout
- dd v_state
+
+ ; stdin, stdout and stderr are constants
+ dd mc_STDIN
+ dd m_Infd
+ dd m_store ; stdin = 0
+ dd mc_STDOUT
+ dd m_Outfd
+ dd m_store ; stdout = 1
+
+ dd m_State
dd c_off ; off stores 0 at state
dd c_decimal ; decimal setting base = 0
dd c_quit ; quit
dd m_exitcolon
+
L137:
db 'unable to restore input'
L170: