#include <ctype.h>
#include <stdio.h>
#include "copyright.h"
#include "config.h"
#include "version.h"
#include "db.h"
#include "interface.h"
#include "inst.h"
#include "externs.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. */
/* Of course I modified the crap out of it to handle for, do, and while
loops. now the type field holds a SORCE_whatever to tell where the
loop came from, and LOOP parses accordingly to tidy up --Doran*/
/* Also, if you change any primitive names, you need to look through
the 'name dependency' and change those accordingly. */
/* name dependancy *//* not all are used */
#define IF_NAME "IF"
#define CALL_NAME "CALL"
#define READ_NAME "READ"
#define EXIT_NAME "EXIT"
#define JMP_NAME "JMP"
#define PROGRAM_NAME "PROGRAM "
#define EXECUTE_NAME "EXECUTE"
#define SLEEP_NAME "SLEEP"
#define VAR_NAME "VAR"
#define LOOP_NAME "LOOP"
#define NOP_NAME "NOP"
#define FOR_CHECK_NAME "FOR_CHECK "
#define FOR_ADD_NAME "FOR_ADD "
#define FOR_POP_NAME "FOR_POP "
static hash_tab primitive_list[COMP_HASH_SIZE];
/* #defines for types of addresses shoved on the if stack */
#define SOURCE_ERROR -1
#define SOURCE_IF 0
#define SOURCE_FOR 1
#define SOURCE_DO 2
#define SOURCE_WHILE_ALPHA 3
#define SOURCE_WHILE_BETA 4
/* 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. */
typedef struct intermediate
{
int no; /* which number instruction this is */
inst in; /* instruction itself */
struct intermediate *next; /* next instruction */
} intermediate;
typedef struct if_stack
{
int source;
intermediate *place;
struct if_stack *next;
} if_stack;
if_stack *ifs;
/* 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.
*/
typedef struct proc_list
{
char *name;
intermediate *code;
struct proc_list *next;
} proc_list;
proc_list *procs;
static int nowords; /* number of words compiled */
static intermediate *curr_word; /* word currently being compiled */
static intermediate *first_word; /* first word of the list */
static intermediate *curr_proc; /* first word of current procedure */
/* variable names. The index into variables give you what position
* the variable holds.
*/
static char *variables[MAX_VAR] = { "ME", "LOC", "TRIGGER" };
static line *curr_line; /* current line */
static int lineno; /* current line number */
static char *next_char; /* next char * */
static dbref player, program; /* globalized player and program */
/* 1 if error occured */
static int compile_err;
int primitive(char *s); /* returns primitive_number if primitive */
void advance_line();
void free_prog(inst *, int);
char *next_token();
char *next_token_raw();
intermediate *next_word(char *);
intermediate *process_special(char *);
intermediate *primitive_word(char *);
intermediate *string_word(char *);
intermediate *number_word(char *);
intermediate *floating_word(char *);
intermediate *object_word(char *);
intermediate *quoted_word(char *);
intermediate *call_word(char *);
intermediate *var_word(char *);
char *do_string();
void do_comment();
intermediate *new_inst();
intermediate *find_if();
void cleanup();
void add_proc(char *, intermediate *);
void addif(intermediate *, int from);
int query_if();
int for_nest();
int add_variable(char *);
int special(char *);
int call(char *);
int quoted(char *);
int object_check(char *);
int string(char *);
int variable(char *);
int get_primitive(char *);
void copy_program();
void set_start();
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 BEGINDIRECTIVE '$'
#define BEGINESCAPE '\\'
#define SUBSTITUTIONS 20 /* How many nested macros will we allow? */
/* abort compile macro */
#define abort_compile(C) \
{ \
char _buf[BUFFER_LEN]; \
sprintf(_buf, "Error in line %d: %s", lineno, C); \
if (line_copy) \
{ \
free (line_copy); \
line_copy = NULL; \
} \
if (player != NOTHING) notify(player, player, _buf); \
else \
log_muf("MUF compiler warning in program %ld:\n%s\n", program, _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 (line_copy); \
line_copy = NULL; \
} \
if (player != NOTHING) notify(player, player, _buf); \
else\
log_muf("MUF compiler warning in program %ld:\n%s\n", program, _buf); \
cleanup(); \
compile_err++; \
free_prog(DBFETCH(program)->sp.program.code, \
DBFETCH(program)->sp.program.siz); \
return; \
}
extern frame *frame_list;
/* returns true for numbers of form [x.x] <series of digits> */
int floating(char *s)
{
if (!s) return 0;
while (isspace(*s)) s++;
if (*s == '+' || *s == '-') s++;
if ((*s < '0' || *s > '9') || !index(s, '.')) return 0;
return 1;
}
#ifdef PREP
char *alloc_string(char *string1);
char *expand_def(char *defname);
void kill_def(char *defname);
void insert_def(char *defname, char *deff);
void purge_defs(void);
void include_defs(dbref i);
void init_defs(void);
void do_directive(char *direct);
char *alloc_string(char *string1)
{
char *s;
/* NULL, "" -> NULL */
if (string1 == 0 || *string1 == '\0')
return 0;
if ((s = (char *) malloc(strlen(string1) + 1)) == 0) {
abort();
}
strcpy(s, string1);
return s;
}
char *envpropstr(dbref *where, char *propname)
{
char *temp;
while (*where != NOTHING) {
temp = (char *) get_property_data(*where, propname, ACCESS_OT);
if (temp && *temp)
return temp;
*where = DBFETCH(*where)->location;
}
return NULL;
}
void do_directive(char *direct) /* handle compiler directives */
{
char temp[BUFFER_LEN];
char *tmpname;
char *tmpptr;
int i = 0;
int j;
strcpy(temp, ++direct);
if (!(temp[0])) {
v_abort_compile("I don't understand that compiler directive!");
}
if (!string_compare(temp, "define")) {
tmpname = (char *) next_token_raw();
if (!tmpname)
v_abort_compile("Unexpected end of file looking for $define name.");
i = 0;
while ((tmpptr = (char *) next_token_raw()) &&
(string_compare(tmpptr, "$enddef"))) {
strcpy((&temp[i]), tmpptr);
i += strlen(&temp[i]);
if (*tmpptr == BEGINSTRING)
temp[i++] = ENDSTRING;
temp[i++] = ' ';
free(tmpptr);
if (i > (BUFFER_LEN / 2))
v_abort_compile("$define definition too long.");
}
temp[--i] = '\0';
if (!tmpptr)
v_abort_compile("Unexpected end of file in $define definition.");
free(tmpptr);
(void) insert_def(tmpname, temp);
free(tmpname);
} else if (!string_compare(temp, "enddef")) {
v_abort_compile("$enddef without a previous matching $define.");
} else if (!string_compare(temp, "def")) {
tmpname = (char *) next_token_raw();
if (!tmpname)
v_abort_compile("Unexpected end of file looking for $define name.");
(void) insert_def(tmpname, next_char);
while (*next_char)
next_char++;
advance_line();
free(tmpname);
} else if (!string_compare(temp, "include")) {
struct match_data md;
tmpname = (char *) next_token_raw();
if (!tmpname)
v_abort_compile("Unexpected end of file while doing $include.");
{
char tempa[BUFFER_LEN], tempb[BUFFER_LEN];
strcpy(tempa, match_args);
strcpy(tempb, match_cmdname);
init_match(player, tmpname, NOTYPE, &md);
match_registered(&md);
match_absolute(&md);
match_me(&md);
i = (int) match_result(&md);
strcpy(match_args, tempa);
strcpy(match_cmdname, tempb);
}
free(tmpname);
if (((dbref) i == NOTHING) || (i < 0) || (i > db_top)
|| (Typeof(i) == TYPE_GARBAGE))
v_abort_compile("I don't understand what object you want to $include.");
include_defs((dbref) i);
} else if (!string_compare(temp, "undef")) {
tmpname = (char *) next_token_raw();
if (!tmpname)
v_abort_compile("Unexpected end of file looking for name to $undef.");
kill_def(tmpname);
free(tmpname);
} else if (!string_compare(temp, "echo")) {
tmpname = (char *) next_token();
if (!tmpname)
v_abort_compile("Unexpected end of file looking for string to $echo.");
notify(player, player, tmpname);
free(tmpname);
} else if (!string_compare(temp, "ifdef")) {
tmpname = (char *) next_token_raw();
if (!tmpname)
v_abort_compile("Unexpected end of file looking for $ifdef condition.");
strcpy(temp, tmpname);
free(tmpname);
for (i = 1; temp[i] && (temp[i] != '=') && (temp[i] != '>') && (temp[i] != '<'); i++);
tmpname = &(temp[i]);
i = (temp[i] == '>') ? 1 : ((temp[i] == '=') ? 0 : ((temp[i] == '<') ? -1 : -2));
*tmpname = '\0';
tmpname++;
tmpptr = (char *) expand_def(temp);
if (i == -2) {
j = (!tmpptr);
if (tmpptr)
free(tmpptr);
} else {
if (!tmpptr) {
j = 1;
} else {
j = string_compare(tmpptr, tmpname);
j = !((!i && !j) || ((i * j) > 0));
free(tmpptr);
}
}
if (j) {
i = 0;
while ((tmpptr = (char *) next_token_raw()) &&
(i || ((string_compare(tmpptr, "$else"))
&& (string_compare(tmpptr, "$endif"))))) {
if (!string_compare(tmpptr, "$ifdef"))
i++;
else if (!string_compare(tmpptr, "$ifndef"))
i++;
else if (!string_compare(tmpptr, "$endif"))
i--;
}
if (!tmpptr) {
v_abort_compile("Unexpected end of file in $ifdef clause.");
}
free(tmpptr);
}
} else if (!string_compare(temp, "ifndef")) {
tmpname = (char *) next_token_raw();
if (!tmpname) {
v_abort_compile("Unexpected end of file looking for $ifndef condition.");
}
strcpy(temp, tmpname);
free(tmpname);
for (i = 1; temp[i] && (temp[i] != '=') && (temp[i] != '>') && (temp[i] != '<'); i++);
tmpname = &(temp[i]);
i = (temp[i] == '>') ? 1 : ((temp[i] == '=') ? 0 : ((temp[i] == '<') ? -1 : -2));
*tmpname = '\0';
tmpname++;
tmpptr = (char *) expand_def(temp);
if (i == -2) {
j = (!tmpptr);
if (tmpptr)
free(tmpptr);
} else {
if (!tmpptr) {
j = 1;
} else {
j = string_compare(tmpptr, tmpname);
j = !((!i && !j) || ((i * j) > 0));
free(tmpptr);
}
}
if (!j) {
i = 0;
while ((tmpptr = (char *) next_token_raw()) &&
(i || ((string_compare(tmpptr, "$else"))
&& (string_compare(tmpptr, "$endif"))))) {
if (!string_compare(tmpptr, "$ifdef"))
i++;
else if (!string_compare(tmpptr, "$ifndef"))
i++;
else if (!string_compare(tmpptr, "$endif"))
i--;
}
if (!tmpptr) {
v_abort_compile("Unexpected end of file in $ifndef clause.");
}
free(tmpptr);
}
} else if (!string_compare(temp, "else")) {
i = 0;
while ((tmpptr = (char *) next_token_raw()) &&
(i || (string_compare(tmpptr, "$endif")))) {
if (!string_compare(tmpptr, "$ifdef"))
i++;
else if (!string_compare(tmpptr, "$ifndef"))
i++;
else if (!string_compare(tmpptr, "$endif"))
i--;
free(tmpptr);
}
if (!tmpptr) {
v_abort_compile("Unexpected end of file in $else clause.");
}
free(tmpptr);
} else if (!string_compare(temp, "endif")) {
} else {
v_abort_compile("Unrecognized compiler directive.");
}
}
#define DEFHASHSIZE (256) /* Table for compiler $defines */
static hash_tab defhash[DEFHASHSIZE];
char *expand_def(char *defname)
{
hash_data *exp = find_hash(defname, defhash, DEFHASHSIZE);
if (!exp) {
if (*defname == BEGINMACRO) {
return ((char *) macro_expansion(macrotop, &defname[1]));
} else {
return (NULL);
}
}
return (alloc_string((char *) exp->pval));
}
void kill_def(char *defname)
{
hash_data *exp = find_hash(defname, defhash, DEFHASHSIZE);
if (exp) {
free(exp->pval);
(void) free_hash(defname, defhash, DEFHASHSIZE);
}
}
void insert_def(char *defname, char *deff)
{
hash_data hd;
(void) kill_def(defname);
hd.pval = (void *) alloc_string(deff);
(void) add_hash(defname, hd, defhash, DEFHASHSIZE);
}
void purge_defs(void)
{
kill_hash(defhash, DEFHASHSIZE, 1);
}
void include_defs(dbref i)
{
propdir *ptr;
char *one, *two;
ptr = find_property(i, "_defs", ACCESS_OT);
if(ptr && ptr->child) {
for(ptr = ptr->child; ptr; ptr = ptr->next) {
if(ptr->data) {
one = uncompress(ptr->name);
two = uncompress(ptr->data);
insert_def(one, two);
}
}
}
}
void init_defs(void)
{
/* What version of the server is this? */
(void) insert_def((char *) "__version", (char *) VERSION);
/* make defines for compatability to removed primitives */
/*
(void) insert_def((char *) "desc", (char *) "\"_/de\" getpropstr");
(void) insert_def((char *) "succ", (char *) "\"_/sc\" getpropstr");
(void) insert_def((char *) "fail", (char *) "\"_/fl\" getpropstr");
(void) insert_def((char *) "drop", (char *) "\"_/dr\" getpropstr");
(void) insert_def((char *) "osucc", (char *) "\"_/osc\" getpropstr");
(void) insert_def((char *) "ofail", (char *) "\"_/ofl\" getpropstr");
(void) insert_def((char *) "odrop", (char *) "\"_/odr\" getpropstr");
(void) insert_def((char *) "setdesc", (char *) "\"_/de\" swap 0 addprop");
(void) insert_def((char *) "setsucc", (char *) "\"_/sc\" swap 0 addprop");
(void) insert_def((char *) "setfail", (char *) "\"_/fl\" swap 0 addprop");
(void) insert_def((char *) "setdrop", (char *) "\"_/dr\" swap 0 addprop");
(void) insert_def((char *) "setosucc", (char *) "\"_/osc\" swap 0 addprop");
(void) insert_def((char *) "setofail", (char *) "\"_/ofl\" swap 0 addprop");
(void) insert_def((char *) "setodrop", (char *) "\"_/odr\" swap 0 addprop");
(void) insert_def((char *) "notify_except", (char *) "1 swap notify_exclude");
*/
/* Create standard server defines */
(void) insert_def((char *) "strip", (char *) "striplead striptail");
(void) insert_def((char *) "background", (char *) "0 sleep");
(void) insert_def((char *) "repeat", (char *) "loop");
(void) insert_def((char *) "instring",
(char *) "tolower swap tolower swap instr");
(void) insert_def((char *) "rinstring",
(char *) "tolower swap tolower swap rinstr");
/* include any defines set in #0's _defs/ propdir. */
include_defs((dbref) 0);
}
#endif /* PREP */
/* overall control code. Does piece-meal tokenization parsing and
backward checking. */
void do_compile(dbref player_in, dbref program_in)
{
char *token;
char buf[BUFFER_LEN];
intermediate *new_word;
sprintf (buf, "Program %s has been recompiled by %s.",
unparse_name(program_in), unparse_name(player_in));
bump_frames(buf, program_in, player_in);
/* set all global variables */
#ifdef PREP
init_defs();
#endif
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;
ifs = 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(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();
}
intermediate *next_word(char *token)
{
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 (floating(token)) new_word = floating_word(token);
else if (number(token)) new_word = number_word(token);
else if (object_check(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);
}
if (new_word) new_word -> in.linenum = lineno;
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 (line_copy);
line_copy = NULL;
}
if (curr_line) next_char = (line_copy = dup_string(curr_line -> this_line));
else next_char = (line_copy = NULL);
}
#ifdef PREP
/* Skips comments, grabs strings, returns NULL when no more tokens to grab. */
char *next_token_raw()
{
static char buf[BUFFER_LEN];
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();
return next_token_raw();
}
/* take care of comments */
if (*next_char == BEGINCOMMENT) {
do_comment();
return next_token_raw();
}
if (*next_char == BEGINSTRING)
return do_string();
for (i = 0; *next_char && !isspace(*next_char); i++) {
buf[i] = *next_char;
next_char++;
}
buf[i] = '\0';
return alloc_string(buf);
}
char *next_token()
{
static char *expansion, *temp;
temp = (char *) next_token_raw();
if (!temp)
return NULL;
if (temp[0] == BEGINDIRECTIVE) {
do_directive(temp);
free(temp);
return next_token();
}
if (temp[0] == BEGINESCAPE) {
if (temp[1]) {
return (++temp);
} else {
return (temp);
}
}
if ((expansion = expand_def(temp))) {
free(temp);
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);
if (line_copy) {
free((void *) line_copy);
}
next_char = line_copy = temp;
return next_token();
}
} else {
return (temp);
}
}
#else
/* Skips comments, grabs strings, returns NULL when no more tokens to grab. */
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 (expansion);
free (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 dup_string(buf);
}
#endif /* PREP */
/* 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 */
char * do_string()
{
char buf[BUFFER_LEN];
int i = 0, quoted1 = 0;
buf[i] = *next_char;
next_char++;
i++;
while ((quoted1 || *next_char != ENDSTRING) && *next_char)
if (*next_char == '\\' && !quoted1)
{
quoted1++;
next_char++;
}
else
{
buf[i] = *next_char;
i++; next_char++; quoted1 = 0;
}
if (!*next_char)
{
abort_compile("Unterminated string found at end of line.");
}
next_char++;
buf[i] = '\0';
return dup_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. */
intermediate * process_special(char *token)
{
char buf[BUFFER_LEN];
char *tok;
intermediate *new;
if (!string_compare(token, ":"))
{
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(tok);
if (!new)
{
sprintf(buf, "Error in definition of %s.", proc_name);
free(proc_name);
abort_compile(buf);
}
curr_proc = new;
add_proc(proc_name, new);
free(proc_name);
return new;
}
else if (!string_compare(token, ";"))
{
if (ifs) 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 = get_primitive(EXIT_NAME); /* name dependency */
return new;
}
else if (!string_compare(token, "IF"))
{
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 = get_primitive(IF_NAME); /* name dependency */
addif(new, SOURCE_IF);
return new;
}
else if (!string_compare(token, "ELSE"))
{
intermediate *eef;
intermediate *curr;
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 = get_primitive(JMP_NAME); /* name dependency */
addif(new, SOURCE_IF); /* treated as if when next then comes up */
tok = next_token();
curr -> next = after = next_word(tok);
if (tok) free(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 */
intermediate *eef;
if (query_if() != SOURCE_IF) abort_compile("THEN improperly nested.");
eef = find_if();
if (!eef) abort_compile("THEN without IF.");
tok = next_token();
new = next_word(tok);
if (tok) free(tok);
if (!new) abort_compile("Unexpected end of program.");
eef -> in.data.number = new -> no;
return new;
}
else if (!string_compare(token, "DO"))
{
intermediate *after;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(NOP_NAME); /* name dependency */
addif(new, SOURCE_DO);
tok = next_token();
new -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
return new;
}
else if (!string_compare(token, "BEGIN"))
{
intermediate *after;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(NOP_NAME); /* name dependency */
addif(new, SOURCE_WHILE_ALPHA);
tok = next_token();
new -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
return new;
}
else if (!string_compare(token, "WHILE"))
{
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 = get_primitive(IF_NAME); /* name dependency */
addif(new, SOURCE_WHILE_BETA);
return new;
}
else if (!string_compare(token, "FOR"))
{
intermediate *after;
intermediate *curr;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(FOR_ADD_NAME); /* name dependency */
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(NOP_NAME); /* name dependency */
addif(curr, SOURCE_FOR);
tok = next_token();
curr -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
return new;
}
else if (!string_compare(token, "LOOP"))
{
/* can't use 'if' because it's a reserved word */
intermediate *eef;
intermediate *wheel;
intermediate *curr;
intermediate *after;
if (query_if() == SOURCE_IF
|| query_if() == SOURCE_ERROR) abort_compile("LOOP improperly nested.");
switch(query_if()) {
case SOURCE_WHILE_BETA:
eef = find_if();
if (query_if() != SOURCE_WHILE_ALPHA)
abort_compile("Improperly nested loop in conditional of WHILE.");
wheel = find_if();
if (!wheel) abort_compile("WHILE ... LOOP without BEGIN.");
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
new -> in.data.number = wheel -> no;
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(JMP_NAME); /* name dependency */
tok = next_token();
curr -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
eef -> in.data.number = new -> no + 2;
break;
case SOURCE_DO:
eef = find_if();
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_ADD;
new -> in.data.number = eef -> no;
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(LOOP_NAME); /* name dependency */
tok = next_token();
curr -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
break;
case SOURCE_FOR:
eef = find_if();
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(FOR_CHECK_NAME);
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_ADD;
curr -> in.data.number = eef -> no;
curr -> next = new_inst();
curr = curr -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(LOOP_NAME); /* name dependency */
tok = next_token();
curr -> next = after = next_word(tok);
if (tok) free(tok);
if (!after) abort_compile("Unexpected end of program.");
break;
case SOURCE_WHILE_ALPHA:
abort_compile("WHILE statement missing.");
break;
default:
{ char BUF[80];
sprintf(BUF, "Unexpected IF_STACK type: %d.", query_if());
abort_compile(BUF);
}
break;
}
return new;
}
#ifdef BREAK_CONTINUE
else if (!string_compare(token, "BREAK")) {
/* can't use 'if' because it's a reserved word */
intermediate *eef;
intermediate *curr;
eef = find_if();
if (!eef)
abort_compile("Can't have a BREAK outside of a loop.");
new = new_inst();
new->no = nowords++;
new->in.type = PROG_ADD;
/* new->in.line = lineno; */
new->in.data.number = 0;
new->next = new_inst();
curr = new->next;
curr->no = nowords++;
curr->in.type = PROG_PRIMITIVE;
/* curr->in.line = lineno; */
curr->in.data.number = IN_JMP;
/* addwhile(new); */
addif(new, SOURCE_WHILE_BETA);
return new;
} else if (!string_compare(token, "CONTINUE")) {
/* can't use 'if' because it's a reserved word */
intermediate *beef;
intermediate *curr;
beef = find_if();
if (!beef)
abort_compile("Can't CONTINUE outside of a loop.");
new = new_inst();
new->no = nowords++;
new->in.type = PROG_ADD;
/* new->in.line = lineno; */
new->in.data.number = beef->no;
new->next = new_inst();
curr = new->next;
curr->no = nowords++;
curr->in.type = PROG_PRIMITIVE;
/* curr->in.line = lineno; */
curr->in.data.number = IN_JMP;
return new;
}
#endif /* PREP */
else if (!string_compare(token, "CALL"))
{
intermediate *curr;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(CALL_NAME); /* name dependency */
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 = get_primitive(PROGRAM_NAME); /* name dependency */
return new;
}
else if (!string_compare(token, "EXIT"))
{
intermediate *curr;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_PRIMITIVE;
new -> in.data.number = get_primitive(EXIT_NAME); /* name dependency */
if (for_nest() != 0)
{
new -> in.type = PROG_INTEGER;
new -> in.data.number = for_nest();
new -> next = new_inst();
curr = new -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(FOR_POP_NAME); /* name dependency */
curr -> next = new_inst();
curr = curr -> next;
curr -> no = nowords++;
curr -> in.type = PROG_PRIMITIVE;
curr -> in.data.number = get_primitive(EXIT_NAME); /* name dependency */
}
return new;
}
#ifdef PUBLIC
else if (!string_compare(token, "PUBLIC")) {
struct PROC_LIST *p;
struct publics *pub;
if (curr_proc)
abort_compile("Public declaration within procedure.");
tok = next_token();
if ((!tok) || !call(tok))
abort_compile("Subroutine unknown in PUBLIC declaration.");
for (p = procs; p; p = p->next)
if (!string_compare(p->name, tok))
break;
if (!p)
abort_compile("Subroutine unknown in PUBLIC declaration.");
if (!currpubs) {
currpubs = (struct publics *) malloc(sizeof(struct publics));
currpubs->next = NULL;
currpubs->subname = (char *) strdup(tok);
if (tok)
free((void *) tok);
currpubs->addr.no = p->code->no;
return 0;
}
for (pub = currpubs; pub;) {
if (!string_compare(tok, pub->subname)) {
abort_compile("Function already declared public.");
} else {
if (pub->next) {
pub = pub->next;
} else {
pub->next = (struct publics *) malloc(sizeof(struct publics));
pub = pub->next;
pub->next = NULL;
pub->subname = (char *) strdup(tok);
if (tok)
free((void *) tok);
pub->addr.no = p->code->no;
pub = NULL;
}
}
}
return 0;
}
#endif /* PUBLIC */
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(tok);
return 0;
}
else
{
sprintf(buf, "Unrecognized special form %s found on line %d.",
token, lineno);
abort_compile(buf);
}
}
/* return primitive word. */
intermediate * primitive_word(char *token)
{
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) */
intermediate *string_word(char *token)
{
intermediate *new;
new = new_inst();
new->no = nowords++;
new->in.type = PROG_STRING;
new->in.data.string = dup_string(token);
return new;
}
/* return self pushing word (number) */
intermediate *number_word(char *token)
{
intermediate *new;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_INTEGER;
new -> in.data.number = strtol(token, NULL, 0);
return new;
}
/* return self pushing word (floating) */
intermediate *floating_word(char *token)
{
intermediate *new;
new = new_inst();
new -> no = nowords++;
new -> in.type = PROG_FLOAT;
new -> in.data.fnum = atof(token);
return new;
}
/* do a subroutine call --- push address onto stack, then make a primitive
CALL.
*/
intermediate *call_word(char *token)
{
intermediate *new;
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 = get_primitive(EXECUTE_NAME); /* name dependency */
return new;
}
intermediate *quoted_word(char *token)
{
intermediate *new;
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 */
intermediate *var_word(char *token)
{
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 */
intermediate *object_word(char *token)
{
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(char *proc_name, intermediate *place)
{
proc_list *new;
new = (proc_list *) malloc(sizeof(proc_list));
new -> name = dup_string(proc_name);
new -> code = place;
new -> next = procs;
procs = new;
}
/* add if to if stack */
void addif(intermediate *place, int from)
{
if_stack *new;
new = (if_stack *) malloc(sizeof(if_stack));
new->place = place;
new->next = ifs;
new->source = from;
ifs = new;
}
/* queries the type of the top element on the if stack */
/* non destructive */
int query_if()
{
if (!ifs) return SOURCE_ERROR;
return(ifs->source);
}
/* checks nested for depth */
int for_nest()
{
int result = 0;
if_stack *temp = ifs;
for(;temp;temp = temp->next) if (temp->source == SOURCE_FOR) result++;
return (result);
}
/* pops topmost if off the stack */
intermediate *find_if()
{
intermediate *temp;
if_stack *tofree;
if (!ifs) return 0;
temp = ifs->place;
tofree = ifs;
ifs = ifs->next;
free(tofree);
return temp;
}
/* adds variable. Return 0 if no space left */
int add_variable(char *varname)
{
int i;
for (i = RES_VAR; i < MAX_VAR; i++)
if (!variables[i]) break;
if (i == MAX_VAR) return 0;
variables[i] = dup_string(varname);
return i;
}
/* predicates for procedure calls */
int special(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, "FOR") &&
string_compare(token, "BEGIN") &&
string_compare(token, "WHILE") &&
#ifdef BREAK_CONTINUE
string_compare(token, "BREAK") &&
string_compare(token, "CONTINUE") &&
#endif
string_compare(token, "DO") &&
string_compare(token, "LOOP") &&
string_compare(token, "EXIT") &&
string_compare(token, "VAR")));
}
/* see if procedure call */
int call(char *token)
{
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(char *token)
{
return ( *token == '\'' && call(token + 1));
}
/* see if it's an object # */
int object_check(char *token)
{
if (*token == '#' && number(token + 1)) return 1;
else return 0;
}
/* see if string */
int string(char *token)
{
return ( token[0] == '"' );
}
int variable(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(char *token)
{
return get_primitive(token);
}
/* return primitive instruction */
int get_primitive(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()
{
intermediate *wd, *tempword;
if_stack *eef, *tempif;
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(wd->in.data.string);
free(wd);
}
first_word = 0;
for (eef = ifs; eef; eef = tempif)
{
tempif = eef -> next;
free(eef);
}
ifs = NULL;
for (p = procs; p; p = tempp)
{
tempp = p -> next;
free(p -> name);
free(p);
}
procs = 0;
#ifdef PREP
purge_defs();
#endif
for (i = RES_VAR; i < MAX_VAR && variables[i]; i++)
{
free(variables[i]);
variables[i] = 0;
}
}
/* copy program to an array */
void copy_program()
{
/* Everything should be peachy keen now, so we don't do any error
checking */
intermediate *curr;
inst *code;
int i;
if (!first_word) v_abort_compile("Nothing to compile.");
code = (inst *) malloc(sizeof(inst) * (nowords + 1));
i = 0;
for (curr = first_word; curr; curr = curr -> next)
{
code[i].type = curr -> in.type;
code[i].linenum = curr -> in.linenum;
switch (code[i].type)
{
case PROG_PRIMITIVE:
case PROG_INTEGER:
case PROG_FLOAT:
case PROG_VAR:
code[i].data.number = curr -> in.data.number;
break;
case PROG_STRING:
code[i].data.string = curr -> in.data.string ?
dup_string(curr->in.data.string) : 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()
{
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. */
intermediate * new_inst()
{
intermediate *new;
new = (intermediate *) malloc(sizeof (intermediate));
new -> next = 0;
new -> no = 0;
new -> in.type = 0;
new -> in.linenum = 0;
new -> in.data.number = 0;
return new;
}
void free_prog(inst *c, int siz)
{
int i;
for (i = 0; i < siz; i++)
if (c[i].type == PROG_STRING && c[i].data.string)
free(c[i].data.string);
if (c) free(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()
{
kill_hash(primitive_list, COMP_HASH_SIZE, 0);
return;
}
void init_primitives()
{
int i;
fprintf(stderr, "Initializing primitives %d thru %d\n", BASE_MIN, BASE_MAX);
clear_primitives();
for (i = BASE_MIN; i <= BASE_MAX; i++)
{
add_primitive(i);
#ifdef NOISY_PRIMS
fprintf(stderr, "%d : %s\n",i,base_inst[i-BASE_MIN]);
#endif
}
}
void uncompile_program(dbref i, dbref player1, char *buf)
{
/* free program */
bump_frames(buf, i, player1);
free_prog(DBFETCH(i)->sp.program.code, DBFETCH(i)->sp.program.siz);
/* cleanpubs(DBFETCH(i)->sp.program.pubs); */
/* DBFETCH(i)->sp.program.pubs = NULL; */
DBFETCH(i)->sp.program.first = 0;
DBFETCH(i)->sp.program.curr_line = 0;
DBFETCH(i)->sp.program.siz = 0;
DBFETCH(i)->sp.program.code = 0;
DBFETCH(i)->sp.program.start = 0;
}
void do_uncompile(__DO_PROTO) /* Add program matching to this */
{
dbref i;
char buf[100];
if (!Wizard(player)) {
notify(player, player, "Permission denied.");
return;
}
for (i = 0; i < db_top; i++) {
if (Typeof(i) == TYPE_PROGRAM) {
sprintf (buf, "Program %s uncompiled by %s", unparse_name(i),
unparse_name(player));
uncompile_program(i, player, buf);
}
}
notify(player, player, "All programs decompiled.");
}