FINF Is Not Forth!

finf.c

/*
 * 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 <l@tia.mat.br>
 *
 * 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();
}