+#include <stdint.h>
+#include <stdlib.h>
+
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
/** Pointer to the next most recently defined word in the dictionary. */
struct word_t const* link;
/** A collection of flags describing attributes of the word. */
- long flags;
+ struct {
+ long f_hidden : 1; /*< Flag if this word should be hidden from the interpreter */
+ long f_immed : 1; /*< flag if this word should be executed at compile time */
+ long padding : 6; /*< Pads the flags to 8-bits */
+ long codesize : 24; /*< The lenght of the bytecode section of the word */
+ } flags;
/** Pointer to the null terminated string that holds the name of the word. */
char const* name;
/**
long* prev_code = CodePtr;
/* Set the next instruction to execute */
CodePtr = code;
- /* And loop through until we get the bytecode instructionof 0 (NEXT) */
+ /* And loop through until we get the bytecode instruction of 0 (NEXT) */
while(*CodePtr)
{
/* Execute the byte code instruction */
if(ArgStackPtr < (ArgStack-1))
{
puts("Stack Underflow!");
- exit(1);
+ //exit(1);
}
if(ArgStackPtr > (ArgStack+30))
{
puts("Stack Overflow!");
- exit(1);
+ //exit(1);
}
}
/**
* Define a built-in word that executes native code */
-#define defcode(name_str,c_name,flags,prev) \
+#define defcode(name_str,c_name,immed,hide,prev) \
static void c_name##_code(long* code); \
- static char const c_name##_str[]; \
static word_t const c_name = { \
prev, \
- flags, \
- c_name##_str, \
+ { immed, hide, 0, 0 }, \
+ name_str, \
&c_name##_code, \
0 \
}; \
- static char const c_name##_str[] = name_str; \
static void c_name##_code(long* inst_ptr) \
/**
* Define a built-in word representing a variable with the provided initial value */
-#define defvar(name_str,c_name,flags,prev,initial) \
+#define defvar(name_str,c_name,immed,hide,prev,initial) \
static long c_name##_val = initial; \
- defcode(name_str,c_name,flags,prev) { \
+ defcode(name_str,c_name,immed,hide,prev) { \
ArgStackPtr++; \
*(ArgStackPtr) = (long)&(c_name##_val); \
}
/**
* Define a built-in word representing a constant with the provided value */
-#define defconst(name_str,c_name,flags,prev,value) \
+#define defconst(name_str,c_name,immed,hide,prev,value) \
static long const c_name##_val = value; \
- defcode(name_str,c_name,flags,prev) { \
+ defcode(name_str,c_name,immed,hide,prev) { \
ArgStackPtr++; \
*(ArgStackPtr) = c_name##_val; \
}
/* Built-in Constants
*****************************************************************************/
-defconst("VERSION", version, 0, 0, 1);
-defconst("EXECDEF", execdef, 0, &version, (long)&docolon);
-defconst("F_IMMED", f_immed, 0, &execdef, 0x01);
-defconst("F_HIDDEN", f_hidden, 0, &f_immed, 0x02);
+defconst("VERSION", version, 0, 0, 0, 1);
+defconst("EXECDEF", execdef, 0, 0, &version, (long)&docolon);
+defconst("WORDSZ", wordsz, 0, 0, &execdef, sizeof(long));
/* Built-in Variables
*****************************************************************************/
-defvar("state", state, 0, &f_hidden, 0);
-defvar("here", here, 0, &state, 0);
-defvar("latest", latest, 0, &here, 0);
+defvar("state", state, 0, 0, &wordsz, 0);
+defvar("here", here, 0, 0, &state, 0);
+defvar("latest", latest, 0, 0, &here, 0);
/* Input Words
*****************************************************************************/
-defcode("getc", get_char, 0, &latest){
+defcode("getc", get_char, 0, 0, &latest){
ArgStackPtr++;
*(ArgStackPtr) = getc(stdin);
}
-defcode("ws?", is_ws, 0, &get_char){
+defcode("ws?", is_ws, 0, 0, &get_char){
char ch = *(ArgStackPtr);
*(ArgStackPtr) = ((ch == ' ') || (ch == '\t') ||
(ch == '\r') || (ch == '\n'));
- /* Note: total hack to get the prompt to reappear when the user hits
+ /* TODO: total hack to get the prompt to reappear when the user hits
* enter */
if(ch == '\n')
Line_Read = 1;
}
-defcode("getw", get_word, 0, &is_ws){
+defcode("getw", get_word, 0, 0, &is_ws){
static char buffer[32];
int i = 0;
int wschar = 0;
*(ArgStackPtr) = (long)&buffer;
}
-defcode("findw", find_word, 0, &get_word){
+defcode("findw", find_word, 0, 0, &get_word){
word_t const* curr = (word_t const*)latest_val;
char* name = (char*)*(ArgStackPtr);
while(curr)
{
- if (!(curr->flags & 0x02) && (0 == strcmp(curr->name,name)))
+ if (!(curr->flags.f_hidden) && (0 == strcmp(curr->name,name)))
{
break;
}
/* Branching and Literal Words
*****************************************************************************/
-defcode("lit", literal, 0, &find_word){
+defcode("lit", literal, 0, 0, &find_word){
CodePtr++;
ArgStackPtr++;
*(ArgStackPtr) = *CodePtr;
}
-defcode("br", branch, 0, &literal){
+defcode("br", branch, 0, 0, &literal){
CodePtr++;
CodePtr += *(CodePtr);
}
-defcode("0br", zbranch, 0, &branch){
+defcode("0br", zbranch, 0, 0, &branch){
if (!(*ArgStackPtr))
{
CodePtr++;
/* Compiler Words
*****************************************************************************/
-defcode("[", lbrack, 0, &zbranch){
+defcode("[", lbrack, 0, 0, &zbranch){
state_val = 0;
}
-defcode("]", rbrack, 0x01, &lbrack){
+defcode("]", rbrack, 0, 1, &lbrack){
state_val = 1;
}
-defcode("create", create, 0, &rbrack){
+defcode("create", create, 0, 0, &rbrack){
/* Copy the name string */
char* name = 0u;
if (*(ArgStackPtr))
/* Create the word entry */
word_t* word = (word_t*)malloc(sizeof(word_t));
word->link = (word_t*)latest_val;
- word->flags = f_hidden_val;
+ word->flags.f_immed = 0;
+ word->flags.f_hidden = 1;
+ word->flags.codesize = 0;
word->name = name;
word->codeword = &docolon;
word->code = (long*)malloc(sizeof(long));
*(ArgStackPtr) = (long)word;
}
-defcode(",", comma, 0, &create){
+defcode(",", comma, 0, 0, &create){
/* Get the word we are currently compiling */
word_t* word = (word_t*)latest_val;
/* Put the next instruction in place of the terminating NULL that "here"
*((long*)here_val) = 0;
}
-defcode("hidden", hidden, 1, &comma){
- ((word_t*)*(ArgStackPtr))->flags ^= f_hidden_val;
+defcode("hidden", hidden, 0, 1, &comma){
+ ((word_t*)*(ArgStackPtr))->flags.f_hidden ^= 1;
}
-defcode("immediate", immediate, 1, &hidden){
- ((word_t*)*(ArgStackPtr))->flags ^= f_immed_val;
+defcode("immediate", immediate, 0, 1, &hidden){
+ ((word_t*)*(ArgStackPtr))->flags.f_immed ^= 1;
}
-defcode(":", colon, 0, &immediate){
+defcode(":", colon, 0, 0, &immediate){
EXEC(get_word);
EXEC(create);
EXEC(rbrack);
}
-defcode(";", semicolon, 1, &colon){
+defcode(";", semicolon, 0, 1, &colon){
EXEC(lbrack);
EXEC(hidden);
ArgStackPtr--;
}
-defcode("'", tick, 1, &semicolon){
- ArgStackPtr++;
- *(ArgStackPtr) = *(CodePtr+1);
+defcode("'", tick, 0, 1, &semicolon){
+ EXEC(get_word);
+ EXEC(find_word);
}
/* Interpreter Words
*****************************************************************************/
-defcode("execw", exec_word, 0, &tick){
+defcode("execw", exec_word, 0, 0, &tick){
word_t* word = (word_t*)(*ArgStackPtr);
ArgStackPtr--;
EXEC( *(word) );
}
-defcode("parsenum", parse_num, 0, &exec_word){
+defcode("parsenum", parse_num, 0, 0, &exec_word){
char* end;
long num = strtol((const char *)*(ArgStackPtr), &end, 10);
if(end != (char *)*(ArgStackPtr))
}
else
{
- puts("Parse Error");
+ printf("%s ? \n", ((char*)*(ArgStackPtr)));
ArgStackPtr--;
}
}
-defcode("interpret", interpret, 0, &parse_num){
+defcode("interpret", interpret, 0, 0, &parse_num){
char* curr_word;
/* Parse a word */
EXEC(get_word);
if (*ArgStackPtr)
{
/* If we are in immediate mode or the found word is marked immediate */
- if((state_val == 0) || (((word_t*)*ArgStackPtr)->flags & f_immed_val))
+ if((state_val == 0) || (((word_t*)*ArgStackPtr)->flags.f_immed))
{
/* Execute the word */
EXEC(exec_word);
}
}
-defcode("quit", quit, 0, &interpret){
+defcode("quit", quit, 0, 0, &interpret){
int i;
printf("=> ");
Line_Read = 0;
/* Stack Manipulation Words
*****************************************************************************/
-defcode("drop", drop, 0, &quit){
+defcode("drop", drop, 0, 0, &quit){
ArgStackPtr--;
}
-defcode("swap", swap, 0, &drop){
+defcode("swap", swap, 0, 0, &drop){
long temp = *(ArgStackPtr);
*(ArgStackPtr) = *(ArgStackPtr-1);
*(ArgStackPtr-1) = temp;
}
-defcode("dup", dup, 0, &swap){
+defcode("dup", dup, 0, 0, &swap){
ArgStackPtr++;
*(ArgStackPtr) = *(ArgStackPtr-1);
}
-defcode("over", over, 0, &dup){
+defcode("over", over, 0, 0, &dup){
ArgStackPtr++;
*(ArgStackPtr) = *(ArgStackPtr-2);
}
-defcode("rot", rot, 0, &over){
+defcode("rot", rot, 0, 0, &over){
long temp = *(ArgStackPtr);
*(ArgStackPtr) = *(ArgStackPtr-1);
*(ArgStackPtr-1) = *(ArgStackPtr-2);
*(ArgStackPtr-2) = temp;
}
-defcode("-rot", nrot, 0, &rot){
+defcode("-rot", nrot, 0, 0, &rot){
long temp = *(ArgStackPtr-2);
*(ArgStackPtr-2) = *(ArgStackPtr-1);
*(ArgStackPtr-1) = *(ArgStackPtr);
*(ArgStackPtr) = temp;
}
-defcode("2drop", twodrop, 0, &nrot){
- ArgStackPtr -= 2;
-}
-
-defcode("2dup", twodup, 0, &twodrop){
- ArgStackPtr += 2;
- *(ArgStackPtr-1) = *(ArgStackPtr-3);
- *(ArgStackPtr) = *(ArgStackPtr-2);
-}
-
-defcode("2swap", twoswap, 0, &twodup){
-}
-
-defcode("?dup", dup_if, 0, &twoswap){
- if (*ArgStackPtr)
- {
- ArgStackPtr++;
- *(ArgStackPtr) = *(ArgStackPtr-1);
- }
-}
-
/* Arithmetic Words
*****************************************************************************/
-defcode("+", add, 0, &dup_if){
+defcode("+", add, 0, 0, &nrot){
*(ArgStackPtr-1) += *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("-", sub, 0, &add){
+defcode("-", sub, 0, 0, &add){
*(ArgStackPtr-1) -= *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("*", mul, 0, &sub){
+defcode("*", mul, 0, 0, &sub){
*(ArgStackPtr-1) *= *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("/", divide, 0, &mul){
+defcode("/", divide, 0, 0, &mul){
*(ArgStackPtr-1) /= *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("%", mod, 0, ÷){
+defcode("%", mod, 0, 0, ÷){
*(ArgStackPtr-1) %= *(ArgStackPtr);
ArgStackPtr--;
}
/* Boolean Conditional Words
*****************************************************************************/
-defcode("=", equal, 0, &mod){
+defcode("=", equal, 0, 0, &mod){
*(ArgStackPtr-1) = *(ArgStackPtr-1) == *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("!=", notequal, 0, &equal){
+defcode("!=", notequal, 0, 0, &equal){
*(ArgStackPtr-1) = *(ArgStackPtr-1) != *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("<", lessthan, 0, ¬equal){
+defcode("<", lessthan, 0, 0, ¬equal){
*(ArgStackPtr-1) = *(ArgStackPtr-1) < *(ArgStackPtr);
ArgStackPtr--;
}
-defcode(">", greaterthan, 0, &lessthan){
+defcode(">", greaterthan, 0, 0, &lessthan){
*(ArgStackPtr-1) = *(ArgStackPtr-1) > *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("<=", lessthaneq, 0, &greaterthan){
+defcode("<=", lessthaneq, 0, 0, &greaterthan){
*(ArgStackPtr-1) = *(ArgStackPtr-1) <= *(ArgStackPtr);
ArgStackPtr--;
}
-defcode(">=", greaterthaneq, 0, &lessthaneq){
+defcode(">=", greaterthaneq, 0, 0, &lessthaneq){
*(ArgStackPtr-1) = *(ArgStackPtr-1) >= *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("and", and, 0, &greaterthaneq){
+defcode("and", and, 0, 0, &greaterthaneq){
*(ArgStackPtr-1) = *(ArgStackPtr-1) && *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("or", or, 0, &and){
+defcode("or", or, 0, 0, &and){
*(ArgStackPtr-1) = *(ArgStackPtr-1) || *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("not", not, 0, &or){
+defcode("not", not, 0, 0, &or){
*(ArgStackPtr) = !(*(ArgStackPtr));
}
/* Bitwise Words
*****************************************************************************/
-defcode("band", band, 0, ¬){
+defcode("band", band, 0, 0, ¬){
*(ArgStackPtr-1) = *(ArgStackPtr-1) & *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("bor", bor, 0, &band){
+defcode("bor", bor, 0, 0, &band){
*(ArgStackPtr-1) = *(ArgStackPtr-1) | *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("bxor", bxor, 0, &bor){
+defcode("bxor", bxor, 0, 0, &bor){
*(ArgStackPtr-1) = *(ArgStackPtr-1) ^ *(ArgStackPtr);
ArgStackPtr--;
}
-defcode("bnot", bnot, 0, &bxor){
+defcode("bnot", bnot, 0, 0, &bxor){
*(ArgStackPtr) = ~(*(ArgStackPtr));
}
/* Memory Manipulation Words
*****************************************************************************/
-defcode("!", store, 0, &bnot){
+defcode("!", store, 0, 0, &bnot){
*((long*)*(ArgStackPtr)) = *(ArgStackPtr-1);
ArgStackPtr -= 2;
}
-defcode("@", fetch, 0, &store){
+defcode("@", fetch, 0, 0, &store){
*(ArgStackPtr) = *((long*)*(ArgStackPtr));
}
-defcode("+!", addstore, 0, &fetch){
+defcode("+!", addstore, 0, 0, &fetch){
*((long*)*(ArgStackPtr)) += *(ArgStackPtr-1);
ArgStackPtr -= 2;
}
-defcode("-!", substore, 0, &addstore){
+defcode("-!", substore, 0, 0, &addstore){
*((long*)*(ArgStackPtr)) -= *(ArgStackPtr-1);
ArgStackPtr -= 2;
}
-defcode("b!", bytestore, 0, &substore){
+defcode("b!", bytestore, 0, 0, &substore){
*((char*)*(ArgStackPtr)) = (char)*(ArgStackPtr-1);
ArgStackPtr -= 2;
}
-defcode("b@", bytefetch, 0, &bytestore){
+defcode("b@", bytefetch, 0, 0, &bytestore){
*(ArgStackPtr) = *((char*)*(ArgStackPtr));
}
-defcode("b@b!", bytecopy, 0, &bytefetch){
+defcode("b@b!", bytecopy, 0, 0, &bytefetch){
}
-defcode("bmove", bytemove, 0, &bytecopy){
+defcode("bmove", bytemove, 0, 0, &bytecopy){
+}
+
+/* Control Flow Words
+ *****************************************************************************/
+defcode("if", _if, 1, 0, &bytemove){
+ // : IF IMMEDIATE
+ // ' 0BRANCH , \ compile 0BRANCH
+ // HERE @ \ save location of the offset on the stack
+ // 0 , \ compile a dummy offset
+ // ;
+}
+
+defcode("then", _then, 1, 0, &_if){
+ // : THEN IMMEDIATE
+ // DUP
+ // HERE @ SWAP - \ calculate the offset from the address saved on the stack
+ // SWAP ! \ store the offset in the back-filled location
+ // ;
+}
+
+defcode("else", _else, 1, 0, &_then){
+ // : ELSE IMMEDIATE
+ // ' BRANCH , \ definite branch to just over the false-part
+ // HERE @ \ save location of the offset on the stack
+ // 0 , \ compile a dummy offset
+ // SWAP \ now back-fill the original (IF) offset
+ // DUP \ same as for THEN word above
+ // HERE @ SWAP -
+ // SWAP !
+ // ;
+}
+
+/* Debugging Words
+ *****************************************************************************/
+defcode("printw", printw, 0, 0, &_else){
+ word_t* word = (word_t*)*(ArgStackPtr);
+ long* bytecode = word->code;
+ ArgStackPtr--;
+
+ printf("Name: %s\n", word->name);
+ //printf("Flags: 0x%lX\n", word->flags);
+ if (word->codeword == &docolon)
+ {
+ puts("CodeFn: docolon");
+ puts("Bytecode:");
+ while(*bytecode)
+ {
+ printf("\t%s\n", ((word_t*) *bytecode)->name);
+ bytecode++;
+ }
+ printf("\tret\n");
+ }
+ else
+ {
+ printf("CodeFn: 0x%lX\n",(long)word->codeword);
+ printf("Bytecode: (native)\n");
+ }
+}
+
+defcode("printallw", printallw, 0, 0, &printw){
+ const word_t* word = (word_t*)latest_val;
+ while(word)
+ {
+ puts(word->name);
+ word = word->link;
+ }
+}
+
+defcode("printdefw", printdefw, 0, 0, &printallw){
+ const word_t* word = (word_t*)latest_val;
+ while(word != &printdefw)
+ {
+ printf("%s\t%lu %lu",
+ word->name,
+ word->flags.f_immed,
+ word->flags.f_hidden);
+ word = word->link;
+ }
}
/* Main
*****************************************************************************/
+static void run_tests(void);
+
int main(int argc, char** argv)
{
+ run_tests();
ArgStackPtr = ArgStack - 1;
- latest_val = (long)&bytemove;
+ latest_val = (long)&printdefw;
EXEC(quit);
return 0;
}
+/* Unit Tests
+ *****************************************************************************/
+static char* Current_Test_Desc;
+
+#define TEST(desc) \
+ Current_Test_Desc = desc; \
+ test_setup(); \
+ for(int i=0; i == 0; i++)
+
+#define CHECK(expr) \
+ if (!(expr)) { \
+ test_setup(); \
+ printf(__FILE__ ":%d:0:FAIL:%s\n\t" #expr "\n", __LINE__-1, Current_Test_Desc); \
+ continue; \
+ }
+
+static void test_setup(void)
+{
+ ArgStackPtr = ArgStack - 1;
+ CodePtr = 0;
+ latest_val = (long)&printw;
+}
+
+static void run_tests(void) {
+ TEST("Expected 0 to be 1"){
+ CHECK(0 == 1);
+ }
+}
+
projects / proto / sclpl.git / commitdiff