Cleanup of source code.
Want to arrange things so that a system can dump its state and start from it again without having to re-bootstrap the dictionary every run. Also want to eventually remove the bootstrap code from the main binary so the system can consist of just the primitives and dictionary once it has been bootstrapped.master
Levi Pearson
parent
cfda2c945b
commit
4e079f7414
326
simpleForth.c
326
simpleForth.c
|
|
@ -7,6 +7,10 @@
|
|||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
/*
|
||||
* Constants and Helper Macros
|
||||
*/
|
||||
|
||||
#define TRACE 0
|
||||
#define TRACE2 0
|
||||
|
||||
|
|
@ -17,6 +21,9 @@
|
|||
#define TRUE -1
|
||||
#define IMM_MASK 0x80
|
||||
|
||||
#define BACKSPACE_IN 127
|
||||
#define BACKSPACE_OUT 8
|
||||
|
||||
#define INC(lval) do { lval += sizeof (lval); } while (0)
|
||||
#define DEC(lval) do { lval -= sizeof (lval); } while (0)
|
||||
#define AT(addr) (*((Cell *)addr))
|
||||
|
|
@ -45,11 +52,15 @@
|
|||
|
||||
#define NEXT return
|
||||
|
||||
/*
|
||||
* Core System Datatypes
|
||||
*/
|
||||
|
||||
typedef uintptr_t Cell;
|
||||
typedef void (*Code)(void);
|
||||
typedef Code * XT;
|
||||
|
||||
#define HDRNAMESZ 3
|
||||
#define HDRNAMESZ 7
|
||||
typedef struct forthDictEntry DictEntry;
|
||||
struct forthDictEntry {
|
||||
union {
|
||||
|
|
@ -57,7 +68,7 @@ struct forthDictEntry {
|
|||
unsigned char nameLength;
|
||||
unsigned char nameBegin[HDRNAMESZ];
|
||||
};
|
||||
Cell padding;
|
||||
Cell padding[2];
|
||||
};
|
||||
DictEntry *link;
|
||||
Code codeAddress;
|
||||
|
|
@ -66,13 +77,16 @@ struct forthDictEntry {
|
|||
typedef struct forthState {
|
||||
/* Interpreter Registers */
|
||||
Cell IP; /* Interpreter Pointer */
|
||||
Cell WP; /* Word/Work Pointer */
|
||||
Cell WP; /* Word Pointer */
|
||||
Cell SP; /* Argument Stack Pointer */
|
||||
Cell RP; /* Return Stack Pointer */
|
||||
Cell DP; /* Dictionary Pointer */
|
||||
int running;
|
||||
} ForthState;
|
||||
|
||||
/*
|
||||
* Interpreter State and Main Memory
|
||||
*/
|
||||
|
||||
ForthState FS;
|
||||
Cell FM[CELLCOUNT];
|
||||
char TIB[128];
|
||||
|
|
@ -82,6 +96,15 @@ Cell *BASE = &FM[1];
|
|||
Cell *NUM_TIB = &FM[2];
|
||||
Cell *TO_IN = &FM[3];
|
||||
Cell *STATE = &FM[4];
|
||||
Cell *DP = &FM[5];
|
||||
Cell *SP0 = &FM[6];
|
||||
Cell *RP0 = &FM[7];
|
||||
Cell *DP0 = &FM[8];
|
||||
Cell *IP0 = &FM[9];
|
||||
|
||||
/*
|
||||
* Utility and I/O Functions
|
||||
*/
|
||||
|
||||
void dumpStack(void) {
|
||||
Cell *BOS = (Cell *)(FM + CELLCOUNT - 1);
|
||||
|
|
@ -95,38 +118,20 @@ void dumpStack(void) {
|
|||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Terminal IO Primitives
|
||||
*/
|
||||
|
||||
void QRX(void) {
|
||||
int rv;
|
||||
int oldflag, newflag;
|
||||
char buf[1];
|
||||
struct termios oldt, newt;
|
||||
|
||||
tcgetattr(STDIN_FILENO, &oldt);
|
||||
fcntl(STDIN_FILENO, F_GETFL, &oldflag);
|
||||
newt = oldt;
|
||||
newt.c_lflag &= ~( ICANON | ECHO );
|
||||
newflag = oldflag | O_NONBLOCK;
|
||||
|
||||
fcntl(STDIN_FILENO, F_SETFL, newflag);
|
||||
tcsetattr(STDIN_FILENO, TCSANOW, &newt);
|
||||
|
||||
rv = read(STDIN_FILENO, buf, 1);
|
||||
|
||||
fcntl(STDIN_FILENO, F_SETFL, oldflag);
|
||||
tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
|
||||
|
||||
if (rv == -1 || rv == 0) {
|
||||
SPUSH(FALSE);
|
||||
} else {
|
||||
SPUSH(buf[0]);
|
||||
SPUSH(TRUE);
|
||||
DictEntry *findWord(int len, char *name, DictEntry *vocab) {
|
||||
char length;
|
||||
length = (len > HDRNAMESZ) ? HDRNAMESZ : len;
|
||||
while (vocab != NULL) {
|
||||
if ((vocab->nameLength & ~(IMM_MASK)) == len) {
|
||||
if (strncmp(name, (char*)vocab->nameBegin, length) == 0) {
|
||||
return vocab;
|
||||
}
|
||||
NEXT;
|
||||
}
|
||||
vocab = vocab->link;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
char rxchar(void) {
|
||||
int rv;
|
||||
|
|
@ -140,7 +145,6 @@ char rxchar(void) {
|
|||
tcsetattr(STDIN_FILENO, TCSANOW, &newt);
|
||||
|
||||
rv = read(STDIN_FILENO, &b, 1);
|
||||
//fprintf(stderr, "%d\n\n", b);
|
||||
|
||||
tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
|
||||
|
||||
|
|
@ -162,10 +166,12 @@ void txchar(char b) {
|
|||
tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
|
||||
}
|
||||
|
||||
/*
|
||||
* Terminal IO Primitives
|
||||
*/
|
||||
|
||||
// accept ( a l -- l2 ) Read a string of up to l characters, storing it at a.
|
||||
// Return the length of the string actually read.
|
||||
#define BACKSPACE_IN 127
|
||||
#define BACKSPACE_OUT 8
|
||||
void ACCEPT(void) {
|
||||
Cell addr, len;
|
||||
char *inbuf, in;
|
||||
|
|
@ -216,7 +222,7 @@ void WORD(void) {
|
|||
|
||||
ch = TIB + *TO_IN;
|
||||
last = TIB + *NUM_TIB;
|
||||
lenp = (char*)FS.DP;
|
||||
lenp = (char*)*DP;
|
||||
strp = lenp + 1;
|
||||
*lenp = 0;
|
||||
|
||||
|
|
@ -277,8 +283,8 @@ void DOT(void) {
|
|||
* Memory Access Primitives
|
||||
*/
|
||||
|
||||
// @ ( addr -- x ) \ read x from addr
|
||||
void PEEK(void) {
|
||||
// @ ( addr -- x ) read x from addr
|
||||
void FETCH(void) {
|
||||
Cell addr, val;
|
||||
SPOP(addr);
|
||||
val = AT(addr);
|
||||
|
|
@ -286,8 +292,8 @@ void PEEK(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// ! ( x addr -- ) \ store x at addr
|
||||
void POKE(void) {
|
||||
// ! ( x addr -- ) store x at addr
|
||||
void STORE(void) {
|
||||
Cell addr, val;
|
||||
SPOP(addr);
|
||||
SPOP(val);
|
||||
|
|
@ -295,8 +301,8 @@ void POKE(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// c@ ( addr -- c ) \ read character from addr
|
||||
void CPEEK(void) {
|
||||
// c@ ( addr -- c ) read character from addr
|
||||
void CFETCH(void) {
|
||||
Cell addr;
|
||||
char c;
|
||||
SPOP(addr);
|
||||
|
|
@ -309,13 +315,13 @@ void CPEEK(void) {
|
|||
* Stack Manipulation Primitives
|
||||
*/
|
||||
|
||||
// drop ( x -- ) \ drop x from stack
|
||||
// drop ( x -- ) drop x from stack
|
||||
void DROP(void) {
|
||||
INC(FS.SP);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
// dup ( x -- x x ) \ push a copy of x to stack
|
||||
// dup ( x -- x x ) push a copy of x to stack
|
||||
void DUP(void) {
|
||||
Cell addr, val;
|
||||
addr = FS.SP;
|
||||
|
|
@ -325,7 +331,7 @@ void DUP(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// swap ( x y -- y x ) \ swap top two values on stack
|
||||
// swap ( x y -- y x ) swap top two values on stack
|
||||
void SWAP(void) {
|
||||
Cell vx, vy;
|
||||
SPOP(vy);
|
||||
|
|
@ -335,7 +341,7 @@ void SWAP(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// rot ( x y z -- y z x ) \ rotate-left top 3 values on stack
|
||||
// rot ( x y z -- y z x ) rotate-left top 3 values on stack
|
||||
void ROT(void) {
|
||||
Cell vx, vy, vz;
|
||||
SPOP(vz);
|
||||
|
|
@ -351,7 +357,7 @@ void ROT(void) {
|
|||
* Flow Control Primitives
|
||||
*/
|
||||
|
||||
// next ( -- ) \ Decrement index on return stack and exit loop if < 0
|
||||
// next ( -- ) Decrement index on return stack and exit loop if < 0
|
||||
void DONEXT(void) {
|
||||
AT(FS.RP) -= 1;
|
||||
if ((int)AT(FS.RP) < 0) {
|
||||
|
|
@ -363,7 +369,7 @@ void DONEXT(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// ?branch ( f -- ) \ Branch if flag is 0
|
||||
// ?branch ( f -- ) Branch if flag is 0
|
||||
void DOQBRANCH(void) {
|
||||
Cell flag;
|
||||
|
||||
|
|
@ -376,7 +382,7 @@ void DOQBRANCH(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
// branch ( -- ) \ Branch to an inline address.
|
||||
// branch ( -- ) Branch to an inline address.
|
||||
void DOBRANCH(void) {
|
||||
FS.IP = AT(FS.IP);
|
||||
NEXT;
|
||||
|
|
@ -386,28 +392,28 @@ void DOBRANCH(void) {
|
|||
* Compiling Primitives
|
||||
*/
|
||||
|
||||
// , ( x -- ) \ Compile x to the current definition
|
||||
// , ( x -- ) Compile x to the current definition
|
||||
void COMMA(void) {
|
||||
Cell x;
|
||||
SPOP(x);
|
||||
AT(FS.DP) = x;
|
||||
FS.DP += sizeof x;
|
||||
AT(*DP) = x;
|
||||
*DP += sizeof x;
|
||||
NEXT;
|
||||
}
|
||||
|
||||
// c, ( c -- ) \ Compile character c to the current definition
|
||||
// c, ( c -- ) Compile character c to the current definition
|
||||
void CCOMMA(void) {
|
||||
char c;
|
||||
SPOP(c);
|
||||
C_AT(FS.DP) = c;
|
||||
FS.DP += 1;
|
||||
C_AT(*DP) = c;
|
||||
*DP += 1;
|
||||
NEXT;
|
||||
}
|
||||
|
||||
/* DOVAR is the machine code for variable definitions. When it is executed, WP
|
||||
will be pointing at the codeAddress field of its dictionary entry, so the
|
||||
next cell will be the variable cell. DOVAR pushes the address of the variable
|
||||
cell to the data stack and */
|
||||
cell to the data stack. */
|
||||
void DOVAR(void) {
|
||||
Cell LP;
|
||||
LP = FS.WP;
|
||||
|
|
@ -419,7 +425,7 @@ void DOVAR(void) {
|
|||
// create ( -- ) build a header for a new word in the dictionary, taking the
|
||||
// name as the next word in the input buffer
|
||||
void CREATE(void) {
|
||||
DictEntry *newHead = HEADER_AT(FS.DP);
|
||||
DictEntry *newHead = HEADER_AT(*DP);
|
||||
Cell cell;
|
||||
char *name;
|
||||
int len;
|
||||
|
|
@ -430,19 +436,14 @@ void CREATE(void) {
|
|||
|
||||
name = (char *)(cell + 1);
|
||||
len = *(char *)(cell);
|
||||
#if 0
|
||||
fprintf(stderr, "create: nameLength %d, nameBegin '%s'\n",
|
||||
newHead->nameLength, newHead->nameBegin);
|
||||
#endif
|
||||
newHead->link = HEADER_AT(*VOCAB);
|
||||
newHead->codeAddress = DOVAR;
|
||||
*VOCAB = newHead;
|
||||
FS.DP += sizeof (DictEntry);
|
||||
*DP += sizeof (DictEntry);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
void DOCOL(void);
|
||||
|
||||
// : ( -- ) start defining a new word.
|
||||
void COLON(void) {
|
||||
*STATE = -1;
|
||||
|
|
@ -468,8 +469,8 @@ void CONSTANT(void) {
|
|||
SPOP(value);
|
||||
CREATE();
|
||||
(*VOCAB)->codeAddress = DOCONST;
|
||||
AT(FS.DP) = value;
|
||||
FS.DP += sizeof value;
|
||||
AT(*DP) = value;
|
||||
*DP += sizeof value;
|
||||
NEXT;
|
||||
}
|
||||
|
||||
|
|
@ -548,20 +549,6 @@ void TONUMBER(void) {
|
|||
* Dictionary Lookup Primitive
|
||||
*/
|
||||
|
||||
DictEntry *findWord(int len, char *name, DictEntry *vocab) {
|
||||
char length;
|
||||
length = (len > HDRNAMESZ) ? HDRNAMESZ : len;
|
||||
while (vocab != NULL) {
|
||||
if ((vocab->nameLength & ~(IMM_MASK)) == len) {
|
||||
if (strncmp(name, (char*)vocab->nameBegin, length) == 0) {
|
||||
return vocab;
|
||||
}
|
||||
}
|
||||
vocab = vocab->link;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
// find ( cstring -- a2 flag ) look up a word in the dictionary.
|
||||
// If found, a2 is XT of the word; flag is 1 for imm, -1 otherwise
|
||||
// If not found, a2 is cstring and flag is 0
|
||||
|
|
@ -618,7 +605,8 @@ void DOLIT(void) {
|
|||
}
|
||||
static Code DOLIT_codeAddress = DOLIT;
|
||||
|
||||
/* DOCONST is like DOVAR, but it pushes the value of the cell after the codeAddress rather than the address of the cell */
|
||||
/* DOCONST is like DOVAR, but it pushes the value of the cell after the
|
||||
codeAddress rather than the address of the cell */
|
||||
void DOCONST(void) {
|
||||
Cell LP, L;
|
||||
LP = FS.WP;
|
||||
|
|
@ -706,9 +694,24 @@ void EXECUTE(void) {
|
|||
NEXT;
|
||||
}
|
||||
|
||||
/* ABORT resets the interpreter state and resumes execution at COLD */
|
||||
void ABORT(void) {
|
||||
FS.SP = *SP0;
|
||||
FS.RP = *RP0;
|
||||
FS.IP = *IP0;
|
||||
|
||||
*NUM_TIB = 0;
|
||||
*TO_IN = 0;
|
||||
*STATE = 0;
|
||||
NEXT;
|
||||
}
|
||||
|
||||
/*
|
||||
* Bootstrap Helper Functions
|
||||
*/
|
||||
|
||||
void compileHeader(const char *name, Code code) {
|
||||
DictEntry *newHead = HEADER_AT(FS.DP);
|
||||
DictEntry *newHead = HEADER_AT(*DP);
|
||||
int i, len;
|
||||
|
||||
len = strlen(name);
|
||||
|
|
@ -719,19 +722,19 @@ void compileHeader(const char *name, Code code) {
|
|||
newHead->link = HEADER_AT(*VOCAB);
|
||||
newHead->codeAddress = code;
|
||||
*VOCAB = newHead;
|
||||
FS.DP += sizeof (DictEntry);
|
||||
*DP += sizeof (DictEntry);
|
||||
}
|
||||
|
||||
void compileCode(XT codeAddress) {
|
||||
AT(FS.DP) = (Cell)codeAddress;
|
||||
FS.DP += sizeof codeAddress;
|
||||
AT(*DP) = (Cell)codeAddress;
|
||||
*DP += sizeof codeAddress;
|
||||
}
|
||||
|
||||
void compileLiteral(Cell literal) {
|
||||
AT(FS.DP) = (Cell)&DOLIT_codeAddress;
|
||||
FS.DP += sizeof literal;
|
||||
AT(FS.DP) = literal;
|
||||
FS.DP += sizeof literal;
|
||||
AT(*DP) = (Cell)&DOLIT_codeAddress;
|
||||
*DP += sizeof literal;
|
||||
AT(*DP) = literal;
|
||||
*DP += sizeof literal;
|
||||
}
|
||||
|
||||
XT lookupWord(const char *name, DictEntry *vocab) {
|
||||
|
|
@ -756,92 +759,19 @@ void addImmPrimitive(const char *name, Code code) {
|
|||
(*VOCAB)->nameLength |= IMM_MASK;
|
||||
}
|
||||
|
||||
void addSecondary(const char *name, const char **words) {
|
||||
XT code;
|
||||
Cell lit;
|
||||
compileHeader(name, DOCOL);
|
||||
while (*words != NULL) {
|
||||
code = lookupWord(*words, *VOCAB);
|
||||
if (code != NULL) {
|
||||
compileCode(code);
|
||||
} else {
|
||||
char *end;
|
||||
lit = strtol(*words, &end, 0);
|
||||
if (*end == '\0') {
|
||||
compileLiteral(lit);
|
||||
} else {
|
||||
printf("Error adding secondary '%s': '%s' is not in the dictionary"
|
||||
" and is not a number\n", name, *words);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
words++;
|
||||
}
|
||||
compileCode(lookupWord("EXIT", *VOCAB));
|
||||
}
|
||||
|
||||
void addVariable(const char *name, Cell initVal) {
|
||||
compileHeader(name, DOVAR);
|
||||
AT(FS.DP) = initVal;
|
||||
FS.DP += sizeof initVal;
|
||||
}
|
||||
|
||||
void addConstant(const char *name, Cell value) {
|
||||
compileHeader(name, DOCONST);
|
||||
AT(FS.DP) = value;
|
||||
FS.DP += sizeof value;
|
||||
AT(*DP) = value;
|
||||
*DP += sizeof value;
|
||||
}
|
||||
|
||||
void ABORT(void) {
|
||||
*NUM_TIB = 0;
|
||||
*TO_IN = 0;
|
||||
*STATE = 0;
|
||||
FS.SP = (Cell)(FM + CELLCOUNT - 1);
|
||||
FS.RP = (Cell)(FM + CELLCOUNT - 65);
|
||||
|
||||
/* Load IP with the first parameter cell of a secondary. */
|
||||
FS.IP = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
static const char *TEST[] = {
|
||||
"40",
|
||||
"2",
|
||||
"+",
|
||||
".",
|
||||
"NL"
|
||||
};
|
||||
|
||||
static const char *TESTWORD[] = {
|
||||
"TIB", "128", "ACCEPT",
|
||||
"#TIB", "!",
|
||||
"0", ">IN", "!",
|
||||
"0",
|
||||
"32", "WORD",
|
||||
"COUNT",
|
||||
">NUMBER", "DROP", "DROP", "NL", ".", "NL",
|
||||
0
|
||||
};
|
||||
|
||||
static const char *TESTCREATE[] = {
|
||||
"TIB", "128", "ACCEPT",
|
||||
"#TIB", "!",
|
||||
"0", ">IN", "!",
|
||||
"CREATE",
|
||||
0
|
||||
};
|
||||
|
||||
static const char *COLD[] = {
|
||||
"INTERPRET",
|
||||
0
|
||||
};
|
||||
|
||||
Cell cW(const char *name) {
|
||||
XT code;
|
||||
Cell codeAddr = 0;
|
||||
code = lookupWord(name, *VOCAB);
|
||||
if (code != NULL) {
|
||||
codeAddr = FS.DP;
|
||||
codeAddr = *DP;
|
||||
compileCode(code);
|
||||
} else {
|
||||
fprintf(stderr, "Error: %s not in dictionary\n", name);
|
||||
|
|
@ -853,15 +783,14 @@ Cell cW(const char *name) {
|
|||
Cell *cB(const char *name) {
|
||||
Cell labelAddr;
|
||||
cW(name);
|
||||
labelAddr = FS.DP;
|
||||
// would code label in here if we knew it
|
||||
FS.DP += sizeof (Cell);
|
||||
labelAddr = *DP;
|
||||
*DP += sizeof (Cell);
|
||||
|
||||
return (Cell *)labelAddr;
|
||||
}
|
||||
|
||||
Cell cL(Cell literal) {
|
||||
Cell codeAddr = FS.DP;
|
||||
Cell codeAddr = *DP;
|
||||
compileLiteral(literal);
|
||||
return codeAddr;
|
||||
}
|
||||
|
|
@ -870,6 +799,21 @@ void buildOuterInterpreter(void) {
|
|||
Cell interpt, intpar, intexc, intnf, intnc, intskip, intdone;
|
||||
Cell *b_interpt, *b_intpar, *b_intexc, *b_intnf, *b_intnc,
|
||||
*b_intskip, *b_intdone, *b_intdone2, *b_intdone3;
|
||||
/*
|
||||
: INTERPRET ( -- )
|
||||
BEGIN #TIB @ >IN @ = IF
|
||||
TIB 50 ACCEPT #TIB ! 0 >IN ! / Refill Input Buffer
|
||||
THEN 32 WORD FIND DUP IF
|
||||
STATE @ = IF , ELSE EXECUTE THEN / Compile or Execute Word
|
||||
ELSE
|
||||
SWAP COUNT >NUMBER IF / Not a number; cleanup and abort
|
||||
STATE @ IF VOCAB @ DUP CELLL + @ VOCAB ! DP !
|
||||
THEN ABORT
|
||||
ELSE / A number; compile or retain on stack
|
||||
DROP STATE @ IF ['] DOLIT , , THEN
|
||||
THEN
|
||||
THEN AGAIN / Loop forever!
|
||||
*/
|
||||
|
||||
compileHeader("INTERPRET", DOCOL);
|
||||
interpt = cW("#TIB");
|
||||
|
|
@ -914,7 +858,7 @@ void buildOuterInterpreter(void) {
|
|||
cW("@");
|
||||
cW("VOCAB");
|
||||
cW("!");
|
||||
cL((Cell)&(FS.DP));
|
||||
cL((Cell)&(*DP));
|
||||
cW("!");
|
||||
intnc = cW("ABORT");
|
||||
intskip = cW("DROP");
|
||||
|
|
@ -923,11 +867,15 @@ void buildOuterInterpreter(void) {
|
|||
b_intdone3 = cB("?BRANCH");
|
||||
cL((Cell)&DOLIT_codeAddress);
|
||||
cW(",");
|
||||
cW(","); intdone = FS.DP;
|
||||
cW(","); intdone = *DP;
|
||||
b_interpt = cB("BRANCH");
|
||||
|
||||
cW("EXIT");
|
||||
|
||||
compileHeader("COLD", DOCOL);
|
||||
cW("INTERPRET");
|
||||
cW("EXIT");
|
||||
|
||||
/* Fix up branch targets */
|
||||
*b_interpt = interpt;
|
||||
*b_intpar = intpar;
|
||||
|
|
@ -940,10 +888,10 @@ void buildOuterInterpreter(void) {
|
|||
*b_intdone3 = intdone;
|
||||
}
|
||||
|
||||
void initialize(void) {
|
||||
FS.SP = (Cell)(FM + CELLCOUNT - 1);
|
||||
FS.RP = (Cell)(FM + CELLCOUNT - 65);
|
||||
FS.DP = (Cell)(FM + 128);
|
||||
void bootstrapCore(void) {
|
||||
FS.SP = *SP0 = (Cell)(FM + CELLCOUNT - 1);
|
||||
FS.RP = *RP0 = (Cell)(FM + CELLCOUNT - 65);
|
||||
*DP = *DP0 = (Cell)(FM + 128);
|
||||
*VOCAB = NULL;
|
||||
|
||||
/* Inner Interpreter Primitives */
|
||||
|
|
@ -954,13 +902,15 @@ void initialize(void) {
|
|||
DOEXIT_XT = &(*VOCAB)->codeAddress;
|
||||
|
||||
/* Core address constants */
|
||||
addConstant("TIB", (Cell)TIB);
|
||||
addConstant("VOCAB", (Cell)VOCAB);
|
||||
addConstant("TIB", (Cell)TIB);
|
||||
addConstant("BASE", (Cell)BASE);
|
||||
addConstant("TIB", (Cell)TIB);
|
||||
addConstant("#TIB", (Cell)NUM_TIB);
|
||||
addConstant(">IN", (Cell)TO_IN);
|
||||
addConstant("STATE", (Cell)STATE);
|
||||
addConstant("DP", (Cell)DP);
|
||||
addConstant("SP0", (Cell)SP0);
|
||||
addConstant("RP0", (Cell)RP0);
|
||||
|
||||
/* Terminal I/O Primitives */
|
||||
addPrimitive("ACCEPT", ACCEPT);
|
||||
|
|
@ -970,9 +920,9 @@ void initialize(void) {
|
|||
addPrimitive(".", DOT);
|
||||
|
||||
/* Memory Access Primitives */
|
||||
addPrimitive("@", PEEK);
|
||||
addPrimitive("!", POKE);
|
||||
addPrimitive("c@", CPEEK);
|
||||
addPrimitive("@", FETCH);
|
||||
addPrimitive("!", STORE);
|
||||
addPrimitive("c@", CFETCH);
|
||||
|
||||
/* Stack Manipulation Primitives */
|
||||
addPrimitive("DROP", DROP);
|
||||
|
|
@ -1008,20 +958,18 @@ void initialize(void) {
|
|||
addPrimitive("ABORT", ABORT);
|
||||
buildOuterInterpreter();
|
||||
|
||||
/* Extra stuff! */
|
||||
addSecondary("TEST", TEST);
|
||||
addSecondary("TESTCREATE", TESTCREATE);
|
||||
addSecondary("TESTWORD", TESTWORD);
|
||||
addSecondary("COLD", COLD);
|
||||
|
||||
/* Load IP with the first parameter cell of a secondary. */
|
||||
FS.IP = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);
|
||||
*IP0 = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);
|
||||
}
|
||||
|
||||
void initialize(void) {
|
||||
/* Set the running state to a true value */
|
||||
FS.running = 1;
|
||||
|
||||
ABORT();
|
||||
}
|
||||
|
||||
int main(void) {
|
||||
bootstrapCore();
|
||||
initialize();
|
||||
inner_interpreter();
|
||||
return 0;
|
||||
|
|
|
|||
Loading…
Reference in New Issue