#include #include #include #include #include #define TFOBJ_TYPE_INT 0 #define TFOBJ_TYPE_STR 1 #define TFOBJ_TYPE_BOOL 2 #define TFOBJ_TYPE_LIST 3 #define TFOBJ_TYPE_SYMBOL 4 #define TFOBJ_TYPE_ALL 255 // Used by listPop() and other functions #define TF_ERR 1 #define TF_OK 0 /* ############################# Data Structures ########################################## */ typedef struct tfobj { int refcount; int type; // TFOBJ_TYPE_* union { int i; struct { char *ptr; size_t len; int quoted; } str; struct { struct tfobj **ele; size_t len; } list; }; } tfobj; typedef struct tfparser { char *prg; // The program to compile into a list. char *p; // Next token to parse. } tfparser; /* Function table entry: each of this entry represents a symbol name * associated with a function implementation. */ struct tfctx; typedef struct FunctionTableEntry { tfobj *name; int (*callback)(struct tfctx *ctx, char *name); tfobj *user_func; } tffuncentry; struct FunctionTable { tffuncentry **func_table; size_t func_count; }; /* Our execution context. */ typedef struct tfctx { tfobj *stack; struct FunctionTable functable; } tfctx; /* ############################# Function Prototypes #################################### */ void retain(tfobj *o); void release(tfobj *o); int basicMathFunctions(tfctx *ctx, char *name); /* ############################# Allocations wrappers ################################### */ void *xmalloc(size_t size) { void *ptr = malloc(size); if (ptr == NULL) { fprintf(stderr, "Out of memory allocating %zu bytes", size); exit(1); } return ptr; } void *xrealloc(void *oldptr, size_t size) { void *ptr = realloc(oldptr, size); if (ptr == NULL) { fprintf(stderr, "Out of memory allocating %zu bytes", size); exit(1); } return ptr; } /* ######################### Object related functions ################################### * The following functions allocate ToyForth objects of different types. */ /*Allocate and initialize a new Toy Forth object. */ tfobj *createObject(int type) { tfobj *o = xmalloc(sizeof(tfobj)); o->type = type; o->refcount = 1; return o; } tfobj *createIntObject(int i) { tfobj *obj = createObject(TFOBJ_TYPE_INT); obj->i = i; return obj; } tfobj *createBoolObject(int b) { tfobj *obj = createObject(TFOBJ_TYPE_BOOL); obj->i = b; return obj; } /* Free an object and all the other nested objects. */ void freeObject(tfobj *obj) { switch (obj->type) { case TFOBJ_TYPE_LIST: for (size_t j = 0; j < obj->list.len; j++) { tfobj *ele = obj->list.ele[j]; release(ele); } break; case TFOBJ_TYPE_SYMBOL: case TFOBJ_TYPE_STR: free(obj->str.ptr); break; } free(obj); } void retain(tfobj *obj) { obj->refcount++; } void release(tfobj *obj) { assert(obj->refcount > 0); obj->refcount--; if (obj->refcount == 0) freeObject(obj); } void printObject(tfobj *obj) { switch (obj->type) { case TFOBJ_TYPE_INT: printf("%d", obj->i); break; case TFOBJ_TYPE_LIST: printf("["); for (size_t j = 0; j < obj->list.len; j++) { tfobj *o = obj->list.ele[j]; printObject(o); if (j != o->list.len - 1) printf(" "); } printf("]"); break; case TFOBJ_TYPE_STR: printf("\"%s\"", obj->str.ptr); break; case TFOBJ_TYPE_SYMBOL: printf("%s", obj->str.ptr); break; default: printf("?"); break; } } /* ############################ String Object ########################################## */ tfobj *createStringObject(char *s, size_t len) { tfobj *obj = createObject(TFOBJ_TYPE_STR); obj->str.ptr = xmalloc(len + 1); obj->str.len = len; memcpy(obj->str.ptr, s, len); obj->str.ptr[len] = 0; return obj; } tfobj *createSymbolObject(char *s, size_t len) { tfobj *obj = createStringObject(s, len); obj->type = TFOBJ_TYPE_SYMBOL; return obj; } /* Compare the two string objects 'a' and 'b', returns 0 if they are * the same, '1' if a > b , '-1' if a < b. * The comparison is performed using memcmp(). */ int compareStringObject(tfobj *a, tfobj *b) { size_t minlen = a->str.len < b->str.len ? a->str.len : b->str.len; int cmp = memcmp(a->str.ptr, b->str.ptr, minlen); if (cmp == 0) { if (a->str.len == b->str.len) return 0; else if (a->str.len > b->str.len) return 1; else return -1; } else { if (cmp < 0) return -1; else return 1; } } /* ############################ List Object ############################################ */ tfobj *createListObject(void) { tfobj *obj = createObject(TFOBJ_TYPE_LIST); obj->list.ele = NULL; obj->list.len = 0; return obj; } tfobj *listPopType(tfctx *ctx, int type) { tfobj *stack = ctx->stack; if (stack->list.len == 0) return NULL; tfobj *to_pop = stack->list.ele[stack->list.len - 1]; if (type != TFOBJ_TYPE_ALL && to_pop->type != type) return NULL; stack->list.len--; if (stack->list.len == 0) { free(stack->list.ele); stack->list.ele = NULL; } else { stack->list.ele = xrealloc(stack->list.ele, sizeof(tfobj *) * (stack->list.len)); } return to_pop; } tfobj *listPop(tfctx *ctx) { return listPopType(ctx, TFOBJ_TYPE_ALL); } /* Add the new element at the end of the 'list'. * It is up to the caller to increment the reference count of the * element added to the list, if needed. */ void listPush(tfobj *l, tfobj *ele) { l->list.ele = xrealloc(l->list.ele, sizeof(tfobj *) * (l->list.len + 1)); l->list.ele[l->list.len] = ele; l->list.len++; } /* ####################### Turn program into toy forth list ############################ */ void parseSpaces(tfparser *parser) { while (isspace(parser->p[0])) parser->p++; } #define MAX_NUM_LEN 128 tfobj *parseNumber(tfparser *parser) { char buf[MAX_NUM_LEN]; char *start = parser->p; char *end; if (parser->p[0] == '-') parser->p++; while (parser->p[0] && isdigit(parser->p[0])) parser->p++; end = parser->p; int numLen = end - start; if (numLen >= MAX_NUM_LEN) return NULL; memcpy(buf, start, numLen); buf[numLen] = 0; tfobj *obj = createIntObject(atoi(buf)); return obj; } /* Return true if the character 'c' is one of the characters * acceptable for our symbols. */ int isSymbolChar(int c) { char symchars[] = "+-*/%"; return isalpha(c) || strchr(symchars, c) != NULL; } tfobj *parseSymbol(tfparser *parser) { char *start = parser->p; while (parser->p[0] && isSymbolChar(parser->p[0])) parser->p++; int len = parser->p - start; return createSymbolObject(start, len); } tfobj *compile(char *prg) { tfparser parser; parser.prg = prg; parser.p = prg; tfobj *parsed = createListObject(); while (parser.p) { tfobj *obj; char *token_start = parser.p; parseSpaces(&parser); if (parser.p[0] == 0) break; // End of program reached. if (isdigit(parser.p[0]) || (parser.p[0] == '-' && isdigit(parser.p[1]))) { obj = parseNumber(&parser); } else if (isSymbolChar(parser.p[0])) { obj = parseSymbol(&parser); } else { obj = NULL; } // Check if the current token produced a parsing error. if (obj == NULL) { release(parsed); printf("Syntax error near: %32s ...\n", token_start); return NULL; } else { listPush(parsed, obj); } } return parsed; } int ctxCheckStackMinLen(tfctx *ctx, size_t min) { return (ctx->stack->list.len < min) ? TF_ERR : TF_OK; } /* Pop the top element from the interpreter main stack, assuming it * will match 'type', otherwise NULL is returned. Also the function * returns NULL if the stack is empty. * * The reference counting of the popped object is not modified: it * is assumed that we just transfer the ownership from stack to * the caller. */ tfobj *ctxStackPop(tfctx *ctx, int type) { return listPopType(ctx, type); } /* Just push the object on the interpreter main stack */ void ctxStackPush(tfctx *ctx, tfobj *obj) { listPush(ctx->stack, obj); } /* ############################# Execution and context ################################## */ /* Resolve the function scanning the function table looking for a matching * name. If a matching function was not found, NULL is returned, otherwise * the function returns the function entry object. */ tffuncentry *getFunctionByName(tfctx *ctx, tfobj *name) { for (size_t j = 0; j < ctx->functable.func_count; j++) { tffuncentry *fe = ctx->functable.func_table[j]; if (compareStringObject(fe->name, name) == 0) return fe; } return NULL; } /* Push a new function entry in the context. It's up to the caller * to set either the C callback or the list representing the user * defined function */ tffuncentry *registerFunction(tfctx *ctx, tfobj *name) { ctx->functable.func_table = xrealloc(ctx->functable.func_table, sizeof(tffuncentry *) * ctx->functable.func_count + 1); tffuncentry *fe = xmalloc(sizeof(tffuncentry)); ctx->functable.func_table[ctx->functable.func_count] = fe; ctx->functable.func_count++; fe->name = name; retain(name); fe->callback = NULL; fe->user_func = NULL; return fe; } /* Register a new function with the given name in the function table * of the context. The function can't fail since if a function with the * same name already exist, it gets replaced by the new one. */ void registerCFunction(tfctx *ctx, char *name, int (*callback)(tfctx *ctx, char *name)) { tffuncentry *fe; tfobj *oname = createStringObject(name, strlen(name)); fe = getFunctionByName(ctx, oname); if (fe) { if (fe->user_func) { release(fe->user_func); fe->user_func = NULL; } fe->callback = callback; } else { fe = registerFunction(ctx, oname); fe->callback = callback; } release(oname); } tfctx *createContext(void) { tfctx *ctx = xmalloc(sizeof(*ctx)); ctx->stack = createListObject(); ctx->functable.func_table = NULL; ctx->functable.func_count = 0; registerCFunction(ctx, "+", basicMathFunctions); return ctx; } /* Try to resolve and call the function associated with the symbol * name 'word'. Return 0 if the symbol was actually bound to some * function and was executed, return 1 otherwise (on error). */ int callSymbol(tfctx *ctx, tfobj *word) { tffuncentry *fe = getFunctionByName(ctx, word); if (fe == NULL) return TF_ERR; if (fe->user_func) { // TODO return TF_ERR; } else { return fe->callback(ctx, fe->name->str.ptr); } return TF_OK; } /* Execute the Toy Forth program stored into the list 'prg'. */ int exec(tfctx *ctx, tfobj *prg) { assert(prg->type == TFOBJ_TYPE_LIST); for (size_t j = 0; j < prg->list.len; j++) { tfobj *word = prg->list.ele[j]; switch (word->type) { case TFOBJ_TYPE_SYMBOL: if (callSymbol(ctx, word) == TF_ERR) { printf("Runtime error\n"); return TF_ERR; } break; default: ctxStackPush(ctx, word); retain(word); break; } } return TF_OK; } /* ############################# Basic Standard Library ################################# */ int basicMathFunctions(tfctx *ctx, char *name) { if (ctxCheckStackMinLen(ctx, 2)) return TF_ERR; tfobj *b = ctxStackPop(ctx, TFOBJ_TYPE_INT); if (b == NULL) return TF_ERR; tfobj *a = ctxStackPop(ctx, TFOBJ_TYPE_INT); if (a == NULL) { ctxStackPush(ctx, b); return TF_ERR; } int result = a->i + b->i; switch (name[0]) { case '+': result = a->i + b->i; break; case '-': result = a->i - b->i; break; case '*': result = a->i * b->i; break; } release(a); release(b); ctxStackPush(ctx, createIntObject(result)); return TF_OK; } /* ###################################### Main ############################################ */ int main(int argc, char **argv) { if (argc != 2) { fprintf(stderr, "Usage: %s \n", argv[0]); return 1; } // Read the program in memory, for later parsing. FILE *fp = fopen(argv[1], "r"); if (fp == NULL) { perror("Opening Toy Forth program"); return 1; } fseek(fp, 0, SEEK_END); long file_size = ftell(fp); char *prgtext = xmalloc(file_size + 1); fseek(fp, 0, SEEK_SET); fread(prgtext, file_size, 1, fp); prgtext[file_size] = 0; fclose(fp); // printf("Program text: \"%s\"\n", prgtext); tfobj *prg = compile(prgtext); printObject(prg); printf("\n"); tfctx *ctx = createContext(); exec(ctx, prg); printf("Stack content at end: "); printObject(ctx->stack); printf("\n"); return 0; }