ref: 6b9b01c4efb785704a8a5bff92d11250cb284c11
parent: 0977f294bab0345ba43fbf674449fd8e996c5719
author: 9ferno <[email protected]>
date: Fri Oct 29 04:29:34 EDT 2021
compiling native forth interpreter
--- a/.gitignore
+++ b/.gitignore
@@ -358,3 +358,5 @@
os/pc64/6.*
os/pc64/*.i
+os/pc64/primitives.s
+os/pc64/words.s
--- a/mkfiles/mksyslib-rc
+++ b/mkfiles/mksyslib-rc
@@ -34,7 +34,7 @@
$YACC $YFLAGS $prereq
clean-std:V:
- rm -f *.[$OS] [$OS].out
+ rm -f *.[$OS] [$OS].out $CLEANEXTRA
nuke-std:V: clean-std
rm -f y.tab.? y.output y.error
--- /dev/null
+++ b/os/pc64/ff.s
@@ -1,0 +1,617 @@
+#include "mem.h"
+
+/*
+ ff kernel, amd64 9front variant
+
+ Register usage:
+
+ TOS: AX top of stack register
+ SP: SP parameter stack pointer, grows towards lower memory (downwards)
+ RP: BP return stack pointer, grows towards higher memory (upwards)
+ AP: SI address pointer
+ W: DI work register (holds CFA)
+ BX, CX, DX, R8-R15 temporary registers
+
+Memory map:
+
+Return stack 4096 bytes at FFSTART
+ |
+ |
+ v (grows downwards)
+Others 4096 bytes
+ system variables
+ word buffer
+ tib, text input buffer
+Parameter stack 4096 bytes at FFEND-4096
+ ^ (grows upwards)
+ |
+ |
+SSTACK_END = FFEND
+*/
+
+#define SSTACK_SIZE 4096
+#define RSTACK_SIZE 4096
+#define LAST $centry_c_boot(SB) /* last defined word, should generate this */
+#define SSTACK_END FFEND
+
+/* 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
+ c_ for colon word cfa
+ ci_ for colon immediate word cfa
+ v_ for colon variable word cfa
+ */
+#include "primitives.s"
+
+TEXT ffmain(SB), 1, $-4 /* _main(SB), 1, $-4 without the libc */
+ /* 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.
+ */
+ MOVQ $mventry_dp+24(SB), BX /* BX = dp parameter field address, which has the dtop address */
+ MOVQ (BX), BX /* BX = *BX = dtop address */
+ MOVQ (BX), AX /* AX = *BX = $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))), AX */
+ /*
+ * Could do this instead of the calculations below
+ * LEAQ 24(AX), SI
+ */
+ ADDQ $16, AX /* AX += link (8 bytes) + len (1 byte) + minimum for align to 8 bytes */
+ XORQ CX, CX
+ MOVB 8(BX), CL /* CL = length of boot name */
+ ADDQ CX, AX /* AX += len */
+ ANDQ $~7, AX /* AX = address of boot's code - 8 bytes */
+ LEAQ 8(AX), SI /* SI = L257 = start of boot code = has docol address there
+ * skipping over docol as we do not need to save the SI
+ * could have done LEAQ 24(AX), SI
+ */
+ MOVQ $FFEND, SP /* setting up stack, argc + argv */
+
+/* lodsl could make this simpler. But, this is more comprehensible
+ why not JMP* (DI)?
+ */
+#define NEXT MOVQ (SI), DI; \
+ ADDQ $8, SI; \
+ MOVQ (DI), BX; \
+ JMP* BX;
+
+ NEXT
+
+TEXT reset(SB), 1, $-4
+ MOVQ $FFSTART, BP
+ NEXT
+
+TEXT clear(SB), 1, $-4
+ MOVQ $FFEND, SP
+ NEXT
+
+TEXT colon(SB), 1, $-4
+ MOVQ SI,(BP)
+ ADDQ $8, BP
+ LEAQ 8(DI), SI
+ NEXT
+
+TEXT dodoes(SB), 1, $-4 /* ( -- a ) */
+ MOVQ SI,(BP)
+ ADDQ $8,BP
+ MOVQ 8(DI),SI
+ PUSHQ AX
+ LEAQ 16(DI), AX
+ NEXT
+
+TEXT jump(SB), 1, $-4 /* ( -- ) */
+ MOVQ (SI),SI
+ NEXT
+
+/* ( f -- ) cjump address
+ if true, skip the address and continue
+ else, go to the address */
+TEXT cjump(SB), 1, $-4 /* ( f -- ) */
+ MOVQ (SI), BX /* get the next address */
+ ADDQ $8, SI /* move esi beyond that */
+ TESTQ AX, AX
+ JNZ .l1 /* if true, move along */
+ MOVQ BX, SI /* if false, go to the above address */
+.l1:
+ POPQ AX
+ NEXT
+
+TEXT fetch(SB), 1, $-4 /* ( a -- n) */
+ MOVQ (AX), AX
+ NEXT
+
+/* shouldn't it be (a n -- )? */
+TEXT store(SB), 1, $-4 /* ( n a -- ) */
+ POPQ (AX)
+ POPQ AX
+ NEXT
+
+TEXT cfetch(SB), 1, $-4 /* ( a -- c ) */
+ XORQ BX, BX
+ MOVB (AX), BL
+ MOVQ BX, AX
+ NEXT
+
+TEXT cstore(SB), 1, $-4 /* ( c a -- ) */
+ POPQ BX
+ MOVB BL, (AX)
+ POPQ AX
+ NEXT
+
+TEXT terminate(SB), 1, $-4 /* ( n -- ) */
+ XORQ BX, BX
+ TESTQ AX, AX
+ JZ .l2
+ MOVQ $failtext(SB), BX
+.l2:
+ /* PUSHQ BX */
+ /* SUBQ $8, SP */ /* dummy retaddr */
+ MOVQ BX, a0+0(FP) /* address of exit status? status = nil? */
+ MOVQ $8, RARG /* EXITS */
+ SYSCALL /* syscall for exit */
+
+TEXT testfsopen(SB), 1, $-4
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ PUSHQ $0 /* OREAD */
+ PUSHQ $name(SB)
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $14, RARG /* open */
+ SYSCALL
+ ADDQ $24, SP
+ POPQ BP
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+/* man errstr */
+TEXT errstr(SB), 1, $-4
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ PUSHQ AX
+
+ PUSHQ $128 /* size */
+ PUSHQ $errstrbuffer(SB) /* buf */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $41, RARG /* errstr */
+ SYSCALL
+ ADDQ $24, SP
+
+ MOVQ $-1, BX /* -1LL (seek pos) */
+ PUSHQ BX /* offset */
+ PUSHQ $128 /* size, could use c's strlen for the exact size */
+ PUSHQ $errstrbuffer(SB) /* buf */
+ PUSHQ $2 /* assuming that stderr = 2 */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $51, RARG /* PWRITE */
+ SYSCALL
+ ADDQ $40, SP
+
+ POPQ AX
+ POPQ BP
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+TEXT fsopen(SB), 1, $-4 /* ( cstr flags mode -- fd ) */
+ POPQ BX /* flags */
+ POPQ CX /* name */
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ PUSHQ AX
+ MOVQ $14, RARG /* OPEN */
+ TESTQ $512, BX /* O_CREAT? */
+ JZ .l3
+ MOVQ $22, RARG /* CREATE */
+.l3:
+ ANDQ $0xF, BX /* retain only OREAD, OWRITE, ORDWR */
+ PUSHQ BX
+ PUSHQ CX
+ PUSHQ $0 /* dummy retaddr */
+ SYSCALL
+ ADDQ $32, SP
+ POPQ BP
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+TEXT fsclose(SB), 1, $-4 /* ( fd -- n ) */
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ PUSHQ AX /* fd */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $4, RARG /* CLOSE */
+ SYSCALL
+ ADDQ $16, SP /* removing the pushed parameters */
+ POPQ BP
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+TEXT fsread(SB), 1, $-4 /* ( a n fd -- n2 ) */
+ POPQ CX /* size */
+ POPQ DX /* buf */
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ MOVQ $-1, BX /* -1LL (seek pos) */
+ PUSHQ BX /* offset */
+ PUSHQ CX /* size */
+ PUSHQ DX /* buf */
+ PUSHQ AX /* fd */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $50, RARG /* PREAD */
+ SYSCALL /* return value in AX */
+ ADDQ $40, SP
+ POPQ BP /* restore return stack pointer */
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+TEXT fswrite(SB), 1, $-4 /* ( a n fd -- n2 ) */
+ POPQ CX /* size */
+ POPQ DX /* buf */
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ MOVQ $-1, BX /* -1LL (seek pos) */
+ PUSHQ BX /* offset */
+ PUSHQ CX /* size */
+ PUSHQ DX /* buf */
+ PUSHQ AX /* fd */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $51, RARG /* PWRITE */
+ SYSCALL
+ ADDQ $40, SP
+ POPQ BP
+ POPQ SI
+ NEXT
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+
+TEXT fsseek(SB), 1, $-4 /* ( pos fd -- n ) */
+ POPQ BX /* offset */
+ PUSHQ SI /* for some reason, the syscall is changing SI and DI */
+ PUSHQ BP
+ XORQ DX, DX /* type 0 */
+ PUSHQ DX /* type 0 */
+ PUSHQ BX /* offset */
+ PUSHQ AX /* fd */
+ PUSHQ $0 /* dummy retaddr */
+ MOVQ $39, RARG /* SEEK */
+ SYSCALL
+ ADDQ $32, SP /* remove the pushed parameters */
+ POPQ BP
+ POPQ SI
+ NEXT
+
+TEXT mmap(SB), 1, $-4 /* ( a1 -- a2 ) */
+ MOVQ $-1, AX /* unimplemented */
+
+TEXT variable(SB), 1, $-4 /* ( -- a ) */
+ PUSHQ AX
+ LEAQ 8(DI), AX
+ NEXT
+
+TEXT constant(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ MOVQ 8(DI), AX
+ NEXT
+
+TEXT literal(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ MOVQ (SI), AX
+ ADDQ $8, SI
+ NEXT
+
+TEXT sliteral(SB), 1, $-4 /* ( -- a n ) */
+ PUSHQ AX
+ XORQ AX,AX
+ MOVB (SI), AL
+ INCQ SI
+ PUSHQ SI
+ ADDQ AX, SI
+ ADDQ $7, SI
+ ANDQ $~7, SI
+ NEXT
+
+TEXT exitcolon(SB), 1, $-4
+ SUBQ $8, BP
+ MOVQ (BP), SI
+ NEXT
+
+/* puts the top 2 entries of the data stack in the return stack */
+TEXT doinit(SB), 1, $-4 /* ( hi lo -- ) */
+ MOVQ AX, (BP)
+ POPQ AX
+ MOVQ AX, 8(BP)
+ POPQ AX
+ ADDQ $16, BP
+ NEXT
+
+/* not sure if this works, needs testing to follow https://github.com/mark4th/x64
+ check the notes
+ return stack would have
+ current index
+ end index
+ (R lo hi -- )
+ increment lo
+ when hi > lo, go to the address next to doloop
+ */
+TEXT doloop(SB), 1, $-4
+ INCQ -16(BP)
+doloop1:
+ MOVQ -16(BP), BX
+ CMPQ BX, -8(BP)
+ JGE .l4
+ MOVQ (SI), SI
+ NEXT
+.l4:
+ SUBQ $16, BP
+ ADDQ $8, SI
+ NEXT
+
+TEXT doploop(SB), 1, $-4 /* ( n -- ) */
+ ADDQ AX, -16(BP)
+ POPQ AX
+ JMP doloop1
+
+TEXT rfetch(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ MOVQ -8(BP), AX
+ NEXT
+
+TEXT rpush(SB), 1, $-4 /* ( n -- ) */
+ MOVQ AX,(BP)
+ POPQ AX
+ ADDQ $8,BP
+ NEXT
+
+TEXT rpop(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ SUBQ $8, BP
+ MOVQ (BP), AX
+ NEXT
+
+TEXT i(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ MOVQ -16(BP), AX
+ NEXT
+
+TEXT j(SB), 1, $-4 /* ( -- n ) */
+ PUSHQ AX
+ MOVQ -32(BP), AX
+ NEXT
+
+TEXT plus(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ POPQ BX
+ ADDQ BX, AX
+ NEXT
+
+TEXT minus(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ POPQ BX
+ SUBQ AX, BX
+ MOVQ BX, AX
+ NEXT
+
+TEXT multiply(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ POPQ BX
+ IMULQ BX
+ NEXT
+
+TEXT slashmod(SB), 1, $-4 /* ( n1 n2 -- n3 n4 ) */
+ MOVQ AX, BX
+ MOVQ (SP), AX
+ CDQ
+ IDIVQ BX
+ MOVQ AX, (SP)
+ NEXT
+
+TEXT uslashmod(SB), 1, $-4 /* ( u1 u2 -- u3 u4 ) */
+ MOVQ AX, BX
+ MOVQ (SP), AX
+ XORQ DX, DX
+ DIVQ BX
+ MOVQ DX, (SP)
+ NEXT
+
+TEXT binand(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ ANDQ (SP), AX
+ ADDQ $8, SP
+ NEXT
+
+TEXT binor(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ ORQ (SP), AX
+ ADDQ $8, SP
+ NEXT
+
+TEXT binxor(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ XORQ (SP), AX
+ ADDQ $8, SP
+ NEXT
+
+TEXT xswap(SB), 1, $-4 /* ( x y -- y x ) */
+ XCHGQ AX, (SP)
+ NEXT
+
+TEXT drop(SB), 1, $-4 /* ( x -- ) */
+ POPQ AX
+ NEXT
+
+TEXT dup(SB), 1, $-4 /* ( x -- x x ) */
+ PUSHQ AX
+ NEXT
+
+TEXT over(SB), 1, $-4 /* ( x y -- x y x ) */
+ PUSHQ AX
+ MOVQ 8(SP), AX
+ NEXT
+
+TEXT equal(SB), 1, $-4 /* ( x y -- f ) */
+ POPQ BX
+ CMPQ BX, AX
+ JEQ .true
+ XORQ AX, AX
+ NEXT
+TEXT true(SB), 1, $-4
+.true:
+ MOVQ $-1, AX
+ NEXT
+
+TEXT greater(SB), 1, $-4 /* ( x y -- f ) */
+ POPQ BX
+ CMPQ BX, AX
+ JGT .true
+ XORQ AX, AX
+ NEXT
+
+/* if x < y then y - x > 0, no sign flag
+ intel manual says destination operand - source operand
+ but, 9front assemblers seem to work differently
+ compare x and y == CMP x, y
+ */
+TEXT less(SB), 1, $-4 /* ( x y -- f ) */
+ POPQ BX
+ CMPQ BX, AX
+ JLT .true
+ XORQ AX, AX
+ NEXT
+
+TEXT stackptr(SB), 1, $-4 /* ( -- a ) does not include TOS! */
+ PUSHQ AX
+ MOVQ SP, AX
+ NEXT
+
+TEXT lshift(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ MOVQ AX, CX
+ POPQ AX
+ SHLQ CL, AX
+ NEXT
+
+TEXT rshift(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ MOVQ AX, CX
+ POPQ AX
+ SHRQ CL, AX
+ NEXT
+
+TEXT rshifta(SB), 1, $-4 /* ( n1 n2 -- n ) */
+ MOVQ AX, CX
+ POPQ AX
+ SARQ CL, AX
+ NEXT
+
+TEXT execute(SB), 1, $-4 /* ( ... a -- ... ) */
+ MOVQ AX, DI
+ POPQ AX
+ MOVQ (DI), BX
+ JMP BX
+
+TEXT deferred(SB), 1, $-4
+ MOVQ 8(DI), DI
+ MOVQ (DI), BX
+ JMP BX
+
+TEXT unloop(SB), 1, $-4
+ SUBQ $16, BP
+ NEXT
+
+TEXT cmove(SB), 1, $-4 /* ( a1 a2 n -- ) */
+ MOVQ AX, CX
+ POPQ DI
+ MOVQ SI, BX
+ POPQ SI
+ REP; MOVSB
+ MOVQ BX, SI
+ POPQ AX
+ NEXT
+
+TEXT cmoveb(SB), 1, $-4 /* ( a1 a2 n -- ) */
+ MOVQ AX, CX
+ POPQ DI
+ DECQ AX
+ ADDQ AX, DI
+ MOVQ SI, BX
+ POPQ SI
+ ADDQ AX, SI
+ STD
+ REP; MOVSB
+ CLD
+ MOVQ BX, SI
+ POPQ AX
+ NEXT
+
+TEXT cas(SB), 1, $-4 /* ( a old new -- f ) */
+ MOVQ AX, CX /* new */
+ POPQ AX /* old */
+ POPQ BX /* addr */
+ LOCK; CMPXCHGQ CX, (BX)
+ JE .true
+ XORQ AX, AX
+ /* pause -- no equivalent in 6a ? */
+ NEXT
+
+TEXT ffend(SB), 1, $-4
+
+#include "words.s"
+
+DATA failtext(SB)/6, $"error\z"
+GLOBL failtext(SB), $6
+
+DATA name(SB)/8, $"/tmp/tes"
+DATA name+8(SB)/6, $"t.txt\z"
+GLOBL name(SB), $14
+
+DATA errstrbuffer(SB)/1, $0
+GLOBL errstrbuffer(SB), $128 /* matches ERRMAX of libc.h */
+
+DATA tibuffer(SB)/1, $0
+GLOBL tibuffer(SB), $1024
+DATA wordbuffer(SB)/1, $0
+GLOBL wordbuffer(SB), $256
+/* TODO there should not be a heap limit, get rid of this */
+/*
+DATA heap(SB)/1, $0
+GLOBL heap(SB), $HEAP_SIZE
+*/
+
+
+DATA dtop(SB)/8, LAST
+GLOBL dtop(SB), $8
+/* 0's until heap allocated */
+DATA htop(SB)/8, $0
+GLOBL htop(SB), $8
+DATA heapend(SB)/8, $0
+GLOBL heapend(SB), $8
+
+ END
--- a/os/pc64/l.s
+++ b/os/pc64/l.s
@@ -125,6 +125,9 @@
MOVB $15, BX
MOVB BX, (AX)
JMP _idle1
+
+ to dumpstack
+JMP dumpstack(SB)
*/
TEXT _warp64<>(SB), 1, $-4
@@ -595,7 +598,7 @@
RET
TEXT cmpswap486(SB), 1, $-4
-TEXT cas(SB), 1, $-4
+/* TEXT cas(SB), 1, $-4 *//* ff uses this name */
MOVL exp+8(FP), AX
MOVL new+16(FP), BX
LOCK; CMPXCHGL BX, (RARG)
--- a/os/pc64/main.c
+++ b/os/pc64/main.c
@@ -25,6 +25,7 @@
char bootdisk[KNAMELEN];
+extern void ffmain(void); /* forth interpreter */
/* until I sort out the mp initialization issue */
extern void startaps(void);
@@ -113,9 +114,11 @@
"\tcpu0mach 0x%p cpu0sp 0x%p cpu0gdt 0x%p\n"
"\tcpu0pml4 0x%p cpu0pdp 0x%p cpu0pd 0x%p\n"
"\tcpu0end 0x%p\n",
+ "\tetext 0x%p edata 0x%p end 0x%p\n",
(void*)KDZERO, CONFADDR,APBOOTSTRAP,
IDTADDR, CPU0MACH, CPU0SP, GDTADDR,
- PML4ADDR, PDPADDR, PD0ADDR, CPU0END);
+ PML4ADDR, PDPADDR, PD0ADDR, CPU0END,
+ etext, edata, end);
print("Some page table entries\n");ptedebug(1*MiB,"1 MiB");
ptedebug(2*MiB,"2 MiB");
@@ -144,6 +147,7 @@
screeninit();
print("\nInferno release built at %lud\n", kerndate);showconfig();
+ffmain();
cpuidentify();
meminit0(); /* builds the memmap */
doc("archinit");--- a/os/pc64/mem.h
+++ b/os/pc64/mem.h
@@ -79,17 +79,19 @@
#define CPU0END (KDZERO+0x12000ull) /* CPU0MACH + (MACHSIZE = 64 KiB = 0x10 000) */
/* MACHSIZE includes stack size */
#define CPU0SP (KDZERO+0x12000ull)
+#define FFSTART (KDZERO+0x12000ull) /* FF stacks, system variables, tib, word buffer */
+#define FFEND (KDZERO+0x15000ull) /* 3 pages */
/* 1 PD table has 512 entries
* each entry maps to a 2MB page
* 512 entries maps 1GiB and occupies 512*8 = 4096 bytes
*/
-#define PML4ADDR (KDZERO+0x13000ull)
-#define PDPADDR (KDZERO+0x14000ull) /* KZERO=0 .. 512GiB */
-#define PD0ADDR (KDZERO+0x15000ull) /* KZERO=0 .. 1GiB */
-#define PT0ADDR (KDZERO+0x16000ull) /* KZERO=0 .. 2MiB */
-#define PT1ADDR (KDZERO+0x17000ull) /* 2MiB .. 4MiB */
-#define PT2ADDR (KDZERO+0x18000ull) /* 4MiB .. 6MiB */
-#define PT3ADDR (KDZERO+0x19000ull) /* 6MiB .. 8MiB */
+#define PML4ADDR (KDZERO+0x15000ull)
+#define PDPADDR (KDZERO+0x16000ull) /* KZERO=0 .. 512GiB */
+#define PD0ADDR (KDZERO+0x17000ull) /* KZERO=0 .. 1GiB */
+#define PT0ADDR (KDZERO+0x18000ull) /* KZERO=0 .. 2MiB */
+#define PT1ADDR (KDZERO+0x19000ull) /* 2MiB .. 4MiB */
+#define PT2ADDR (KDZERO+0x1a000ull) /* 4MiB .. 6MiB */
+#define PT3ADDR (KDZERO+0x1b000ull) /* 6MiB .. 8MiB */
/* fill with page tables until KTZERO */
/*
--- a/os/pc64/mkfile
+++ b/os/pc64/mkfile
@@ -24,6 +24,7 @@
OBJ=\
l.$O\
+ ff.$O\
fpu.$O\
portclock.$O\
tod.$O\
@@ -88,6 +89,14 @@
fault386.$O: $ROOT/Inferno/$OBJTYPE/include/ureg.h
main.$O: $ROOT/Inferno/$OBJTYPE/include/ureg.h rebootcode.i
trap.$O: $ROOT/Inferno/$OBJTYPE/include/ureg.h
+
+ff.$O: primitives.s words.s
+primitives.s: primitives.awk primitives-nasm.s
+ cat primitives-nasm.s | ./primitives.awk > primitives.s
+words.s: words.awk words-nasm.s
+ cat words-nasm.s | ./words.awk > words.s
+
+CLEANEXTRA=words.s primitives.s
devether.$O $ETHERS: etherif.h ../port/netif.h
$IP devip.$O: ../ip/ip.h
--- /dev/null
+++ b/os/pc64/primitives-nasm.s
@@ -1,0 +1,65 @@
+dict:
+ MENTRY "@", fetch, 1
+ MENTRY "!", store, 1
+ MENTRY "c@", cfetch, 2
+ MENTRY "c!", cstore, 2
+ MENTRY "testfsopen", testfsopen, 10
+ MENTRY "errstr", errstr, 6
+ MENTRY "fsread", fsread, 6
+ MENTRY "fswrite", fswrite, 7
+ MENTRY "fsseek", fsseek, 6
+ MENTRY "fsopen", fsopen, 6
+ MENTRY "fsclose", fsclose, 7
+ MENTRY "mmap", mmap, 4
+ MENTRY "halt", terminate, 4
+ MENTRY "clear", clear, 5
+ MENTRY "reset", reset, 5
+ MVENTRY "h", h, htop, 1
+ MVENTRY "dp", dp, dtop, 2
+ MENTRY "exitcolon", exitcolon, 4
+ MENTRY "(literal)", literal, 9
+ MENTRY "(sliteral)", sliteral, 10
+ MENTRY "(do)", doinit, 4
+ MENTRY "(loop)", doloop, 6
+ MENTRY "(+loop)", doploop, 7
+ MENTRY "r@", rfetch, 2
+ MENTRY "r>", rpop, 2
+ MENTRY ">r", rpush, 2
+ MENTRY "i", i, 1
+ MENTRY "j", j, 1
+ MENTRY "+", plus, 1
+ MENTRY "-", minus, 1
+ MENTRY "*", multiply, 1
+ MENTRY "(if)", cjump, 4
+ MENTRY "(else)", jump, 6
+ MENTRY "/mod", slashmod, 4
+ MENTRY "u/mod", uslashmod, 5
+ MENTRY "and", binand, 3
+ MENTRY "or", binor, 2
+ MENTRY "xor", binxor, 3
+ MENTRY "swap", xswap, 4
+ MENTRY "drop", drop, 4
+ MENTRY "dup", dup, 3
+ MENTRY "over", over, 4
+ MENTRY "=", equal, 1
+ MENTRY ">", greater, 1
+ MENTRY "<", less, 1
+ MVENTRY "tib", tib, tibuffer, 3
+ MVENTRY "wordb", wordb, wordbuffer, 5
+ MENTRY "s@", stackptr, 2
+ MENTRY "lshift", lshift, 6
+ MENTRY "rshift", rshift, 6
+ MENTRY "rshifta", rshifta, 7
+ MENTRY "execute", execute, 7
+ MENTRY "unloop", unloop, 6
+ MENTRY "cmove", cmove, 5
+ MENTRY "cmove>", cmoveb, 6
+ MENTRY "(variable)", variable, 10
+ MENTRY "(constant)", constant, 10
+ MENTRY "(:)", colon, 3
+ MENTRY "(does)", dodoes, 6
+ MVENTRY "heaptop", heaptop, heapend, 7
+ MVENTRY "_start", textbase, ffmain, 6
+ MVENTRY "_end", textend, ffend, 4
+ MENTRY "cas", cas, 3
+ MENTRY "(deferred)", deferred, 10
--- /dev/null
+++ b/os/pc64/primitives.awk
@@ -1,0 +1,96 @@
+#!/bin/awk -f
+
+# rc script to build amd64 9front forth words from words-nasm.s
+# ./words words-nassm.s
+# watch -e 'words.awk' 'head words-nasm.s | ./words.awk'
+
+BEGIN{+ FS=",[ \t]*|[ \t]+"
+ last=""
+ nlines=0
+ addr=""
+}
+{+ lines[++nlines]=sprintf("/* %s */\n", $0);+}
+function writelast(typ, label, last){+ if(last == "")
+ lines[++nlines]=sprintf("DATA %s_%s(SB)/8, LAST\n", typ, label);+ else
+ lines[++nlines]=sprintf("DATA %s_%s(SB)/8, $%s\n", typ, label, last);+}
+$2 == "MENTRY" {+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ }
+ gsub(/"/,"", $3)
+ name = $3
+ label = $4
+ tot = 0
+ writelast("mentry", label, last)+ last=sprintf("mentry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA mentry_%s+8(SB)/1, $%d\n", label, length(name));+ for(i=1; i<=length(name); i++){+ lines[++nlines]=sprintf("DATA mentry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ }
+ tot = 8+i;
+ # for alignment
+ if(tot%8 > 0)
+ tot += 8-(tot%8);
+ lines[++nlines]=sprintf("DATA mentry_%s+%d(SB)/8, $%s(SB)\n", label, tot, label);+ lines[++nlines]=sprintf("#define m_%s(SB) mentry_%s+%d(SB)\n", label, label, tot);+ tot += 8
+ addrlabel = sprintf("mentry_%s", label)+}
+$2 == "MVENTRY" {+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ }
+ gsub(/"/,"", $3)
+ name = $3
+ label = $4
+ tot = 0
+ writelast("mventry", label, last)+ last=sprintf("mventry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA mventry_%s+8(SB)/1, $%d\n", label, length(name));+ for(i=1; i<=length(name); i++){+ lines[++nlines]=sprintf("DATA mventry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ }
+ tot = 8+i;
+ # for alignment
+ if(tot%8 > 0)
+ tot += 8-(tot%8);
+ 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);+ tot += 8;
+ addrlabel = sprintf("mventry_%s", label)+}
+$1 ~ /:$/ && $1 !~ /^dict:$/ {+ l=$1
+ gsub(/:$/,"",l)
+ # for not printing out the labels while still developing the program
+ # to only print the unprocessed lines
+ #lines[++nlines] = ""
+ printf("#define %s(SB) %s+%d(SB)\n", l, addrlabel, tot);+}
+{+ #if(done == nlines){+ # print $0
+ #}
+ #for(i = done+1; i <= nlines; i++){+ # printf("%s", lines[i])+ #}
+ done=nlines
+}
+END{+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s(SB), $%d\n", addrlabel, tot);+ lines[++nlines]=sprintf("#undef LAST\n");+ lines[++nlines]=sprintf("#define LAST $%s\n", last);+ }
+ for(i = 1; i <= nlines; i++){+ printf("%s", lines[i])+ }
+}
--- a/os/pc64/trap.c
+++ b/os/pc64/trap.c
@@ -253,6 +253,8 @@
print(" CS %4.4zux DS %4.4ux ES %4.4ux FS %4.4ux GS %4.4ux\n",ureg->cs & 0xFFFF, ureg->ds & 0xFFFF, ureg->es & 0xFFFF,
ureg->fs & 0xFFFF, ureg->gs & 0xFFFF);
+ print(" R8 %4.4zux R9 %4.4ux R10 %4.4ux R11 %4.4ux R12 %4.4ux\n",+ ureg->r8, ureg->r9, ureg->r10, ureg->r11, ureg->r12);
}
void
--- /dev/null
+++ b/os/pc64/words-nasm.s
@@ -1,0 +1,1815 @@
+ CENTRY `false`, c_false, 5
+ dd m_literal
+ dd 0
+ dd m_exitcolon
+ CENTRY `true`, c_true, 4
+ dd m_literal
+ dd -1
+ dd m_exitcolon
+ CENTRY `bl`, c_bl, 2
+ dd m_literal
+ dd 32
+ dd m_exitcolon
+ VENTRY `s0`, v_s0, 2
+ VENTRY `args`, v_args, 4
+ CENTRY `on`, c_on, 2
+ dd m_literal
+ dd -1
+ dd m_xswap
+ dd m_store
+ dd m_exitcolon
+ CENTRY `off`, c_off, 3
+ dd m_literal
+ dd 0
+ dd m_xswap
+ dd m_store
+ dd m_exitcolon
+ CENTRY `>body`, c_tobody, 5
+ dd m_literal
+ dd 8
+ dd m_plus
+ dd m_exitcolon
+ CENTRY `aligned`, c_aligned, 7
+ dd m_literal
+ dd 7
+ dd m_plus
+ dd m_literal
+ dd -8
+ dd m_binand
+ dd m_exitcolon
+ CENTRY `cells`, c_cells, 5
+ dd m_literal
+ dd 3 ; (index << 2) -> (index << 3)for amd64
+ dd m_lshift
+ dd m_exitcolon
+ CENTRY `cell+`, c_cellplus, 5
+ dd m_literal
+ dd 1
+ dd c_cells
+ dd m_plus
+ dd m_exitcolon
+ CENTRY `depth`, c_depth, 5
+ dd v_s0
+ dd m_fetch
+ dd m_stackptr
+ dd m_minus
+ dd m_literal
+ dd 3
+ dd m_rshift
+ dd m_literal
+ dd 1
+ dd m_minus
+ dd m_exitcolon
+ CENTRY `nip`, c_nip, 3
+ dd m_xswap
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `rot`, c_rot, 3
+ dd m_rpush
+ dd m_xswap
+ dd m_rpop
+ dd m_xswap
+ dd m_exitcolon
+ CENTRY `2drop`, c_2drop, 5
+ dd m_drop
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `2dup`, c_2dup, 4
+ dd m_over
+ dd m_over
+ dd m_exitcolon
+ CENTRY `2nip`, c_2nip, 4
+ dd c_nip
+ dd c_nip
+ dd m_exitcolon
+ CENTRY `2swap`, c_2swap, 5
+ dd c_rot
+ dd m_rpush
+ dd c_rot
+ dd m_rpop
+ dd m_exitcolon
+ CENTRY `?dup`, c_qdup, 4 ; if (tos != 0) dup ( n -- ) TODO correct stack notations
+ dd m_dup ; ( n n -- )
+ dd m_dup ; ( n n n -- )
+ dd m_literal
+ dd 0 ; ( n n n 0 -- )
+ dd m_equal ; ( n n f -- )
+ dd m_cjump ; ( n n -- )
+ dd L20
+ dd m_drop ; tos == 0 ( n -- )
+L20: ; tos != 0 ( n n -- )
+ dd m_exitcolon
+ CENTRY `pick`, c_pick, 4
+ dd c_qdup
+ dd m_cjump
+ dd L22
+ dd m_literal
+ dd 1
+ dd m_plus
+ dd c_cells
+ dd m_stackptr
+ dd m_plus
+ dd m_fetch
+ dd m_jump
+ dd L23
+L22:
+ dd m_dup
+L23:
+ dd m_exitcolon
+ CENTRY `tuck`, c_tuck, 4
+ dd m_dup
+ dd m_rpush
+ dd m_xswap
+ dd m_rpop
+ dd m_exitcolon
+ CENTRY `/`, c_divides, 1
+ dd m_slashmod
+ dd c_nip
+ dd m_exitcolon
+ CENTRY `+!`, c_plusstore, 2
+ dd m_dup
+ dd m_fetch
+ dd c_rot
+ dd m_plus
+ dd m_xswap
+ dd m_store
+ dd m_exitcolon
+ CENTRY `invert`, c_invert, 6
+ dd m_literal
+ dd -1
+ dd m_binxor
+ dd m_exitcolon
+ CENTRY `mod`, c_mod, 3
+ dd m_slashmod
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `1+`, c_1plus, 2
+ dd m_literal
+ dd 1
+ dd m_plus
+ dd m_exitcolon
+ CENTRY `1-`, c_1minus, 2
+ dd m_literal
+ dd 1
+ dd m_minus
+ dd m_exitcolon
+ CENTRY `negate`, c_negate, 6
+ dd m_literal
+ dd 0
+ dd m_xswap
+ dd m_minus
+ dd m_exitcolon
+ CENTRY `2*`, c_2multiplies, 2
+ dd m_literal
+ dd 1
+ dd m_lshift
+ dd m_exitcolon
+ CENTRY `2/`, c_2divides, 2
+ dd m_literal
+ dd 1
+ dd m_rshifta
+ dd m_exitcolon
+ CENTRY `0=`, c_0eq, 2
+ dd m_literal
+ dd 0
+ dd m_equal
+ dd m_exitcolon
+ CENTRY `0<`, c_0lt, 2
+ dd m_literal
+ dd 0
+ dd m_less
+ dd m_exitcolon
+ CENTRY `0>`, c_0gt, 2
+ dd m_literal
+ dd 0
+ dd m_greater
+ dd m_exitcolon
+ CENTRY `<>`, c_neq, 2
+ dd m_equal
+ dd c_invert
+ dd m_exitcolon
+ CENTRY `0<>`, c_0neq, 3
+ dd m_literal
+ dd 0
+ dd c_neq
+ dd m_exitcolon
+ CENTRY `max`, c_max, 3
+ dd c_2dup
+ dd m_greater
+ dd m_cjump
+ dd L40
+ dd m_drop
+ dd m_jump
+ dd L41
+L40:
+ dd c_nip
+L41:
+ dd m_exitcolon
+ CENTRY `min`, c_min, 3
+ dd c_2dup
+ dd m_less
+ dd m_cjump
+ dd L43
+ dd m_drop
+ dd m_jump
+ dd L44
+L43:
+ dd c_nip
+L44:
+ dd m_exitcolon
+ CENTRY `signum`, c_signum, 6
+ dd m_dup
+ dd c_0gt
+ dd m_cjump
+ dd L46
+ dd m_drop
+ dd m_literal
+ dd 1
+ dd m_jump
+ dd L47
+L46:
+ dd c_0lt
+ dd m_cjump
+ dd L48
+ dd m_literal
+ dd -1
+ dd m_jump
+ dd L49
+L48:
+ dd m_literal
+ dd 0
+L49:
+L47:
+ dd m_exitcolon
+ CENTRY `within`, c_within, 6
+ dd m_rpush
+ dd m_over
+ dd m_greater
+ dd c_0eq
+ dd m_xswap
+ dd m_rpop
+ dd m_greater
+ dd c_0eq
+ dd m_binand
+ dd m_exitcolon
+ CENTRY `abs`, c_abs, 3
+ dd m_dup
+ dd c_0lt
+ dd m_cjump
+ dd L52
+ 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_literal
+ dd 1
+ dd v_stdin ; variable stdin
+ dd m_fetch ; ( iobuf 1 0 -- )
+ dd m_fsread
+ dd c_0eq
+ dd m_cjump
+ dd L78
+ dd v_eof
+ dd c_on
+ dd m_literal
+ dd -1
+ dd m_jump
+ dd L79
+L78:
+ dd v_iobuf
+ dd m_cfetch
+L79:
+ dd m_exitcolon
+ CENTRY `emit`, c_emit, 4 ; ( character -- ) TODO correct the below stack notations
+ dd v_iobuf ; variable iobuf
+ dd m_cstore ; variable iobuf has character
+ dd v_iobuf ; variable iobuf
+ dd m_literal
+ dd 1 ; ( iobuf 1 -- )
+ dd v_stdout ; variable stdout
+ dd m_fetch ; ( iobuf 1 1 -- )
+ dd m_fswrite ; ( -- ) writes out the character
+ dd m_drop ; the return value of fswrite
+ dd m_exitcolon
+ CENTRY `type`, c_type, 4 ; ( addr n -- )
+ dd v_stdout ; variable stdout, normally 1
+ dd m_fetch ; ( addr n 1 -- )
+ dd m_fswrite
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `cr`, c_cr, 2
+ dd m_literal
+ dd 10 ; ascii value of carriage return
+ dd c_emit ; emit
+ dd m_exitcolon
+ CENTRY `space`, c_space, 5
+ dd c_bl
+ dd c_emit
+ dd m_exitcolon
+ CENTRY `emits`, c_emits, 5
+L85:
+ dd c_qdup
+ dd m_cjump
+ dd L86
+ dd m_over
+ dd c_emit
+ dd c_1minus
+ dd m_jump
+ dd L85
+L86:
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `spaces`, c_spaces, 6
+ dd c_bl
+ dd m_xswap
+ dd c_emits
+ dd m_exitcolon
+ CENTRY `count`, c_count, 5 ; ( a -- a+1 n ) a = counted string
+ dd c_1plus
+ dd m_dup
+ dd c_1minus
+ dd m_cfetch
+ dd m_exitcolon
+ CENTRY `compare`, c_compare, 7 ; ( a1 n1 a2 n2 -- f ) a1 = dictionary entry a2 = word name to search
+ dd c_rot ; ( a1 n1 a2 n2 -- a1 a2 n2 n1 )
+ dd c_2dup ; ( -- a1 a2 n2 n1 n2 n1 )
+ dd m_rpush ; ( -- a1 a2 n2 n1 n2 ) (R n1 -- )
+ dd m_rpush ; ( -- a1 a2 n2 n1 ) (R n1 n2 -- )
+ dd c_min ; ( -- a1 a2 nmin ) (R n1 n2 -- )
+ dd m_literal
+ dd 0 ; ( -- a1 a2 nmin 0 ) (R n1 n2 -- )
+ dd m_doinit ; ( -- a1 a2 ) (R n1 n2 0 nmin -- )
+L55:
+ dd m_over
+ dd m_i
+ dd m_plus
+ dd m_cfetch
+ dd m_over
+ dd m_i
+ dd m_plus
+ dd m_cfetch
+ dd m_minus
+ dd c_signum
+ dd c_qdup
+ dd m_cjump
+ dd L56
+ dd c_2nip
+ dd m_unloop
+ dd m_unloop
+ dd m_exitcolon
+L56:
+ dd m_doloop
+ dd L55
+ dd c_2drop ; ( a1 a2 -- ) (R n1 n2 -- )
+ dd m_rpop
+ dd m_rpop ; ( n2 n1 -- ) (R -- )
+ dd m_minus ; ( -- n1-n2 )
+ dd c_signum
+ dd m_exitcolon
+ CENTRY `erase`, c_erase, 5
+ dd m_literal
+ dd 0
+ dd m_doinit
+L58:
+ dd m_literal
+ dd 0
+ dd m_over
+ dd m_cstore
+ dd c_1plus
+ dd m_doloop
+ dd L58
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `fill`, c_fill, 4
+ dd m_xswap
+ dd m_literal
+ dd 0
+ dd m_doinit
+L60:
+ dd c_2dup
+ dd m_xswap
+ dd m_i
+ dd m_plus
+ dd m_cstore
+ dd m_doloop
+ dd L60
+ dd c_2drop
+ dd m_exitcolon
+ CENTRY `blank`, c_blank, 5
+ dd c_bl
+ dd c_fill
+ dd m_exitcolon
+ VENTRY `searchlen`, v_searchlen, 9
+ CENTRY `search`, c_search, 6
+ dd v_searchlen
+ dd m_store
+ dd m_xswap
+ dd m_dup
+ dd m_rpush
+ dd v_searchlen
+ dd m_fetch
+ dd m_minus
+ dd c_1plus
+ dd m_literal
+ dd 0
+ dd m_doinit
+L64:
+ dd m_over
+ dd m_i
+ dd m_plus
+ dd m_over
+ dd v_searchlen
+ dd m_fetch
+ dd m_xswap
+ dd v_searchlen
+ dd m_fetch
+ dd c_compare
+ dd c_0eq
+ dd m_cjump
+ dd L65
+ dd m_drop
+ dd m_i
+ dd m_plus
+ dd m_i
+ dd m_unloop
+ dd m_rpop
+ dd m_xswap
+ dd m_minus
+ dd c_true
+ dd m_exitcolon
+L65:
+ dd m_doloop
+ dd L64
+ dd m_drop
+ dd m_rpop
+ dd c_false
+ dd m_exitcolon
+ CENTRY `here`, c_here, 4
+ dd mc_h
+ dd m_fetch
+ dd m_exitcolon
+ CENTRY `,`, c_comma, 1
+ dd c_here
+ dd m_store
+ dd m_literal
+ dd 8
+ dd mc_h
+ dd c_plusstore
+ dd m_exitcolon
+ CENTRY `c,`, c_c, 2
+ dd c_here
+ dd m_cstore
+ dd m_literal
+ dd 1
+ dd mc_h
+ dd c_plusstore
+ dd m_exitcolon
+ CENTRY `allot`, c_allot, 5
+ dd mc_h
+ dd c_plusstore
+ dd m_exitcolon
+ CENTRY `pad`, c_pad, 3
+ dd c_here
+ dd m_literal
+ dd 256
+ dd m_plus
+ dd m_exitcolon
+ CENTRY `align`, c_align, 5
+ dd c_here
+ dd c_aligned
+ dd mc_h
+ dd m_store
+ dd m_exitcolon
+ CENTRY `unused`, c_unused, 6
+ dd mc_heaptop
+ 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_store
+ dd m_exitcolon
+ CENTRY `#`, c_hash, 1
+ dd v_base
+ dd m_fetch
+ dd m_uslashmod
+ dd m_xswap
+ dd m_dup
+ dd m_literal
+ dd 9
+ dd m_greater
+ dd m_cjump
+ dd L92
+ dd m_literal
+ dd 97
+ dd m_plus
+ dd m_literal
+ dd 10
+ dd m_minus
+ dd m_jump
+ dd L93
+L92:
+ dd m_literal
+ dd 48
+ dd m_plus
+L93:
+ dd v_tonum
+ dd m_fetch
+ dd c_1minus
+ dd m_dup
+ dd v_tonum
+ dd m_store
+ dd m_cstore
+ dd m_exitcolon
+ CENTRY `#s`, c_hashs, 2
+L95:
+ dd c_hash
+ dd m_dup
+ dd m_cjump
+ dd L96
+ dd m_jump
+ dd L95
+L96:
+ dd m_exitcolon
+ CENTRY `#>`, c_hashfrom, 2
+ dd m_drop
+ dd v_tonum
+ dd m_fetch
+ dd m_dup
+ dd c_pad
+ dd m_literal
+ dd 1024
+ dd m_plus
+ dd m_xswap
+ dd m_minus
+ dd m_exitcolon
+ CENTRY `hold`, c_hold, 4
+ dd v_tonum
+ dd m_fetch
+ dd c_1minus
+ dd m_dup
+ dd m_rpush
+ dd m_cstore
+ dd m_rpop
+ dd v_tonum
+ dd m_store
+ dd m_exitcolon
+ CENTRY `sign`, c_sign, 4
+ dd c_0lt
+ dd m_cjump
+ dd L100
+ dd m_literal
+ dd 45
+ dd c_hold
+L100:
+ dd m_exitcolon
+ CENTRY `.`, c_dot, 1
+ dd m_dup
+ dd c_abs
+ dd c_fromhash
+ dd c_hashs
+ dd m_xswap
+ dd c_sign
+ dd c_hashfrom
+ dd c_type
+ dd c_space
+ dd m_exitcolon
+ CENTRY `.r`, c_dotr, 2
+ dd m_rpush
+ dd m_dup
+ dd c_abs
+ dd c_fromhash
+ dd c_hashs
+ dd m_xswap
+ dd c_sign
+ dd c_hashfrom
+ dd m_rpop
+ dd m_over
+ dd m_minus
+ dd m_literal
+ dd 0
+ dd c_max
+ dd c_spaces
+ dd c_type
+ dd m_exitcolon
+ CENTRY `hex`, c_hex, 3
+ dd m_literal
+ dd 16
+ dd v_base
+ dd m_store
+ dd m_exitcolon
+ CENTRY `decimal`, c_decimal, 7
+ dd m_literal
+ dd 10
+ dd v_base
+ dd m_store
+ dd m_exitcolon
+ CENTRY `digit`, c_digit, 5
+ dd m_dup
+ dd m_literal
+ dd 65
+ dd m_literal
+ dd 91
+ dd c_within
+ dd m_cjump
+ dd L106
+ dd m_literal
+ dd 55
+ dd m_minus
+ dd m_jump
+ dd L107
+L106:
+ dd m_dup
+ dd m_literal
+ dd 97
+ dd m_literal
+ dd 123
+ dd c_within
+ dd m_cjump
+ dd L108
+ dd m_literal
+ dd 87
+ dd m_minus
+ dd m_jump
+ dd L109
+L108:
+ dd m_dup
+ dd m_literal
+ dd 48
+ dd m_literal
+ dd 58
+ dd c_within
+ dd m_cjump
+ dd L110
+ dd m_literal
+ dd 48
+ dd m_minus
+ dd m_jump
+ dd L111
+L110:
+ dd m_drop
+ dd c_false
+ dd m_exitcolon
+L111:
+L109:
+L107:
+ dd m_dup
+ dd v_base
+ dd m_fetch
+ dd m_less
+ dd m_cjump
+ dd L112
+ dd c_true
+ dd m_jump
+ dd L113
+L112:
+ dd m_drop
+ dd c_false
+L113:
+ dd m_exitcolon
+ CENTRY `number`, c_number, 6
+ dd m_xswap
+ dd m_dup
+ dd m_cfetch
+ dd m_literal
+ dd 45
+ dd m_equal
+ dd m_cjump
+ dd L115
+ dd c_1plus
+ dd m_xswap
+ dd c_1minus
+ dd m_literal
+ dd -1
+ dd m_rpush
+ dd m_jump
+ dd L116
+L115:
+ dd m_xswap
+ dd m_literal
+ dd 1
+ dd m_rpush
+L116:
+ dd m_dup
+ dd m_rpush
+ dd m_literal
+ dd 0
+ dd m_xswap
+ dd m_literal
+ dd 0
+ dd m_doinit
+L117:
+ dd v_base
+ dd m_fetch
+ dd m_multiply
+ dd m_over
+ dd m_i
+ dd m_plus
+ dd m_cfetch
+ dd c_digit
+ dd m_cjump
+ dd L118
+ dd m_plus
+ dd m_jump
+ dd L119
+L118:
+ dd m_drop
+ dd m_unloop
+ dd m_rpop
+ dd m_rpop
+ dd m_drop
+ dd c_false
+ dd m_exitcolon
+L119:
+ dd m_doloop
+ dd L117
+ dd m_rpop
+ dd m_drop
+ dd c_nip
+ dd m_rpop
+ 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_fetch
+ dd m_execute
+ dd m_exitcolon
+ CENTRY `source`, c_source, 6
+ dd v_sourcebuf
+ dd m_fetch
+ dd m_exitcolon
+ CENTRY `current-input`, c_current_input, 13
+ dd v_toin
+ dd m_fetch
+ dd c_source
+ dd m_plus
+ dd m_cfetch
+ dd m_exitcolon
+ CENTRY `save-input`, c_save_input, 10
+ dd v_stdin
+ dd m_fetch
+ dd v_toin
+ dd m_fetch
+ dd v_tolimit
+ dd m_fetch
+ dd v_sourcebuf
+ 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 c_off
+ dd v_toin
+ dd c_off
+ dd v_tolimit
+ dd c_off
+ dd mc_tib
+ dd v_sourcebuf
+ dd m_store
+ dd v_blk
+ dd c_off
+ dd m_exitcolon
+ CENTRY `restore-input`, c_restore_input, 13
+ dd v_eof
+ dd c_off
+ dd m_literal
+ dd 5
+ dd c_neq
+ dd m_cjump
+ dd L133
+ dd c_default_input
+ dd c_false
+ dd m_jump
+ dd L134
+L133:
+ dd v_blk
+ dd m_store
+ dd v_sourcebuf
+ dd m_store
+ dd v_tolimit
+ dd m_store
+ dd v_toin
+ dd m_store
+ dd v_stdin
+ dd m_store
+ dd c_true
+L134:
+ dd m_exitcolon
+ CENTRY `?restore-input`, c_qrestore_input, 14
+ dd c_restore_input
+ dd c_0eq
+ dd m_cjump
+ dd L136
+ dd c_space
+ dd m_literal
+ dd L137
+ dd m_literal
+ dd 23
+ dd c_type
+ dd c_cr
+ dd c_abort
+L136:
+ dd m_exitcolon
+ CENTRY `next-input`, c_next_input, 10
+ dd v_toin
+ dd m_fetch
+ dd v_tolimit
+ dd m_fetch
+ dd m_less
+ dd m_cjump
+ dd L139
+ dd c_true
+ dd c_current_input
+ dd m_jump
+ dd L140
+L139:
+ dd m_literal
+ dd 0
+ dd c_false
+L140:
+ dd m_exitcolon
+ CENTRY `parse`, c_parse, 5
+ dd m_rpush
+ dd v_wordbuf
+ dd m_fetch
+ dd c_1plus
+L142:
+ dd c_next_input
+ dd m_rfetch
+ dd c_neq
+ dd m_binand
+ dd m_cjump
+ dd L143
+ dd c_current_input
+ dd m_over
+ dd m_cstore
+ dd c_1plus
+ dd m_literal
+ dd 1
+ dd v_toin
+ dd c_plusstore
+ dd m_jump
+ dd L142
+L143:
+ dd m_literal
+ dd 1
+ dd v_toin
+ dd c_plusstore
+ dd m_rpop
+ dd m_drop
+ dd v_wordbuf
+ dd m_fetch
+ dd m_dup
+ dd m_rpush
+ dd m_minus
+ dd c_1minus
+ dd m_rfetch
+ dd m_cstore
+ dd m_rpop
+ dd m_exitcolon
+ CENTRY `word`, c_word, 4 ; ( c -- )
+ dd m_rpush ; ( -- ) (R -- c )
+L145:
+ dd c_next_input ; ( -- c2 ) (R c1 -- )
+ dd m_rfetch
+ dd m_equal
+ dd m_binand
+ dd m_cjump
+ dd L146
+ dd m_literal
+ dd 1
+ dd v_toin
+ dd c_plusstore
+ dd m_jump
+ dd L145
+L146:
+ dd m_rpop
+ dd c_parse
+ dd m_exitcolon
+ CENTRY `accept`, c_accept, 6 ; ( a n -- ) TODO correct below stack notations
+ dd m_xswap ; ( n a -- )
+ dd m_dup ; ( n a a -- )
+ dd m_rpush
+ dd m_rpush ; ( n -- ) (R a a -- )
+L148:
+ dd c_qdup ; ( n n -- ) (R a a -- )
+ dd m_cjump ; (if)
+ dd L149 ; n == 0
+ dd c_key ; n > 0 ( n c -- )
+ dd m_dup ; ( n c c -- )
+ dd m_literal
+ dd 10 ; ( n c c 10 -- )
+ dd m_equal ; ( n c f -- )
+ dd m_over ; ( n c f n -- )
+ dd m_literal
+ dd -1 ; ( n c f n -1 -- )
+ dd m_equal ; ( n c f1 f2 -- )
+ dd m_binor ; ( n c f -- )
+ dd m_cjump
+ dd L150
+ dd c_2drop ; n == -1 || n == 10 ( -- )
+ dd m_rpop
+ dd m_rpop
+ dd m_minus
+ dd m_exitcolon ; ( 0 -- ) (R -- )
+L150:
+ dd m_rfetch ; ( n c a -- ) (R a a -- )
+ dd m_cstore
+ dd m_rpop ; ( n a -- ) (R a -- )
+ dd c_1plus
+ dd m_rpush ; ( n -- ) (R a1 a2 -- )
+ dd c_1minus ; ( n-1 -- ) (R a1 a2 -- )
+ dd m_jump
+ dd L148
+L149: ; n == 0 ( -- ) (R a a -- )
+ dd m_rpop
+ dd m_rpop ; ( a a -- )
+ dd m_minus ; ( 0 -- )
+ dd m_exitcolon
+ CENTRY `query`, c_query, 5
+ dd v_eof ; variable eof
+ dd c_off ; off sets variable eof = 0
+ dd mc_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 m_fetch
+ dd m_binand
+ dd m_cjump
+ dd L152
+ dd m_drop
+ dd c_qrestore_input
+ dd m_jump
+ dd L153
+L152:
+ dd v_tolimit
+ dd m_store
+ dd v_toin
+ dd c_off
+L153:
+ dd m_exitcolon
+ CENTRY `refill`, c_refill, 6
+ dd v_blk
+ dd m_fetch
+ dd m_cjump
+ dd L155
+ dd c_false
+ dd m_jump
+ dd L156
+L155:
+ dd c_query
+ 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_store
+ dd mc_dp
+ dd m_fetch ; get dictionary link
+L158:
+ dd c_qdup
+ dd m_cjump
+ dd L159 ; seached until the first dictionary entry, get out
+ dd m_dup ; ( a -- a a )
+ dd c_cellplus ; lenth + initial name address
+ dd m_cfetch ; length + initial name
+ dd m_literal
+ dd 64 ; max name length?
+ dd m_binand ; keep only the length
+ dd m_cjump
+ dd L160
+ dd m_fetch
+ dd m_jump
+ dd L161
+L160: ; valid length? ( a -- )
+ dd m_dup
+ dd c_cellplus
+ dd c_count ; ( a1 a1+8 -- a1 a1+8+1 n )
+ 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_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
+ dd c_0eq ; found a match?
+ dd m_cjump
+ dd L162
+ dd c_cellplus
+ dd c_true
+ dd m_exitcolon
+L162:
+ dd m_fetch
+L161:
+ dd m_jump
+ dd L158
+L159:
+ dd v_findadr
+ dd m_fetch
+ dd c_false
+ dd m_exitcolon
+ CENTRY `find`, c_find, 4 ; ( a1 -- a2 f )?
+ dd c_findname
+ dd m_cjump
+ dd L164
+ dd m_dup
+ dd m_cfetch
+ dd m_xswap
+ dd m_over
+ dd m_literal
+ dd 63
+ dd m_binand
+ dd m_plus
+ dd c_1plus
+ dd c_aligned
+ dd m_xswap
+ dd m_literal
+ dd 128
+ dd m_binand
+ dd m_cjump
+ dd L165
+ dd m_literal
+ dd 1
+ dd m_jump
+ dd L166
+L165:
+ dd m_literal
+ dd -1
+L166:
+ dd m_exitcolon
+ dd m_jump
+ dd L167
+L164:
+ dd c_false
+L167:
+ dd m_exitcolon
+ CENTRY `'`, c_single_quote, 1
+ dd c_bl
+ dd c_word
+ dd c_find
+ dd c_0eq
+ dd m_cjump
+ dd L169
+ dd c_space
+ dd c_count
+ dd c_type
+ dd m_literal
+ dd L170
+ dd m_literal
+ dd 3
+ dd c_type
+ dd c_cr
+ dd c_abort
+L169:
+ dd m_exitcolon
+ CENTRY `?stack`, c_qstack, 6
+ dd m_stackptr
+ dd v_s0
+ dd m_fetch
+ dd m_greater
+ dd m_cjump
+ dd L172
+ dd m_literal
+ dd L173
+ dd m_literal
+ dd 16
+ dd c_type
+ dd c_cr
+ dd c_abort
+L172:
+ dd m_exitcolon
+ CENTRY `interpret`, c_interpret, 9
+L175:
+ dd c_bl
+ dd c_word
+ dd m_dup
+ dd m_cfetch
+ dd c_0neq
+ dd m_cjump
+ dd L176
+ dd c_find ; ( a -- ) a = address of counted string
+ dd m_cjump
+ dd L177
+ dd m_execute
+ dd c_qstack
+ dd m_jump
+ dd L178
+L177:
+ dd c_count
+ dd c_number
+ dd c_0eq
+ dd m_cjump
+ dd L179
+ dd c_space
+ dd c_type
+ dd m_literal
+ dd L180 ; error I?
+ dd m_literal
+ dd 3
+ dd c_type
+ dd c_cr
+ dd c_abort
+L179:
+L178:
+ dd m_jump
+ dd L175
+L176:
+ dd m_drop
+ dd m_exitcolon
+ CENTRY `create`, c_create, 6
+ dd c_align
+ dd c_here
+ dd m_rpush
+ dd mc_dp
+ dd m_fetch
+ dd c_comma
+ dd c_bl
+ dd c_word
+ dd m_dup
+ dd m_cfetch
+ dd c_here
+ dd m_xswap
+ dd c_1plus
+ dd m_dup
+ dd m_rpush
+ dd m_cmove
+ dd m_rpop
+ dd c_allot
+ dd c_align
+ dd m_literal
+ dd m_variable
+ dd m_fetch
+ dd c_comma
+ dd m_rpop
+ dd mc_dp
+ dd m_store
+ dd m_exitcolon
+ CENTRY `variable`, c_variable, 8
+ dd c_create
+ dd m_literal
+ dd 0
+ dd c_comma
+ dd m_exitcolon
+ CENTRY `constant`, c_constant, 8
+ dd c_create
+ dd m_literal
+ dd m_constant
+ dd m_fetch
+ dd c_here
+ dd m_literal
+ dd 1
+ dd c_cells
+ dd m_minus
+ dd m_store
+ dd c_comma
+ dd m_exitcolon
+ VENTRY `state`, v_state, 5
+ CENTRY `immediate`, c_immediate, 9
+ dd mc_dp
+ dd m_fetch
+ dd c_cellplus
+ dd m_dup
+ dd m_cfetch
+ dd m_literal
+ dd 128
+ dd m_binor
+ dd m_xswap
+ dd m_cstore
+ dd m_exitcolon
+ CENTRY `>cfa`, c_tocfa, 4
+ dd c_count
+ dd m_literal
+ dd 63
+ dd m_binand
+ dd m_plus
+ dd c_aligned
+ dd m_exitcolon
+ CENTRY `compile`, c_compile, 7
+ dd c_findname
+ dd m_cjump
+ dd L188
+ dd m_dup
+ dd m_cfetch
+ dd m_literal
+ dd 128
+ dd m_binand
+ dd m_cjump
+ dd L189
+ dd c_tocfa ; immediate
+ dd m_execute
+ dd c_qstack
+ dd m_jump
+ dd L190
+L189:
+ dd c_tocfa
+ dd c_comma
+L190:
+ dd m_jump
+ dd L191
+L188:
+ dd c_count
+ dd c_number
+ dd c_0eq
+ dd m_cjump
+ dd L192
+ dd c_space
+ dd c_type
+ dd m_literal
+ dd L193
+ dd m_literal
+ dd 3
+ dd c_type
+ dd c_cr
+ dd c_abort
+ dd m_jump
+ dd L194
+L192:
+ dd m_literal
+ dd m_literal
+ dd c_comma
+ dd c_comma
+L194:
+L191:
+ dd m_exitcolon
+ CENTRY `]`, c_close_bracket, 1
+ dd v_state
+ dd c_on
+L196:
+ dd c_bl
+ dd c_word
+ dd m_dup
+ dd m_cfetch
+ dd c_0eq
+ dd m_cjump
+ dd L197
+ dd m_drop
+ dd c_refill
+ dd m_jump
+ dd L198
+L197:
+ dd c_compile
+ dd v_state
+ dd m_fetch
+L198:
+ dd m_cjump
+ dd L199
+ dd m_jump
+ dd L196
+L199:
+ dd m_exitcolon
+ CIENTRY `[`, ci_open_bracket, 1
+ dd v_state
+ dd c_off
+ dd m_exitcolon
+ CENTRY `smudge`, c_smudge, 6
+ dd mc_dp
+ dd m_fetch
+ dd c_cellplus
+ dd m_dup
+ dd m_cfetch
+ dd m_literal
+ dd 64
+ dd m_binor
+ dd m_xswap
+ dd m_cstore
+ dd m_exitcolon
+ CENTRY `reveal`, c_reveal, 6
+ dd mc_dp
+ dd m_fetch
+ dd c_cellplus
+ dd m_dup
+ dd m_cfetch
+ dd m_literal
+ dd 64
+ dd c_invert
+ dd m_binand
+ dd m_xswap
+ dd m_cstore
+ dd m_exitcolon
+ CENTRY `:`, c_colon, 1
+ dd c_create
+ dd c_smudge
+ dd m_literal
+ dd m_colon
+ dd m_fetch
+ dd c_here
+ dd m_literal
+ dd 1
+ dd c_cells
+ dd m_minus
+ dd m_store
+ dd c_close_bracket
+ dd m_exitcolon
+ CIENTRY `;`, ci_semicolon, 1
+ dd m_literal
+ dd m_exitcolon
+ dd c_comma
+ dd v_state
+ dd c_off
+ dd c_reveal
+ dd m_exitcolon
+ CIENTRY `recurse`, ci_recurse, 7
+ dd mc_dp
+ dd m_fetch
+ dd c_cellplus
+ dd c_tocfa
+ dd c_comma
+ dd m_exitcolon
+ CENTRY `char`, L206, 4
+ dd c_bl
+ dd c_word
+ dd c_1plus
+ dd m_cfetch
+ dd m_exitcolon
+ CENTRY `literal`, c_literal, 7
+ dd m_literal
+ dd m_literal
+ dd c_comma
+ dd c_comma
+ dd m_exitcolon
+ CENTRY `sliteral`, c_sliteral, 8
+ dd m_literal
+ dd m_sliteral
+ dd c_comma
+ dd c_here
+ dd m_literal
+ dd 34
+ dd c_parse
+ dd m_dup
+ dd m_cfetch
+ dd c_1plus
+ dd m_rpush
+ dd m_xswap
+ dd m_rfetch
+ dd m_cmove
+ dd m_rpop
+ dd c_allot
+ dd c_align
+ dd m_exitcolon
+ CENTRY `string`, c_string, 6
+ dd c_word
+ dd m_dup
+ dd m_cfetch
+ dd c_1plus
+ dd m_rpush
+ dd c_here
+ dd m_rfetch
+ dd m_cmove
+ dd m_rpop
+ dd c_allot
+ dd m_exitcolon
+ CIENTRY `[char]`, ci_char_brackets, 6
+ dd c_bl
+ dd c_word
+ dd c_1plus
+ dd m_cfetch
+ dd c_literal
+ dd m_exitcolon
+ CIENTRY `[']`, ci_quote_brackets, 3
+ dd c_single_quote
+ dd c_literal
+ dd m_exitcolon
+ CIENTRY `(`, ci_openparen, 1
+ dd m_literal
+ dd 41
+ dd c_parse
+ dd m_drop
+ dd m_exitcolon
+ CIENTRY `\`, ci_backslash, 1
+ dd v_blk
+ dd m_fetch
+ dd m_cjump
+ dd L214
+ dd v_toin
+ dd m_fetch
+ dd m_literal
+ dd 63
+ dd m_plus
+ dd m_literal
+ dd 63
+ dd c_invert
+ dd m_binand
+ dd v_toin
+ dd m_store
+ dd m_jump
+ dd L215
+L214:
+ dd v_tolimit
+ dd m_fetch
+ dd v_toin
+ dd m_store
+L215:
+ dd m_exitcolon
+ CENTRY `(?abort)`, c_qabort_parens, 8
+ dd v_state
+ dd m_cjump
+ dd L217
+ dd c_space
+ dd c_type
+ dd c_cr
+ dd c_abort
+ dd m_jump
+ dd L218
+L217:
+ dd c_2drop
+L218:
+ dd m_exitcolon
+ CIENTRY `abort"`, ci_abort_double_quote, 6
+ dd c_sliteral
+ dd m_literal
+ dd c_qabort_parens
+ dd c_comma
+ dd m_exitcolon
+ CENTRY `"`, c_double_quote, 1
+ dd m_literal
+ dd 34
+ dd c_word
+ dd c_count
+ dd m_rpush
+ dd c_here
+ dd m_rfetch
+ dd m_cmove
+ dd c_here
+ dd m_rpop
+ dd m_dup
+ dd c_allot
+ dd m_exitcolon
+ CENTRY `c"`, c_cdouble_quote, 2
+ dd m_literal
+ dd 34
+ dd c_word
+ dd m_dup
+ dd m_cfetch
+ dd c_1plus
+ dd m_rpush
+ dd c_here
+ dd m_rfetch
+ dd m_cmove
+ dd c_here
+ dd m_rpop
+ dd c_allot
+ dd m_exitcolon
+ CIENTRY `s"`, ci_sdouble_quote, 2
+ dd c_sliteral
+ dd m_exitcolon
+ CIENTRY `."`, ci_dotstr, 2
+ dd c_sliteral
+ dd m_literal
+ dd c_type
+ dd c_comma
+ dd m_exitcolon
+ CIENTRY `if`, ci_if, 2
+ dd m_literal
+ dd m_cjump
+ dd c_comma
+ dd c_here
+ dd m_literal
+ dd 0
+ dd c_comma
+ dd m_exitcolon
+ CIENTRY `else`, ci_else, 4
+ dd m_literal
+ dd m_jump
+ dd c_comma
+ dd c_here
+ dd m_rpush
+ dd m_literal
+ dd 0
+ dd c_comma
+ dd c_here
+ dd m_xswap
+ dd m_store
+ dd m_rpop
+ dd m_exitcolon
+ CIENTRY `then`, ci_then, 4
+ dd c_here
+ dd m_xswap
+ dd m_store
+ dd m_exitcolon
+ CIENTRY `begin`, ci_begin, 5
+ dd c_here
+ dd m_exitcolon
+ CIENTRY `again`, ci_again, 5
+ dd m_literal
+ dd m_jump
+ dd c_comma
+ dd c_comma
+ dd m_exitcolon
+ CIENTRY `until`, ci_until, 5
+ dd m_literal
+ dd m_cjump
+ dd c_comma
+ dd c_comma
+ dd m_exitcolon
+ CIENTRY `while`, ci_while, 5
+ dd m_literal
+ dd m_cjump
+ dd c_comma
+ dd c_here
+ dd m_literal
+ dd 0
+ dd c_comma
+ dd m_exitcolon
+ CIENTRY `repeat`, ci_repeat, 6
+ dd m_literal
+ dd m_jump
+ dd c_comma
+ dd m_xswap
+ dd c_comma
+ dd c_here
+ dd m_xswap
+ dd m_store
+ dd m_exitcolon
+ CIENTRY `do`, ci_do, 2
+ dd m_literal
+ dd m_doinit
+ dd c_comma
+ dd m_literal
+ dd 0
+ dd c_here
+ dd m_exitcolon
+ CIENTRY `loop`, ci_loop, 4
+ dd m_literal
+ dd m_doloop
+ dd c_comma
+ dd c_comma
+ dd c_qdup
+ dd m_cjump
+ dd L234
+ dd c_here
+ dd m_xswap
+ dd m_store
+L234:
+ dd m_exitcolon
+ CIENTRY `+loop`, ci_ploop, 5
+ dd m_literal
+ dd m_doploop
+ dd c_comma
+ dd c_comma
+ dd c_qdup
+ dd m_cjump
+ dd L236
+ dd c_here
+ dd m_xswap
+ dd m_store
+L236:
+ dd m_exitcolon
+ CENTRY `w/o`, c_wo, 3
+ dd m_literal
+ dd 1
+ dd m_literal
+ dd 512
+ dd m_binor
+ dd m_literal
+ dd 64
+ dd m_binor
+ dd m_exitcolon
+ CENTRY `r/o`, c_ro, 3
+ dd m_literal
+ dd 0
+ dd m_exitcolon
+ CENTRY `r/w`, c_rw, 3
+ dd m_literal
+ dd 2
+ dd m_exitcolon
+ CENTRY `open-file`, c_open_file, 9
+ dd m_rpush
+ dd c_pad
+ dd m_literal
+ dd 1024
+ dd m_plus
+ dd m_xswap
+ dd m_dup
+ dd m_rpush
+ dd m_cmove
+ dd m_literal
+ dd 0
+ dd m_rpop
+ dd c_pad
+ dd m_plus
+ dd m_literal
+ dd 1024
+ dd m_plus
+ dd m_cstore
+ dd c_pad
+ dd m_literal
+ dd 1024
+ dd m_plus
+ dd m_rpop
+ dd m_literal
+ dd 420
+ dd m_fsopen
+ dd m_dup
+ dd m_literal
+ dd -1
+ dd m_greater
+ dd m_exitcolon
+ CENTRY `close-file`, c_close_file, 10
+ dd m_fsclose
+ dd c_0eq
+ dd m_exitcolon
+ CENTRY `read-file`, c_read_file, 9
+ dd m_fsread
+ dd m_dup
+ dd m_literal
+ dd -1
+ dd c_neq
+ dd m_exitcolon
+ CENTRY `write-file`, c_write_file, 10
+ dd m_fswrite
+ dd m_literal
+ dd -1
+ dd c_neq
+ dd m_exitcolon
+ CENTRY `reposition-file`, c_reposition_file, 15
+ dd m_fsseek
+ dd m_literal
+ dd -1
+ dd c_neq
+ dd m_exitcolon
+ CENTRY `?fcheck`, c_qfcheck, 7
+ dd c_0eq
+ dd m_cjump
+ dd L246
+ dd c_space
+ dd m_literal
+ dd L247
+ dd m_literal
+ dd 9
+ dd c_type
+ dd c_cr
+ dd m_errstr
+ dd c_abort
+L246:
+ dd m_exitcolon
+ CENTRY `bye`, c_bye, 3
+ dd m_literal
+ dd 0
+ dd m_terminate
+ dd m_exitcolon
+ CENTRY `include`, c_include, 7
+ dd c_bl
+ dd c_word
+ dd m_rpush
+ dd v_tolimit
+ dd m_fetch
+ dd v_toin
+ dd m_store
+ dd c_save_input
+ dd m_rpop
+ dd c_count
+ dd c_ro
+ dd c_open_file
+ dd c_qfcheck
+ dd v_stdin
+ dd m_store
+ dd m_exitcolon
+ CENTRY `crash`, c_crash, 5
+ dd m_literal
+ dd L251
+ dd m_literal
+ dd 30
+ dd c_type
+ dd c_cr
+ dd c_abort
+ dd m_exitcolon
+ CENTRY `quit`, c_quit, 4 ; TODO correct below stack notations
+ dd m_reset ; initialize return stack
+ dd m_clear ; SP = sstack_end, initialize data stack
+L253:
+ dd c_query
+ dd c_interpret
+ dd v_stdin
+ dd m_fetch ; ( 0 -- )
+ dd c_0eq
+ dd m_cjump
+ dd L254
+ dd m_literal
+ dd L255 ; address of string ok
+ dd m_literal
+ dd 3
+ dd c_type ; ( addr n -- ) type
+ dd c_cr ; cr
+L254:
+ dd m_jump
+ dd L253
+ dd m_exitcolon
+ CENTRY `(abort)`, c_parenabort, 7 ; TODO correct below stack notations
+ dd v_state ; ( v_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_store ; variable sourcebuf = address of tibuffer
+ dd v_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 c_quit ; quit resets return stack and data stack
+ dd m_exitcolon
+ CENTRY `oldboot`, c_oldboot, 7 ; TODO correct below stack notations
+ dd m_reset
+ dd m_clear ; SP = sstack_end
+ dd m_stackptr ; (D -- FFEND)
+ dd v_s0
+ dd m_store ; s0 = FFEND
+ dd mc_heaptop ; heaptop = heapend
+ dd m_fetch ; ( heapend -- )
+ dd m_literal
+ dd 1 ; ( heapend 1 -- )
+ 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_store ; args = contents_from_heapend-8
+ dd m_literal
+ dd c_parenabort ; ( (abort) -- )
+ dd v_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_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_store ; variable sourcebuf = address of tibuffer
+ dd m_literal
+ dd 0
+ dd v_stdin
+ dd m_store ; stdin = 0
+ dd m_literal
+ dd 1
+ dd v_stdout
+ dd m_store ; stdout = 1
+ dd v_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
+ ; no args
+ dd m_literal
+ dd c_parenabort ; ( (abort) -- )
+ dd v_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_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_store ; variable sourcebuf = address of tibuffer
+ ; no stdin or stdout
+ dd v_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:
+ db ' Q?'
+L173:
+ db ' stack underflow'
+L180:
+ db ' I?'
+L193:
+ db ' C?'
+L247:
+ db 'I/O error'
+L251:
+ db 'uninitialized execution vector'
+L255:
+ db ' ok'
--- /dev/null
+++ b/os/pc64/words.awk
@@ -1,0 +1,165 @@
+#!/bin/awk -f
+
+# rc script to build amd64 9front forth words from words-nasm.s
+# ./words words-nassm.s
+# watch -e 'words.awk' 'head words-nasm.s | ./words.awk'
+
+BEGIN{+ FS=", [ \t]*|[ \t]+"
+ last=""
+ nlines=0
+ addr=""
+ strlabel["L137:"] = 1
+ strlabel["L170:"] = 1
+ strlabel["L173:"] = 1
+ strlabel["L180:"] = 1
+ strlabel["L193:"] = 1
+ strlabel["L247:"] = 1
+ strlabel["L251:"] = 1
+ strlabel["L255:"] = 1
+}
+{+ lines[++nlines]=sprintf("/* %s */\n", $0);+}
+function writelast(typ, label, last){+ if(last == "")
+ lines[++nlines]=sprintf("DATA %s_%s(SB)/8, LAST\n", typ, label);+ else
+ lines[++nlines]=sprintf("DATA %s_%s(SB)/8, $%s\n", typ, label, last);+}
+$2 == "CENTRY" {+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ }
+ gsub(/`/,"", $3)
+ name = $3
+ label = $4
+ tot = 0
+ writelast("centry", label, last)+ last=sprintf("centry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA centry_%s+8(SB)/1, $%d\n", label, length(name));+ for(i=1; i<=length(name); i++){+ lines[++nlines]=sprintf("DATA centry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ }
+ tot = 8+i;
+ # for alignment
+ if(tot%8 > 0)
+ tot += 8-(tot%8);
+ lines[++nlines]=sprintf("DATA centry_%s+%d(SB)/8, $colon(SB)\n", label, tot);+ lines[++nlines]=sprintf("#define %s(SB) centry_%s+%d(SB)\n", label, label, tot);+ tot += 8
+ addrlabel = sprintf("centry_%s", label)+}
+$2 == "CIENTRY" {+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ }
+ gsub(/`/,"", $3)
+ name = $3
+ label = $4
+ tot = 0
+ writelast("cientry", label, last)+ last=sprintf("cientry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA cientry_%s+8(SB)/1, $%d\n", label, length(name)+128);+ if(name == "\\"){+ lines[++nlines]=sprintf("DATA cientry_%s+%d(SB)/1, $92\n", label, 8+1);+ } else
+ for(i=1; i<=length(name); i++){+ lines[++nlines]=sprintf("DATA cientry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ }
+ tot = 8+i;
+ # for alignment
+ if(tot%8 > 0)
+ tot += 8-(tot%8);
+ lines[++nlines]=sprintf("DATA cientry_%s+%d(SB)/8, $colon(SB)\n", label, tot);+ lines[++nlines]=sprintf("#define %s(SB) cientry_%s+%d(SB)\n", label, label, tot);+ tot += 8
+ addrlabel = sprintf("cientry_%s", label)+}
+$2 == "VENTRY" {+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ }
+ gsub(/`/,"", $3)
+ name = $3
+ label = $4
+ tot = 0
+ writelast("ventry", label, last)+ last=sprintf("ventry_%s(SB)", label);+ lines[++nlines]=sprintf("DATA ventry_%s+8(SB)/1, $%d\n", label, length(name));+ for(i=1; i<=length(name); i++){+ lines[++nlines]=sprintf("DATA ventry_%s+%d(SB)/1, $'%c'\n", label, 8+i, substr(name,i,1));+ }
+ tot = 8+i;
+ # for alignment
+ if(tot%8 > 0)
+ tot += 8-(tot%8);
+ lines[++nlines]=sprintf("DATA ventry_%s+%d(SB)/8, $variable(SB)\n", label, tot);+ lines[++nlines]=sprintf("#define %s(SB) ventry_%s+%d(SB)\n", label, label, tot);+ tot += 8;
+ lines[++nlines]=sprintf("DATA ventry_%s+%d(SB)/8, $0\n", label, tot);+ tot += 8;
+ addrlabel = sprintf("ventry_%s", label)+}
+$1 ~ /:$/ && $1 in strlabel {+ if(label != ""){+ if(last != ""){+ lines[++nlines]=sprintf("GLOBL %s, $%d\n", last, tot);+ lines[++nlines]=sprintf("#undef LAST\n");+ lines[++nlines]=sprintf("#define LAST $%s\n", last);+ }
+ else
+ lines[++nlines]=sprintf("GLOBL %s(SB), $%d\n", addrlabel, tot);+
+ }
+ gsub(/:/,"", $1)
+ name = $3
+ label = $1
+ tot = 0
+ last="" #sprintf("$%s(SB)", label);+ addrlabel = sprintf("%s", label)+}
+$2 == "db" {+ start = index($0,"'")+1
+ str = substr($0,start,length($0)-start)
+ #printf("str length %d %d: %s\n", length(str), index($0,"'"), str);+ for(i=1; i<=length(str); i++){+ lines[++nlines]=sprintf("DATA %s+%d(SB)/1, $'%c'\n", addrlabel, i-1, substr(str,i,1));+ }
+ tot = i-1
+}
+$2 == "dd" {+ if($3 ~ /^[-0-9]+$/)
+ lines[++nlines]=sprintf("DATA %s+%d(SB)/8, $%s\n", addrlabel, tot, $3);+ else if($3 ~ /^L[0-9]+$/)
+ lines[++nlines]=sprintf("DATA %s+%d(SB)/8, $%s(SB)\n", addrlabel, tot, $3);+ else
+ lines[++nlines]=sprintf("DATA %s+%d(SB)/8, $%s(SB)\n", addrlabel, tot, $3);+ tot += 8
+ #addr = sprintf("$centry_%s+%d(SB)", label, tot)+}
+$1 ~ /:$/ && !($1 in strlabel) {+ l=$1
+ gsub(/:$/,"",l)
+ # for not printing out the labels while still developing the program
+ # to only print the unprocessed lines
+ #lines[++nlines] = ""
+ printf("#define %s(SB) %s+%d(SB)\n", l, addrlabel, tot);+}
+{+# if(done == nlines){+# print $0
+# }
+# for(i = done+1; i <= nlines; i++){+# printf("%s", lines[i])+# }
+# done=nlines
+}
+END{+ if(label != ""){+ lines[++nlines]=sprintf("GLOBL %s(SB), $%d\n", addrlabel, tot);+ }
+ for(i = 1; i <= nlines; i++){+ printf("%s", lines[i])+ }
+}