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

View File

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