pinealservo
/
simpleForth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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 2015-12-01 01:42:46 -07:00
parent cfda2c945b
commit 4e079f7414
1 changed files with 141 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

334
simpleForth.c
View File

@ -7,6 +7,10 @@
#include <unistd.h> #include <unistd.h>
#include <fcntl.h> #include <fcntl.h>
/*
* Constants and Helper Macros
*/
#define TRACE 0 #define TRACE 0
#define TRACE2 0 #define TRACE2 0
@ -17,6 +21,9 @@
#define TRUE -1 #define TRUE -1
#define IMM_MASK 0x80 #define IMM_MASK 0x80
#define BACKSPACE_IN 127
#define BACKSPACE_OUT 8
#define INC(lval) do { lval += sizeof (lval); } while (0) #define INC(lval) do { lval += sizeof (lval); } while (0)
#define DEC(lval) do { lval -= sizeof (lval); } while (0) #define DEC(lval) do { lval -= sizeof (lval); } while (0)
#define AT(addr) (*((Cell *)addr)) #define AT(addr) (*((Cell *)addr))
@ -45,11 +52,15 @@
#define NEXT return #define NEXT return
/*
* Core System Datatypes
*/
typedef uintptr_t Cell; typedef uintptr_t Cell;
typedef void (*Code)(void); typedef void (*Code)(void);
typedef Code * XT; typedef Code * XT;
#define HDRNAMESZ 3 #define HDRNAMESZ 7
typedef struct forthDictEntry DictEntry; typedef struct forthDictEntry DictEntry;
struct forthDictEntry { struct forthDictEntry {
union { union {
@ -57,7 +68,7 @@ struct forthDictEntry {
unsigned char nameLength; unsigned char nameLength;
unsigned char nameBegin[HDRNAMESZ]; unsigned char nameBegin[HDRNAMESZ];
}; };
Cell padding; Cell padding[2];
}; };
DictEntry *link; DictEntry *link;
Code codeAddress; Code codeAddress;
@ -66,22 +77,34 @@ struct forthDictEntry {
typedef struct forthState { typedef struct forthState {
/* Interpreter Registers */ /* Interpreter Registers */
Cell IP; /* Interpreter Pointer */ Cell IP; /* Interpreter Pointer */
Cell WP; /* Word/Work Pointer */ Cell WP; /* Word Pointer */
Cell SP; /* Argument Stack Pointer */ Cell SP; /* Argument Stack Pointer */
Cell RP; /* Return Stack Pointer */ Cell RP; /* Return Stack Pointer */
Cell DP; /* Dictionary Pointer */
int running; int running;
} ForthState; } ForthState;
/*
* Interpreter State and Main Memory
*/
ForthState FS; ForthState FS;
Cell FM[CELLCOUNT]; Cell FM[CELLCOUNT];
char TIB[128]; char TIB[128];
DictEntry **VOCAB = (DictEntry **)&FM[0]; DictEntry **VOCAB = (DictEntry **)&FM[0];
Cell *BASE = &FM[1]; Cell *BASE = &FM[1];
Cell *NUM_TIB = &FM[2]; Cell *NUM_TIB = &FM[2];
Cell *TO_IN = &FM[3]; Cell *TO_IN = &FM[3];
Cell *STATE = &FM[4]; 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) { void dumpStack(void) {
Cell *BOS = (Cell *)(FM + CELLCOUNT - 1); Cell *BOS = (Cell *)(FM + CELLCOUNT - 1);
@ -95,39 +118,21 @@ void dumpStack(void) {
} }
} }
/* DictEntry *findWord(int len, char *name, DictEntry *vocab) {
* Terminal IO Primitives char length;
*/ length = (len > HDRNAMESZ) ? HDRNAMESZ : len;
while (vocab != NULL) {
void QRX(void) { if ((vocab->nameLength & ~(IMM_MASK)) == len) {
int rv; if (strncmp(name, (char*)vocab->nameBegin, length) == 0) {
int oldflag, newflag; return vocab;
char buf[1]; }
struct termios oldt, newt; }
vocab = vocab->link;
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);
} }
NEXT; return NULL;
} }
char rxchar(void) { char rxchar(void) {
int rv; int rv;
char b; char b;
@ -140,7 +145,6 @@ char rxchar(void) {
tcsetattr(STDIN_FILENO, TCSANOW, &newt); tcsetattr(STDIN_FILENO, TCSANOW, &newt);
rv = read(STDIN_FILENO, &b, 1); rv = read(STDIN_FILENO, &b, 1);
//fprintf(stderr, "%d\n\n", b);
tcsetattr(STDIN_FILENO, TCSANOW, &oldt); tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
@ -162,10 +166,12 @@ void txchar(char b) {
tcsetattr(STDIN_FILENO, TCSANOW, &oldt); tcsetattr(STDIN_FILENO, TCSANOW, &oldt);
} }
/*
* Terminal IO Primitives
*/
// accept ( a l -- l2 ) Read a string of up to l characters, storing it at a. // accept ( a l -- l2 ) Read a string of up to l characters, storing it at a.
// Return the length of the string actually read. // Return the length of the string actually read.
#define BACKSPACE_IN 127
#define BACKSPACE_OUT 8
void ACCEPT(void) { void ACCEPT(void) {
Cell addr, len; Cell addr, len;
char *inbuf, in; char *inbuf, in;
@ -216,7 +222,7 @@ void WORD(void) {
ch = TIB + *TO_IN; ch = TIB + *TO_IN;
last = TIB + *NUM_TIB; last = TIB + *NUM_TIB;
lenp = (char*)FS.DP; lenp = (char*)*DP;
strp = lenp + 1; strp = lenp + 1;
*lenp = 0; *lenp = 0;
@ -277,8 +283,8 @@ void DOT(void) {
* Memory Access Primitives * Memory Access Primitives
*/ */
// @ ( addr -- x ) \ read x from addr // @ ( addr -- x ) read x from addr
void PEEK(void) { void FETCH(void) {
Cell addr, val; Cell addr, val;
SPOP(addr); SPOP(addr);
val = AT(addr); val = AT(addr);
@ -286,8 +292,8 @@ void PEEK(void) {
NEXT; NEXT;
} }
// ! ( x addr -- ) \ store x at addr // ! ( x addr -- ) store x at addr
void POKE(void) { void STORE(void) {
Cell addr, val; Cell addr, val;
SPOP(addr); SPOP(addr);
SPOP(val); SPOP(val);
@ -295,8 +301,8 @@ void POKE(void) {
NEXT; NEXT;
} }
// c@ ( addr -- c ) \ read character from addr // c@ ( addr -- c ) read character from addr
void CPEEK(void) { void CFETCH(void) {
Cell addr; Cell addr;
char c; char c;
SPOP(addr); SPOP(addr);
@ -309,13 +315,13 @@ void CPEEK(void) {
* Stack Manipulation Primitives * Stack Manipulation Primitives
*/ */
// drop ( x -- ) \ drop x from stack // drop ( x -- ) drop x from stack
void DROP(void) { void DROP(void) {
INC(FS.SP); INC(FS.SP);
NEXT; 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) { void DUP(void) {
Cell addr, val; Cell addr, val;
addr = FS.SP; addr = FS.SP;
@ -325,7 +331,7 @@ void DUP(void) {
NEXT; 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) { void SWAP(void) {
Cell vx, vy; Cell vx, vy;
SPOP(vy); SPOP(vy);
@ -335,7 +341,7 @@ void SWAP(void) {
NEXT; 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) { void ROT(void) {
Cell vx, vy, vz; Cell vx, vy, vz;
SPOP(vz); SPOP(vz);
@ -351,7 +357,7 @@ void ROT(void) {
* Flow Control Primitives * 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) { void DONEXT(void) {
AT(FS.RP) -= 1; AT(FS.RP) -= 1;
if ((int)AT(FS.RP) < 0) { if ((int)AT(FS.RP) < 0) {
@ -363,7 +369,7 @@ void DONEXT(void) {
NEXT; NEXT;
} }
// ?branch ( f -- ) \ Branch if flag is 0 // ?branch ( f -- ) Branch if flag is 0
void DOQBRANCH(void) { void DOQBRANCH(void) {
Cell flag; Cell flag;
@ -376,7 +382,7 @@ void DOQBRANCH(void) {
NEXT; NEXT;
} }
// branch ( -- ) \ Branch to an inline address. // branch ( -- ) Branch to an inline address.
void DOBRANCH(void) { void DOBRANCH(void) {
FS.IP = AT(FS.IP); FS.IP = AT(FS.IP);
NEXT; NEXT;
@ -386,28 +392,28 @@ void DOBRANCH(void) {
* Compiling Primitives * Compiling Primitives
*/ */
// , ( x -- ) \ Compile x to the current definition // , ( x -- ) Compile x to the current definition
void COMMA(void) { void COMMA(void) {
Cell x; Cell x;
SPOP(x); SPOP(x);
AT(FS.DP) = x; AT(*DP) = x;
FS.DP += sizeof x; *DP += sizeof x;
NEXT; NEXT;
} }
// c, ( c -- ) \ Compile character c to the current definition // c, ( c -- ) Compile character c to the current definition
void CCOMMA(void) { void CCOMMA(void) {
char c; char c;
SPOP(c); SPOP(c);
C_AT(FS.DP) = c; C_AT(*DP) = c;
FS.DP += 1; *DP += 1;
NEXT; NEXT;
} }
/* DOVAR is the machine code for variable definitions. When it is executed, WP /* 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 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 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) { void DOVAR(void) {
Cell LP; Cell LP;
LP = FS.WP; LP = FS.WP;
@ -419,7 +425,7 @@ void DOVAR(void) {
// create ( -- ) build a header for a new word in the dictionary, taking the // create ( -- ) build a header for a new word in the dictionary, taking the
// name as the next word in the input buffer // name as the next word in the input buffer
void CREATE(void) { void CREATE(void) {
DictEntry *newHead = HEADER_AT(FS.DP); DictEntry *newHead = HEADER_AT(*DP);
Cell cell; Cell cell;
char *name; char *name;
int len; int len;
@ -430,19 +436,14 @@ void CREATE(void) {
name = (char *)(cell + 1); name = (char *)(cell + 1);
len = *(char *)(cell); len = *(char *)(cell);
#if 0
fprintf(stderr, "create: nameLength %d, nameBegin '%s'\n",
newHead->nameLength, newHead->nameBegin);
#endif
newHead->link = HEADER_AT(*VOCAB); newHead->link = HEADER_AT(*VOCAB);
newHead->codeAddress = DOVAR; newHead->codeAddress = DOVAR;
*VOCAB = newHead; *VOCAB = newHead;
FS.DP += sizeof (DictEntry); *DP += sizeof (DictEntry);
NEXT; NEXT;
} }
void DOCOL(void); void DOCOL(void);
// : ( -- ) start defining a new word. // : ( -- ) start defining a new word.
void COLON(void) { void COLON(void) {
*STATE = -1; *STATE = -1;
@ -468,8 +469,8 @@ void CONSTANT(void) {
SPOP(value); SPOP(value);
CREATE(); CREATE();
(*VOCAB)->codeAddress = DOCONST; (*VOCAB)->codeAddress = DOCONST;
AT(FS.DP) = value; AT(*DP) = value;
FS.DP += sizeof value; *DP += sizeof value;
NEXT; NEXT;
} }
@ -548,20 +549,6 @@ void TONUMBER(void) {
* Dictionary Lookup Primitive * 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. // 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 found, a2 is XT of the word; flag is 1 for imm, -1 otherwise
// If not found, a2 is cstring and flag is 0 // If not found, a2 is cstring and flag is 0
@ -618,7 +605,8 @@ void DOLIT(void) {
} }
static Code DOLIT_codeAddress = DOLIT; 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) { void DOCONST(void) {
Cell LP, L; Cell LP, L;
LP = FS.WP; LP = FS.WP;
@ -706,9 +694,24 @@ void EXECUTE(void) {
NEXT; 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) { void compileHeader(const char *name, Code code) {
DictEntry *newHead = HEADER_AT(FS.DP); DictEntry *newHead = HEADER_AT(*DP);
int i, len; int i, len;
len = strlen(name); len = strlen(name);
@ -719,19 +722,19 @@ void compileHeader(const char *name, Code code) {
newHead->link = HEADER_AT(*VOCAB); newHead->link = HEADER_AT(*VOCAB);
newHead->codeAddress = code; newHead->codeAddress = code;
*VOCAB = newHead; *VOCAB = newHead;
FS.DP += sizeof (DictEntry); *DP += sizeof (DictEntry);
} }
void compileCode(XT codeAddress) { void compileCode(XT codeAddress) {
AT(FS.DP) = (Cell)codeAddress; AT(*DP) = (Cell)codeAddress;
FS.DP += sizeof codeAddress; *DP += sizeof codeAddress;
} }
void compileLiteral(Cell literal) { void compileLiteral(Cell literal) {
AT(FS.DP) = (Cell)&DOLIT_codeAddress; AT(*DP) = (Cell)&DOLIT_codeAddress;
FS.DP += sizeof literal; *DP += sizeof literal;
AT(FS.DP) = literal; AT(*DP) = literal;
FS.DP += sizeof literal; *DP += sizeof literal;
} }
XT lookupWord(const char *name, DictEntry *vocab) { XT lookupWord(const char *name, DictEntry *vocab) {
@ -756,92 +759,19 @@ void addImmPrimitive(const char *name, Code code) {
(*VOCAB)->nameLength |= IMM_MASK; (*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) { void addConstant(const char *name, Cell value) {
compileHeader(name, DOCONST); compileHeader(name, DOCONST);
AT(FS.DP) = value; AT(*DP) = value;
FS.DP += sizeof 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) { Cell cW(const char *name) {
XT code; XT code;
Cell codeAddr = 0; Cell codeAddr = 0;
code = lookupWord(name, *VOCAB); code = lookupWord(name, *VOCAB);
if (code != NULL) { if (code != NULL) {
codeAddr = FS.DP; codeAddr = *DP;
compileCode(code); compileCode(code);
} else { } else {
fprintf(stderr, "Error: %s not in dictionary\n", name); fprintf(stderr, "Error: %s not in dictionary\n", name);
@ -853,15 +783,14 @@ Cell cW(const char *name) {
Cell *cB(const char *name) { Cell *cB(const char *name) {
Cell labelAddr; Cell labelAddr;
cW(name); cW(name);
labelAddr = FS.DP; labelAddr = *DP;
// would code label in here if we knew it *DP += sizeof (Cell);
FS.DP += sizeof (Cell);
return (Cell *)labelAddr; return (Cell *)labelAddr;
} }
Cell cL(Cell literal) { Cell cL(Cell literal) {
Cell codeAddr = FS.DP; Cell codeAddr = *DP;
compileLiteral(literal); compileLiteral(literal);
return codeAddr; return codeAddr;
} }
@ -870,6 +799,21 @@ void buildOuterInterpreter(void) {
Cell interpt, intpar, intexc, intnf, intnc, intskip, intdone; Cell interpt, intpar, intexc, intnf, intnc, intskip, intdone;
Cell *b_interpt, *b_intpar, *b_intexc, *b_intnf, *b_intnc, Cell *b_interpt, *b_intpar, *b_intexc, *b_intnf, *b_intnc,
*b_intskip, *b_intdone, *b_intdone2, *b_intdone3; *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); compileHeader("INTERPRET", DOCOL);
interpt = cW("#TIB"); interpt = cW("#TIB");
@ -914,7 +858,7 @@ void buildOuterInterpreter(void) {
cW("@"); cW("@");
cW("VOCAB"); cW("VOCAB");
cW("!"); cW("!");
cL((Cell)&(FS.DP)); cL((Cell)&(*DP));
cW("!"); cW("!");
intnc = cW("ABORT"); intnc = cW("ABORT");
intskip = cW("DROP"); intskip = cW("DROP");
@ -923,11 +867,15 @@ void buildOuterInterpreter(void) {
b_intdone3 = cB("?BRANCH"); b_intdone3 = cB("?BRANCH");
cL((Cell)&DOLIT_codeAddress); cL((Cell)&DOLIT_codeAddress);
cW(","); cW(",");
cW(","); intdone = FS.DP; cW(","); intdone = *DP;
b_interpt = cB("BRANCH"); b_interpt = cB("BRANCH");
cW("EXIT"); cW("EXIT");
compileHeader("COLD", DOCOL);
cW("INTERPRET");
cW("EXIT");
/* Fix up branch targets */ /* Fix up branch targets */
*b_interpt = interpt; *b_interpt = interpt;
*b_intpar = intpar; *b_intpar = intpar;
@ -940,10 +888,10 @@ void buildOuterInterpreter(void) {
*b_intdone3 = intdone; *b_intdone3 = intdone;
} }
void initialize(void) { void bootstrapCore(void) {
FS.SP = (Cell)(FM + CELLCOUNT - 1); FS.SP = *SP0 = (Cell)(FM + CELLCOUNT - 1);
FS.RP = (Cell)(FM + CELLCOUNT - 65); FS.RP = *RP0 = (Cell)(FM + CELLCOUNT - 65);
FS.DP = (Cell)(FM + 128); *DP = *DP0 = (Cell)(FM + 128);
*VOCAB = NULL; *VOCAB = NULL;
/* Inner Interpreter Primitives */ /* Inner Interpreter Primitives */
@ -954,13 +902,15 @@ void initialize(void) {
DOEXIT_XT = &(*VOCAB)->codeAddress; DOEXIT_XT = &(*VOCAB)->codeAddress;
/* Core address constants */ /* Core address constants */
addConstant("TIB", (Cell)TIB);
addConstant("VOCAB", (Cell)VOCAB); addConstant("VOCAB", (Cell)VOCAB);
addConstant("TIB", (Cell)TIB);
addConstant("BASE", (Cell)BASE); addConstant("BASE", (Cell)BASE);
addConstant("TIB", (Cell)TIB);
addConstant("#TIB", (Cell)NUM_TIB); addConstant("#TIB", (Cell)NUM_TIB);
addConstant(">IN", (Cell)TO_IN); addConstant(">IN", (Cell)TO_IN);
addConstant("STATE", (Cell)STATE); addConstant("STATE", (Cell)STATE);
addConstant("DP", (Cell)DP);
addConstant("SP0", (Cell)SP0);
addConstant("RP0", (Cell)RP0);
/* Terminal I/O Primitives */ /* Terminal I/O Primitives */
addPrimitive("ACCEPT", ACCEPT); addPrimitive("ACCEPT", ACCEPT);
@ -970,9 +920,9 @@ void initialize(void) {
addPrimitive(".", DOT); addPrimitive(".", DOT);
/* Memory Access Primitives */ /* Memory Access Primitives */
addPrimitive("@", PEEK); addPrimitive("@", FETCH);
addPrimitive("!", POKE); addPrimitive("!", STORE);
addPrimitive("c@", CPEEK); addPrimitive("c@", CFETCH);
/* Stack Manipulation Primitives */ /* Stack Manipulation Primitives */
addPrimitive("DROP", DROP); addPrimitive("DROP", DROP);
@ -1008,20 +958,18 @@ void initialize(void) {
addPrimitive("ABORT", ABORT); addPrimitive("ABORT", ABORT);
buildOuterInterpreter(); buildOuterInterpreter();
/* Extra stuff! */ *IP0 = (Cell)((Cell *)lookupWord("COLD", *VOCAB) + 1);
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);
void initialize(void) {
/* Set the running state to a true value */ /* Set the running state to a true value */
FS.running = 1; FS.running = 1;
ABORT();
} }
int main(void) { int main(void) {
bootstrapCore();
initialize(); initialize();
inner_interpreter(); inner_interpreter();
return 0; return 0;