GLK: AGT: Added subengine files

1 files changed, 1154 insertions, 0 deletions

diff --git a/engines/glk/agt/metacommand.cpp b/engines/glk/agt/metacommand.cpp
new file mode 100644
index 0000000000..9324a0b054
--- /dev/null
+++ b/engines/glk/agt/metacommand.cpp
@@ -0,0 +1,1154 @@
+/* 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