1 /* ScummVM - Graphic Adventure Engine
2 *
3 * ScummVM is the legal property of its developers, whose names
4 * are too numerous to list here. Please refer to the COPYRIGHT
5 * file distributed with this source distribution.
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20 *
21 */
22
23 #include "glk/agt/agility.h"
24 #include "glk/agt/interp.h"
25 #include "glk/agt/exec.h"
26
27 namespace Glk {
28 namespace AGT {
29
30 /* This contains the code for scanning and running metacommands.
31 Note that while the code here deals with all of the flow-of-execution
32 details, the code for executing individual tokens is actually
33 in token.c (With a few exceptions for commands that impact
34 the order of execution). */
35
36 #define DEBUG_SCAN 1
37
38 #define MAX_REDIR 50000L /* Maximum number of redirects, to catch
39 infinite loops. If this is 0, allow infinitely
40 many */
41
42 #define MAX_SUBCALL 2047 /* Maximum number of subroutine calls.
43 If this is 0, no limit (except for the
44 program's stack size). */
45
46
47 /*
48
49 scan_metacommand
50 -2=end of cycle, something happened (disambiguation only)
51 0=end of this cycle (disambig: end of cycle, nothing happened)
52 1=end of all commands (disambig: end of cycle, nothing happened)
53 2=end of turn (disambig: nothing happened)
54
55 run_metacommand
56 0 to go on to next metacommand,
57 1 to stop running metacommands, and
58 2 to end the turn.
59 3 indicates that redirection has just occured
60 4 indicates a subcall has just occured.
61 5 to go on to next metacommand after a return has occured.
62 -2 means we're doing disambiguation and just hit an action token.
63
64 */
65
66
67 /* ====================================================================*/
68 /* RUN METACOMMAND: The following are the routines used to execute */
69 /* a single metacommand block. run_metacommand is invoked by */
70 /* scan_metacommand, which is further down in this file. */
71 /* ====================================================================*/
72
73 /* ------------------------------------------------------------------- */
74 /* TYPE CHECKING ROUTINES */
75 /* Routines used to do type checking for metacommands. */
76 /* ------------------------------------------------------------------- */
77
78
argvalid(int argtype,int arg)79 rbool argvalid(int argtype, int arg) {
80 if (argtype & AGT_VAR) { /* We have a variable */
81 /* First, verify that arg actually indexes a variable */
82 if (arg < 0 || arg > VAR_NUM) return 0; /* Nope */
83
84 if (argtype == AGT_VAR) return 1; /* Pure variable; contents don't matter */
85
86 /* Next, verify its contents, using the rest of this routine */
87 arg = agt_var[arg];
88 argtype &= ~AGT_VAR; /* Mask off AGT_VAR */
89 }
90
91 if (argtype < 128) {
92 if (tnoun(arg)) return (argtype & AGT_ITEM) != 0;
93 if (troom(arg)) return (argtype & AGT_ROOM) != 0;
94 if (arg == 0) return (argtype & AGT_NONE) != 0;
95 if (arg == 1) return (argtype & AGT_SELF) != 0;
96 if (tcreat(arg)) return (argtype & AGT_CREAT) != 0;
97 if (arg == 1000) return (argtype & AGT_WORN) != 0;
98 return 0;
99 } else switch (argtype) {
100 case AGT_NUM:
101 return 1;
102 case AGT_DIR:
103 return (arg >= 1 && arg <= 12);
104 case AGT_FLAG:
105 return (arg >= 0 && arg <= FLAG_NUM);
106 case AGT_CNT:
107 return (arg >= 0 && arg <= CNT_NUM);
108 case AGT_QUEST:
109 return (arg >= 1 && arg <= MaxQuestion);
110 case AGT_MSG:
111 return (arg >= 1 && arg <= last_message);
112 case AGT_ERR:
113 return (arg >= 1 && arg <= NUM_ERR);
114 case AGT_STR:
115 return (arg >= 1 && arg <= MAX_USTR);
116 case AGT_SUB:
117 return (arg >= 1 && arg <= MAX_SUB);
118 case AGT_PIC:
119 return (arg >= 1 && arg <= maxpict);
120 case AGT_PIX:
121 return (arg >= 1 && arg <= maxpix);
122 case AGT_FONT:
123 return (arg >= 1 && arg <= maxfont);
124 case AGT_SONG:
125 return (arg >= 1 && arg <= maxsong);
126 case AGT_ROOMFLAG:
127 return (arg >= 1 && arg <= 32);
128 case AGT_EXIT:
129 return (argvalid(AGT_ROOM | AGT_NONE, arg)
130 || argvalid(AGT_MSG, arg - exitmsg_base)
131 || (arg < 0 && aver >= AGX00)); /* Treat as verb */
132 case AGT_OBJFLAG:
133 return (arg >= 0 && arg < oflag_cnt);
134 case AGT_OBJPROP:
135 return (arg >= 0 && arg < oprop_cnt);
136 case AGT_ATTR: /* ATTR and PROP are type-checked elsewhere */
137 case AGT_PROP:
138 return 1;
139 default:
140 writeln("INTERNAL ERROR:Unrecognized type specifier.");
141 }
142 return 0;
143 }
144
145 /* <special> is set true for NOUN, OBJECT, NAME variables that are 0 */
146 /* (In this case, some error handling is suppressed) */
147
argfix(int argtype,int * arg,int optype,rbool * special)148 static rbool argfix(int argtype, int *arg, int optype, rbool *special) {
149 *special = 0;
150 switch (optype) {
151 case 0:
152 break; /* Direct: The easy case */
153 case 1: /* Variable */
154 if (*arg == -1) { /* Top-of-stack */
155 *arg = pop_expr_stack();
156 break;
157 }
158 if (!argvalid(AGT_VAR, *arg)) return 0;
159 *arg = (int)agt_var[*arg];
160 break;
161 case 2:
162 *arg = dobj;
163 *special = (dobj == 0);
164 break; /* NOUN */
165 case 3:
166 *arg = iobj;
167 *special = (iobj == 0);
168 break; /* OBJECT */
169 default:
170 rprintf("Internal error: Invalid optype.");
171 return 0;
172 }
173 if (!(optype & 2)) {
174 /* i.e. we have direct or variable type */
175 /* The noun and object types below are useless for direct use,
176 but may be useful when used as values of variables. */
177 if (argtype < 64) {
178 if (*arg == -1) { /* NAME */
179 *arg = actor;
180 *special = (actor == 0);
181 } else if (*arg == -2) { /* NOUN */
182 *arg = dobj;
183 *special = (dobj == 0);
184 } else if (*arg == -3) { /* OBJECT */
185 *arg = iobj;
186 *special = (iobj == 0);
187 }
188 }
189 }
190 return argvalid(argtype, *arg);
191 }
192
193
194 /* These are handled in the order ARG2 then ARG1 so that
195 top-of-stack references will pop the stack in that order
196 (so that the push-order will corrospond to the argument order) */
197 /* <grammer_arg> is true if "bad" argument is NOUN/OBJECT/etc. and
198 is 0. */
argok(const opdef * opdata,int * arg1,int * arg2,int optype,rbool * grammer_arg)199 static int argok(const opdef *opdata, int *arg1, int *arg2, int optype,
200 rbool *grammer_arg) {
201 if ((opdata->argnum) > 1 && !argfix(opdata->arg2, arg2, optype % 4, grammer_arg))
202 return 0;
203 if ((opdata->argnum) > 0 && !argfix(opdata->arg1, arg1, optype / 4, grammer_arg))
204 return 0;
205 return 1;
206 }
207
208 /* ------------------------------------------------------------------- */
209 /* INSTRUCTION DECODING ROUTINES */
210 /* Routines for decoding opcodes and their arguments */
211 /* ------------------------------------------------------------------- */
212
decode_instr(op_rec * oprec,const integer * data,int maxleng)213 static int decode_instr(op_rec *oprec, const integer *data, int maxleng) {
214 integer op_;
215 int optype;
216 int leng;
217 rbool special_arg1; /* Is the first argument a special 0-length argument? */
218
219 oprec->negate = oprec->failmsg = oprec->disambig = 0;
220 oprec->errmsg = NULL;
221 oprec->op = -1;
222 oprec->opdata = &illegal_def;
223 oprec->argcnt = 0;
224 oprec->endor = 1;
225
226 special_arg1 = 0;
227
228 if (maxleng <= 0) {
229 oprec->errmsg = "GAME ERROR: Unexpected end of token sequence.";
230 return 1;
231 }
232 op_ = data[0];
233 if (op_ < 0) {
234 oprec->errmsg = "GAME ERROR: Negative token found.";
235 return 1;
236 }
237 oprec->optype = optype = op_ / 2048; /* Split op_ into operand proper and optype */
238 oprec->op = op_ = op_ % 2048;
239 oprec->opdata = get_opdef(op_);
240
241 if (oprec->opdata == &illegal_def) {
242 if (op_ < START_ACT)
243 oprec->errmsg = "GAME ERROR: Illegal condition token encountered.";
244 else
245 oprec->errmsg = "GAME ERROR: Illegal action token encountered.";
246 return 1;
247 }
248
249 if (op_ < 1000) oprec->endor = 0; /* Conditional tokens don't end OR block */
250
251 /* Recall that oprec->disambig is initialized to 0 */
252 switch (op_) {
253 case 89:
254 case 95:
255 case 96:
256 case 97:
257 oprec->disambig = 1;
258 break; /* YesNo and Chance */
259 case WIN_ACT:
260 case WIN_ACT+1:
261 oprec->disambig = 1;
262 break; /* WinGame, EndGame */
263
264 case 1037:
265 case 1038: /* DoSubroutine, Return */
266 case 1062:
267 case 1115: /* RedirectTo, SetDisambigPriority */
268 case 1132: /* AND */
269 case 1149:
270 case 1150: /* Goto and OnFailGoto */
271 case 1151: /* EndDisambig */
272 case 1152: /* XRedirect */
273 break; /* Accept default of 0: these tokens don' trigger disambig */
274
275 case 1135:
276 case 1137:
277 case 1138:
278 case 1139:
279 case 1140:
280 case 1141:
281 case 1142:
282 case 1143:
283 case 1147:
284 case 1159:
285 oprec->endor = 0;
286 break; /* Operations that only affect the stack don't
287 stop disambiguation, either. They also
288 don't mark the end of an OR block */
289
290 default:
291 /* Aside from the above exceptions, all actions will stop
292 disambiguation (with success) and all conditions will let it
293 continue. */
294 oprec->disambig = (op_ >= START_ACT && op_ < WIN_ACT);
295 }
296
297 if (op_ >= 1128 && op_ <= 1131) /* FailMessage group */
298 oprec->failmsg = 1;
299
300 leng = oprec->opdata->argnum + 1;
301 if (optype != 0) { /* Correct leng for NOUN and OBJECT args */
302 special_arg1 = ((optype & 8) == 8);
303 leng -= special_arg1 + ((optype & 2) == 2);
304 if (leng < 1) {
305 oprec->errmsg = "GAME ERROR: Token list corrupted.";
306 return 1;
307 }
308 }
309 if (leng > maxleng) {
310 oprec->errmsg = "GAME ERROR: Unexpected end of token sequence";
311 return 1;
312 }
313
314 if (op_ == 108) { /* NOT */
315 leng = 1 + decode_instr(oprec, data + 1, maxleng - 1);
316 oprec->negate = !oprec->negate;
317 return leng;
318 }
319 oprec->argcnt = leng - 1;
320 oprec->arg1 = oprec->arg2 = 0;
321 if (leng >= 2) {
322 if (special_arg1) {
323 assert(leng == 2);
324 oprec->arg2 = data[1];
325 oprec->arg1 = 0;
326 } else oprec->arg1 = data[1];
327 }
328 if (leng >= 3) oprec->arg2 = data[2];
329 if (leng >= 4) writeln("INTERNAL ERROR: Too many token arguments.");
330 return leng;
331 }
332
333
334 /* decode_args checks and decodes the arguments to metacommand tokens */
335 /* Returns false on an error */
decode_args(int ip_,op_rec * oprec)336 static rbool decode_args(int ip_, op_rec *oprec) {
337 rbool grammer_arg; /* Have NOUN/OBJECT that is 0 and so failed argok tests */
338
339 if (oprec->errmsg != NULL) {
340 if (!PURE_ERROR)
341 writeln(oprec->errmsg);
342 return 0;
343 }
344 if (DEBUG_AGT_CMD && !supress_debug) {
345 if (oprec->negate) { /* Output NOT */
346 debug_cmd_out(ip_, 108, 0, 0, 0);
347 ip_++;
348 }
349 }
350
351 if (DEBUG_AGT_CMD && !supress_debug)
352 debug_cmd_out(ip_, oprec->op, oprec->arg1, oprec->arg2, oprec->optype);
353
354 /* This checks and translates the arguments */
355 if (!argok(oprec->opdata, &(oprec->arg1), &(oprec->arg2),
356 oprec->optype, &grammer_arg)) {
357 /* Don't report errors for null NOUN/OBJECT/ACTOR arguments
358 used in conditional tokens */
359 if (grammer_arg && oprec->op <= MAX_COND)
360 return 0;
361 if (!PURE_ERROR) {
362 if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
363 writeln("GAME ERROR: Invalid argument to metacommand token.");
364 }
365 return 0;
366 }
367 return 1;
368 }
369
370
371
372
373 /* ------------------------------------------------------------------- */
374 /* Subroutine Call Stack routines */
375 /* ------------------------------------------------------------------- */
376 /* Note: run_metacommand() passes subroutine calls up to it's parent,
377 but it processes Returns on its own (and is the routine responsible
378 for maintaining the subcall stack-- scan_metacommand treats
379 a subroutine call just like RedirecTo) */
380 /* The progression for subroutine calls goes like this:
381 run_metacommand hits a DoSubroutine token;
382 the subroutine id is saved in subcall_arg by exec_token.
383 run_metacommand does push_subcall, saving cnum and ip,
384 and then returns 4 to scan_metacommand.
385 scan_metacommand saves grammar state to the new stack entry
386 with push_subcall and then starts scanning SUBROUTINEnn
387
388 Many tokens are executed.
389
390 run_metacommand hits Return. It sets restart_state and
391 returns 5 to its parent.
392 scan_metacommand then runs pop_subcall_grammar and restores
393 the original scanning grammer. It subtracts one from cnum
394 so the original cnum will be rerun.
395 run_metacommand sees that restart_state is set and pops the
396 rest of the information (cnum and ip) off of the stack.
397 Things continue as usual.
398 */
399
400
401
402 typedef struct {
403 /* run_metacommand state */
404 short cnum, ip, failaddr;
405 /* scan_metacommand state */
406 integer mactor, mdobj, miobj;
407 word mprep;
408 short vcode;
409 /* Global state (is this really saved?) */
410 short vb;
411 word prep;
412 } subcall_rec;
413
414
415 static subcall_rec *substack = NULL;
416 static short subcnt = 0;
417 static short subsize = 0;
418
419
push_subcall(int cnum,int ip_,int failaddr)420 static rbool push_subcall(int cnum, int ip_, int failaddr) {
421 subcall_rec *savestack; /* In case something goes wrong. */
422
423 if (MAX_SUBCALL != 0 && ++subcnt > MAX_SUBCALL)
424 return 0;
425 if (subcnt > subsize) {
426 subsize += 5;
427 savestack = substack;
428 rm_trap = 0;
429 substack = (subcall_rec *)rrealloc(substack, subsize * sizeof(subcall_rec));
430 rm_trap = 1;
431 if (substack == NULL) { /* out of memory */
432 substack = savestack;
433 return 0;
434 }
435 }
436 substack[subcnt - 1].cnum = cnum;
437 substack[subcnt - 1].ip = ip_;
438 substack[subcnt - 1].failaddr = failaddr;
439 return 1;
440 }
441
442
443 /* pop_subcall_grammar is called before this */
pop_subcall(int * rcnum,int * rip,int * rfailaddr)444 static void pop_subcall(int *rcnum, int *rip, int *rfailaddr) {
445 assert(*rcnum == substack[subcnt - 1].cnum);
446 /* *rcnum=substack[subcnt-1].cnum; */
447 *rip = substack[subcnt - 1].ip;
448 *rfailaddr = substack[subcnt - 1].failaddr;
449 subcnt--;
450 }
451
452 /* This is called after push_subcall */
push_subcall_grammar(int m_actor,int vcode,int m_dobj,word m_prep,int m_iobj,int cnum)453 static void push_subcall_grammar(int m_actor, int vcode, int m_dobj, word m_prep,
454 int m_iobj, int cnum) {
455 /* run_metacommand should already have pushed cnum on the stack */
456 substack[subcnt - 1].vb = vb;
457 substack[subcnt - 1].prep = prep;
458 substack[subcnt - 1].mactor = m_actor;
459 substack[subcnt - 1].vcode = vcode;
460 substack[subcnt - 1].mdobj = m_dobj;
461 substack[subcnt - 1].mprep = m_prep;
462 substack[subcnt - 1].miobj = m_iobj;
463 }
464
465 /* Return false if something goes wrong-- such as stack underflow. */
466 /* This is called *before* pop_subcall */
pop_subcall_grammar(integer * m_actor,int * vcode,integer * m_dobj,word * m_prep,integer * m_iobj,int * cnum)467 static rbool pop_subcall_grammar(integer *m_actor, int *vcode,
468 integer *m_dobj, word *m_prep, integer *m_iobj,
469 int *cnum) {
470 if (subcnt == 0) return 0;
471 vb = substack[subcnt - 1].vb;
472 prep = substack[subcnt - 1].prep;
473 *cnum = substack[subcnt - 1].cnum;
474 *m_actor = substack[subcnt - 1].mactor;
475 *vcode = substack[subcnt - 1].vcode;
476 *m_dobj = substack[subcnt - 1].mdobj;
477 *m_prep = substack[subcnt - 1].mprep;
478 *m_iobj = substack[subcnt - 1].miobj;
479 return 1;
480 }
481
482
483
484
485 /* ------------------------------------------------------------------- */
486 /* Run Metacommand */
487 /* ------------------------------------------------------------------- */
488
run_metacommand(int cnum,int * redir_offset)489 static int run_metacommand(int cnum, int *redir_offset)
490 /* cnum=command number to run. */
491 /* *redir_offset=offset of redirect header, if we exit with redirection. */
492 /* Return
493 0 to go on to next metacommand,
494 1 to stop running metacommands, and
495 2 to end the turn.
496 3 indicates that redirection has just occured
497 4 indicates a subcall has just occured.
498 5 Is used to go on to the next metacommand after a Return.
499 -2 means we're doing disambiguation and just hit an action token. */
500 {
501 int ip_, oip; /* ip_=Instruction pointer, oip=Old instruction pointer */
502 int r; /* Used to hold return value from token execution */
503 int fail_addr; /* What address to jump to on failure */
504 rbool fail; /* Last token was a conditional token that failed */
505 rbool ortrue, blocktrue, orflag; /* OR stuff
506 orflag: Are we in an OR group?
507 ortrue: Is current OR group true?
508 blocktrue: Is current block w/in OR true?
509 */
510 static rbool restart = 0; /* Restarting after subroutine? */
511 op_rec currop; /* Information on the current token and its args */
512
513 fail_addr = 32000; /* Fall off the end when we fail */
514 fail = 0;
515 ip_ = 0;
516 orflag = blocktrue = ortrue = 0;
517 *redir_offset = 1; /* Default: This is what RedirectTo does.
518 Only XRedirect can send a different value */
519
520
521 if (restart) /* finish up Return from subroutine */
522 pop_subcall(&cnum, &ip_, &fail_addr);
523
524 if (DEBUG_AGT_CMD && !supress_debug) {
525 debug_head(cnum);
526 if (restart) debugout(" (Resuming after subroutine)\n");
527 }
528
529 restart = 0;
530
531
532 /* ========== Main Loop ================= */
533 while (ip_ < command[cnum].cmdsize) {
534
535 oip = ip_;
536 ip_ += decode_instr(&currop, command[cnum].data + ip_, command[cnum].cmdsize - ip_);
537
538 /* ------- OR Logic --------------- */
539 if (currop.op == 109) { /* OR */
540 if (!orflag) { /* First OR; set things up */
541 orflag = 1;
542 ortrue = 0;
543 blocktrue = 1;
544 }
545 blocktrue = blocktrue && !fail; /* Was the previous token true? */
546 fail = 0;
547 ortrue = ortrue || blocktrue; /* OR in last block */
548 blocktrue = 1; /* New block starts out true. */
549 } else if (orflag) { /* we're in the middle of a block */
550 blocktrue = blocktrue && !fail; /* Add in previous token */
551 fail = 0;
552 if (currop.endor) { /* i.e. not a conditional token */
553 orflag = 0; /* End of OR block */
554 ortrue = ortrue || blocktrue; /* OR in last block */
555 fail = !ortrue; /* Success of whole group */
556 }
557 }
558
559 /* ------------ FAILMESSAGE handling ------------- */
560 if (currop.failmsg) { /* Is the current token a Fail... token? */
561 if (!fail) continue; /* Skip it; look at next instruction */
562 /* ErrMessage and ErrStdMessage: set disambiguation score */
563 if (do_disambig) {
564 if (currop.op == 1130 || currop.op == 1131) {
565 if (!decode_args(oip, &currop)) return 2;
566 disambig_score = currop.arg1;
567 return 2;
568 } else return -2; /* FailMessage counts as an action token */
569 }
570 /* Then run the failmessage, skipping the following step... */
571 }
572 /* -------- Failure routines -------------------- */
573 else if (fail) { /* ... and not failmessage */
574 /* consequences of failure */
575 fail = 0; /* In case fail_addr doesn't point off the edge of the world */
576 ip_ = fail_addr;
577 fail_addr = 32000; /* Reset fail_addr */
578 continue; /* Usually fail_addr will fall off the end, causing this to
579 return 0 */
580 }
581
582 /* - Finish decoding arguments and print out debugging message - */
583 if (!decode_args(oip, &currop)) {
584 if (currop.op < 1000) fail = currop.negate ? 0 : 1;
585 continue;
586 /* return 2;*/
587 }
588
589 /* -------- Commands that need to be handled specially -------------- */
590 if (currop.op == 109) { /* OR */
591 if (DEBUG_AGT_CMD && !supress_debug) debug_newline(op, 0);
592 continue; /* OR: skip further processing */
593 }
594
595 if (currop.op == 1037) { /* DoSubroutine */
596 if (!push_subcall(cnum, ip_, fail_addr)) {
597 writeln("GAME ERROR: Subroutine stack overflow.");
598 return 2;
599 }
600 subcall_arg = currop.arg1;
601 if (DEBUG_AGT_CMD && !supress_debug) debugout("--> Call\n");
602 return 4;
603 }
604
605 if (currop.op == 1038) { /* Return */
606 restart = 1;
607 if (DEBUG_AGT_CMD && !supress_debug) debugout("--> Return\n");
608 return 5;
609 }
610
611 if (currop.op == 1149) { /* Goto */
612 ip_ = currop.arg1;
613 if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
614 continue;
615 }
616
617 if (currop.op == 1150) { /* OnFailGoto */
618 fail_addr = currop.arg1;
619 if (DEBUG_AGT_CMD && !supress_debug) debugout("\n");
620 continue;
621 }
622
623 if (currop.op == 1152) /* XRedirect */
624 *redir_offset = currop.arg1;
625
626 /* ---------- Disambiguation Success -------------- */
627 if (do_disambig && currop.disambig) {
628 if (DEBUG_AGT_CMD && !supress_debug) debugout("==> ACTION\n");
629 return -2;
630 }
631
632 /* ---------- Run normal metacommands -------------- */
633 switch (r = exec_instr(&currop)) {
634 case 0: /* Normal action token or successful conditional token */
635 if (DEBUG_AGT_CMD && !supress_debug) debug_newline(op, 0);
636 continue;
637 case 1: /* Conditional token: fail */
638 if (DEBUG_AGT_CMD && !supress_debug) {
639 if (orflag) debugout(" (-->FAIL)\n");
640 else debugout("--->FAIL\n");
641 }
642 fail = 1;
643 continue;
644 default: /* Return explicit value */
645 if (DEBUG_AGT_CMD && !supress_debug) {
646 if (r == 103) debugout("-->Redirect\n");
647 else debugout("==> END\n");
648 }
649 return r - 100;
650 }
651 }
652 return 0;
653 }
654
655
656
657 /* ====================================================================*/
658 /* SCAN METACOMMAND: These are the routines that scan through the */
659 /* metacommand headers and find the appropriate ones to execute */
660 /* Redirection is also handled at this level */
661 /* ====================================================================*/
662
663
664 /* ------------------------------------------------------------------- */
665 /* Support routines for extracting object information */
666 /* ------------------------------------------------------------------- */
667
668 /* For $ strings. Returns object number if there is one, or negative
669 the dictionary index.
670 This is used by the metacommand redirection routines */
671
expand_redirect(word w)672 static integer expand_redirect(word w) {
673 assert(w != -1); /* <*NONE*> object shouldn't make it this far */
674 if (w == 0 || aver < AGTME10) return -w;
675 if (w == ext_code[wdverb]) return -syntbl[auxsyn[vb]];
676 if (w == ext_code[wdnoun]) return dobj;
677 if (w == ext_code[wdobject]) return iobj;
678 if (w == ext_code[wdname]) return actor;
679 if (w == ext_code[wdadjective]) return -it_adj(dobj);
680 if (w == ext_code[wdprep]) return -prep;
681 return -w;
682 }
683
684
extract_actor(int actnum)685 static int extract_actor(int actnum) {
686 if (actnum < 0) actnum = -actnum; /* Erase redirection stuff */
687 if (tcreat(actnum)) return actnum;
688 else return 0;
689 }
690
691 /* Basically, we need to find an object with a matching noun
692 and adj to our choice. */
extract_obj(word name,word adj)693 static int extract_obj(word name, word adj) {
694 int i, obj;
695
696 /* We just take the first one. We split this into separate noun and
697 creature loops for performance reaons */
698
699 if (name == -1) /* <*NONE*> */
700 return 0;
701
702 obj = expand_redirect(name);
703 adj = it_name(expand_redirect(adj));
704
705 if (obj > 0) { /* $noun$, $object$, or $name$ */
706 if (adj == 0 || adj == it_adj(obj))
707 return obj; /* We're done */
708 name = it_name(obj);
709 } else
710 name = -obj;
711
712 if (adj == 0) return -name; /* Adjectives required for CLASS redirect */
713 nounloop(i)
714 if (noun[i].name == name && noun[i].adj == adj) return i + first_noun;
715 creatloop(i)
716 if (creature[i].name == name && creature[i].adj == adj)
717 return i + first_creat;
718 /* Hmm... just hope it's an internal noun. */
719 writeln("GAME ERROR: Redirect statement with bad object name.");
720 return -name;
721 }
722
723
724 /* ------------------------------------------------------------------- */
725 /* Redirection Routines */
726 /* ------------------------------------------------------------------- */
727
728
729 #define wordcode_fix(w) it_name(expand_redirect(w));
730
731 /* 'real_obj' below is the dobj_obj/iobj_obj field; it takes
732 precedence over anything else if it is nonzero.
733 It represents an *explicitly* declared object in
734 the header */
735
fix_objnum(integer * objnum,word match,int real_obj,int actor_,int dobj_,int iobj_)736 static void fix_objnum(integer *objnum, word match,
737 int real_obj,
738 int actor_, int dobj_, int iobj_) {
739 if (real_obj) *objnum = real_obj;
740 else if (match == ext_code[wdobject]) *objnum = iobj_;
741 else if (match == ext_code[wdnoun]) *objnum = dobj_;
742 else if (match == ext_code[wdname]) *objnum = actor_;
743 }
744
745 /* Returns TRUE if we changed *objrec, FALSE otherwise */
746 /* (This is needed for memory allocation purposes) */
fix_objrec(parse_rec ** objrec,word match,int real_obj,parse_rec * actrec,parse_rec * dobjrec,parse_rec * iobjrec)747 static rbool fix_objrec(parse_rec **objrec, word match,
748 int real_obj,
749 parse_rec *actrec, parse_rec *dobjrec,
750 parse_rec *iobjrec) {
751 if (real_obj) *objrec = make_parserec(real_obj, NULL);
752 else if (match == ext_code[wdobject]) *objrec = copy_parserec(iobjrec);
753 else if (match == ext_code[wdnoun]) *objrec = copy_parserec(dobjrec);
754 else if (match == ext_code[wdname]) *objrec = copy_parserec(actrec);
755 else return 0; /* *objrec unchanged */
756
757 return 1; /* *objrec changed */
758 }
759
objcode_fix(cmd_rec * cmd)760 static void objcode_fix(cmd_rec *cmd)
761 /* For $ strings. Fixes object redirection if neccessary */
762 {
763 int actorword;
764 word nounword, objword;
765 int dobj_obj, iobj_obj;
766 int savedobj, saveactor;
767 parse_rec *savedrec, *saveactrec, *saveirec;
768 rbool achange, dchange, ichange; /* Did the given _rec ptr change? */
769
770 /* dobj_obj/iobj_obj take precedence over anything else */
771 actorword = cmd->actor;
772 nounword = cmd->nouncmd;
773 objword = cmd->objcmd;
774 dobj_obj = cmd->noun_obj;
775 iobj_obj = cmd->obj_obj;
776
777 /* Make temporary copies of things for when more than one thing is
778 being shuffled around; we don't need to save iobj since
779 it's processed last */
780 saveactor = actor;
781 saveactrec = actor_rec;
782 savedobj = dobj;
783 savedrec = dobj_rec;
784 saveirec = iobj_rec; /* Saved only so it can be freed */
785
786 /* Fix object numbers... */
787 fix_objnum(&actor, actorword, 0, saveactor, savedobj, iobj);
788 fix_objnum(&dobj, nounword, dobj_obj, saveactor, savedobj, iobj);
789 fix_objnum(&iobj, objword, iobj_obj, saveactor, savedobj, iobj);
790
791 /* ... and records */
792 achange = fix_objrec(&actor_rec, actorword, 0, saveactrec, savedrec, iobj_rec);
793 dchange = fix_objrec(&dobj_rec, nounword, dobj_obj, saveactrec, savedrec, iobj_rec);
794 ichange = fix_objrec(&iobj_rec, objword, iobj_obj, saveactrec, savedrec, iobj_rec);
795
796 /* Free up whatever needs freeing */
797 if (achange) rfree(saveactrec);
798 if (dchange) rfree(savedrec);
799 if (ichange) rfree(saveirec);
800 }
801
802
803 /* Redirection is very superficial-- normally all it does is */
804 /* change the matching pattern, not the underlying objects */
805 /* The one exception is when we use the special redirection tokens */
806 /* NOUN or OBJECT */
807
redirect_exec(cmd_rec * cmd,word * m_actor,int * vcode,word * m_dobj,word * m_prep,word * m_iobj)808 void redirect_exec(cmd_rec *cmd, word *m_actor, int *vcode,
809 word *m_dobj, word *m_prep, word *m_iobj) {
810 *m_actor = extract_actor(cmd->actor);
811 vb = *vcode = verb_code(it_name(expand_redirect(cmd->verbcmd)));
812 *m_dobj = extract_obj(cmd->nouncmd, cmd->noun_adj);
813 if (cmd->prep == -1)
814 *m_prep = 0;
815 else
816 *m_prep = it_name(expand_redirect(cmd->prep));
817 *m_iobj = extract_obj(cmd->objcmd, cmd->obj_adj);
818
819 /* This shuffles the _real_ objects if $noun$ forms are being
820 used */
821 objcode_fix(cmd);
822 }
823
824
825
826
827 /* ------------------------------------------------------------------- */
828 /* Scan Metacommand and the matching function it uses */
829 /* ------------------------------------------------------------------- */
830
831 /* This is used to match the elements of metacommand trigger patterns */
832 /* Sees if w2 matches COMMMAND pattern word w1; w1==0 corresponds to ANY */
833 #define cmatch(w1,w2) ((w1)==0 || (w1)==(w2) || ((w1)==-1 && (w2)==0))
834
cm_actor(int actnum,int actor_)835 static int cm_actor(int actnum, int actor_)
836 /* cmd: actnum, player entry: actor_ */
837 {
838 if (aver < AGX00) return 1; /* Bit of AGT brain-deadness. */
839 if (actnum == 1) return actor_ == 0; /* No actor_: just the player */
840 if (tcreat(actnum))
841 return (creat_fix[actor_ - first_creat] == creat_fix[actnum - first_creat]);
842 if (actnum == 2) return (actor_ != 0); /* ANYBODY? */
843 return (actor_ == 0);
844 }
845
846
847 /* Check that the explicit object matches */
cm_x_obj(int x_obj,int real_obj)848 static rbool cm_x_obj(int x_obj, int real_obj) {
849 if (x_obj == 0) return 1; /* No explicit object; automatically match. */
850 /* Explicit object case */
851 /* In this case, we match against the _real_ object */
852 /* However, we also require a "normal" match */
853 do {
854 if (x_obj == real_obj) return 1;
855 real_obj = it_class(real_obj);
856 } while (real_obj != 0);
857 return 0;
858 }
859
860 /* Does [obj] match <adj> <noun> [x_obj]? */
861 /* --[obj] must match up with <adj> <noun> */
862 /* --If x_obj(the explicit object) is defined, it must match with
863 the "real" object-- that is, the global dobj or iobj value. */
cm_obj(word name,word adj,int x_obj,int obj,int real_obj)864 static rbool cm_obj(word name, word adj, int x_obj, int obj, int real_obj) {
865 if (name == -1) return (obj == 0); /* <NONE> */
866
867 if (x_obj && !cm_x_obj(x_obj, real_obj)) return 0;
868
869 /* (Note that ANY does not match ALL) */
870 if (obj == -ext_code[wall])
871 return (name == ext_code[wall] && adj == 0);
872
873 do { /* Work our way up the class hierarchy */
874 if (cmatch(name, it_name(obj)) && cmatch(adj, it_adj(obj)))
875 return 1;
876 obj = it_class(obj);
877 } while (obj != 0);
878
879 return 0;
880 }
881
882
883
scan_dbg(int vcode)884 static void scan_dbg(int vcode) {
885 char buff[220];
886 word w;
887
888 if (vcode >= BASE_VERB && vcode < BASE_VERB + DUMB_VERB
889 && syntbl[synlist[vcode]] != 0)
890 w = syntbl[synlist[vcode]];
891 else w = syntbl[auxsyn[vcode]];
892
893 if (strlen(dict[w]) > 200) return; /* Just in case... */
894 sprintf(buff, "+++++Scanning %s\n", dict[w]);
895 debugout(buff);
896 }
897
898 #define not_any(n,a) (n!=0 || a!=0)
899
900 /* This returns true if we redirect from VERB OBJ {PREP OBJ}
901 to something that has fewer objects or no (explicit) preposition.
902 This is less perfect than I would like since there is currently
903 no way of distinguishing between ANY and an empty slot unless
904 the new "NOMATCH" extension is used. */
905
redir_narrows_grammar(cmd_rec * cmd1,cmd_rec * cmd2)906 static rbool redir_narrows_grammar(cmd_rec *cmd1, cmd_rec *cmd2) {
907 /* Check inward from obj to prep to noun; if in any of these
908 fields cmd2 has ANY and cmd1 doesn't, return 1.
909 Stop as soon as we find a non-ANY field in either one. */
910
911 /* If we *are* using the new extension, we can just use that info */
912 if (cmd2->objcmd == -1) {
913 if (cmd1->objcmd != -1) return 1;
914 if (cmd1->prep == -1) {
915 if (cmd1->prep != -1) return 1;
916 if (cmd2->nouncmd == -1 && cmd1->objcmd != -1) return 1;
917 }
918 }
919 if (nomatch_aware) return 0; /* If we are using nomatch, don't need
920 to go through the rest of this nonsense. */
921
922 if (not_any(cmd2->objcmd, cmd2->obj_adj)) return 0;
923 if (not_any(cmd1->objcmd, cmd1->obj_adj)) return 1;
924
925 if (cmd2->prep != 0) return 0;
926 if (cmd1->prep != 0) return 1;
927
928 if (not_any(cmd2->nouncmd, cmd2->noun_adj)) return 0;
929 if (not_any(cmd1->nouncmd, cmd1->noun_adj)) return 1;
930
931 return 0; /* They are both all ANY. */
932 }
933
934
935
cm_command(cmd_rec * cmd,integer m_actor,int m_verb,integer m_dobj,word m_prep,integer m_iobj)936 static rbool cm_command(cmd_rec *cmd,
937 integer m_actor, int m_verb,
938 integer m_dobj, word m_prep, integer m_iobj) {
939 if (cmd->verbcmd == 0) { /* ANY */
940 if (cmd->actor == 0 && aver >= AGX00)
941 return (m_verb == 0); /* ANY command: rest of line ignored */
942 /* Else ANY matchs; go on to test other things. */
943 } else if (cmd->verbcmd != m_verb) return 0;
944
945 return
946 cm_actor(cmd->actor, m_actor)
947 && cm_obj(cmd->nouncmd, cmd->noun_adj, cmd->noun_obj, m_dobj, dobj)
948 && cmatch(cmd->prep, m_prep)
949 && cm_obj(cmd->objcmd, cmd->obj_adj, cmd->obj_obj, m_iobj, iobj);
950 }
951
952
953
scan_for_actor(integer m_actor,int * start,int * end)954 static void scan_for_actor(integer m_actor, int *start, int *end) {
955 int i;
956
957 assert(m_actor != 0);
958
959 if (aver >= AGX00) {
960 if (start != NULL) *start = verbptr[DIR_ADDR_CODE];
961 *end = verbend[DIR_ADDR_CODE];
962 return;
963 }
964 for (i = verbend[DIR_ADDR_CODE]; i > verbptr[DIR_ADDR_CODE]; i--)
965 if (creat_fix[command[i].actor - first_creat]
966 == creat_fix[m_actor - first_creat]) {
967 i++;
968 break;
969 }
970 *end = i;
971
972 if (start == NULL) return;
973
974 for (i = verbptr[DIR_ADDR_CODE]; i <= *end; i++)
975 if (creat_fix[command[i].actor - first_creat]
976 == creat_fix[m_actor - first_creat])
977 break;
978 *start = i;
979 }
980
981
982 /* m_<word> are the matching criterion; they have no *neccessary*
983 connection to dobj, iobj, etc. */
984
scan_metacommand(integer m_actor,int vcode,integer m_dobj,word m_prep,integer m_iobj,int * redir_flag)985 int scan_metacommand(integer m_actor, int vcode,
986 integer m_dobj, word m_prep, integer m_iobj,
987 int *redir_flag)
988 /* Return codes: 0=end of this cycle, 1=end of all commands
989 2=end of turn */
990 /* If doing disambiguation, then -2=end of cycle, something happened;
991 0 or 1=end of cycle; nothing happened; 2=end of turn, nothing happened. */
992 /* If redir_flag is non-NULL, it is set when redirection occurs:
993 1+=Redirection occured
994 2=Grammar-changing redirection occured. */
995 {
996 int i, oldi;
997 word m_verb;
998 int scanend;
999 int redir_offset; /* Used for multiple redirects in the same
1000 metacommand (which can occur in AGATE-style
1001 commands)-- this is used to hold the offset
1002 of the given redirect. */
1003 long redirect_count; /* This is a safety measure: this keeps track of how
1004 many redirections have occured on a single turn, and
1005 if there are "too many" it will issue an error message
1006 and stop. This is to prevent the system from getting
1007 into a redirection loop. The number should be set
1008 high enough not to prevent deliberate loops,
1009 however. */
1010
1011 rfree(substack);
1012 subcnt = 0;
1013 subsize = 0;
1014 redirect_count = 0;
1015
1016 if (mars_fix)
1017 if (vcode == 0 || m_actor == 2) return 0;
1018 /* Don't explicity scan ANY metacommands if MARS fix is active. */
1019 if (m_actor == -ext_code[weverybody]) m_actor = 2;
1020
1021
1022 if (DEBUG_AGT_CMD && DEBUG_SCAN && !supress_debug) scan_dbg(vcode);
1023
1024 m_verb = syntbl[auxsyn[vcode]];
1025 if (m_actor == 0) {
1026 i = verbptr[vcode];
1027 scanend = verbend[vcode];
1028 } else
1029 scan_for_actor(m_actor, &i, &scanend);
1030 for (; i < scanend; i++)
1031 if (command[i].actor < 0) {
1032 /* REDIRECT data; skip over it */;
1033 } else if (cm_command(&command[i], m_actor, m_verb, m_dobj, m_prep, m_iobj))
1034 switch (run_metacommand(i, &redir_offset)) {
1035 case -2:
1036 rfree(substack);
1037 return -2;
1038 /* We are doing disambiguation and reached
1039 an action token */
1040 case 0:
1041 default:
1042 break; /* Go onto next metacommand */
1043 case 1:
1044 rfree(substack);
1045 return 1; /* Done with metacommands */
1046 case 2:
1047 rfree(substack);
1048 return 2; /* Done with turn */
1049
1050
1051 /* -------- REDIRECTION ------------ */
1052 /* This handles RedirectTo tokens */
1053 case 3:
1054 oldi = i;
1055 i += redir_offset;
1056 if (i == last_cmd || command[i].actor > 0) {
1057 if (!PURE_ERROR) writeln("GAME ERROR: Invalid REDIRECT token.");
1058 rfree(substack);
1059 return 2;
1060 }
1061 if (MAX_REDIR != 0 && ++redirect_count > MAX_REDIR) {
1062 if (!PURE_ERROR) writeln("GAME ERROR: Infinite REDIRECT loop.");
1063 rfree(substack);
1064 return 2;
1065 }
1066 if (DEBUG_AGT_CMD && !supress_debug) {
1067 debugout(" ==>");
1068 debug_head(i);
1069 }
1070
1071 /* REDIRECT :If we do a redirect from a broader grammar to a
1072 narrower grammer, it will be noted so that certain types
1073 of grammer checking can be disabled. */
1074 if (redir_flag != NULL) {
1075 if (*redir_flag < 2
1076 && redir_narrows_grammar(&command[oldi], &command[i]))
1077 *redir_flag = 2;
1078
1079 /* Set *redir_flag to at least 1 if we do *any* redirection. */
1080 if (!*redir_flag) *redir_flag = 1;
1081 }
1082
1083 /* REDIRECT: Do the actual redirection, building the new command
1084 header and shuffling around nouns and verbs as
1085 neccessary */
1086 redirect_exec(&command[i], &m_actor, &vcode,
1087 &m_dobj, &m_prep, &m_iobj);
1088
1089 /* REDIRECT: Start scanning again from the beginning */
1090 if (!mars_fix) {/* In MARS, we *don't* go back to the top */
1091 if (m_actor != 0)
1092 scan_for_actor(m_actor, &i, &scanend);
1093 else {
1094 i = verbptr[vcode];
1095 scanend = verbend[vcode];
1096 }
1097 i--; /* Back up one so that the following i++ we'll
1098 be at the right location */
1099 }
1100
1101 /* So when i is incremented, we start back at the correct start: i.e.
1102 we start scanning again from the beginning. It's even possible
1103 to use REDIRECT to run verb commands from an AFTER command,
1104 although it precludes other AFTER commands from running. */
1105 m_verb = syntbl[auxsyn[vcode]];
1106 break;
1107
1108
1109
1110 /* -------- SUBROUTINE CALL ------------ */
1111 case 4: /* Subroutine Call -- same idea as RedirectTo,
1112 but less complicated */
1113 push_subcall_grammar(m_actor, vcode, m_dobj, m_prep, m_iobj, i);
1114 vcode = verb_code(sub_name[subcall_arg - 1]);
1115 m_actor = m_dobj = m_iobj = 0;
1116 m_prep = 0;
1117
1118 if (!mars_fix) /* In MARS, we *don't* go back to the top */
1119 i = verbptr[vcode] - 1;
1120 scanend = verbend[vcode];
1121 m_verb = syntbl[auxsyn[vcode]];
1122 break;
1123
1124
1125 /* -------- RETURN ------------ */
1126 case 5: /* Return: pop grammar state, then ... ? */
1127 if (!pop_subcall_grammar(&m_actor, &vcode,
1128 &m_dobj, &m_prep, &m_iobj, &i)) {
1129 writeln("GAME ERROR: Return without DoSubroutine.");
1130 rfree(substack);
1131 return 2;
1132 }
1133
1134 if (m_actor == 0)
1135 scanend = verbend[vcode];
1136 else
1137 scan_for_actor(m_actor, NULL, &scanend);
1138 m_verb = syntbl[auxsyn[vcode]];
1139
1140 i--; /* Cause the last command to restart,
1141 at which point run_command will pop the rest of the
1142 stack. */
1143
1144 break;
1145 }
1146 rfree(substack);
1147 return 0; /* Done with this cycle of metacommands */
1148 }
1149
1150 /* ====================================================================*/
1151
1152 #undef cm
1153
1154 } // End of namespace AGT
1155 } // End of namespace Glk
1156