path: root/engines/glk/agt/metacommand.cpp

/* ScummVM - Graphic Adventure Engine
 *
 * ScummVM is the legal property of its developers, whose names
 * are too numerous to list here. Please refer to the COPYRIGHT
 * file distributed with this source distribution.
 *
 * 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; either version 2
 * of the License, or (at your option) any later version.
 *
 * 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 *
 */

#include "glk/agt/agility.h"
#include "glk/agt/interp.h"
#include "glk/agt/exec.h"

namespace Glk {
namespace AGT {

/* This contains the code for scanning and running metacommands.
   Note that while the code here deals with all of the flow-of-execution
   details, the code for executing individual tokens is actually
   in token.c (With a few exceptions for commands that impact
   the order of execution).  */

#define DEBUG_SCAN 1

#define MAX_REDIR 50000L  /* Maximum number of redirects, to catch
                infinite loops. If this is 0, allow infinitely
                many */

#define MAX_SUBCALL 2047  /* Maximum number of subroutine calls.
                 If this is 0, no limit (except for the 
                 program's stack size). */


/*

scan_metacommand
 -2=end of cycle, something happened (disambiguation only)
  0=end of this cycle   (disambig: end of cycle, nothing happened)
  1=end of all commands (disambig: end of cycle, nothing happened)
  2=end of turn         (disambig: nothing happened)

run_metacommand
    0 to go on to next metacommand,
    1 to stop running metacommands,  and
    2 to end the turn.
    3 indicates that redirection has just occured
    4 indicates a subcall has just occured.
    5 to go on to next metacommand after a return has occured.
    -2 means we're doing disambiguation and just hit an action token.

*/


/* ====================================================================*/
/*  RUN METACOMMAND: The following are the routines used to execute */
/*   a single metacommand block.  run_metacommand is invoked by */
/*   scan_metacommand, which is further down in this file.  */
/* ====================================================================*/

/* ------------------------------------------------------------------- */
/*  TYPE CHECKING ROUTINES        */
/*  Routines used to do type checking for metacommands. */
/* ------------------------------------------------------------------- */


rbool argvalid(int argtype, int arg) {
	if (argtype & AGT_VAR) { /* We have a variable */
		/* First, verify that arg actually indexes a variable */
		if (arg < 0 || arg > VAR_NUM) return 0; /* Nope */

		if (argtype == AGT_VAR) return 1; /* Pure variable; contents don't matter */

		/* Next, verify its contents, using the rest of this routine */
		arg = agt_var[arg];
		argtype &= ~AGT_VAR; /* Mask off AGT_VAR */
	}

	if (argtype < 128) {
		if (tnoun(arg)) return (argtype & AGT_ITEM) != 0;
		if (troom(arg)) return (argtype & AGT_ROOM) != 0;
		if (arg == 0) return (argtype & AGT_NONE) != 0;
		if (arg == 1) return (argtype & AGT_SELF) != 0;
		if (tcreat(arg)) return (argtype & AGT_CREAT) != 0;
		if (arg == 1000) return (argtype & AGT_WORN) != 0;
		return 0;
	} else switch (argtype) {
		case AGT_NUM:
			return 1;
		case AGT_DIR:
			return (arg >= 1 && arg <= 12);
		case AGT_FLAG:
			return (arg >= 0 && arg <= FLAG_NUM);
		case AGT_CNT:
			return (arg >= 0 && arg <= CNT_NUM);
		case AGT_QUEST:
			return (arg >= 1 && arg <= MaxQuestion);
		case AGT_MSG:
			return (arg >= 1 && arg <= last_message);
		case AGT_ERR:
			return (arg >= 1 && arg <= NUM_ERR);
		case AGT_STR:
			return (arg >= 1 && arg <= MAX_USTR);
		case AGT_SUB:
			return (arg >= 1 && arg <= MAX_SUB);
		case AGT_PIC:
			return (arg >= 1 && arg <= maxpict);
		case AGT_PIX:
			return (arg >= 1 && arg <= maxpix);
		case AGT_FONT:
			return (arg >= 1 && arg <= maxfont);
		case AGT_SONG:
			return (arg >= 1 && arg <= maxsong);
		case AGT_ROOMFLAG:
			return (arg >= 1 && arg <= 32);
		case AGT_EXIT:
			return (argvalid(AGT_ROOM | AGT_NONE, arg)
			        || argvalid(AGT_MSG, arg - exitmsg_base)
			        || (arg < 0 && aver >= AGX00)); /* Treat as verb */
		case AGT_OBJFLAG:
			return (arg >= 0 && arg < oflag_cnt);
		case AGT_OBJPROP:
			return (arg >= 0 && arg < oprop_cnt);
		case AGT_ATTR:  /* ATTR and PROP are type-checked elsewhere */
		case AGT_PROP:
			return 1;
		default:
			writeln("INTERNAL ERROR:Unrecognized type specifier.");
		}
	return 0;
}

/* <special> is set true for NOUN, OBJECT, NAME variables that are 0 */
/* (In this case, some error handling is suppressed) */

static rbool argfix(int argtype, int *arg, int optype, rbool *special) {
	*special = 0;
	switch (optype) {
	case 0:
		break;  /* Direct: The easy case */
	case 1:  /* Variable */
		if (*arg == -1) { /* Top-of-stack */
			*arg = pop_expr_stack();
			break;
		}
		if (!argvalid(AGT_VAR, *arg)) return 0;
		*arg = (int)agt_var[*arg];
		break;
	case 2:
		*arg = dobj;
		*special = (dobj == 0);
		break; /* NOUN */
	case 3:
		*arg = iobj;
		*special = (iobj == 0);
		break; /* OBJECT */
	default:
		rprintf("Internal error: Invalid optype.");
		return 0;
	}
	if (!(optype & 2)) {
		/* i.e. we have direct or variable type */
		/* The noun and object types below are useless for direct use,
		   but may be useful when used as values of variables. */
		if (argtype < 64) {
			if (*arg == -1) { /* NAME */
				*arg = actor;
				*special = (actor == 0);
			} else if (*arg == -2) { /* NOUN */
				*arg = dobj;
				*special = (dobj == 0);
			} else if (*arg == -3) { /* OBJECT */
				*arg = iobj;
				*special = (iobj == 0);
			}
		}
	}
	return argvalid(argtype, *arg);
}


/* These are handled in the order ARG2 then ARG1 so that
   top-of-stack references will pop the stack in that order
   (so that the push-order will corrospond to the argument order) */
/* <grammer_arg> is true if "bad" argument is NOUN/OBJECT/etc. and
   is 0. */
static int argok(const opdef *opdata, int *arg1, int *arg2, int optype,
                 rbool *grammer_arg) {
	if ((opdata->argnum) > 1 && !argfix(opdata->arg2, arg2, optype % 4, grammer_arg))
		return 0;
	if ((opdata->argnum) > 0 && !argfix(opdata->arg1, arg1, optype / 4, grammer_arg))
		return 0;
	return 1;
}

/* ------------------------------------------------------------------- */
/*  INSTRUCTION DECODING ROUTINES  */
/*  Routines for decoding opcodes and their arguments */
/* ------------------------------------------------------------------- */

static int decode_instr(op_rec *oprec, const integer *data, int maxleng) {
	integer op_;
	int optype;
	int leng;
	rbool special_arg1;  /* Is the first argument a special 0-length argument? */

	oprec->negate = oprec->failmsg = oprec->disambig = 0;
	oprec->errmsg = NULL;
	oprec->op = -1;
	oprec->opdata = &illegal_def;
	oprec->argcnt = 0;
	oprec->endor = 1;

	special_arg1 = 0;

	if (maxleng <= 0) {
		oprec->errmsg = "GAME ERROR: Unexpected end of token sequence.";
		return 1;
	}
	op_ = data[0];
	if (op_ < 0) {
		oprec->errmsg = "GAME ERROR: Negative token found.";
		return 1;
	}
	oprec->optype = optype = op_ / 2048; /* Split op_ into operand proper and optype */
	oprec->op = op_ = op_ % 2048;
	oprec->opdata = get_opdef(op_);

	if (oprec->opdata == &illegal_def) {
		if (op_ < START_ACT)
			oprec->errmsg = "GAME ERROR: Illegal condition token encountered.";
		else
			oprec->errmsg = "GAME ERROR: Illegal action token encountered.";
		return 1;
	}

	if (op_ < 1000) oprec->endor = 0; /* Conditional tokens don't end OR block */

	/* Recall that oprec->disambig is initialized to 0 */
	switch (op_) {
	case 89:
	case 95:
	case 96:
	case 97:
		oprec->disambig = 1;
		break; /* YesNo and Chance */
	case WIN_ACT:
	case WIN_ACT+1:
		oprec->disambig = 1;
		break; /* WinGame, EndGame */

	case 1037:
	case 1038: /* DoSubroutine, Return */
	case 1062:
	case 1115: /* RedirectTo, SetDisambigPriority */
	case 1132:            /* AND */
	case 1149:
	case 1150: /* Goto and OnFailGoto */
	case 1151:            /* EndDisambig */
	case 1152:            /* XRedirect */
		break;   /* Accept default of 0: these tokens don' trigger disambig */

	case 1135:
	case 1137:
	case 1138:
	case 1139:
	case 1140:
	case 1141:
	case 1142:
	case 1143:
	case 1147:
	case 1159:
		oprec->endor = 0;
		break;  /* Operations that only affect the stack don't
         stop disambiguation, either. They also
         don't mark the end of an OR block */

	default:
		/* Aside from the above exceptions, all actions will stop
		disambiguation (with success) and all conditions will let it
		 continue. */
		oprec->disambig = (op_ >= START_ACT && op_ < WIN_ACT);
	}

	if (op_ >= 1128 && op_ <= 1131) /* FailMessage group */
		oprec->failmsg = 1;

	leng = oprec->opdata->argnum + 1;
	if (optype != 0) { /* Correct leng for NOUN and OBJECT args */
		special_arg1 = ((optype & 8) == 8);
		leng -= special_arg1 + ((optype & 2) == 2);
		if (leng < 1) {
			oprec->errmsg = "GAME ERROR: Token list corrupted.";
			return 1;
		}
	}
	if (leng > maxleng) {
		oprec->errmsg = "GAME ERROR: Unexpected end of token sequence";
		return 1;
	}

	if (op_ == 108) { /* NOT */
		leng = 1 + decode_instr(oprec, data + 1, maxleng - 1);
		oprec->negate = !oprec->negate;
		return leng;
	}
	oprec->argcnt = leng - 1;
	oprec->arg1 = oprec->arg2 = 0;
	if (leng >= 2) {
		if (special_arg1) {
			assert(leng == 2);
			oprec->arg2 = data[1];
			oprec->arg1 = 0;
		} else oprec->arg1 = data[1];
	}
	if (leng >= 3) oprec->arg2 = data[2];
	if (leng >= 4) writeln("INTERNAL ERROR: Too many token arguments.");
	return leng;
}


/* decode_args checks and decodes the arguments to metacommand tokens */
/* Returns false on an error */
static rbool decode_args(int ip_, op_rec *oprec) {
	rbool grammer_arg; /* Have NOUN/OBJECT that is 0 and so failed argok tests */

	if (oprec->errmsg != NULL) {
		if (!PURE_ERROR)
			writeln(oprec->errmsg);
		return 0;
	}
	if (DEBUG_AGT_CMD && !supress_debug) {
		if (oprec->negate) { /* Output NOT */
			debug_cmd_out(ip_, 108, 0, 0, 0);
			ip_++;
		}
	}

	if (DEBUG_AGT_CMD && !supress_debug)
		debug_cmd_out(ip_, oprec->op, oprec->arg1, oprec->arg2, oprec->optype);

	/* This checks and translates the arguments */
	if (!argok(oprec->opdata, &(oprec->arg1), &(oprec->arg2),
	           oprec->optype, &grammer_arg)) {
		/* Don't report errors for null NOUN/OBJECT/ACTOR arguments
		   used in conditional tokens */
		if (grammer_arg && oprec->op <= MAX_COND)
			return 0;
		if (!PURE_ERROR) {
			if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
			writeln("GAME ERROR: Invalid argument to metacommand token.");
		}
		return 0;
	}
	return 1;
}




/* ------------------------------------------------------------------- */
/*  Subroutine Call Stack routines                                     */
/* ------------------------------------------------------------------- */
/* Note: run_metacommand() passes subroutine calls up to it's parent,
   but it processes Returns on its own (and is the routine responsible
   for maintaining the subcall stack--  scan_metacommand treats
   a subroutine call just like RedirecTo) */
/* The progression for subroutine calls goes like this:
    run_metacommand hits a DoSubroutine token;
      the subroutine id is saved in subcall_arg by exec_token.
    run_metacommand does push_subcall, saving cnum and ip,
      and then returns 4 to scan_metacommand.
    scan_metacommand saves grammar state to the new stack entry
      with push_subcall and then starts scanning SUBROUTINEnn

    Many tokens are executed.

    run_metacommand hits Return. It sets restart_state and
      returns 5 to its parent.
    scan_metacommand then runs pop_subcall_grammar and restores
      the original scanning grammer. It subtracts one from cnum
      so the original cnum will be rerun.
    run_metacommand sees that restart_state is set and pops the
      rest of the information (cnum and ip) off of the stack.
    Things continue as usual.
    */



typedef struct {
	/* run_metacommand state */
	short cnum, ip, failaddr;
	/* scan_metacommand state */
	integer mactor, mdobj, miobj;
	word mprep;
	short vcode;
	/* Global state (is this really saved?) */
	short vb;
	word prep;
} subcall_rec;


static subcall_rec *substack = NULL;
static short subcnt = 0;
static short subsize = 0;


static rbool push_subcall(int cnum, int ip_, int failaddr) {
	subcall_rec *savestack; /* In case something goes wrong. */

	if (MAX_SUBCALL != 0 && ++subcnt > MAX_SUBCALL)
		return 0;
	if (subcnt > subsize) {
		subsize += 5;
		savestack = substack;
		rm_trap = 0;
		substack = (subcall_rec *)rrealloc(substack, subsize * sizeof(subcall_rec));
		rm_trap = 1;
		if (substack == NULL) { /* out of memory */
			substack = savestack;
			return 0;
		}
	}
	substack[subcnt - 1].cnum = cnum;
	substack[subcnt - 1].ip = ip_;
	substack[subcnt - 1].failaddr = failaddr;
	return 1;
}


/* pop_subcall_grammar is called before this */
static void pop_subcall(int *rcnum, int *rip, int *rfailaddr) {
	assert(*rcnum == substack[subcnt - 1].cnum);
	/* *rcnum=substack[subcnt-1].cnum; */
	*rip = substack[subcnt - 1].ip;
	*rfailaddr = substack[subcnt - 1].failaddr;
	subcnt--;
}

/* This is called after push_subcall */
static void push_subcall_grammar(int m_actor, int vcode, int m_dobj, word m_prep,
                                 int m_iobj, int cnum) {
	/* run_metacommand should already have pushed cnum on the stack */
	substack[subcnt - 1].vb = vb;
	substack[subcnt - 1].prep = prep;
	substack[subcnt - 1].mactor = m_actor;
	substack[subcnt - 1].vcode = vcode;
	substack[subcnt - 1].mdobj = m_dobj;
	substack[subcnt - 1].mprep = m_prep;
	substack[subcnt - 1].miobj = m_iobj;
}

/* Return false if something goes wrong-- such as stack underflow. */
/* This is called *before* pop_subcall */
static rbool pop_subcall_grammar(integer *m_actor, int *vcode,
                                 integer *m_dobj, word *m_prep, integer *m_iobj,
                                 int *cnum) {
	if (subcnt == 0) return 0;
	vb = substack[subcnt - 1].vb;
	prep = substack[subcnt - 1].prep;
	*cnum = substack[subcnt - 1].cnum;
	*m_actor = substack[subcnt - 1].mactor;
	*vcode = substack[subcnt - 1].vcode;
	*m_dobj = substack[subcnt - 1].mdobj;
	*m_prep = substack[subcnt - 1].mprep;
	*m_iobj = substack[subcnt - 1].miobj;
	return 1;
}




/* ------------------------------------------------------------------- */
/*  Run Metacommand                                                    */
/* ------------------------------------------------------------------- */

static int run_metacommand(int cnum, int *redir_offset)
/* cnum=command number to run. */
/* *redir_offset=offset of redirect header, if we exit with redirection. */
/* Return
      0 to go on to next metacommand,
      1 to stop running metacommands,  and
      2 to end the turn.
      3 indicates that redirection has just occured
      4 indicates a subcall has just occured.
      5 Is used to go on to the next metacommand after a Return.
      -2 means we're doing disambiguation and just hit an action token. */
{
	int ip_, oip;  /* ip_=Instruction pointer, oip=Old instruction pointer */
	int r;        /* Used to hold return value from token execution */
	int fail_addr;  /* What address to jump to on failure */
	rbool fail;    /* Last token was a conditional token that failed */
	rbool ortrue, blocktrue, orflag; /* OR stuff
                     orflag: Are we in an OR group?
                     ortrue: Is current OR group true?
                     blocktrue: Is current block w/in OR true?
                     */
	static rbool restart = 0; /* Restarting after subroutine?  */
	op_rec currop;          /* Information on the current token and its args */

	fail_addr = 32000; /* Fall off the end when we fail */
	fail = 0;
	ip_ = 0;
	orflag = blocktrue = ortrue = 0;
	*redir_offset = 1;  /* Default: This is what RedirectTo does.
               Only XRedirect can send a different value */


	if (restart)  /* finish up Return from subroutine */
		pop_subcall(&cnum, &ip_, &fail_addr);

	if (DEBUG_AGT_CMD && !supress_debug) {
		debug_head(cnum);
		if (restart) debugout("   (Resuming after subroutine)\n");
	}

	restart = 0;


	/* ==========  Main Loop ================= */
	while (ip_ < command[cnum].cmdsize) {

		oip = ip_;
		ip_ += decode_instr(&currop, command[cnum].data + ip_, command[cnum].cmdsize - ip_);

		/* -------  OR Logic --------------- */
		if (currop.op == 109) { /* OR */
			if (!orflag) { /* First OR; set things up */
				orflag = 1;
				ortrue = 0;
				blocktrue = 1;
			}
			blocktrue = blocktrue && !fail; /* Was the previous token true? */
			fail = 0;
			ortrue = ortrue || blocktrue; /* OR in last block */
			blocktrue = 1; /* New block starts out true. */
		} else if (orflag) { /* we're in the middle of a block */
			blocktrue = blocktrue && !fail; /* Add in previous token */
			fail = 0;
			if (currop.endor) {  /* i.e. not a conditional token */
				orflag = 0;                /* End of OR block */
				ortrue = ortrue || blocktrue; /* OR in last block */
				fail = !ortrue; /* Success of whole group */
			}
		}

		/* ------------  FAILMESSAGE handling ------------- */
		if (currop.failmsg) {  /* Is the current token a Fail... token? */
			if (!fail) continue;  /* Skip it; look at next instruction */
			/* ErrMessage and ErrStdMessage: set disambiguation score */
			if (do_disambig) {
				if (currop.op == 1130 || currop.op == 1131) {
					if (!decode_args(oip, &currop)) return 2;
					disambig_score = currop.arg1;
					return 2;
				} else return -2; /* FailMessage counts as an action token */
			}
			/* Then run the failmessage, skipping the following step... */
		}
		/* -------- Failure routines -------------------- */
		else if (fail) {  /* ... and not failmessage */
			/* consequences of failure */
			fail = 0; /* In case fail_addr doesn't point off the edge of the world */
			ip_ = fail_addr;
			fail_addr = 32000; /* Reset fail_addr */
			continue; /* Usually fail_addr will fall off the end, causing this to
           return 0 */
		}

		/* - Finish decoding arguments and print out debugging message - */
		if (!decode_args(oip, &currop)) {
			if (currop.op < 1000) fail = currop.negate ? 0 : 1;
			continue;
			/* return 2;*/
		}

		/* -------- Commands that need to be handled specially -------------- */
		if (currop.op == 109) { /* OR */
			if (DEBUG_AGT_CMD && !supress_debug) debug_newline(op, 0);
			continue; /* OR: skip further processing */
		}

		if (currop.op == 1037) { /* DoSubroutine */
			if (!push_subcall(cnum, ip_, fail_addr)) {
				writeln("GAME ERROR: Subroutine stack overflow.");
				return 2;
			}
			subcall_arg = currop.arg1;
			if (DEBUG_AGT_CMD && !supress_debug) debugout("--> Call\n");
			return 4;
		}

		if (currop.op == 1038) { /* Return */
			restart = 1;
			if (DEBUG_AGT_CMD && !supress_debug) debugout("--> Return\n");
			return 5;
		}

		if (currop.op == 1149) { /* Goto */
			ip_ = currop.arg1;
			if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
			continue;
		}

		if (currop.op == 1150) { /* OnFailGoto */
			fail_addr = currop.arg1;
			if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
			continue;
		}

		if (currop.op == 1152) /* XRedirect */
			*redir_offset = currop.arg1;

		/* ---------- Disambiguation Success -------------- */
		if (do_disambig && currop.disambig) {
			if (DEBUG_AGT_CMD && !supress_debug) debugout("==> ACTION\n");
			return -2;
		}

		/* ---------- Run normal metacommands -------------- */
		switch (r = exec_instr(&currop)) {
		case 0:  /* Normal action token or successful conditional token */
			if (DEBUG_AGT_CMD && !supress_debug) debug_newline(op, 0);
			continue;
		case 1: /* Conditional token: fail */
			if (DEBUG_AGT_CMD && !supress_debug) {
				if (orflag) debugout("  (-->FAIL)\n");
				else debugout("--->FAIL\n");
			}
			fail = 1;
			continue;
		default: /* Return explicit value */
			if (DEBUG_AGT_CMD && !supress_debug) {
				if (r == 103) debugout("-->Redirect\n");
				else debugout("==> END\n");
			}
			return r - 100;
		}
	}
	return 0;
}



/* ====================================================================*/
/*  SCAN METACOMMAND: These are the routines that scan through the  */
/*    metacommand headers and find the appropriate ones to execute */
/*    Redirection is also handled at this level  */
/* ====================================================================*/


/* ------------------------------------------------------------------- */
/*  Support routines for extracting object information */
/* ------------------------------------------------------------------- */

/* For $ strings. Returns object number if there is one, or negative
   the dictionary index.
   This is used by the metacommand redirection routines */

static integer expand_redirect(word w) {
	assert(w != -1); /* <*NONE*> object shouldn't make it this far */
	if (w == 0 || aver < AGTME10) return -w;
	if (w == ext_code[wdverb]) return -syntbl[auxsyn[vb]];
	if (w == ext_code[wdnoun]) return dobj;
	if (w == ext_code[wdobject]) return iobj;
	if (w == ext_code[wdname]) return actor;
	if (w == ext_code[wdadjective]) return -it_adj(dobj);
	if (w == ext_code[wdprep]) return -prep;
	return -w;
}


static int extract_actor(int actnum) {
	if (actnum < 0) actnum = -actnum; /* Erase redirection stuff */
	if (tcreat(actnum)) return actnum;
	else return 0;
}

/* Basically, we need to find an object with a matching noun
   and adj to our choice. */
static int extract_obj(word name, word adj) {
	int i, obj;

	/* We just take the first one. We split this into separate noun and
	 creature loops for performance reaons */

	if (name == -1) /* <*NONE*> */
		return 0;

	obj = expand_redirect(name);
	adj = it_name(expand_redirect(adj));

	if (obj > 0) { /* $noun$, $object$, or $name$ */
		if (adj == 0 || adj == it_adj(obj))
			return obj; /* We're done */
		name = it_name(obj);
	} else
		name = -obj;

	if (adj == 0) return -name; /* Adjectives required for CLASS redirect */
	nounloop(i)
	if (noun[i].name == name && noun[i].adj == adj) return i + first_noun;
	creatloop(i)
	if (creature[i].name == name && creature[i].adj == adj)
		return i + first_creat;
	/* Hmm... just hope it's an internal noun. */
	writeln("GAME ERROR: Redirect statement with bad object name.");
	return -name;
}


/* ------------------------------------------------------------------- */
/*  Redirection Routines     */
/* ------------------------------------------------------------------- */


#define wordcode_fix(w) it_name(expand_redirect(w));

/* 'real_obj' below is the dobj_obj/iobj_obj field; it takes
   precedence over anything else if it is nonzero.
   It represents an *explicitly* declared object in
   the header */

static void fix_objnum(integer *objnum, word match,
                       int real_obj,
                       int actor_, int dobj_, int iobj_) {
	if (real_obj) *objnum = real_obj;
	else if (match == ext_code[wdobject]) *objnum = iobj_;
	else if (match == ext_code[wdnoun]) *objnum = dobj_;
	else if (match == ext_code[wdname]) *objnum = actor_;
}

/* Returns TRUE if we changed *objrec, FALSE otherwise */
/*  (This is needed for memory allocation purposes) */
static rbool fix_objrec(parse_rec **objrec, word match,
                        int real_obj,
                        parse_rec *actrec, parse_rec *dobjrec,
                        parse_rec *iobjrec) {
	if (real_obj) *objrec = make_parserec(real_obj, NULL);
	else if (match == ext_code[wdobject]) *objrec = copy_parserec(iobjrec);
	else if (match == ext_code[wdnoun]) *objrec = copy_parserec(dobjrec);
	else if (match == ext_code[wdname]) *objrec = copy_parserec(actrec);
	else return 0; /* *objrec unchanged */

	return 1;  /* *objrec changed */
}

static void objcode_fix(cmd_rec *cmd)
/* For $ strings. Fixes object redirection if neccessary */
{
	int actorword;
	word nounword, objword;
	int dobj_obj, iobj_obj;
	int savedobj, saveactor;
	parse_rec *savedrec, *saveactrec, *saveirec;
	rbool achange, dchange, ichange; /* Did the given _rec ptr change? */

	/* dobj_obj/iobj_obj take precedence over anything else */
	actorword = cmd->actor;
	nounword = cmd->nouncmd;
	objword = cmd->objcmd;
	dobj_obj = cmd->noun_obj;
	iobj_obj = cmd->obj_obj;

	/* Make temporary copies of things for when more than one thing is
	   being shuffled around; we don't need to save iobj since
	   it's processed last */
	saveactor = actor;
	saveactrec = actor_rec;
	savedobj = dobj;
	savedrec = dobj_rec;
	saveirec = iobj_rec; /* Saved only so it can be freed */

	/* Fix object numbers... */
	fix_objnum(&actor, actorword, 0, saveactor, savedobj, iobj);
	fix_objnum(&dobj, nounword, dobj_obj, saveactor, savedobj, iobj);
	fix_objnum(&iobj, objword, iobj_obj, saveactor, savedobj, iobj);

	/* ... and records */
	achange = fix_objrec(&actor_rec, actorword, 0, saveactrec, savedrec, iobj_rec);
	dchange = fix_objrec(&dobj_rec, nounword, dobj_obj, saveactrec, savedrec, iobj_rec);
	ichange = fix_objrec(&iobj_rec, objword, iobj_obj, saveactrec, savedrec, iobj_rec);

	/* Free up whatever needs freeing */
	if (achange) rfree(saveactrec);
	if (dchange) rfree(savedrec);
	if (ichange) rfree(saveirec);
}


/* Redirection is very superficial-- normally all it does is */
/* change the matching pattern, not the underlying objects */
/* The one exception is when we use the special redirection tokens */
/* NOUN or OBJECT */

void redirect_exec(cmd_rec *cmd, word *m_actor, int *vcode,
                   word *m_dobj, word *m_prep, word *m_iobj) {
	*m_actor = extract_actor(cmd->actor);
	vb = *vcode = verb_code(it_name(expand_redirect(cmd->verbcmd)));
	*m_dobj = extract_obj(cmd->nouncmd, cmd->noun_adj);
	if (cmd->prep == -1)
		*m_prep = 0;
	else
		*m_prep = it_name(expand_redirect(cmd->prep));
	*m_iobj = extract_obj(cmd->objcmd, cmd->obj_adj);

	/* This shuffles the _real_ objects if $noun$ forms are being
	   used */
	objcode_fix(cmd);
}




/* ------------------------------------------------------------------- */
/*  Scan Metacommand and the matching function it uses                 */
/* ------------------------------------------------------------------- */

/* This is used to match the elements of metacommand trigger patterns */
/* Sees if w2 matches COMMMAND pattern word w1; w1==0 corresponds to ANY */
#define cmatch(w1,w2) ((w1)==0 || (w1)==(w2) || ((w1)==-1 && (w2)==0))

static int cm_actor(int actnum, int actor_)
/* cmd: actnum,  player entry: actor_ */
{
	if (aver < AGX00) return 1; /* Bit of AGT brain-deadness. */
	if (actnum == 1) return actor_ == 0; /* No actor_: just the player  */
	if (tcreat(actnum))
		return (creat_fix[actor_ - first_creat] == creat_fix[actnum - first_creat]);
	if (actnum == 2) return (actor_ != 0); /* ANYBODY? */
	return (actor_ == 0);
}


/* Check that the explicit object matches */
static rbool cm_x_obj(int x_obj, int real_obj) {
	if (x_obj == 0) return 1; /* No explicit object; automatically match. */
	/* Explicit object case */
	/* In this case, we match against the _real_ object */
	/* However, we also require a "normal" match */
	do {
		if (x_obj == real_obj) return 1;
		real_obj = it_class(real_obj);
	} while (real_obj != 0);
	return 0;
}

/* Does [obj] match <adj> <noun> [x_obj]? */
/*  --[obj] must match up with <adj> <noun> */
/*  --If x_obj(the explicit object) is defined, it must match with
      the "real" object-- that is, the global dobj or iobj value. */
static rbool cm_obj(word name, word adj, int x_obj, int obj, int real_obj) {
	if (name == -1) return (obj == 0); /* <NONE> */

	if (x_obj && !cm_x_obj(x_obj, real_obj)) return 0;

	/* (Note that ANY does not match ALL) */
	if (obj == -ext_code[wall])
		return (name == ext_code[wall] && adj == 0);

	do {  /* Work our way up the class hierarchy */
		if (cmatch(name, it_name(obj)) && cmatch(adj, it_adj(obj)))
			return 1;
		obj = it_class(obj);
	} while (obj != 0);

	return 0;
}



static void scan_dbg(int vcode) {
	char buff[220];
	word w;

	if (vcode >= BASE_VERB && vcode < BASE_VERB + DUMB_VERB
	        && syntbl[synlist[vcode]] != 0)
		w = syntbl[synlist[vcode]];
	else w = syntbl[auxsyn[vcode]];

	if (strlen(dict[w]) > 200) return; /* Just in case... */
	sprintf(buff, "+++++Scanning %s\n", dict[w]);
	debugout(buff);
}

#define not_any(n,a) (n!=0 || a!=0)

/* This returns true if we redirect from VERB OBJ {PREP OBJ}
   to something that has fewer objects or no (explicit) preposition.
   This is less perfect than I would like since there is currently
   no way of distinguishing between ANY and an empty slot unless
   the new "NOMATCH" extension is used. */

static rbool redir_narrows_grammar(cmd_rec *cmd1, cmd_rec *cmd2) {
	/* Check inward from obj to prep to noun; if in any of these
	   fields cmd2 has ANY and cmd1 doesn't, return 1.
	   Stop as soon as we find a non-ANY field in either one. */

	/* If we *are* using the new extension, we can just use that info */
	if (cmd2->objcmd == -1) {
		if (cmd1->objcmd != -1) return 1;
		if (cmd1->prep == -1) {
			if (cmd1->prep != -1) return 1;
			if (cmd2->nouncmd == -1 && cmd1->objcmd != -1) return 1;
		}
	}
	if (nomatch_aware) return 0; /* If we are using nomatch, don't need
                  to go through the rest of this nonsense. */

	if (not_any(cmd2->objcmd, cmd2->obj_adj)) return 0;
	if (not_any(cmd1->objcmd, cmd1->obj_adj)) return 1;

	if (cmd2->prep != 0) return 0;
	if (cmd1->prep != 0) return 1;

	if (not_any(cmd2->nouncmd, cmd2->noun_adj)) return 0;
	if (not_any(cmd1->nouncmd, cmd1->noun_adj)) return 1;

	return 0; /* They are both all ANY. */
}



static rbool cm_command(cmd_rec *cmd,
                        integer m_actor, int m_verb,
                        integer m_dobj, word m_prep, integer m_iobj) {
	if (cmd->verbcmd == 0) { /* ANY */
		if (cmd->actor == 0 && aver >= AGX00)
			return (m_verb == 0); /* ANY command: rest of line ignored */
		/* Else ANY matchs; go on to test other things. */
	} else if (cmd->verbcmd != m_verb) return 0;

	return
	    cm_actor(cmd->actor, m_actor)
	    && cm_obj(cmd->nouncmd, cmd->noun_adj, cmd->noun_obj, m_dobj, dobj)
	    && cmatch(cmd->prep, m_prep)
	    && cm_obj(cmd->objcmd, cmd->obj_adj, cmd->obj_obj, m_iobj, iobj);
}



static void scan_for_actor(integer m_actor, int *start, int *end) {
	int i;

	assert(m_actor != 0);

	if (aver >= AGX00) {
		if (start != NULL) *start = verbptr[DIR_ADDR_CODE];
		*end = verbend[DIR_ADDR_CODE];
		return;
	}
	for (i = verbend[DIR_ADDR_CODE]; i > verbptr[DIR_ADDR_CODE]; i--)
		if (creat_fix[command[i].actor - first_creat]
		        == creat_fix[m_actor - first_creat]) {
			i++;
			break;
		}
	*end = i;

	if (start == NULL) return;

	for (i = verbptr[DIR_ADDR_CODE]; i <= *end; i++)
		if (creat_fix[command[i].actor - first_creat]
		        == creat_fix[m_actor - first_creat])
			break;
	*start = i;
}


/* m_<word> are the matching criterion; they have no *neccessary*
  connection to dobj, iobj, etc. */

int scan_metacommand(integer m_actor, int vcode,
                     integer m_dobj, word m_prep, integer m_iobj,
                     int *redir_flag)
/* Return codes:  0=end of this cycle, 1=end of all commands
   2=end of turn */
/* If doing disambiguation, then -2=end of cycle, something happened;
   0 or 1=end of cycle; nothing happened; 2=end of turn, nothing happened. */
/* If redir_flag is non-NULL, it is set when redirection occurs:
   1+=Redirection occured
   2=Grammar-changing redirection occured. */
{
	int i, oldi;
	word m_verb;
	int scanend;
	int redir_offset;   /* Used for multiple redirects in the same
             metacommand (which can occur in AGATE-style
             commands)-- this is used to hold the offset
             of the given redirect. */
	long redirect_count;  /* This is a safety measure: this keeps track of how
            many redirections have occured on a single turn, and
            if there are "too many" it will issue an error message
            and stop. This is to prevent the system from getting
            into a redirection loop. The number should be set
            high enough not to prevent deliberate loops,
            however. */

	rfree(substack);
	subcnt = 0;
	subsize = 0;
	redirect_count = 0;

	if (mars_fix)
		if (vcode == 0 || m_actor == 2) return 0;
	/* Don't explicity scan ANY metacommands if MARS fix is active. */
	if (m_actor == -ext_code[weverybody]) m_actor = 2;


	if (DEBUG_AGT_CMD && DEBUG_SCAN && !supress_debug) scan_dbg(vcode);

	m_verb = syntbl[auxsyn[vcode]];
	if (m_actor == 0) {
		i = verbptr[vcode];
		scanend = verbend[vcode];
	} else
		scan_for_actor(m_actor, &i, &scanend);
	for (; i < scanend; i++)
		if (command[i].actor < 0) {
			/* REDIRECT data; skip over it */;
		} else if (cm_command(&command[i], m_actor, m_verb, m_dobj, m_prep, m_iobj))
			switch (run_metacommand(i, &redir_offset)) {
			case -2:
				rfree(substack);
				return -2;
			/* We are doing disambiguation and reached
			   an action token */
			case 0:
				break; /* Go onto next metacommand */
			case 1:
				rfree(substack);
				return 1;  /* Done with metacommands */
			case 2:
				rfree(substack);
				return 2;  /* Done with turn */


			/* -------- REDIRECTION  ------------ */
			/* This handles RedirectTo tokens */
			case 3:
				oldi = i;
				i += redir_offset;
				if (i == last_cmd || command[i].actor > 0) {
					if (!PURE_ERROR) writeln("GAME ERROR: Invalid REDIRECT token.");
					rfree(substack);
					return 2;
				}
				if (MAX_REDIR != 0 && ++redirect_count > MAX_REDIR) {
					if (!PURE_ERROR) writeln("GAME ERROR: Infinite REDIRECT loop.");
					rfree(substack);
					return 2;
				}
				if (DEBUG_AGT_CMD && !supress_debug) {
					debugout("   ==>");
					debug_head(i);
				}

				/* REDIRECT :If we do a redirect from a broader grammar to a
				   narrower grammer, it will be noted so that certain types
				   of grammer checking can be disabled. */
				if (redir_flag != NULL) {
					if (*redir_flag < 2
					        && redir_narrows_grammar(&command[oldi], &command[i]))
						*redir_flag = 2;

					/* Set *redir_flag to at least 1 if we do *any* redirection. */
					if (!*redir_flag) *redir_flag = 1;
				}

				/* REDIRECT: Do the actual redirection, building the new command
				   header and shuffling around nouns and verbs as
				   neccessary */
				redirect_exec(&command[i], &m_actor, &vcode,
				              &m_dobj, &m_prep, &m_iobj);

				/* REDIRECT: Start scanning again from the beginning */
				if (!mars_fix) {/* In MARS, we *don't* go back to the top */
					if (m_actor != 0)
						scan_for_actor(m_actor, &i, &scanend);
					else {
						i = verbptr[vcode];
						scanend = verbend[vcode];
					}
					i--; /* Back up one so that the following i++ we'll
            be at the right location */
				}

				/* So when i is incremented, we start back at the correct start: i.e.
				   we start scanning again from the beginning. It's even possible
				   to use REDIRECT to run verb commands from an AFTER command,
				   although it precludes other AFTER commands from running. */
				m_verb = syntbl[auxsyn[vcode]];
				break;



			/* -------- SUBROUTINE CALL  ------------ */
			case 4:  /* Subroutine Call -- same idea as RedirectTo,
          but less complicated */
				push_subcall_grammar(m_actor, vcode, m_dobj, m_prep, m_iobj, i);
				vcode = verb_code(sub_name[subcall_arg - 1]);
				m_actor = m_dobj = m_iobj = 0;
				m_prep = 0;

				if (!mars_fix) /* In MARS, we *don't* go back to the top */
					i = verbptr[vcode] - 1;
				scanend = verbend[vcode];
				m_verb = syntbl[auxsyn[vcode]];
				break;


			/* -------- RETURN  ------------ */
			case 5: /* Return: pop grammar state, then ... ? */
				if (!pop_subcall_grammar(&m_actor, &vcode,
				                         &m_dobj, &m_prep, &m_iobj, &i)) {
					writeln("GAME ERROR: Return without DoSubroutine.");
					rfree(substack);
					return 2;
				}

				if (m_actor == 0)
					scanend = verbend[vcode];
				else
					scan_for_actor(m_actor, NULL, &scanend);
				m_verb = syntbl[auxsyn[vcode]];

				i--; /* Cause the last command to restart,
          at which point run_command will pop the rest of the
          stack. */

				break;
			}
	rfree(substack);
	return 0; /* Done with this cycle of metacommands */
}

/* ====================================================================*/

#undef cm

} // End of namespace AGT
} // End of namespace Glk