ref: bc67178c247505d72696611797c6a3879dce84fd
parent: 3b212b65f7af30de9b846da7dab418add0dcabcd
author: 9ferno <gophone2015@gmail.com>
date: Tue Dec 28 10:23:25 EST 2021
moved code around
--- a/os/pc64/forth.h
+++ b/os/pc64/forth.h
@@ -517,7 +517,7 @@
/* ; cannot use H as it is nil in inferno, address where here (next available dictionary cell location) is stored *//* ; here = Dp @ */ {.type Header, {.hdr { 2, "Dp", /* M_Dp = 2072 */ Dp }}}, /* MENTRY "Dp" Dp 2 h 2080 */ {.type Header, {.hdr { 4, "Dtop", /* M_Dtop = 2096 */ Dtop }}}, /* MENTRY "Dtop" Dtop 4 ; last defined header h 2104 */ {.type Header, {.hdr { 2, "S0", /* M_S0 = 2120 */ S0 }}}, /* MENTRY "S0" S0 2 h 2128 */- {.type Header, {.hdr { 2, "s@", /* M_stackptr = 2144 */ stackptr }}}, /* MENTRY "s@" stackptr 2 ; puts PSP on stack h 2152 */+ {.type Header, {.hdr { 2, "s@", /* M_stackptr = 2144 */ stackptr }}}, /* MENTRY "s@" stackptr 2 ; puts PSP on stack. Not a variable hence lower case h 2152 */ {.type Header, {.hdr { 5, "Wordb", /* M_Wordb = 2168 */ Wordb }}}, /* MENTRY "Wordb" Wordb 5 h 2176 */ {.type Header, {.hdr { 3, "Tib", /* M_Tib = 2192 */ Tib }}}, /* MENTRY "Tib" Tib 3 h 2200 */ {.type Header, {.hdr { 4, "Args", /* M_Args = 2216 */ Args }}}, /* MENTRY "Args" Args 4 h 2224 */--- a/os/pc64/forth.s
+++ b/os/pc64/forth.s
@@ -214,78 +214,6 @@
POP(TOP)
NEXT
-/*
-callable by forth primitives to check address
- ( a -- -1|0|1 )
- argument 1 in TOP = address
- return value in TOP
- -1 0 1
- if UP < address < UPE
- return 0 within range
- else if address < UP
- return -1 below UP
- else if UPE < address
- return 1 above UP
- */
-TEXT inup(SB), 1, $-4
- CMPQ TOP, UPE
- JGT aboveupe /* a > UPE */
- CMPQ TOP, UP
- JLT belowup /* a < UP */
- MOVQ $0, TOP /* could use XORQ TOP, TOP to zero too */
- RET
-belowup:
- MOVQ $-1, TOP
- RET
-aboveupe:
- MOVQ $1, TOP
- RET
-
-/*
-callable by forth primitives to check address
- ( n a -- -1|0|1 )
- argument 1 in TOP = address
- return value in TOP
- -1 0 1
- if UP < address && address+n < UPE
- return 0 within range
- else if address < UP
- return -1 below UP
- else if UPE < address+n
- return 1 above UP
- */
-TEXT bufinup(SB), 1, $-4
- POP(CX)
- CMPQ CX, $0 /* negative n? */
- JLT belowup /* TODO have an appropriate error message */
- ADDQ TOP, CX
- CMPQ CX, UPE /* a+n, UPE */
- JGT aboveupe /* a+n > UPE */
- CMPQ TOP, UP
- JLT belowup /* a < UP */
- MOVQ $0, TOP
- RET
-
-invalidaddress:
- /* TODO need error reporting here */
- RET
-
-TEXT validateaddress(SB), 1, $0 /* a -- */
- CALL inup(SB)
- MOVQ TOP, CX
- POP(TOP)
- CMPQ CX, $0
- JNE invalidaddress
- RET
-
-TEXT validatebuffer(SB), 1, $0 /* n a -- */
- CALL bufinup(SB)
- MOVQ TOP, CX
- POP(TOP)
- CMPQ CX, $0
- JNE invalidaddress
- RET
-
TEXT fetch(SB), 1, $-4 /* ( a -- n) */
PUSH(TOP)
CALL validateaddress(SB) /* a a -- a */
@@ -533,7 +461,7 @@
.true:
MOVQ $-1, TOP
NEXT
-
+
TEXT greater(SB), 1, $-4 /* ( x y -- f ) */
POP(CX)
CMPQ CX, TOP
@@ -556,6 +484,11 @@
XORQ TOP, TOP
NEXT
+/*
+ Return the address of the top of the stack, just before sp@ was executed.
+ 1 2 S0 s@ - hex cr . . . cr gives 18 2 1, so S@ would have been pointing at S0
+ 18 in hex translates to 3 64-bit cells
+ */
TEXT stackptr(SB), 1, $-4 /* ( -- a ) does not include TOP! */
MOVQ PSP, CX
PUSH(TOP)
@@ -663,6 +596,83 @@
NEXT;
VARIABLE(Tib, $TIB)
*/
+
+/*
+ * routines called by forth asm macros or bindings
+ */
+
+/*
+callable by forth primitives to check address
+ ( a -- -1|0|1 )
+ argument 1 in TOP = address
+ return value in TOP
+ -1 0 1
+ if UP < address < UPE
+ return 0 within range
+ else if address < UP
+ return -1 below UP
+ else if UPE < address
+ return 1 above UP
+ */
+TEXT inup(SB), 1, $-4
+ CMPQ TOP, UPE
+ JGT aboveupe /* a > UPE */
+ CMPQ TOP, UP
+ JLT belowup /* a < UP */
+ MOVQ $0, TOP /* could use XORQ TOP, TOP to zero too */
+ RET
+belowup:
+ MOVQ $-1, TOP
+ RET
+aboveupe:
+ MOVQ $1, TOP
+ RET
+
+/*
+callable by forth primitives to check address
+ ( n a -- -1|0|1 )
+ argument 1 in TOP = address
+ return value in TOP
+ -1 0 1
+ if UP < address && address+n < UPE
+ return 0 within range
+ else if address < UP
+ return -1 below UP
+ else if UPE < address+n
+ return 1 above UP
+ */
+TEXT bufinup(SB), 1, $-4
+ POP(CX)
+ CMPQ CX, $0 /* negative n? */
+ JLT belowup /* TODO have an appropriate error message */
+ ADDQ TOP, CX
+ CMPQ CX, UPE /* a+n, UPE */
+ JGT aboveupe /* a+n > UPE */
+ CMPQ TOP, UP
+ JLT belowup /* a < UP */
+ MOVQ $0, TOP
+ RET
+
+invalidaddress:
+ /* TODO need error reporting here */
+ INT $0x0D /* general protection error */
+ RET
+
+TEXT validateaddress(SB), 1, $0 /* a -- */
+ CALL inup(SB)
+ MOVQ TOP, CX
+ POP(TOP)
+ CMPQ CX, $0
+ JNE invalidaddress
+ RET
+
+TEXT validatebuffer(SB), 1, $0 /* n a -- */
+ CALL bufinup(SB)
+ MOVQ TOP, CX
+ POP(TOP)
+ CMPQ CX, $0
+ JNE invalidaddress
+ RET
TEXT forthend(SB), 1, $-4
--- a/os/pc64/primitives-nasm.s
+++ b/os/pc64/primitives-nasm.s
@@ -82,7 +82,7 @@
MENTRY "Dp" Dp 2
MENTRY "Dtop" Dtop 4 ; last defined header
MENTRY "S0" S0 2
-MENTRY "s@" stackptr 2 ; puts PSP on stack
+MENTRY "s@" stackptr 2 ; puts PSP on stack. Not a variable hence lower case.
MENTRY "Wordb" Wordb 5
MENTRY "Tib" Tib 3
MENTRY "Args" Args 4