Created
March 22, 2024 18:49
-
-
Save lpereira/2f765fae7289e5cfc657f90d1251f8d6 to your computer and use it in GitHub Desktop.
FINF Is Not Forth!
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
/* | |
* FINF 0.1.5a (21 Jul 2005) https://tia.mat.br/ | |
* | |
* Interpreter for the "finf" (finf is not forth) language | |
* Copyright (C) 2005 L. A. F. Pereira <[email protected]> | |
* | |
* This program is free software; you can redistribute it and/or modify | |
* it under the terms of the GNU General Public License as published by | |
* the Free Software Foundation, version 2. | |
* | |
* This program is distributed in the hope that it will be useful, | |
* but WITHOUT ANY WARRANTY; without even the implied warranty of | |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
* GNU General Public License for more details. | |
* | |
* You should have received a copy of the GNU General Public License | |
* along with this program; if not, write to the Free Software | |
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
* | |
* -------------------------------------------------------------------------- | |
* | |
* Version History: | |
* 0.1 01/04/05 * First release | |
* 0.1.1 15/04/05 * Added variables (store/recall) | |
* * Started working on IF...ELSE...THEN construct | |
* 0.1.2 18/04/05 * Implemented IF...ELSE...THEN | |
* * Added support to multi-line word definitions | |
* * Fixed some parser bugs | |
* * Change OP_PRINTCHR word to "emit", as ":" would | |
* conflict with the word defining character. This | |
* is more Forth-like, too | |
* 0.1.3 20/04/05 * Added "dump" word (dumps program memory and word | |
* map) | |
* * Fixed more parser bugs | |
* 21/04/05 * program_dump() now produces better output | |
* * More parser bugs fixed | |
* * Forgot to rename OP_PRINTCHR to OP_EMIT. Oops | |
* * Implemented OP_MOD '%' (division remainder) | |
* 0.1.4 24/04/05 * Added words "exit", "recurse" and "nip" | |
* * Implemented "begin...until" loop | |
* 0.1.4x 25/04/05 * Fixed "begin...until" loop | |
* * Fixed stack_show() | |
* * Renamed ifstack/ic/if_push/if_pop to | |
* ctrlstack/cc/ctrl_push, ctrl_pop | |
* * Removed OP_BEGIN, as it's not needed | |
* 0.1.5 09/04/05 * Reworked some of the parser logic; can't redefine | |
* "opcode" words now | |
* * Disabled program_dump() (needs a rewrite) | |
* 0.1.5a 21/07/05 * Rewrote program_dump() | |
* * Table lookups are still slow... | |
*/ | |
#include <stdio.h> | |
#include <stdlib.h> | |
#include <string.h> | |
#include <ctype.h> | |
/* | |
*---------------------------------------------------------------------------- | |
* Type Definition | |
*---------------------------------------------------------------------------- | |
*/ | |
typedef struct _Program Program; | |
typedef struct _Word Word; | |
typedef union _WordOpcodeEntry WordOpcodeEntry; | |
typedef enum { | |
OP_NUM, OP_SUM, OP_SUB, OP_MUL, | |
OP_DIV, OP_DUP, OP_OVER, OP_DROP, | |
OP_ROT, OP_SWAP, OP_PRINT, OP_EMIT, | |
OP_EQUAL, OP_GREATER, OP_LESSER, OP_NOT, | |
OP_RET, OP_CALL, OP_PICK, OP_SP0, | |
OP_MIN, OP_MAX, OP_ABS, OP_NEG, | |
OP_SHOWSTACK, OP_STORE, OP_RECALL, OP_IF, | |
OP_ELSE, OP_THEN, OP_DUMP, OP_MOD, | |
OP_UNTIL, OP_NIP | |
} Opcode; | |
typedef enum { | |
WT_USER, WT_OPCODE | |
} WordType; | |
union _WordOpcodeEntry { | |
Opcode opcode; | |
int entry; | |
}; | |
struct _Word { | |
char *name; | |
WordType t; | |
WordOpcodeEntry p; | |
}; | |
struct _Program { | |
Opcode opcode; | |
int param; | |
}; | |
/* | |
*---------------------------------------------------------------------------- | |
* Macros, maximum values, etc | |
*---------------------------------------------------------------------------- | |
*/ | |
#define WORD_OPCODE(w) w.p.opcode | |
#define WORD_ENTRY(w) w.p.entry | |
#define WORD_IS_OPCODE(w) (w.t == WT_OPCODE) | |
#define MAX_WORDS 256 | |
#define MAX_PROGRAM 2048 | |
#define MAX_STACK 512 | |
#define MAX_CTRLSTACK 32 | |
#define MAX_VARS 32 | |
/* | |
*---------------------------------------------------------------------------- | |
* Global Variables | |
*---------------------------------------------------------------------------- | |
*/ | |
Program program[MAX_PROGRAM]; | |
Word words[MAX_WORDS]; | |
int pc /* program counter */, | |
pc_max /* progam size */, | |
wc /* word count */, | |
sp /* stack pointer */, | |
stack[MAX_STACK] /* data stack */, | |
vars[MAX_VARS] /* variables */, | |
ctrlstack[MAX_CTRLSTACK] /* ctrl stack */, | |
cc; /* ctrl stack counter */ | |
/* | |
*---------------------------------------------------------------------------- | |
*/ | |
/* control stack */ | |
void inline ctrl_push(int param) | |
{ | |
ctrlstack[++cc] = param; | |
if (cc > MAX_CTRLSTACK) { | |
puts("Control stack overflow"); | |
exit(1); | |
} | |
} | |
int inline ctrl_pop(void) | |
{ | |
return ctrlstack[cc--]; | |
} | |
/* data stack */ | |
void inline stack_push(int value) | |
{ | |
stack[++sp] = value; | |
if (sp > MAX_STACK) { | |
puts("Stack overflow"); | |
exit(1); | |
} | |
} | |
int inline stack_pop(void) | |
{ | |
return stack[sp--]; | |
} | |
/* numbers */ | |
int inline max(int a, int b) | |
{ | |
return (a > b) ? a : b; | |
} | |
int inline min(int a, int b) | |
{ | |
return (a < b) ? a : b; | |
} | |
int inline abs(int a) | |
{ | |
return (a < 0) ? -a : a; | |
} | |
/* inserts a new word into the dictionary */ | |
int inline word_new(char *name) | |
{ | |
if (++wc >= MAX_WORDS) | |
return -1; | |
words[wc].name = name; | |
words[wc].t = WT_USER; | |
words[wc].p.entry = pc; | |
return wc; | |
} | |
/* inserts a new opcode-word into the dictionary */ | |
int inline word_new_opcode(char *name, Opcode opcode) | |
{ | |
if (++wc >= MAX_WORDS) | |
return -1; | |
words[wc].name = name; | |
words[wc].t = WT_OPCODE; | |
words[wc].p.opcode = opcode; | |
return wc; | |
} | |
/* init default word dictionary */ | |
void word_init(void) | |
{ | |
static struct { | |
char *name; | |
Opcode opcode; | |
} default_words[] = { | |
{ "+", OP_SUM }, | |
{ "-", OP_SUB }, | |
{ "*", OP_MUL }, | |
{ "/", OP_DIV }, | |
{ ".", OP_PRINT }, | |
{ "=", OP_EQUAL }, | |
{ ">", OP_GREATER }, | |
{ "<", OP_LESSER }, | |
{ "!", OP_STORE }, | |
{ "@", OP_RECALL }, | |
{ "nip", OP_NIP }, | |
{ "sp0", OP_SP0 }, | |
{ "min", OP_MIN }, | |
{ "max", OP_MAX }, | |
{ "abs", OP_ABS }, | |
{ "dup", OP_DUP }, | |
{ "rot", OP_ROT }, | |
{ "not", OP_NOT }, | |
{ "mod", OP_MOD }, | |
{ "exit", OP_RET }, | |
{ "dump", OP_DUMP }, | |
{ "over", OP_OVER }, | |
{ "drop", OP_DROP }, | |
{ "swap", OP_SWAP }, | |
{ "emit", OP_EMIT }, | |
{ "pick", OP_PICK }, | |
{ "negate", OP_NEG }, | |
{ "showstack", OP_SHOWSTACK }, | |
{ NULL, 0 } | |
}; | |
int i; | |
for (i = 0; i < MAX_WORDS; i++) { | |
words[i].name = NULL; | |
words[i].p.opcode = 0; | |
} | |
for (i = 0; default_words[i].name != NULL; i++) { | |
word_new_opcode(default_words[i].name, default_words[i].opcode); | |
} | |
} | |
/* given an id, returns the word's name or 'nil' if invalid */ | |
char inline *word_get_name(int id) | |
{ | |
return (id > wc) ? "nil" : words[id].name; | |
} | |
int inline word_get_id(char *name) | |
{ | |
int i; | |
for (i = wc; i >= 0; i--) { | |
if (!strcmp(name, words[i].name)) | |
return i; | |
} | |
return -1; | |
} | |
/* given a pc, return the word id or -1 */ | |
int inline word_get_id_from_pc(int pc) | |
{ | |
int i; | |
for (i = wc; i >= 0; i--) { | |
if (WORD_ENTRY(words[i]) == pc) { | |
return i; | |
} | |
} | |
return -1; | |
} | |
/* given a opcode, return the word id */ | |
int inline word_get_id_from_opcode(Opcode opcode) | |
{ | |
int i; | |
for (i = wc; i >= 0; i--) { | |
if (WORD_IS_OPCODE(words[i]) && words[i].p.opcode == opcode) { | |
return i; | |
} | |
} | |
return -1; | |
} | |
/* swap the two topmost items in stack */ | |
void inline stack_swap(void) | |
{ | |
int tmp, idx = sp - 1; | |
tmp = stack[sp]; | |
stack[sp] = stack[idx]; | |
stack[idx] = tmp; | |
} | |
/* prints the stack */ | |
void stack_show(void) | |
{ | |
int i; | |
printf("Stack [sp=%d]: ", sp); | |
for (i = 0; i <= sp; i++) { | |
printf("%d ", stack[i]); | |
} | |
putchar('\n'); | |
} | |
/* appends code to the program memory */ | |
void inline append_code(Opcode opcode, int param) | |
{ | |
program[pc].opcode = opcode; | |
program[pc++].param = param; | |
} | |
/* dumps program (disasm?) and word map */ | |
void program_dump(void) | |
{ | |
int i; | |
printf("\nPC Opcode\n"); | |
for (i = 0; i <= pc; i++) { | |
printf("%8d ", i); | |
switch (program[i].opcode) { | |
case OP_NUM: | |
printf("num (%d)", program[i].param); | |
break; | |
case OP_IF: | |
printf("if (%d)", program[i].param); | |
break; | |
case OP_ELSE: | |
printf("else (%d)", program[i].param); | |
break; | |
case OP_THEN: | |
printf("then (%d)", program[i].param); | |
break; | |
case OP_CALL: | |
printf("call (%d)", program[i].param); | |
break; | |
case OP_UNTIL: | |
printf("until (%d)", program[i].param); | |
break; | |
default: | |
{ | |
int wid = word_get_id_from_opcode(program[i].opcode); | |
printf("%s", words[wid].name); | |
} | |
} | |
putchar('\n'); | |
} | |
printf("\nWord Map\n"); | |
for (i = 0; i < MAX_WORDS; i++) { | |
if (!WORD_IS_OPCODE(words[i]) && words[i].name) | |
printf("%4d %s\n", i, words[i].name); | |
} | |
} | |
#define PARSE_ERROR(msg,...) \ | |
{ fprintf(stderr, "*** Line %d: Parse Error: " msg "\n", line, ##__VA_ARGS__); return 0; } | |
#define COMPILE_ERROR(msg,...) \ | |
{ fprintf(stderr, "*** Line %d: Compile Error: " msg "\n", line, ##__VA_ARGS__); return 0; } | |
/* opens file 'progname', parses it, and fill all structures */ | |
int program_open(char *progname) | |
{ | |
FILE *prog; | |
char buffer[256]; | |
const char delimiters[] = " \t\r\n"; | |
int line = 0, in_word = 0, this_word = 0; | |
prog = fopen(progname, "r"); | |
if (!prog) { | |
/* error while opening progname */ | |
return 0; | |
} | |
while (fgets(buffer, 256, prog)) { | |
line++; /* for error messages */ | |
if (buffer[0] == '#') /* comments */ | |
continue; | |
if (buffer[0] == ':' || in_word) { /* word definition */ | |
char *tmp, *word, *code, *token; | |
int wlen; | |
if (buffer[0] == ':') { | |
/* defining a new word */ | |
if (in_word) | |
alreadyDefining: | |
PARSE_ERROR | |
("Defining a new word while previous not fully " | |
"defined"); | |
in_word = 1; | |
/* finds the word name and its definition */ | |
tmp = buffer; | |
while (*tmp != ' ' && *tmp != '\t' && *tmp != '\n' && | |
*tmp != '\r' && *tmp) | |
tmp++; | |
*tmp = 0; | |
word = buffer + 1; | |
wlen = strlen(word); | |
code = buffer + wlen + 2; | |
/* can't define a word with an empty name */ | |
if (wlen == 0) | |
PARSE_ERROR("Missing word name"); | |
/* can't redefine a word */ | |
if (word_get_id(word) != -1) | |
COMPILE_ERROR("``%s'' already defined", word); | |
/* register a new word */ | |
if ((this_word = word_new(strdup(word))) == -1) | |
COMPILE_ERROR("Maximum number of words reached"); | |
tmp = code; | |
} else { | |
/* continue word definition (multi-line words) */ | |
tmp = buffer; | |
} | |
/* parse its definition */ | |
while ((token = strtok(tmp, delimiters))) { | |
tmp = NULL; | |
if (isdigit(*token) || (*token == '-' && isdigit(*(token + 1)))) { | |
append_code(OP_NUM, atoi(token)); | |
/* | |
* IF parameter should be the ``pc'' of the next ELSE or THEN. | |
* ELSE should be the same, but with the next THEN's ``pc''. | |
*/ | |
} else if (!strcmp(token, "if")) { | |
ctrl_push(pc); | |
append_code(OP_IF, 0); /* we'll change this later */ | |
} else if (!strcmp(token, "else")) { | |
program[ctrl_pop()].param = pc; /* change last if's param */ | |
ctrl_push(pc); | |
append_code(OP_ELSE, 0); /* we'll change this later */ | |
} else if (!strcmp(token, "then")) { | |
program[ctrl_pop()].param = pc; /* change last else or if's param */ | |
append_code(OP_THEN, 0); | |
} else if (!strcmp(token, "begin")) { | |
ctrl_push(pc); | |
} else if (!strcmp(token, "until")) { | |
append_code(OP_UNTIL, ctrl_pop()); | |
} else if (!strcmp(token, ":")) { | |
goto alreadyDefining; | |
} else if (!strcmp(token, ";")) { | |
/* | |
* cc should be the same as we initialized; | |
* if it's different we have an open control | |
* structure somewhere | |
*/ | |
if (cc != -1) | |
COMPILE_ERROR("``if'' without ``then'' or " | |
"``begin'' without ``until''"); | |
append_code(OP_RET, 0); | |
in_word = 0; | |
} else { | |
int iid = word_get_id(token); | |
if (iid == -1) | |
COMPILE_ERROR("Undefined reference to ``%s''", | |
token); | |
if WORD_IS_OPCODE(words[iid]) { | |
append_code(words[iid].p.opcode, 0); | |
} else { | |
/* allow recursion, too */ | |
append_code(OP_CALL, | |
(iid == this_word) ? this_word : iid); | |
} | |
} | |
} | |
} else { | |
/* blank lines are accepted; everything else not */ | |
char blank = 1; | |
char *token = buffer; | |
while (*token++) { | |
if (*token == ' ' || *token == '\t') { | |
blank = 1; | |
} else if (*token == '\n' || *token == 0) { | |
break; | |
} else { | |
blank = 0; | |
break; | |
} | |
} | |
if (!blank) | |
PARSE_ERROR("Unrecognized token: ``%s''", buffer); | |
} | |
} | |
fclose(prog); | |
pc_max = pc; | |
return 1; | |
} | |
#undef PARSE_ERROR | |
/* main interpreter routine */ | |
#define CALL_PUSH(word_id) call_stack[++cs] = pc; pc = words[word_id].p.entry | |
#define CALL_POP() call_stack[cs--] | |
int program_main(void) | |
{ | |
int wid, tmp; | |
int call_stack[256], cs = 0; | |
/* initializes if stack counter */ | |
cc = -1; | |
/* finds entry point, abort if not defined */ | |
if ((wid = word_get_id("main")) == -1) { | |
program_dump(); | |
printf("*** Entry point ``main'' not found. Aborting.\n"); | |
return 0; | |
} | |
/* FIXME: Reorder this switch() so the compiler can create a jump table */ | |
/* begin executing if found */ | |
CALL_PUSH(wid); /* pushes "main" wid to the call stack */ | |
for (;; pc++) { | |
re: | |
switch (program[pc].opcode) { | |
case OP_STORE: vars[stack_pop()] = stack_pop(); break; | |
case OP_RECALL: stack_push(vars[stack_pop()]); break; | |
case OP_DUMP: program_dump(); break; | |
case OP_SHOWSTACK: stack_show(); break; | |
case OP_SP0: sp = -1; break; | |
case OP_DROP: sp--; break; | |
case OP_NEG: stack_push(-stack_pop()); break; | |
case OP_ABS: stack_push(abs(stack_pop())); break; | |
case OP_MIN: stack_push(min(stack_pop(), stack_pop())); break; | |
case OP_MAX: stack_push(max(stack_pop(), stack_pop())); break; | |
case OP_PICK: stack_push(stack[sp - stack_pop()]); break; | |
case OP_NOT: stack_push(!stack_pop()); break; | |
case OP_EQUAL: stack_push(stack_pop() == stack_pop()); break; | |
case OP_GREATER: stack_push(stack_pop() > stack_pop()); break; | |
case OP_LESSER: stack_push(stack_pop() < stack_pop()); break; | |
case OP_OVER: stack_push(stack[sp - 1]); break; | |
case OP_ROT: stack_push(stack[sp - 2]); break; | |
case OP_SUM: stack_push(stack_pop() + stack_pop()); break; | |
case OP_MUL: stack_push(stack_pop() * stack_pop()); break; | |
case OP_DUP: stack_push(stack[sp]); break; | |
case OP_NUM: stack_push(program[pc].param); break; | |
case OP_SWAP: stack_swap(); break; | |
case OP_PRINT: printf("%d", stack_pop()); break; | |
case OP_EMIT: putchar((char) stack_pop()); break; | |
case OP_CALL: CALL_PUSH(program[pc].param); goto re; | |
case OP_NIP: | |
stack_swap(); | |
sp--; | |
break; | |
case OP_SUB: | |
tmp = stack_pop(); | |
stack_push(stack_pop() - tmp); | |
break; | |
case OP_DIV: | |
tmp = stack_pop(); | |
stack_push(stack_pop() / tmp); | |
break; | |
case OP_MOD: | |
tmp = stack_pop(); | |
stack_push(stack_pop() % tmp); | |
break; | |
case OP_RET: | |
pc = CALL_POP() + 1; | |
if (cs == 0) { | |
/* returned from main (program finished) */ | |
putchar('\n'); | |
return 0; | |
} | |
goto re; | |
case OP_UNTIL: | |
if (stack_pop()) | |
pc = program[pc].param; /* jump to "BEGIN" if true */ | |
break; | |
case OP_IF: | |
if (stack_pop()) { | |
ctrl_push(1); /* push a true value into if stack */ | |
} else { | |
pc = program[pc].param; /* jump to else or then */ | |
ctrl_push(0); /* push a false value into if stack */ | |
} | |
break; | |
case OP_ELSE: | |
if (ctrl_pop()) /* last if was true; jump to 'then' | |
(we're finished with this control | |
structure) */ | |
pc = program[pc].param; | |
cc++; | |
break; | |
case OP_THEN: | |
cc--; | |
break; | |
default: | |
/* TODO: Dump stack, registers, etc... */ | |
puts("Invalid opcode or opcode not implemented."); | |
return 1; | |
} | |
} | |
} | |
#undef CALL_PUSH | |
#undef CALL_POP | |
int main(int argc, char **argv) | |
{ | |
/* initialization */ | |
pc = 0; | |
wc = sp = cc = -1; | |
/* default word dictionary */ | |
word_init(); | |
/* opens 'prog.f' by default */ | |
if (!program_open(argc >= 2 ? argv[1] : "prog.f")) { | |
return 1; | |
} | |
/* program_dump() used to be called here; now it can | |
be called whenever the programmer needs, by using | |
the built-in word "dump" */ | |
return program_main(); | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment