⟦6e478b5a3⟧

TextFile


/* 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;
    }
}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦6e478b5a3⟧ TextFile

Derivation

TextFile
