diff --git a/sys/boot/ficl/ficl.c b/sys/boot/ficl/ficl.c index 60e12b3b7371..e70fa44a7c11 100644 --- a/sys/boot/ficl/ficl.c +++ b/sys/boot/ficl/ficl.c @@ -316,7 +316,7 @@ int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size) int ficlExecFD(FICL_VM *pVM, int fd) { char cp[nLINEBUF]; - int i, nLine = 0, rval = VM_OUTOFTEXT; + int nLine = 0, rval = VM_OUTOFTEXT; char ch; CELL id; diff --git a/sys/boot/ficl/ficl.h b/sys/boot/ficl/ficl.h index 79199d17eab1..176d9478390f 100644 --- a/sys/boot/ficl/ficl.h +++ b/sys/boot/ficl/ficl.h @@ -316,7 +316,7 @@ typedef struct */ typedef struct { - INT32 index; + FICL_INT index; char *end; char *cp; } TIB; diff --git a/sys/boot/ficl/softwords/classes.fr b/sys/boot/ficl/softwords/classes.fr index 9e578fbf2f00..3d233e418b69 100644 --- a/sys/boot/ficl/softwords/classes.fr +++ b/sys/boot/ficl/softwords/classes.fr @@ -36,6 +36,13 @@ object subclass c-2byte end-class object subclass c-4byte + 4 chars: .payload + + : get drop i@ ; + : set drop i! ; +end-class + +object subclass c-cell cell: .payload : get drop @ ; @@ -56,23 +63,23 @@ end-class \ Returns the size in address units of the thing the pointer \ refers to. object subclass c-ptr - c-4byte obj: .addr + c-cell obj: .addr \ get the value of the pointer : get-ptr ( inst class -- addr ) - c-ptr => .addr - c-4byte => get + c-ptr => .addr + c-cell => get ; \ set the pointer to address supplied : set-ptr ( addr inst class -- ) - c-ptr => .addr - c-4byte => set + c-ptr => .addr + c-cell => set ; \ force the pointer to be null : clr-ptr - 0 -rot c-ptr => .addr c-4byte => set + 0 -rot c-ptr => .addr c-cell => set ; \ return flag indicating null-ness @@ -108,9 +115,9 @@ end-class \ ** C - C E L L P T R -\ Models a pointer to cell (a 32 bit scalar). +\ Models a pointer to cell (a 32 or 64 bit scalar). c-ptr subclass c-cellPtr - : @size 2drop 4 ; + : @size 2drop 1 cells ; \ fetch and store through the pointer : get ( inst class -- cell ) c-ptr => get-ptr @ @@ -121,6 +128,20 @@ c-ptr subclass c-cellPtr end-class +\ ** C - I N T P T R +\ Models a pointer to an int (a 32 bit scalar). +c-ptr subclass c-4bytePtr + : @size 2drop 4 ; + \ fetch and store through the pointer + : get ( inst class -- value ) + c-ptr => get-ptr i@ + ; + : set ( value inst class -- ) + c-ptr => get-ptr i! + ; +end-class + + \ ** C - 2 B Y T E P T R \ Models a pointer to a 16 bit scalar c-ptr subclass c-2bytePtr diff --git a/sys/boot/ficl/words.c b/sys/boot/ficl/words.c index ab6700d2ad6a..3e0fc18f508a 100644 --- a/sys/boot/ficl/words.c +++ b/sys/boot/ficl/words.c @@ -1018,6 +1018,27 @@ static void plusStore(FICL_VM *pVM) } +static void iFetch(FICL_VM *pVM) +{ + UNS32 *pw; +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 1); +#endif + pw = (UNS32)stackPopPtr(pVM->pStack); + stackPushUNS(pVM->pStack, (FICL_UNS)*pw); + return; +} + +static void iStore(FICL_VM *pVM) +{ + UNS32 *pw; +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 2, 0); +#endif + pw = (UNS32 *)stackPopPtr(pVM->pStack); + *pw = (UNS32)(stackPop(pVM->pStack).u); +} + static void wFetch(FICL_VM *pVM) { UNS16 *pw; @@ -1444,8 +1465,8 @@ static void listWords(FICL_VM *pVM) vmTextOut(pVM, pPad, 1); } - sprintf(pVM->pad, "Dictionary: %d words, %ld cells used of %lu total", - nWords, dp->here - dp->dict, dp->size); + sprintf(pVM->pad, "Dictionary: %d words, %ld cells used of %u total", + nWords, (long) (dp->here - dp->dict), dp->size); vmTextOut(pVM, pVM->pad, 1); return; } @@ -1467,8 +1488,8 @@ static void listEnv(FICL_VM *pVM) } } - sprintf(pVM->pad, "Environment: %d words, %ld cells used of %lu total", - nWords, dp->here - dp->dict, dp->size); + sprintf(pVM->pad, "Environment: %d words, %ld cells used of %u total", + nWords, (long) (dp->here - dp->dict), dp->size); vmTextOut(pVM, pVM->pad, 1); return; } @@ -4931,6 +4952,8 @@ void ficlCompileCore(FICL_DICT *dp) dictAppendWord(dp, "sliteral", sLiteralCoIm, FW_COMPIMMED); /* STRING */ dictAppendWord(dp, "wid-set-super", setParentWid, FW_DEFAULT); + dictAppendWord(dp, "i@", iFetch, FW_DEFAULT); + dictAppendWord(dp, "i!", iStore, FW_DEFAULT); dictAppendWord(dp, "w@", wFetch, FW_DEFAULT); dictAppendWord(dp, "w!", wStore, FW_DEFAULT); dictAppendWord(dp, "x.", hexDot, FW_DEFAULT);