Add "int" sized manipulation words.
This commit is contained in:
parent
fb7a8c91b8
commit
b270590aeb
Notes:
svn2git
2020-12-20 02:59:44 +00:00
svn path=/head/; revision=61149
@ -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;
|
||||
|
||||
|
@ -316,7 +316,7 @@ typedef struct
|
||||
*/
|
||||
typedef struct
|
||||
{
|
||||
INT32 index;
|
||||
FICL_INT index;
|
||||
char *end;
|
||||
char *cp;
|
||||
} TIB;
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user