d/freebsd-skq
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add "int" sized manipulation words.

Browse Source
This commit is contained in:
dcs 2000-06-01 18:10:44 +00:00
parent 49cf95cfd9
commit 22ac78c306
4 changed files with 58 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
sys/boot/ficl/ficl.c
View File

@ -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;

2
sys/boot/ficl/ficl.h
View File

@ -316,7 +316,7 @@ typedef struct
*/
typedef struct
{
INT32 index;
FICL_INT index;
char *end;
char *cp;
} TIB;

37
sys/boot/ficl/softwords/classes.fr
View File

@ -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

31
sys/boot/ficl/words.c
View File

@ -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);