/* $Header: /belch_a/users/rearl/tinymuck/src/RCS/compile.c,v 1.12 90/09/28 12:18:33 rearl Exp $ */
/*
* $Log: compile.c,v $
* Revision 1.12 90/09/28 12:18:33 rearl
* Fixed an ELSE bug, added shared program strings.
*
* Revision 1.11 90/09/18 07:53:40 rearl
* Took out redundant instructions; put primitives in a hash table.
*
* Revision 1.10 90/09/16 04:41:37 rearl
* Preparation code added for disk-based MUCK.
*
* Revision 1.9 90/09/12 08:59:21 rearl
* Added ELSE construct and quoted function handling with the EXECUTE
* instruction.
*
* Revision 1.8 90/08/27 03:19:57 rearl
* Changed P's to ?'s, added INSTR, RINSTR, OK?, TIME (tentative)
*
* Revision 1.7 90/08/11 03:50:46 rearl
* *** empty log message ***
*
* Revision 1.6 90/08/02 17:38:36 rearl
* *** empty log message ***
*
* Revision 1.5 90/07/29 23:44:45 rearl
* Added string primitives: strncmp, strcut, strlen.
*
* Revision 1.4 90/07/29 17:30:58 rearl
* Fixed compiler waning/error messages.
*
* Revision 1.3 90/07/23 14:52:00 casie
* *** empty log message ***
*
* Revision 1.2 90/07/21 13:14:13 casie
* ChupChups's changes checked in.
*
* Revision 1.1 90/07/19 23:02:12 casie
* Initial revision
*
*
*/
#include "copyright.h"
#include "config.h"
#include "db.h"
#include "interface.h"
#include "inst.h"
#include "externs.h"
#include <ctype.h>
/* This file contains code for doing "byte-compilation" of
mud-forth programs. As such, it contains many internal
data structures and other such which are not found in other
parts of TinyMUCK. */
/* The IF_STACK is a stack for holding previous IF statements.
Everytime a THEN is encountered, the next address is inserted
into the code before the most recent IF. */
static hash_tab primitive_list[COMP_HASH_SIZE];
struct IF_STACK
{
struct INTERMEDIATE *place;
struct IF_STACK *next;
} *if_stack;
/* This structure is an association list that contains both a procedure
name and the place in the code that it belongs. A lookup to the procedure
will see both it's name and it's number and so we can generate a
reference to it. Since I want to disallow co-recursion, I will not allow
forward referencing.
*/
struct PROC_LIST
{
const char *name;
struct INTERMEDIATE *code;
struct PROC_LIST *next;
} *procs;
/* The intermediate code is code generated as a linked list
when there is no hint or notion of how much code there
will be, and to help resolve all references.
There is always a pointer to the current word that is
being compiled kept. */
struct INTERMEDIATE
{
int no; /* which number instruction this is */
struct inst in; /* instruction itself */
struct INTERMEDIATE *next; /* next instruction */
};
static int nowords; /* number of words compiled */
static struct INTERMEDIATE *curr_word; /* word currently being compiled */
static struct INTERMEDIATE *first_word; /* first word of the list */
static struct INTERMEDIATE *curr_proc; /* first word of current procedure */
/* variable names. The index into variables give you what position
* the variable holds.
*/
static const char *variables[MAX_VAR] = { "ME", "LOC", "TRIGGER" };
static struct line *curr_line; /* current line */
static int lineno; /* current line number */
static const char *next_char; /* next char * */
static dbref player, program; /* globalized player and program */
/* 1 if error occured */
static int compile_err;
int primitive(const char *s); /* returns primitive_number if primitive */
void free_prog(struct inst *, int);
const char *next_token(void);
struct INTERMEDIATE *next_word(const char *);
struct INTERMEDIATE *process_special(const char *);
struct INTERMEDIATE *primitive_word(const char *);
struct INTERMEDIATE *string_word(const char *);
struct INTERMEDIATE *number_word(const char *);
struct INTERMEDIATE *object_word(const char *);
struct INTERMEDIATE *quoted_word(const char *);
struct INTERMEDIATE *call_word(const char *);
struct INTERMEDIATE *var_word(const char *);
const char *do_string(void);
void do_comment(void);
struct INTERMEDIATE *new_inst(void);
struct INTERMEDIATE *find_if(void);
void cleanup(void);
void add_proc(const char *, struct INTERMEDIATE *);
void addif(struct INTERMEDIATE *);
int add_variable(const char *);
int special(const char *);
int call(const char *);
int quoted(const char *);
int object(const char *);
int string(const char *);
int variable(const char *);
int get_primitive(const char *);
void copy_program(void);
void set_start(void);
char *line_copy = NULL;
int macrosubs; /* Safeguard for macro-subst. infinite loops */
/* Character defines */
#define BEGINCOMMENT '('
#define ENDCOMMENT ')'
#define BEGINSTRING '"'
#define ENDSTRING '"'
#define BEGINMACRO '.'
#define SUBSTITUTIONS 20 /* How many nested macros will we allow? */
char my__buf[BUFFER_LEN];
/* abort compile macro */
#define abort_compile(C) { \
sprintf(my__buf, "Error in line %d: %s",lineno,C); \
if (line_copy) { \
free ((void *) line_copy); \
line_copy = NULL; \
} if (FLAGS(player) & INTERACTIVE){ \
notify(player, my__buf); } \
else { \
log_muf("MUF compiler warning in program %d:\n%s\n", (int) program, my__buf); } \
cleanup(); \
compile_err++; \
free_prog(DBFETCH(program)->sp.program.code, \
DBFETCH(program)->sp.program.siz); \
return 0; }
/* for void functions */
#define v_abort_compile(C) { char _buf[BUFFER_LEN]; \
sprintf(_buf, "Error in line %d: %s",lineno,C); \
if (line_copy) { \
free ((void *) line_copy); \
line_copy = NULL; \
} if (FLAGS(player) & INTERACTIVE){ \
notify(player, _buf); } \
else { \
log_muf("MUF compiler warning in program %d:\n%s\n", (int) program, _buf); } \
cleanup(); \
compile_err++; \
free_prog(DBFETCH(program)->sp.program.code, \
DBFETCH(program)->sp.program.siz); \
(DBFETCH(program)->sp.program.code)= (struct inst *) 0; \
DBFETCH(program)->sp.program.siz=0; \
return; }
/* overall control code. Does piece-meal tokenization parsing and
backward checking. */
void
do_compile(dbref player_in, dbref program_in)
{
const char *token;
struct INTERMEDIATE *new_word;
/* set all global variables */
nowords = 0;
curr_word = first_word = curr_proc = 0;
player = player_in;
program = program_in;
lineno = 1;
curr_line = DBFETCH(program)->sp.program.first;
if (curr_line)
next_char = curr_line -> this_line;
first_word = curr_word = NULL;
procs = 0;
compile_err = 0;
if_stack = 0;
/* free old stuff */
free_prog(DBFETCH(program)->sp.program.code, DBFETCH(program)->sp.program.siz);
if (!curr_line)
v_abort_compile("Missing program text.");
/* do compilation */
while (token = next_token() )
{
new_word = next_word(token);
/* test for errors */
if (compile_err)
return;
if (new_word)
{
if (!first_word)
first_word = curr_word = new_word;
else
{
curr_word -> next = new_word;
curr_word = curr_word -> next;
}
}
while (curr_word && curr_word -> next)
curr_word = curr_word -> next;
free((void *) token);
}
if (curr_proc)
v_abort_compile("Unexpected end of file.");
if (!procs)
v_abort_compile("Missing procedure definition.");
/* do copying over */
copy_program();
if (compile_err)
return;
set_start();
cleanup();
}
struct INTERMEDIATE *
next_word(const char *token)
{
struct INTERMEDIATE *new_word;
char buf[BUFFER_LEN];
if (!token)
return 0;
if (special(token))
new_word = process_special(token);
else if (variable(token))
new_word = var_word(token);
else if (primitive(token))
new_word = primitive_word(token);
else if (string(token))
new_word = string_word(token + 1);
else if (number(token))
new_word = number_word(token);
else if (object(token))
new_word = object_word(token);
else if (quoted(token))
new_word = quoted_word(token + 1);
else if (call(token))
new_word = call_word(token);
else
{
sprintf(buf, "Unrecognized word %s.", token);
abort_compile(buf);
}
return new_word;
}
/* Little routine to do the line_copy handling right */
void advance_line()
{
curr_line = curr_line -> next;
lineno++;
macrosubs = 0;
if (line_copy) {
free ((void *) line_copy);
line_copy = NULL;
}
if (curr_line)
next_char = (line_copy = alloc_string(curr_line -> this_line));
else next_char = (line_copy = NULL);
}
/* Skips comments, grabs strings, returns NULL when no more tokens to grab. */
const char *
next_token()
{
char buf[BUFFER_LEN];
char *expansion, *temp;
int i;
if (!curr_line)
return (char *) 0;
if (!next_char)
return (char *) 0;
/* skip white space */
while (*next_char && isspace(*next_char))
next_char++;
if (!(*next_char))
{
advance_line();
if (!curr_line)
return (char *) 0;
else
return next_token();
}
/* take care of comments */
if (*next_char == BEGINCOMMENT)
{
do_comment();
return next_token();
}
if (*next_char == BEGINSTRING)
return do_string();
/* macro */
if (*next_char == BEGINMACRO) {
next_char++;
for (i = 0; *next_char && !isspace(*next_char); i++)
{
buf[i] = *next_char;
next_char++;
}
buf[i] = '\0';
if (!(expansion = (char *)macro_expansion(macrotop, buf))) {
abort_compile ("Macro not defined.");
} else {
if (++macrosubs > SUBSTITUTIONS) {
abort_compile ("Too many macro substitutions.");
} else {
temp = (char *) malloc(strlen(next_char) + strlen(expansion) + 21);
strcpy(temp, expansion);
strcat(temp, next_char);
free ((void *) expansion);
free ((void *) line_copy);
next_char = line_copy = temp;
return next_token();
}
}
}
/* ordinary token */
for (i = 0; *next_char && !isspace(*next_char); i++)
{
buf[i] = *next_char;
next_char++;
}
buf[i] = '\0';
return alloc_string(buf);
}
/* skip comments */
void
do_comment()
{
while (*next_char && *next_char != ENDCOMMENT)
next_char++;
if (!(*next_char))
{
advance_line();
if (!curr_line)
{
v_abort_compile("Unterminated comment.");
}
do_comment();
}
else {
next_char++;
if (!(*next_char)) advance_line();
}
}
/* return string */
const char *
do_string()
{
char buf[BUFFER_LEN];
int i = 0, quoted = 0;
buf[i] = *next_char;
next_char++;
i++;
while ((quoted || *next_char != ENDSTRING) && *next_char)
if (*next_char == '\\' && !quoted)
{ quoted++; next_char++; }
else {
buf[i] = *next_char;
i++; next_char++; quoted = 0;
}
if (!*next_char)
{
abort_compile("Unterminated string found at end of line.");
}
next_char++;
buf[i] = '\0';
return alloc_string(buf);
}
/* process special. Performs special processing.
It sets up FOR and IF structures. Remember --- for those,
we've got to set aside an extra argument space. */
struct INTERMEDIATE *
process_special(const char *token)
{
char buf[BUFFER_LEN];
const char *tok;
struct INTERMEDIATE *new;
if (!string_compare(token, ":"))
{
const char *proc_name;
if (curr_proc)
abort_compile("Definition within definition.");
proc_name = next_token();
if (!proc_name)
abort_compile("Unexpected end of file within procedure.");
tok = next_token();
new = next_word(tok);
if (tok)
free((void *) tok);
if (!new)
{
sprintf(buf, "Error in definition of %s.", proc_name);
abort_compile(buf);
}
curr_proc = new;
add_proc(proc_name, new);
return new;
}
else if (!string_compare(token, ";"))
{
if (if_stack)
abort_compile("Unexpected end of procedure definition.");
if (!curr_proc)
abort_compile("Procedure end without body.");
curr_proc = 0;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = IN_RET;
return new;
}
else if (!string_compare(token, "IF"))
{
struct INTERMEDIATE *curr;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
new -> in.data.call = 0;
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = IN_IF;
addif(new);
return new;
}
else if (!string_compare(token, "ELSE"))
{
struct INTERMEDIATE *eef;
struct INTERMEDIATE *curr;
struct INTERMEDIATE *after;
eef = find_if();
if (!eef)
abort_compile("ELSE without IF.");
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
new -> in.data.call = 0;
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = IN_JMP;
addif(new);
tok = next_token();
curr -> next = after = next_word(tok);
if (tok)
free((void *) tok);
if (!after)
abort_compile("Unexpected end of program.");
eef -> in.data.number = after -> no;
return new;
}
else if (!string_compare(token, "THEN"))
{
/* can't use 'if' because it's a reserved word */
struct INTERMEDIATE *eef;
eef = find_if();
if (!eef) {
abort_compile("THEN without IF."); }
tok = next_token();
new = next_word(tok);
if (tok)
free((void *) tok);
if (!new) {
abort_compile("Unexpected end of program."); }
eef -> in.data.number = new -> no;
return new;
}
else if (!string_compare(token, "CALL"))
{
struct INTERMEDIATE *curr;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = IN_CALL;
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_OBJECT;
curr -> in.data.objref = program;
curr -> next = new_inst();
curr = curr -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = IN_PROGRAM;
return new;
}
else if (!string_compare(token, "VAR"))
{
if (curr_proc)
abort_compile("Variable declared within procedure.");
tok = next_token();
if (!tok || !add_variable(tok))
abort_compile("Variable limit exceeded.");
if (tok)
free((void *) tok);
return 0;
}
else
{
sprintf(buf, "Unrecognized special form %s found in %d.", token, lineno);
abort_compile(buf);
}
}
/* return primitive word. */
struct INTERMEDIATE *
primitive_word(const char *token)
{
struct INTERMEDIATE *new;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(token);
return new;
}
/* return self pushing word (string) */
struct INTERMEDIATE *
string_word(const char *token)
{
struct INTERMEDIATE *new;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_STRING;
new -> in.data.string = alloc_prog_string(token);
return new;
}
/* return self pushing word (number) */
struct INTERMEDIATE *
number_word(const char *token)
{
struct INTERMEDIATE *new;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_INTEGER;
new -> in.data.number = atoi(token);
return new;
}
/* do a subroutine call --- push address onto stack, then make a primitive
CALL.
*/
struct INTERMEDIATE *
call_word(const char *token)
{
struct INTERMEDIATE *new;
struct PROC_LIST *p;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
for (p = procs; p; p = p -> next)
if (!string_compare(p -> name, token))
break;
new -> in.data.number = p -> code -> no;
new -> next = new_inst();
new -> next -> no = nowords++;
new -> next -> in.type = PROG_PRIMITIVE;
new -> next -> in.data.number = IN_EXECUTE;
return new;
}
struct INTERMEDIATE *
quoted_word(const char *token)
{
struct INTERMEDIATE *new;
struct PROC_LIST *p;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
for (p = procs; p; p = p -> next)
if (!string_compare(p -> name, token))
break;
new -> in.data.number = p -> code -> no;
return new;
}
/* returns number corresponding to variable number.
We assume that it DOES exist */
struct INTERMEDIATE *
var_word(const char *token)
{
struct INTERMEDIATE *new;
int var_no;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_VAR;
for (var_no = 0; var_no < MAX_VAR; var_no++)
if (!string_compare(token, variables[var_no]))
break;
new -> in.data.number = var_no;
return new;
}
/* check if object is in database before putting it in */
struct INTERMEDIATE *
object_word(const char *token)
{
struct INTERMEDIATE *new;
int objno;
objno = atol(token + 1);
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_OBJECT;
new -> in.data.objref = objno;
return new;
}
/* support routines for internal data structures. */
/* add procedure to procedures list */
void
add_proc(const char *proc_name, struct INTERMEDIATE *place)
{
struct PROC_LIST *new;
new = (struct PROC_LIST *) malloc(sizeof(struct PROC_LIST));
new -> name = alloc_string(proc_name);
new -> code = place;
new -> next = procs;
procs = new;
}
/* add if to if stack */
void
addif(struct INTERMEDIATE *place)
{
struct IF_STACK *new;
new = (struct IF_STACK *) malloc(sizeof(struct IF_STACK));
new -> place = place;
new -> next = if_stack;
if_stack = new;
}
/* pops topmost if off the stack */
struct INTERMEDIATE *
find_if(void)
{
struct INTERMEDIATE *temp;
struct IF_STACK *tofree;
if (!if_stack)
return 0;
temp = if_stack -> place;
tofree = if_stack;
if_stack = if_stack -> next;
free((void *) tofree);
return temp;
}
/* adds variable. Return 0 if no space left */
int
add_variable(const char *varname)
{
int i;
for (i = RES_VAR; i < MAX_VAR; i++)
if (!variables[i])
break;
if (i == MAX_VAR)
return 0;
variables[i] = alloc_string(varname);
return i;
}
/* predicates for procedure calls */
int
special(const char *token)
{
return ( token && ! (string_compare(token, ":")
&& string_compare(token, ";")
&& string_compare(token, "IF")
&& string_compare(token, "ELSE")
&& string_compare(token, "THEN")
&& string_compare(token, "CALL")
&& string_compare(token, "VAR") ) );
}
/* see if procedure call */
int
call(const char *token)
{
struct PROC_LIST *i;
for (i = procs; i; i = i -> next)
if (!string_compare(i -> name, token))
return 1;
return 0;
}
/* see if it's a quoted procedure name */
int
quoted(const char *token)
{
return ( *token == '\'' && call(token + 1));
}
/* see if it's an object # */
int
object(const char *token)
{
if (*token == '#' && number(token + 1))
return 1;
else
return 0;
}
/* see if string */
int
string(const char *token)
{
return ( token[0] == '"' );
}
int
variable(const char *token)
{
int i;
for (i = 0; i < MAX_VAR && variables[i]; i++)
if (!string_compare(token, variables[i]))
return 1;
return 0;
}
/* see if token is primitive */
int
primitive(const char *token)
{
return get_primitive(token);
}
/* return primitive instruction */
int
get_primitive(const char *token)
{
hash_data *hd;
if ((hd = find_hash(token, primitive_list, COMP_HASH_SIZE)) == NULL)
return 0;
else {
return (hd -> ival);
}
}
/* clean up as nicely as we can. */
void
cleanup(void)
{
struct INTERMEDIATE *wd, *tempword;
struct IF_STACK *eef, *tempif;
struct PROC_LIST *p, *tempp;
int i;
for (wd = first_word; wd; wd = tempword)
{
tempword = wd -> next;
if (wd -> in.type == PROG_STRING)
if (wd -> in.data.string)
free((void *)wd -> in.data.string);
free((void *) wd);
}
first_word = 0;
for (eef = if_stack; eef; eef = tempif)
{
tempif = eef -> next;
free((void *) eef);
}
if_stack = 0;
for (p = procs; p; p = tempp)
{
tempp = p -> next;
free((void *)p -> name);
free((void *) p);
}
procs = 0;
for (i = RES_VAR; i < MAX_VAR && variables[i]; i++)
{
free((void *) variables[i]);
variables[i] = 0;
}
}
/* copy program to an array */
void
copy_program(void)
{
/* Everything should be peachy keen now, so we don't do any error
checking */
struct INTERMEDIATE *curr;
struct inst *code;
int i;
if (!first_word)
v_abort_compile("Nothing to compile.");
code = (struct inst *) malloc(sizeof(struct inst) * (nowords + 1));
i = 0;
for (curr = first_word; curr; curr = curr -> next)
{
code[i].type = curr -> in.type;
switch (code[i].type)
{
case PROG_PRIMITIVE:
case PROG_INTEGER:
case PROG_VAR:
code[i].data.number = curr -> in.data.number;
break;
case PROG_STRING:
code[i].data.string = curr -> in.data.string ?
alloc_prog_string(curr -> in.data.string->data) : 0;
break;
case PROG_OBJECT:
code[i].data.objref = curr -> in.data.objref;
break;
case PROG_ADD:
code[i].data.call = code + curr -> in.data.number;
break;
default:
v_abort_compile("Unknown type compile! Internal error.");
break;
}
i++;
}
DBSTORE(program, sp.program.code, code);
}
void
set_start(void)
{
DBSTORE(program, sp.program.siz, nowords);
DBSTORE(program, sp.program.start, (DBFETCH(program)->sp.program.code + procs -> code -> no));
}
/* allocate and initialize data linked structure. */
struct INTERMEDIATE *
new_inst()
{
struct INTERMEDIATE *new;
new = (struct INTERMEDIATE *) malloc(sizeof (struct INTERMEDIATE));
new -> next = 0;
new -> no = 0;
new -> in.type = 0;
new -> in.data.number = 0;
return new;
}
void
free_prog(struct inst *c, int siz)
{
int i;
for (i = 0; i < siz; i++)
if (c[i].type == PROG_STRING && c[i].data.string)
free((void *) c[i].data.string);
if (c)
free((void *) c);
DBSTORE(program, sp.program.code, 0);
DBSTORE(program, sp.program.siz, 0);
}
static void add_primitive(int val)
{
hash_data hd;
hd.ival = val;
if (add_hash(base_inst[val - BASE_MIN], hd, primitive_list,
COMP_HASH_SIZE) == NULL)
panic("Out of memory");
else
return;
}
void clear_primitives(void)
{
kill_hash(primitive_list, COMP_HASH_SIZE);
return;
}
void init_primitives(void)
{
int i;
clear_primitives();
for (i = BASE_MIN; i <= BASE_MAX; i++) {
add_primitive(i);
}
}