home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The C Users' Group Library 1994 August
/
wc-cdrom-cusersgrouplibrary-1994-08.iso
/
vol_200
/
251_01
/
advexp.c
< prev
next >
Wrap
Text File
|
1987-10-29
|
11KB
|
542 lines
/* advexp.c - expression compiler for adventure games */
/*
Copyright (c) 1986, by David Michael Betz
All rights reserved
*/
#include "advcom.h"
#include "advdbs.h"
/* external routines */
extern SYMBOL *sfind();
/* external variables */
extern char t_token[];
extern int t_value;
extern int curobj;
extern char *code;
extern int cptr;
/* forward declarations */
int do_cond(),do_and(),do_or(),do_if(),do_while(),do_progn();
int do_setq(),do_return(),do_send(),do_sndsuper();
/* opcode tables */
static struct { char *nt_name; int nt_code,nt_args; } *nptr,ntab[] = {
"not", OP_NOT, 1,
"+", OP_ADD, 2,
"-", OP_SUB, 2,
"*", OP_MUL, 2,
"/", OP_DIV, 2,
"%", OP_REM, 2,
"&", OP_BAND, 2,
"|", OP_BOR, 2,
"~", OP_BNOT, 1,
"<", OP_LT, 2,
"=", OP_EQ, 2,
">", OP_GT, 2,
"getp", OP_GETP, 2,
"setp", OP_SETP, 3,
"class", OP_CLASS, 1,
"match", OP_MATCH, 2,
"print", OP_PRINT, 1,
"print-number", OP_PNUMBER, 1,
"print-noun", OP_PNOUN, 1,
"terpri", OP_TERPRI, 0,
"finish", OP_FINISH, 0,
"chain", OP_CHAIN, 0,
"abort", OP_ABORT, 0,
"exit", OP_EXIT, 0,
"save", OP_SAVE, 0,
"restore", OP_RESTORE, 0,
"restart", OP_RESTART, 0,
"yes-or-no", OP_YORN, 0,
"rand", OP_RAND, 1,
"randomize", OP_RNDMIZE, 0,
0
};
static struct { char *ft_name; int (*ft_fcn)(); } *fptr,ftab[] = {
"cond", do_cond,
"and", do_and,
"or", do_or,
"if", do_if,
"while", do_while,
"progn", do_progn,
"setq", do_setq,
"return", do_return,
"send", do_send,
"send-super", do_sndsuper,
0
};
/* do_expr - compile a subexpression */
do_expr()
{
int tkn;
switch (token()) {
case T_OPEN:
switch (tkn = token()) {
case T_IDENTIFIER:
if (in_ntab() || in_ftab())
break;
default:
stoken(tkn);
do_call();
}
break;
case T_NUMBER:
do_literal();
break;
case T_STRING:
do_literal();
break;
case T_IDENTIFIER:
do_identifier();
break;
default:
error("Expecting expression");
}
}
/* in_ntab - check for a function in ntab */
int in_ntab()
{
for (nptr = ntab; nptr->nt_name; ++nptr)
if (strcmp(t_token,nptr->nt_name) == 0) {
do_nary(nptr->nt_code,nptr->nt_args);
return (TRUE);
}
return (FALSE);
}
/* in_ftab - check for a function in ftab */
int in_ftab()
{
for (fptr = ftab; fptr->ft_name; ++fptr)
if (strcmp(t_token,fptr->ft_name) == 0) {
(*fptr->ft_fcn)();
return (TRUE);
}
return (FALSE);
}
/* do_cond - compile the (COND ... ) expression */
do_cond()
{
int tkn,nxt,end;
/* initialize the fixup chain */
end = NIL;
/* compile each COND clause */
while ((tkn = token()) != T_CLOSE) {
require(tkn,T_OPEN);
do_expr();
putcbyte(OP_BRF);
nxt = putcword(NIL);
while ((tkn = token()) != T_CLOSE) {
stoken(tkn);
do_expr();
}
putcbyte(OP_BR);
end = putcword(end);
fixup(nxt,cptr);
}
/* fixup references to the end of statement */
if (end)
fixup(end,cptr);
else
putcbyte(OP_NIL);
}
/* do_and - compile the (AND ... ) expression */
do_and()
{
int tkn,end;
/* initialize the fixup chain */
end = NIL;
/* compile each expression */
while ((tkn = token()) != T_CLOSE) {
stoken(tkn);
do_expr();
putcbyte(OP_BRF);
end = putcword(end);
}
/* fixup references to the end of statement */
if (end)
fixup(end,cptr);
else
putcbyte(OP_NIL);
}
/* do_or - compile the (OR ... ) expression */
do_or()
{
int tkn,end;
/* initialize the fixup chain */
end = NIL;
/* compile each expression */
while ((tkn = token()) != T_CLOSE) {
stoken(tkn);
do_expr();
putcbyte(OP_BRT);
end = putcword(end);
}
/* fixup references to the end of statement */
if (end)
fixup(end,cptr);
else
putcbyte(OP_T);
}
/* do_if - compile the (IF ... ) expression */
do_if()
{
int tkn,nxt,end;
/* compile the test expression */
do_expr();
/* skip around the 'then' clause if the expression is false */
putcbyte(OP_BRF);
nxt = putcword(NIL);
/* compile the 'then' clause */
do_expr();
/* compile the 'else' clause */
if ((tkn = token()) != T_CLOSE) {
putcbyte(OP_BR);
end = putcword(NIL);
fixup(nxt,cptr);
stoken(tkn);
do_expr();
frequire(T_CLOSE);
nxt = end;
}
/* handle the end of the statement */
fixup(nxt,cptr);
}
/* do_while - compile the (WHILE ... ) expression */
do_while()
{
int tkn,nxt,end;
/* compile the test expression */
nxt = cptr;
do_expr();
/* skip around the 'then' clause if the expression is false */
putcbyte(OP_BRF);
end = putcword(NIL);
/* compile the loop body */
while ((tkn = token()) != T_CLOSE) {
stoken(tkn);
do_expr();
}
/* branch back to the start of the loop */
putcbyte(OP_BR);
putcword(nxt);
/* handle the end of the statement */
fixup(end,cptr);
}
/* do_progn - compile the (PROGN ... ) expression */
do_progn()
{
int tkn,n;
/* compile each expression */
for (n = 0; (tkn = token()) != T_CLOSE; ++n) {
stoken(tkn);
do_expr();
}
/* check for an empty statement list */
if (n == 0)
putcbyte(OP_NIL);
}
/* do_setq - compile the (SETQ v x) expression */
do_setq()
{
char name[TKNSIZE+1];
int n;
/* get the symbol name */
frequire(T_IDENTIFIER);
strcpy(name,t_token);
/* compile the value expression */
do_expr();
/* check for this being a local symbol */
if ((n = findarg(name)) >= 0)
code_setargument(n);
else if ((n = findtmp(name)) >= 0)
code_settemporary(n);
else {
n = venter(name);
code_setvariable(n);
}
frequire(T_CLOSE);
}
/* do_return - handle the (RETURN [expr]) expression */
do_return()
{
int tkn;
/* look for a result expression */
if ((tkn = token()) != T_CLOSE) {
stoken(tkn);
do_expr();
frequire(T_CLOSE);
}
/* otherwise, default the result to nil */
else
putcbyte(OP_NIL);
/* insert the return opcode */
putcbyte(OP_RETURN);
}
/* do_send - handle the (SEND obj msg [expr]...) expression */
do_send()
{
/* start searching for the method at the object itself */
putcbyte(OP_NIL);
/* compile the object expression */
putcbyte(OP_PUSH);
do_expr();
/* call the general message sender */
sender();
}
/* do_sndsuper - handle the (SEND-SUPER msg [expr]...) expression */
do_sndsuper()
{
/* start searching for the method at the current class object */
code_literal(curobj);
/* pass the message to "self" */
putcbyte(OP_PUSH);
code_argument(findarg("self"));
/* call the general message sender */
sender();
}
/* sender - compile an expression to send a message to an object */
sender()
{
int tkn,n;
/* compile the selector expression */
putcbyte(OP_PUSH);
do_expr();
/* compile each argument expression */
for (n = 2; (tkn = token()) != T_CLOSE; ++n) {
stoken(tkn);
putcbyte(OP_PUSH);
do_expr();
}
putcbyte(OP_SEND);
putcbyte(n);
}
/* do_call - compile a function call */
do_call()
{
int tkn,n;
/* compile the function itself */
do_expr();
/* compile each argument expression */
for (n = 0; (tkn = token()) != T_CLOSE; ++n) {
stoken(tkn);
putcbyte(OP_PUSH);
do_expr();
}
putcbyte(OP_CALL);
putcbyte(n);
}
/* do_nary - compile nary operator expressions */
do_nary(op,n)
int op,n;
{
while (n--) {
do_expr();
if (n) putcbyte(OP_PUSH);
}
putcbyte(op);
frequire(T_CLOSE);
}
/* do_literal - compile a literal */
do_literal()
{
code_literal(t_value);
}
/* do_identifier - compile an identifier */
do_identifier()
{
SYMBOL *sym;
int n;
if (match("t"))
putcbyte(OP_T);
else if (match("nil"))
putcbyte(OP_NIL);
else if ((n = findarg(t_token)) >= 0)
code_argument(n);
else if ((n = findtmp(t_token)) >= 0)
code_temporary(n);
else if (sym = sfind(t_token)) {
if (sym->s_type == ST_VARIABLE)
code_variable(sym->s_value);
else
code_literal(sym->s_value);
}
else
code_literal(oenter(t_token));
}
/* code_argument - compile an argument reference */
code_argument(n)
int n;
{
putcbyte(OP_ARG);
putcbyte(n);
}
/* code_setargument - compile a set argument reference */
code_setargument(n)
int n;
{
putcbyte(OP_ASET);
putcbyte(n);
}
/* code_temporary - compile an temporary reference */
code_temporary(n)
int n;
{
putcbyte(OP_TMP);
putcbyte(n);
}
/* code_settemporary - compile a set temporary reference */
code_settemporary(n)
int n;
{
putcbyte(OP_TSET);
putcbyte(n);
}
/* code_variable - compile a variable reference */
code_variable(n)
int n;
{
if (n < 32)
putcbyte(OP_XVAR+n);
else if (n < 256)
{ putcbyte(OP_SVAR); putcbyte(n); }
else
{ putcbyte(OP_VAR); putcword(n); }
}
/* code_setvariable - compile a set variable reference */
code_setvariable(n)
int n;
{
if (n < 32)
putcbyte(OP_XSET+n);
else if (n < 256)
{ putcbyte(OP_SSET); putcbyte(n); }
else
{ putcbyte(OP_SET); putcword(n); }
}
/* code_literal - compile a literal reference */
code_literal(n)
int n;
{
if (n >= 0 && n < 64)
putcbyte(OP_XPLIT+n);
else if (n < 0 && n > -64)
putcbyte(OP_XNLIT-n);
else if (n >= 64 && n < 256)
{ putcbyte(OP_SPLIT); putcbyte(n); }
else if (n <= -64 && n > -256)
{ putcbyte(OP_SNLIT); putcbyte(-n); }
else
{ putcbyte(OP_LIT); putcword(n); }
}
/* do_op - insert an opcode and look for closing paren */
do_op(op)
int op;
{
putcbyte(op);
frequire(T_CLOSE);
}
/* putcbyte - put a code byte into data space */
int putcbyte(b)
int b;
{
if (cptr < CMAX)
code[cptr++] = b;
else
error("insufficient code space");
return (cptr-1);
}
/* putcword - put a code word into data space */
int putcword(w)
int w;
{
putcbyte(w);
putcbyte(w >> 8);
return (cptr-2);
}
/* fixup - fixup a reference chain */
fixup(chn,val)
int chn,val;
{
int hval,nxt;
/* store the value into each location in the chain */
for (hval = val >> 8; chn != NIL; chn = nxt) {
if (chn < 0 || chn > CMAX-2)
return;
nxt = (code[chn] & 0xFF) | (code[chn+1] << 8);
code[chn] = val;
code[chn+1] = hval;
}
}