ref: a6fb15ce74d7623c1e3c01bdfeef16fd4279cdca
parent: 3e9b88e288ee88a80e4cc725bc8869726185d78e
author: 9ferno <gophone2015@gmail.com>
date: Tue Feb 15 08:33:01 EST 2022
fixed bug in dictionary setup
--- a/.gitignore
+++ b/.gitignore
@@ -360,3 +360,4 @@
os/pc64/*.i
os/pc64/primitives.s
os/pc64/words.s
+os/pc64/forth.h
--- a/os/pc64/forth.s
+++ b/os/pc64/forth.s
@@ -129,7 +129,10 @@
/* Argument has the start of heap */
MOVQ RARG, UP /* start of heap memory */
- MOVQ 8(UP), UPE /* HEAPEND populated by the caller */
+
+ MOVQ RARG, UPE
+ ADDQ $FORTHUPE, UPE
+ MOVQ (UPE), UPE /* HEAPEND populated by the caller in FORTHUPE */
MOVQ UP, RSP
ADDQ $RSTACK, RSP /* return stack pointer, reset */
--- a/os/pc64/mem.h
+++ b/os/pc64/mem.h
@@ -214,10 +214,11 @@
* easy to get to the variables with a known offset from C
*/
#define HEAPSTART (0ull)
-#define HEAPEND (HEAPSTART+(BY2WD*1))
-/* TODO check stacks for over flow */
-#define DICTIONARY (HEAPSTART+(BY2WD*2)) /* dictionary ends at (HEAPSTART+(16*BY2PG)) */
+/* keeping the dictionary at the start to ease debugging of
+ dictionary addresses in forth.h
+ */
+#define DICTIONARY (HEAPSTART) /* dictionary ends at (HEAPSTART+(16*BY2PG)) */
#define PSTACK (HEAPSTART+(17*BY2PG)) /* upto (HEAPSTART+(16*BY2PG)), going down */
#define TIB (HEAPSTART+(17*BY2PG)) /* text input buffer */
#define RSTACK (HEAPSTART+(19*BY2PG)) /* upto (HEAPSTART+(18*BY2PG)), going down */
@@ -244,4 +245,5 @@
#define FORTHVARS (RSTACK+(BY2WD*84))
#define FORTHEND (HEAPSTART+(22*BY2PG))
+#define HEAPEND (FORTHEND)
#define FORTHHEAPSIZE FORTHEND
--- a/os/pc64/mkdict.awk
+++ b/os/pc64/mkdict.awk
@@ -47,7 +47,7 @@
fentries = fentries t2 "{.what Here, .desc \"len\", .here " h ", .there " vh ",.type Byte, .b " (immediate*128) " + " len " }" nl;h+=1;
fentries = fentries t2 "{.what Here, .desc \"name\",.here " h ", .there " vh ",.type Chars, .str " name " }" nl;- h = align(h);
+ h = align(h+len);
fentries = fentries t2 "{.what Here, .desc \"cfa\", .here " h ", .there " vh ",.type Absoluteptr, .ptr " cfa " }" nl;labels[nlabels++] = prefix label " = " h;
h+=8; # for cfa
--- a/os/pc64/words-nasm.s
+++ b/os/pc64/words-nasm.s
@@ -1363,53 +1363,56 @@
dd M_store
dd MV_Dtop
dd M_fetch ; get latest dictionary link
-L_C_findname:
+
+L_C_findname_loop: ( 'link ) address of link dictionary item
dd C_qdup
dd M_cjump
-dd L_C_findname_1 ; seached until the first dictionary entry get out
-dd M_dup ; ( a -- a a )
-dd C_cell_plus ; ( a a -- a a+8) lenth + initial name address
-dd M_cfetch ; ( a a+8 -- a immediate|hidden|len) length + initial name
+dd L_C_findname_not_found ; seached until the first dictionary entry, nil now. get out
+
+dd M_dup ; ( 'link 'link )
+dd C_cell_plus ; ( 'link 'len) lenth + initial name address
+dd M_cfetch ; ( 'link immediate|hidden|len) length + initial name
dd M_literal
dd 64 ; check the reveal'ed flag 1=hidden, 0=reveal
-dd M_binand ; if hidden, goto L_C_findname_3 else L_C_findname_2
+dd M_binand ; if hidden, goto L_C_findname_previous else L_C_findname_revealed
dd M_cjump
-dd L_C_findname_2
-dd M_fetch ; smudge'd dictionary entry, get the previous entry
-dd M_jump
-dd L_C_findname_3
-L_C_findname_2: ; reveal'ed dictionary entry
-dd M_dup ; ( a1 -- a1 a1)
-dd C_cell_plus ; ( a1 a1 -- a1 a1+8)
-dd C_count ; ( a1 a1+8 -- a1 a1+8+1 n )
+dd L_C_findname_revealed
+dd M_jump ; smudge'd dictionary entry, get the previous entry
+dd L_C_findname_previous
+
+L_C_findname_revealed: ; reveal'ed dictionary entry
+dd M_dup ; ( 'link 'link )
+dd C_cell_plus ; ( 'link 'len )
+dd C_count ; ( 'link 'name immediate|hidden|len )
dd M_literal
dd 63
-dd M_binand ; ( a1 a1+8+1 n 63 -- a1 a1+8+1 n&63=len )
+dd M_binand ; ( 'link 'name (immediate|hidden|len)&63=len )
dd MV_Findadr
-dd M_fetch
-dd C_count ; ( a1 a1+8+1 len=n&63 a2 -- a1 a1+8+1 n&63 a2+1 n2 )
-dd C_compare ; ( a1 a1+8+1 len=n&63 a2+1 n2 -- a1 f ) compare dictionary entry with name
+dd M_fetch ; ( 'link 'name (immediate|hidden|len)&63=len 'find ) 'find = counted string to find
+dd C_count ; ( 'link 'name (immediate|hidden|len)&63=len 'find-name find-length )
+dd C_compare ; ( 'link f ) compare dictionary entry with name
dd C_0eq ; found a match?
dd M_cjump
-dd L_C_findname_4 ; no match
+dd L_C_findname_previous ; not matched, try previous link
dd C_cell_plus ; match found
dd C_true
dd M_exitcolon
-L_C_findname_4:
-dd M_fetch
-L_C_findname_3:
+
+L_C_findname_previous:
+dd M_fetch ; ( 'previous-link ) compare dictionary entry with name
dd M_jump
-dd L_C_findname
-L_C_findname_1:
+dd L_C_findname_loop ; ( 'previous-link ) looping to check it
+
+L_C_findname_not_found: ; not found, getting out
dd MV_Findadr
dd M_fetch
dd C_false
-dd M_exitcolon
+dd M_exitcolon ( 'find false ) 'find = address of the name not found
CENTRY "find" C_find 4 ; ( a1 -- a2 f )?
dd C_findname
dd M_cjump
-dd L_C_find
+dd L_C_find_4
dd M_dup
dd M_cfetch
dd M_xswap
@@ -1437,7 +1440,7 @@
dd M_exitcolon
dd M_jump
dd L_C_find_3
-L_C_find:
+L_C_find_4:
dd C_false
L_C_find_3:
dd M_exitcolon
@@ -2051,6 +2054,7 @@
dd C_abort
L246:
dd M_exitcolon
+
CENTRY "create-file" C_create_file 11 ; ( a n mode perm -- fd ioresult ) not part of the original ff. could move this to a forth file.
dd M_rpush ; ( a n mode ) (R perm)
dd M_rpush ; ( a n ) (R perm mode)
--- a/os/port/chan.c
+++ b/os/port/chan.c
@@ -93,6 +93,8 @@
{int nt;
+ if(ns == 0)
+ print("kstrcpy ns == 0, fix the caller 0x%p\n", getcallerpc(&s));nt = strlen(t);
if(nt < ns){memmove(s, t, nt);
--- a/os/port/devbin.c
+++ b/os/port/devbin.c
@@ -564,8 +564,10 @@
return 0;
/* find ending delimiter */
- for(n=0; p<writep && n < maxn; p++){+ for(n=0, p=readp; p<writep && n < maxn; p++){+ DBG("doublequotefn searching %c 0x%p: %c %d\n", c, p, *p, *p); if(*p == c){+ DBG("doublequotefn found %c 0x%p: %c %d\n", c, p, *p, *p);*nextreadp = p+1; /* skip this for the next read */
return n;
}
@@ -586,6 +588,7 @@
doublequotefn(u8 *readp, u8 *writep, u8 **startp, s32 maxn, u8 **nextreadp)
{/* " = 0x22 = 34 */
+ DBG("doublequotefn searching for %c readp 0x%p writep 0x%p readp has -%s-\n", 0x22, readp, writep, readp);return until(readp, writep, startp, maxn, nextreadp, 0x22);
}
--- a/os/port/devforth.c
+++ b/os/port/devforth.c
@@ -288,7 +288,7 @@
DBG(" %s 0x%zX: 0x%zX %lld: %lld\n", f->desc, (intptr)h, *(intptr*)h, (intptr)h, *(intptr*)h); }else if(f->what == Here && f->type == End){h = fmem+DICTIONARY+f->here;
- DBG(" %s 0x%zX %lld\n", f->desc, h, h);+ DBG(" %s 0x%zX %lld\n", f->desc, (intptr)h, (intptr)h); }else if(f->what == There && f->type == End){vh = fmem+FORTHVARS+f->there;
DBG(" %s 0x%zX %lld\n", f->desc, (intptr)vh, (intptr)vh);@@ -304,6 +304,8 @@
*(intptr*)(fmem + THERE) = (intptr)vh;
*(intptr*)(fmem + FTHPID) = up->pid;
*(intptr*)(fmem + FTHPARENTPID) = up->parentpid;
+ *(intptr*)(fmem + FORTHUP) = (intptr)fmem; /* heap start */
+ *(intptr*)(fmem + FORTHUPE) = (intptr)fmem+FORTHHEAPSIZE-1; /* heap end, TODO make the size variable */
nbytes = snprint((char*)fmem + ARGSFILENAME+1, 32, "#p/%d/args", up->pid);
*(u8*)(fmem + ARGSFILENAME) = nbytes;
@@ -489,9 +491,8 @@
if(p->fmem == nil)
panic("newforthproc p->fmem == nil\n");- /* store the start address at that address too - magic check */
- ((intptr*)p->fmem)[0] = (intptr)p->fmem; /* heap start */
- ((intptr*)p->fmem)[1] = (intptr)p->fmem+FORTHHEAPSIZE-1; /* heap end */
+ *(intptr*)((char*)p->fmem+FORTHUP) = (intptr)p->fmem; /* heap start */
+ *(intptr*)((char*)p->fmem+FORTHUPE) = (intptr)p->fmem+FORTHHEAPSIZE-1; /* heap end */
/* p->kpfun = func;
p->kparg = arg;
@@ -1043,9 +1044,8 @@
if(p->fmem == nil)
panic("goforth p->fmem == nil\n");- /* store the start address at that address too - magic check */
- ((intptr*)p->fmem)[0] = (intptr)p->fmem; /* heap start */
- ((intptr*)p->fmem)[1] = (intptr)p->fmem+FORTHHEAPSIZE-1; /* heap end */
+ *(intptr*)((char*)p->fmem+FORTHUP) = (intptr)p->fmem; /* heap start */
+ *(intptr*)((char*)p->fmem+FORTHUPE) = (intptr)p->fmem+FORTHHEAPSIZE-1; /* heap end */
p->fisgo = 1;
}