Added Nitfol and Frotz source code.
[projects/chimara/chimara.git] / interpreters / nitfol / inform.y
1 %{
2 /*  Nitfol - z-machine interpreter using Glk for output.
3     Copyright (C) 1999  Evin Robertson
4
5     This program is free software; you can redistribute it and/or modify
6     it under the terms of the GNU General Public License as published by
7     the Free Software Foundation; either version 2 of the License, or
8     (at your option) any later version.
9
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13     GNU General Public License for more details.
14
15     You should have received a copy of the GNU General Public License
16     along with this program; if not, write to the Free Software
17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
18
19     The author can be reached at ecr+@andrew.cmu.edu
20 */
21
22 #include "nitfol.h"
23 #include <ctype.h>
24
25 /* bison uses str* functions; make it use n_str* instead... */
26 #ifndef n_strcat
27 #define strcat(d, s) n_strcat(d, s)
28 #endif
29 #ifndef n_strlen
30 #define strlen(s) n_strlen(s)
31 #endif
32 #ifndef n_strcpy
33 #define strcpy(d, s) n_strcpy(d, s)
34 #endif
35   
36   
37 #ifdef DEBUGGING
38   
39   typedef struct zword_list zword_list;
40   struct zword_list {
41     zword_list *next;
42     zword item;
43   };
44
45   typedef struct cond_list cond_list;
46   struct cond_list {
47     cond_list *next;
48     zword val;
49     BOOL (*condfunc)(zword a, zword b);
50     BOOL opposite;
51   };
52
53   cond_list *condlist;
54   
55   static z_typed z_t(z_typed a, z_typed b, zword v);
56   
57   static const char *lex_expression;
58   static int lex_offset;
59
60   static const char *lex_tail(void) {
61     const char *t = lex_expression + lex_offset;
62     while(*t == ' ')
63       t++;
64     lex_offset = n_strlen(lex_expression);
65     return t;
66   }
67   
68   static z_typed inform_result;
69   
70   static int yylex(void);
71   static void yyerror(const char *s);
72   static void inform_help(void);
73   
74   int ignoreeffects;
75
76 #define YYERROR_VERBOSE
77   
78 /*
79 #define YYDEBUG 1
80 */
81
82 %}
83
84 %union {
85   glui32 pcoffset;
86   infix_file *filenum;
87   z_typed val;
88   
89   zword_list *zlist;
90
91   struct {
92     BOOL (*condfunc)(zword a, zword b);
93     BOOL opposite;
94   } cond;
95
96   BOOL flag;
97 }
98
99 %token  <val>           NUM
100 %token  <filenum>       DFILE
101 %token  <cond>          CONDITION
102 %type   <val>           commaexp
103 %type   <val>           condexp
104 %type   <val>           exp
105 %type   <pcoffset>      linespec
106 %type   <zlist>         arglist
107 %type   <flag>          orlist
108
109
110
111 %token ALIAS RALIAS UNALIAS DUMPMEM AUTOMAP HELP UNDO REDO LANGUAGE INFOSOURCE INFOSOURCES COPYING WARRANTY PRINT SET MOVE TO GIVE REMOVE JUMP CONT STEP NEXT UNTIL STEPI NEXTI FINISH BREAK DELETE IF COND IGNORE BREAKPOINTS RESTORE RESTART QUIT RECORDON RECORDOFF REPLAY REPLAYOFF SYMBOL_FILE FRAME SELECT_FRAME BACKTRACE UP_FRAME DOWN_FRAME UP_SILENTLY DOWN_SILENTLY DISPLAY UNDISPLAY DISABLE_DISPLAY ENABLE_DISPLAY DISABLE_BREAK ENABLE_BREAK OBJECT_TREE FIND LIST_GLOBALS BTRUE BFALSE NOTHING PARENT CHILD SIBLING CHILDREN RANDOM
112
113 %left ','
114 %right '='
115 %left ANDAND OROR NOTNOT
116 %nonassoc CONDITION
117 %left OR
118 %left '+' '-'
119 %left '*' '/' '%' '&' '|' '~'
120 %left BYTEARRAY WORDARRAY
121 %nonassoc precNEG
122 %nonassoc NUMBER OBJECT ROUTINE STRING GLOBAL LOCAL
123 %nonassoc INCREMENT DECREMENT
124 %left PROPADDR PROPLENGTH
125 %left '('   /* function calls */
126 %left '.'
127 %left SUPERCLASS
128
129 %%
130 input:    /* empty string */
131 /* :: Enter a comment */
132         | '#' /* comment */     { lex_offset = n_strlen(lex_expression); }
133 /* :: Dump memory to a file */
134         | DUMPMEM /*FILE*/      {
135                 strid_t f;
136                 f = n_file_name_or_prompt(fileusage_Data|fileusage_BinaryMode,
137                                           filemode_Write, lex_tail());
138                 w_glk_put_buffer_stream(f, (char *) z_memory, total_size);
139                 glk_stream_close(f, NULL);
140         }
141 /* :: Add an alias */
142         | ALIAS /*@var{name} @var{value}*/ { parse_new_alias(lex_tail(), FALSE); }
143 /* :: Add a recursive alias */
144         | RALIAS /*@var{name} @var{value}*/ { parse_new_alias(lex_tail(), TRUE); }
145 /* :: Remove an alias */
146         | UNALIAS /*@var{name}*/{ remove_alias(lex_tail()); }
147 /* :: Start automapping */
148         | AUTOMAP /*commaexp*/  { automap_init(object_count, lex_tail()); }
149 /* :: Print list of commands. */
150         | HELP                  { inform_help(); }
151 /* :: Restart the game. */
152         | RESTART               { op_restart(); exit_debugger = TRUE; read_abort = TRUE;  }
153 /* :: Restore a saved game. */
154         | RESTORE               {
155                 if(restoregame()) {
156                   exit_debugger = TRUE; read_abort = TRUE;
157                   if(zversion <= 3)
158                     mop_take_branch();
159                   else
160                     mop_store_result(2);
161                 } else {
162                   infix_print_string("Restore failed.\n");
163                 } }
164 /* :: Start recording a script. */
165         | RECORDON              { zword oldop0 = operand[0]; operand[0] = 4; op_output_stream(); operand[0] = oldop0; }
166 /* :: Stop recording a script. */
167         | RECORDOFF             { zword oldop0 = operand[0]; operand[0] = neg(4); op_output_stream(); operand[0] = oldop0; }
168 /* :: Replay a recorded script. */
169         | REPLAY                { zword oldop0 = operand[0]; operand[0] = 1; op_input_stream(); operand[0] = oldop0; exit_debugger = TRUE; }
170 /* :: Halt replay. */
171         | REPLAYOFF             { zword oldop0 = operand[0]; operand[0] = 0; op_input_stream(); operand[0] = oldop0; }
172 /* :: Exit nitfol. */
173         | QUIT                  { z_close(); glk_exit();        }
174 /* :: Undo last move (not last debugger command). */
175         | UNDO                  {
176                 if(restoreundo()) {
177                   read_abort = TRUE; exit_debugger = TRUE;
178                 } else {
179                   infix_print_string("No undo slots.\n");
180                 } }
181 /* :: Redo undid move.  Only works immediately after an @code{undo}. */
182         | REDO                  {
183                 if(restoreredo()) {
184                   read_abort = TRUE; exit_debugger = TRUE;
185                 } else {
186                   infix_print_string("No redo slots.\n");
187                 } }
188 /* :: Load debugging info from a file (usually @file{gameinfo.dbg}). */
189         | SYMBOL_FILE /*FILE*/  {
190                 strid_t f;
191                 f = n_file_name_or_prompt(fileusage_Data|fileusage_BinaryMode,
192                                           filemode_Read, lex_tail());
193                 if(f) {
194                   kill_infix();
195                   init_infix(f);
196                 } }
197 /* :: Evaluates an expression and prints the result.\nThis can include function calls. */
198         | PRINT commaexp        { infix_display($2);            }
199 /* :: Evaluate an expression without printing its value. */
200         | SET commaexp          { inform_result = $2;           }
201 /* :: Print value of an expression each time the program stops. */
202         | DISPLAY /*commaexp*/  { infix_auto_display(lex_tail()); }
203 /* :: Stop automatically displaying an expression. */
204         | UNDISPLAY NUM         { infix_auto_undisplay($2.v);   }
205 /* :: Temporarily disable an automatic display. */
206         | DISABLE_DISPLAY NUM   { infix_set_display_enabled($2.v, FALSE); }
207 /* :: Re-enable an automatic display. */
208         | ENABLE_DISPLAY NUM    { infix_set_display_enabled($2.v, TRUE); }
209 /* :: Move an object around the object tree. */
210         | MOVE commaexp TO commaexp { infix_move($4.v, $2.v);   }
211 /* :: Display the object tree. */
212         | OBJECT_TREE           { infix_object_tree(0);         }
213 /* :: An argument says which object to use as the root of the tree. */
214         | OBJECT_TREE commaexp  { infix_object_tree($2.v);      }
215 /* :: Find objects whose shortnames contain a string. */
216         | FIND                  {
217                 if(lex_expression[lex_offset])
218                   infix_object_find(lex_tail());
219         }
220 /* :: List all global variables and their values. */
221         | LIST_GLOBALS          {
222                 z_typed v; v.t = Z_GLOBAL;
223                 for(v.o = 0; v.o <= 245; v.o++) {
224                   const char *name = infix_get_name(v);
225                   if(v.o) infix_print_string("; ");
226                   if(name) {
227                     infix_print_string(name);
228                   } else {
229                     infix_print_char('G');
230                     infix_print_number(v.o);
231                   }
232                   infix_print_char('=');
233                   infix_get_val(&v);
234                   infix_print_number(v.v);
235                 }
236                 infix_print_char(10);
237         }
238 /* :: With an argument, list all only those with a specific value. */
239         | LIST_GLOBALS commaexp {
240                 z_typed v; v.t = Z_GLOBAL;
241                 for(v.o = 0; v.o <= 245; v.o++) {
242                   infix_get_val(&v);
243                   if(v.v == $2.v) {
244                     const char *name = infix_get_name(v);
245                     if(name) {
246                       infix_print_string(name);
247                     } else {
248                       infix_print_char('G');
249                       infix_print_number(v.o);
250                     }
251                     infix_print_char(10);
252                   }
253                 } }
254 /* :: Give an object an attribute. */
255         | GIVE commaexp NUM     { infix_set_attrib($2.v, $3.v); }
256 /* :: With a tilde clears the attribute instead of setting it. */
257         | GIVE commaexp '~' NUM { infix_clear_attrib($2.v, $4.v); }
258 /* :: Remove an object from the object tree. */
259         | REMOVE commaexp       { infix_remove($2.v);           }
260 /* :: Continue execution at a new location. */
261         | JUMP linespec         { PC=$2; exit_debugger = TRUE;  }
262 /* :: Continue execution. */
263         | CONT                  { set_step(CONT_GO, 1); }
264 /* :: An argument sets the ignore count of the current breakpoint. */
265         | CONT NUM              { set_step(CONT_GO, 1); infix_set_ignore(cur_break, $2.v); }
266 /* :: Step through program to a different source line. */
267         | STEP                  { set_step(CONT_STEP, 1); }
268 /* :: An argument specifies a repeat count. */
269         | STEP NUM              { set_step(CONT_STEP, $2.v); }
270 /* :: Step through program, stepping over subroutine calls. */
271         | NEXT                  { set_step(CONT_NEXT, 1); }
272 /* :: An argument specifies a repeat count. */
273         | NEXT NUM              { set_step(CONT_NEXT, $2.v); }
274 /* :: Resume execution until the program reaches a line number greater than the current line. */
275         | UNTIL                 { set_step(CONT_UNTIL, 1); }
276 /* :: Step exactly one instruction. */
277         | STEPI                 { set_step(CONT_STEPI, 1); }
278 /* :: An argument specifies a repeat count. */
279         | STEPI NUM             { set_step(CONT_STEPI, $2.v); }
280 /* :: Step one instruction, stepping over subroutine calls. */
281         | NEXTI                 { set_step(CONT_NEXTI, 1); }
282 /* :: Step a specified number of instructions, stepping over subroutine calls. */
283         | NEXTI NUM             { set_step(CONT_NEXTI, $2.v); }
284 /* :: An argument specifies a repeat count. */
285         | FINISH                { set_step(CONT_FINISH, 1); }
286 /* :: Set a breakpoint. */
287         | BREAK linespec        { infix_set_break($2);  }
288 /* :: An @code{if} clause specifies a condition. */
289         | BREAK linespec IF /*commaexp*/ { int n = infix_set_break($2); infix_set_cond(n, lex_tail()); }
290 /* :: Set a condition for an existing breakpoint. */
291         | COND NUM /*commaexp*/ { infix_set_cond($2.v, lex_tail()); }
292 /* :: Set the ignore count for a breakpoint. */
293         | IGNORE NUM NUM        { infix_set_ignore($2.v, $3.v); }
294 /* :: Delete a breakpoint. */
295         | DELETE NUM            { infix_delete_breakpoint($2.v); }
296 /* :: List breakpoints. */
297         | BREAKPOINTS           { infix_show_all_breakpoints(); }
298 /* :: An argument specifies a specific breakpoint to list. */
299         | BREAKPOINTS NUM       { infix_show_breakpoint($2.v);  }
300 /* :: Temporarily disable a breakpoint. */
301         | DISABLE_BREAK NUM     { infix_set_break_enabled($2.v, FALSE); }
302 /* :: Re-enabled a breakpoint. */
303         | ENABLE_BREAK NUM      { infix_set_break_enabled($2.v, TRUE); }
304 /* :: Show the current source language. */
305         | LANGUAGE              { infix_print_string("The current source language is \"inform\".\n"); }
306 /* :: Get information on the current source file. */
307         | INFOSOURCE            { infix_print_string("Current source file is "); infix_print_string(cur_file?cur_file->filename:"unknown"); infix_print_string("\nContains "); infix_print_number(cur_file?cur_file->num_lines:0); infix_print_string(" lines.\nSource language is inform.\n"); }
308 /* :: List source files. */
309         | INFOSOURCES           { infix_print_string("Source files for which symbols have been read in:\n\n"); infix_list_files(); infix_print_char('\n'); }
310 /* :: Show licensing information. */
311         | COPYING               { show_copying(); }
312 /* :: Show warranty information. */
313         | WARRANTY              { show_warranty(); }
314 /* :: Show the selected stack frame. */
315         | FRAME                 { infix_show_frame(infix_selected_frame); }
316 /* :: An argument specifies a stack frame to show. */
317         | FRAME NUM             { infix_select_frame($2.v); infix_show_frame($2.v); }
318 /* :: Select a specific stack frame. */
319         | SELECT_FRAME NUM      { infix_select_frame($2.v); }
320 /* :: Select the parent of the selected frame. */
321         | UP_FRAME              { infix_select_frame(infix_selected_frame - 1); infix_show_frame(infix_selected_frame); }
322 /* :: An argument specifies how many frames up to go. */
323         | UP_FRAME NUM          { infix_select_frame(infix_selected_frame - $2.v); infix_show_frame(infix_selected_frame); }
324 /* :: Select the parent of the selected frame silently. */
325         | UP_SILENTLY           { infix_select_frame(infix_selected_frame - 1); }
326 /* :: An argument specifies how many frames up to go. */
327         | UP_SILENTLY NUM       { infix_select_frame(infix_selected_frame - $2.v); }
328 /* :: Select the child of the selected frame. */
329         | DOWN_FRAME            { infix_select_frame(infix_selected_frame + 1); infix_show_frame(infix_selected_frame); }
330 /* :: An argument specifies how many frames down to go. */
331         | DOWN_FRAME NUM        { infix_select_frame(infix_selected_frame + $2.v); infix_show_frame(infix_selected_frame); }
332 /* :: Silently select the child of the selected frame. */
333         | DOWN_SILENTLY         { infix_select_frame(infix_selected_frame + 1); }
334 /* :: An argument specifies how many frames down to go. */
335         | DOWN_SILENTLY NUM     { infix_select_frame(infix_selected_frame + $2.v); }    
336 /* :: Display the parent functions of the current frame. */
337         | BACKTRACE             { infix_backtrace(0, stack_get_depth()); }
338 /* :: An argument specifies how many frames back to show. */
339         | BACKTRACE NUM         { infix_backtrace(stack_get_depth() - $2.v, $2.v); }
340 /* :: If the argument is negative, start from the first frame instead of the current. */
341         | BACKTRACE '-' NUM     { infix_backtrace(0, $3.v); }
342 /*
343         | LIST                  { infix_print_more(); }
344         | LIST '-'              { infix_print_before(); }
345         | LIST NUM              { if($1.t == Z_ROUTINE) { infix_location loc; infix_decode_; infix_file_print_around(...); }; else infix_file_print_around(cur_location.file, $2.v); }
346 */
347 ;
348
349 linespec: NUM                   { if($1.t == Z_ROUTINE) $$ = infix_get_routine_PC($1.v); else { infix_location l; infix_decode_fileloc(&l, cur_file?cur_file->filename:"", $1.v); $$ = l.thisPC; } }
350         | '+' NUM               { infix_location l; infix_decode_fileloc(&l, cur_file?cur_file->filename:"", cur_line + $2.v); $$ = l.thisPC; }
351         | '-' NUM               { infix_location l; infix_decode_fileloc(&l, cur_file?cur_file->filename:"", cur_line - $2.v); $$ = l.thisPC; }
352         | DFILE ':' NUM         { if($3.t == Z_ROUTINE) $$ = UNPACKR($3.v); else { infix_location l; infix_decode_fileloc(&l, $1->filename, $3.v); $$ = l.thisPC; } }
353         | '*' NUM               { $$ = $2.v;                    }
354 ;
355
356
357 orlist:   exp                   {
358                 if(condlist->condfunc(condlist->val, $1.v) ^ condlist->opposite) {
359                    $$ = TRUE;
360                    ignoreeffects++;
361                 } else
362                    $$ = FALSE;
363             }
364         | orlist OR exp         {
365                 if($1)
366                   $$ = TRUE;
367                 else {
368                   if(condlist->condfunc(condlist->val, $3.v) ^ condlist->opposite) {
369                     $$ = TRUE;
370                     ignoreeffects++;
371                   }
372                   else $$ = FALSE;
373                 } }
374 ;
375
376
377 arglist:  /* empty string */    { $$ = NULL; }
378         | exp ',' arglist       { zword_list g; $$ = $3; g.item = $1.v; LEaddm($$, g, n_rmmalloc); }
379 ;
380
381 /* Expressions with commas */
382 commaexp: exp
383         | condexp
384         | commaexp ',' exp      { $$ = $3;                      }
385         | commaexp ',' condexp  { $$ = $3;                      }
386 ;
387
388 /* Expressions with conditions */
389 condexp:
390         exp CONDITION { cond_list newcond; newcond.val = $1.v; newcond.condfunc = $2.condfunc; newcond.opposite = $2.opposite; LEaddm(condlist, newcond, n_rmmalloc); } orlist { if($4) ignoreeffects--; $$.v = $4; $$.t = Z_BOOLEAN; LEremovem(condlist, n_rmfreeone); }
391 ;
392
393 /* Expressions without commas */
394 exp:      NUM
395                 { $$ = $1;                              }
396         | BFALSE
397                 { $$.v = 0; $$.t = Z_BOOLEAN;           }
398         | BTRUE
399                 { $$.v = 1; $$.t = Z_BOOLEAN;           }
400         | NOTHING
401                 { $$.v = 0; $$.t = Z_OBJECT;            }
402
403         | exp '=' exp
404                 { $$ = $3; infix_assign(&$1, $3.v);     }
405
406         | PARENT '(' commaexp ')'
407                 { $$.v = infix_parent($3.v); $$.t = Z_OBJECT; }
408         | CHILD '(' commaexp ')'
409                 { $$.v = infix_child($3.v); $$.t = Z_OBJECT; }
410         | SIBLING '(' commaexp ')'
411                 { $$.v = infix_sibling($3.v); $$.t = Z_OBJECT; }
412         | CHILDREN '(' commaexp ')'
413                 { int n = 0; zword o = infix_child($3.v); while(o) { n++; o = infix_sibling(o); } $$.v = n; $$.t = Z_NUMBER; }
414
415         | RANDOM '(' commaexp ')'
416                 {
417                   if(!ignoreeffects) {
418                     $$.v = z_random($3.v);
419                     $$.t = Z_NUMBER;
420                   } else {
421                     $$.v = 0;
422                     $$.t = Z_UNKNOWN;
423                   }
424                 }
425         | exp '(' arglist ')'
426               {
427                 zword locals[16];
428                 int i = 0;
429                 zword_list *p;
430                 if(!ignoreeffects) {
431                   for(p = $3; p && i < 16; p=p->next) {
432                     locals[i++] = p->item;
433                   }
434                   mop_call($1.v, i, locals, -2);
435                   decode();
436                   exit_decoder = FALSE;
437                   $$.v = time_ret; $$.t = Z_UNKNOWN;
438                 } else {
439                   $$.v = 0; $$.t = Z_UNKNOWN;
440                 }
441               }
442
443         | exp ANDAND { if($1.v == 0) ignoreeffects++; } exp
444                 { if($1.v == 0) ignoreeffects--; $$ = z_t($1, $4, $1.v && $4.v);        }
445         | exp OROR { if($1.v != 0) ignoreeffects++; } exp
446                 { if($1.v != 0) ignoreeffects--; $$ = z_t($1, $4, $1.v || $4.v);        }
447         | NOTNOT exp
448                 { $$.v = !($2.v); $$.t = Z_NUMBER;      }
449
450         | exp '+' exp
451                 { $$ = z_t($1, $3, $1.v + $3.v);        }
452         | exp '-' exp
453                 { $$ = z_t($1, $3, $1.v + neg($3.v));   }
454         | exp '*' exp
455                 { $$ = z_t($1, $3, z_mult($1.v, $3.v)); }
456         | exp '/' exp
457                 { $$ = z_t($1, $3, z_div($1.v, $3.v));  }
458         | exp '%' exp
459                 { $$ = z_t($1, $3, z_mod($1.v, $3.v));  }
460         | exp '&' exp
461                 { $$ = z_t($1, $3, $1.v & $3.v);        }
462         | exp '|' exp
463                 { $$ = z_t($1, $3, $1.v | $3.v);        }
464         | '~' exp
465                 { $$ = z_t($2, $2, ~$2.v);              }
466
467         | exp BYTEARRAY exp
468                 { $$.t = Z_BYTEARRAY; $$.o = $1.v; $$.p = $3.v; infix_get_val(&$$); }
469         | exp WORDARRAY exp
470                 { $$.t = Z_WORDARRAY; $$.o = $1.v; $$.p = $3.v; infix_get_val(&$$);     }
471
472         | '-' exp               %prec precNEG
473                 { $$ = z_t($2, $2, neg($2.v));          }
474
475         | INCREMENT exp
476                 { if(!ignoreeffects) infix_assign(&$2, ARITHMASK($2.v + 1)); $$ = $2; }
477         | exp INCREMENT
478                 { $$ = $1; if(!ignoreeffects) infix_assign(&$1, ARITHMASK($1.v + 1)); }
479         | DECREMENT exp
480                 { if(!ignoreeffects) infix_assign(&$2, ARITHMASK($2.v + neg(1))); $$ = $2; }
481         | exp DECREMENT
482                 { $$ = $1; if(!ignoreeffects) infix_assign(&$1, ARITHMASK($1.v + neg(1))); }
483
484         | exp PROPADDR exp
485                 { zword len; $$.v = infix_get_proptable($1.v, $3.v, &len); $$.t = Z_NUMBER; }
486         | exp PROPLENGTH exp
487                 { infix_get_proptable($1.v, $3.v, &$$.v); $$.t = Z_NUMBER; }
488
489         | exp '.' exp
490                 { $$.t = Z_OBJPROP; $$.o = $1.v; $$.p = $3.v; infix_get_val(&$$); }
491
492 /*
493         | exp SUPERCLASS exp
494                 { $$ = infix_superclass($1, $3);        }
495 */
496
497         | NUMBER exp
498                 { $$.v = $2.v; $$.t = Z_NUMBER;         }
499         | OBJECT exp
500                 { $$.v = $2.v; $$.t = Z_OBJECT;         }
501         | ROUTINE exp
502                 { $$.v = $2.v; $$.t = Z_ROUTINE;        }
503         | STRING exp
504                 { $$.v = $2.v; $$.t = Z_STRING;         }
505         | GLOBAL exp
506                 { $$.t = Z_WORDARRAY; $$.o = z_globaltable; $$.p = $2.v; infix_get_val(&$$); }
507         | LOCAL exp
508                 { $$.t = Z_LOCAL; $$.o = infix_selected_frame; $$.p = $2.v; infix_get_val(&$$); }
509         | '(' commaexp ')'
510                 { $$ = $2;                              }
511 ;
512
513
514 %%
515
516 #if 0
517 { /* fanagling to get emacs indentation sane */
518 int foo;
519 #endif
520
521 static z_typed z_t(z_typed a, z_typed b, zword v)
522 {
523   z_typed r;
524   r.v = ARITHMASK(v);
525   if(a.t == Z_NUMBER && b.t == Z_NUMBER)
526     r.t = Z_NUMBER;
527   else
528     r.t = Z_UNKNOWN;
529   return r;
530 }
531
532
533
534 typedef struct {
535   int token;
536   const char *name;
537 } name_token;
538
539 static name_token infix_operators[] = {
540   { ANDAND,     "&&" },
541   { OROR,       "||" },
542   { NOTNOT,     "~~" },
543   { BYTEARRAY,  "->" },
544   { WORDARRAY,  "-->" },
545   { NUMBER,     "(number)" },
546   { OBJECT,     "(object)" },
547   { ROUTINE,    "(routine)" },
548   { STRING,     "(string)" },
549   { GLOBAL,     "(global)" },
550   { LOCAL,      "(local)" },
551   { INCREMENT,  "++" },
552   { DECREMENT,  "--" },
553   { SUPERCLASS, "::" }
554 };
555
556
557 static name_token infix_keywords[] = {
558   { TO,         "to" },
559   { IF,         "if" },
560   { OR,         "or" },
561   { BTRUE,      "true" },
562   { BFALSE,     "false" },
563   { NOTHING,    "nothing" },
564   { PARENT,     "parent" },
565   { CHILD,      "child" },
566   { SIBLING,    "sibling" },
567   { RANDOM,     "random" },
568   { CHILDREN,   "children" }
569 };
570
571
572 /* These are only valid as the first token in an expression.  A single space
573    matches at least one typed whitespace character */
574 static name_token infix_commands[] = {
575   { '#',          "#" },
576   { HELP,         "help" },
577   { ALIAS,        "alias" },
578   { RALIAS,       "ralias" },
579   { UNALIAS,      "unalias" },
580   { DUMPMEM,      "dumpmem" },
581   { AUTOMAP,      "automap" },
582   { UNDO,         "undo" },
583   { REDO,         "redo" },
584   { QUIT,         "quit" },
585   { RESTORE,      "restore" },
586   { RESTART,      "restart" },
587   { RESTART,      "run" },
588   { RECORDON,     "recording on" },
589   { RECORDOFF,    "recording off" },
590   { REPLAY,       "replay" },
591   { REPLAYOFF,    "replay off" },
592   { SYMBOL_FILE,  "symbol-file" },
593   { PRINT,        "print" },
594   { PRINT,        "p" },
595   { PRINT,        "call" },  /* No void functions in inform */
596   { SET,          "set" },
597   { MOVE,         "move" },
598   { OBJECT_TREE,  "object-tree" },
599   { OBJECT_TREE,  "tree" },
600   { FIND,         "find" },
601   { REMOVE,       "remove" },
602   { GIVE,         "give" },
603   { LIST_GLOBALS, "globals" },
604   { JUMP,         "jump" },
605   { CONT,         "continue" },
606   { CONT,         "c" },
607   { CONT,         "fg" },
608   { STEP,         "step" },
609   { STEP,         "s" },
610   { NEXT,         "next" },
611   { NEXT,         "n" },
612   { STEPI,        "stepi" },
613   { STEPI,        "si" },
614   { NEXTI,        "nexti" },
615   { NEXTI,        "ni" },
616   { UNTIL,        "until" },
617   { UNTIL,        "u" },
618   { FINISH,       "finish" },
619   { BREAK,        "break" },
620   { DELETE,       "delete" },
621   { DELETE,       "d" },
622   { DELETE,       "delete breakpoints" },
623   { COND,         "condition" },
624   { IGNORE,       "ignore" },
625   { FRAME,        "frame" },
626   { FRAME,        "f" },
627   { SELECT_FRAME, "select-frame" },
628   { UP_FRAME,     "up" },
629   { DOWN_FRAME,   "down" },
630   { DOWN_FRAME,   "do" },
631   { UP_SILENTLY,  "up-silently" },
632   { DOWN_SILENTLY,"down-silently" },
633   { BREAKPOINTS,  "info breakpoints" },
634   { BREAKPOINTS,  "info watchpoints" },
635   { BREAKPOINTS,  "info break" },
636   { DISABLE_BREAK,"disable" },
637   { DISABLE_BREAK,"disable breakpoints" },
638   { DISABLE_BREAK,"dis" },
639   { DISABLE_BREAK,"dis breakpoints" },
640   { ENABLE_BREAK, "enable" },
641   { ENABLE_BREAK, "enable breakpoints" },
642   { LANGUAGE,     "show language" },
643   { INFOSOURCE,   "info source" },
644   { INFOSOURCES,  "info sources" },
645   { COPYING,      "show copying" },
646   { WARRANTY,     "show warranty" },
647   { BACKTRACE,    "backtrace" },
648   { BACKTRACE,    "bt" },
649   { BACKTRACE,    "where" },
650   { BACKTRACE,    "info stack" },
651   { BACKTRACE,    "info s" },
652   { DISPLAY,      "display" },
653   { UNDISPLAY,    "undisplay" },
654   { UNDISPLAY,    "delete display" },
655   { DISABLE_DISPLAY,"disable display" },
656   { DISABLE_DISPLAY,"dis display" },
657   { ENABLE_DISPLAY,"enable display" }
658 };
659
660 #include "dbg_help.h"
661
662 static BOOL z_isequal(zword a, zword b)
663 {
664   return (a == b);
665 }
666
667 static BOOL z_isgreat(zword a, zword b)
668 {
669   return is_greaterthan(a, b);
670 }
671
672 static BOOL z_isless(zword a, zword b)
673 {
674   return is_lessthan(a, b);
675 }
676
677 static BOOL infix_provides(zword o, zword p)
678 {
679   zword len;
680   return (infix_get_proptable(o, p, &len) != 0);
681 }
682
683 static BOOL infix_in(zword a, zword b)
684 {
685   return infix_parent(a) == b;
686 }
687
688 typedef struct {
689   const char *name;
690   BOOL (*condfunc)(zword a, zword b);
691   BOOL opposite;
692 } condition;
693
694 condition conditionlist[] = {
695   { "==",      z_isequal,         FALSE },
696   { "~=",      z_isequal,         TRUE },
697   { ">",       z_isgreat,         FALSE },
698   { "<",       z_isless,          FALSE },
699   { "<=",      z_isgreat,         TRUE },
700   { ">=",      z_isless,          TRUE },
701   { "has",     infix_test_attrib, FALSE },
702   { "hasnt",   infix_test_attrib, TRUE },
703   { "in",      infix_in,          FALSE },
704   { "notin",   infix_in,          TRUE },
705 /*{ "ofclass", infix_ofclass,     FALSE },*/
706   { "provides",infix_provides,    FALSE }
707 };
708
709
710 static BOOL is_command_identifier(char c)
711 {
712   return isalpha(c) || (c == '-');
713 }
714
715 static BOOL is_identifier(char c)
716 {
717   return isalpha(c) || isdigit(c) || (c == '_');
718 }
719
720 static BOOL is_longer_identifier(char c)
721 {
722   return isalpha(c) || isdigit(c) || (c == '_') || (c == '.') || (c == ':');
723 }
724
725 static int grab_number(z_typed *val)
726 {
727   int len = 0;
728   char *endptr;
729   char c = lex_expression[lex_offset + len];
730   int base = 10;
731   long int num;
732
733   /* Don't handle negativity here */
734   if(c == '-' || c == '+')
735     return 0;
736   
737   if(c == '$') {
738     len++;
739     base = 16;
740     c = lex_expression[lex_offset + len];
741     if(c == '$') {
742       len++;
743       base = 2;
744       c = lex_expression[lex_offset + len];
745     }
746   }
747   
748   num = n_strtol(lex_expression + lex_offset + len, &endptr, base);
749
750   if(endptr != lex_expression + lex_offset) {
751     len += endptr - lex_expression - lex_offset;
752     val->v = num;
753     val->t = Z_NUMBER;
754     return len;
755   }
756   return 0;
757 }
758
759
760 typedef enum { match_None, match_Partial, match_Complete } match_type;
761
762 static match_type command_matches(const char *command, const char *expression,
763                                   unsigned *matchedlen)
764 {
765   unsigned c, e;
766   e = 0;
767
768   for(c = 0; command[c]; c++) {
769     if(command[c] != expression[e]) {
770       if(!is_command_identifier(expression[e])) {
771         *matchedlen = e;
772         return match_Partial;
773       }
774       return match_None;
775     }
776
777     e++;
778     
779     if(command[c] == ' ') {
780       while(expression[e] == ' ')
781         e++;
782     }
783   }
784
785   if(!is_command_identifier(expression[e])) {
786     *matchedlen = e;
787     return match_Complete; 
788   }
789
790   return match_None;
791 }
792
793
794 static int grab_command(void)
795 {
796   unsigned i;
797   unsigned len;
798
799   unsigned best;
800   match_type best_match = match_None;
801   unsigned best_len = 0;
802   BOOL found = FALSE;
803   BOOL ambig = FALSE;
804
805   while(isspace(lex_expression[lex_offset]))
806     lex_offset++;
807
808   for(i = 0; i < sizeof(infix_commands) / sizeof(*infix_commands); i++) {
809     switch(command_matches(infix_commands[i].name, lex_expression + lex_offset, &len)) {
810     case match_Complete:
811       if(len > best_len || best_match != match_Complete) {
812         best = i;
813         best_match = match_Complete;
814         best_len = len;
815         found = TRUE;
816       }
817       break;
818
819     case match_Partial:
820       if(best_match != match_Complete) {
821         if(found)
822           ambig = TRUE;
823         best = i;
824         best_match = match_Partial;
825         best_len = len;
826         found = TRUE;
827       }
828
829     case match_None:
830       ;
831     }
832   }
833
834   if(ambig && best_match != match_Complete) {
835     infix_print_string("Ambiguous command.\n");
836     return 0;
837   }
838
839   if(found) {
840     lex_offset += best_len;
841     return infix_commands[best].token;
842   }
843
844   infix_print_string("Undefined command.\n");
845   return 0;
846 }
847
848
849 static void inform_help(void)
850 {
851   int command;
852   unsigned i;
853   BOOL is_command = FALSE;
854   
855   for(i = lex_offset; lex_expression[i]; i++)
856     if(!isspace(lex_expression[i]))
857       is_command = TRUE;
858
859   if(!is_command) {
860     infix_print_string("Help is available on the following commands:\n");
861     for(i = 0; i < sizeof(command_help) / sizeof(*command_help); i++) {
862       unsigned j;
863       for(j = 0; j < sizeof(infix_commands) / sizeof(*infix_commands); j++)
864         if(command_help[i].token == infix_commands[j].token) {
865           infix_print_char('\'');
866           infix_print_string(infix_commands[j].name);
867           infix_print_char('\'');
868           break;
869         }
870       infix_print_char(' ');
871     }
872     infix_print_string("\n");
873     return;
874   }
875   
876   command = grab_command();
877   if(command) {
878     for(i = 0; i < sizeof(command_help) / sizeof(*command_help); i++) {
879       if(command_help[i].token == command) {
880         infix_print_string(command_help[i].name);
881         infix_print_char(10);
882         return;
883       }
884     }
885     infix_print_string("No help available for that command.\n");
886   }
887 }
888
889
890 void process_debug_command(const char *buffer)
891 {
892 #ifdef YYDEBUG
893   yydebug = 1;
894 #endif
895   lex_expression = buffer;
896   lex_offset = 0;
897   ignoreeffects = 0;
898   yyparse();
899   n_rmfree();
900 }
901
902 BOOL exp_has_locals(const char *exp)
903 {
904   return FALSE;
905 }
906
907 z_typed evaluate_expression(const char *exp, unsigned frame)
908 {
909   unsigned old_frame = infix_selected_frame;
910   char *new_exp = (char *) n_malloc(n_strlen(exp) + 5);
911   n_strcpy(new_exp, "set ");
912   n_strcat(new_exp, exp);
913
914   infix_selected_frame = frame;
915   process_debug_command(new_exp);
916   infix_selected_frame = old_frame;
917
918   n_free(new_exp);
919
920   return inform_result;
921 }
922
923 static void yyerror(const char *s)
924 {
925   infix_print_string(s);
926   infix_print_char(10);
927 }
928
929 static int yylex(void)
930 {
931   unsigned i, len, longer;
932   BOOL check_command = FALSE;
933
934   if(lex_offset == 0)
935     check_command = TRUE;
936
937   while(isspace(lex_expression[lex_offset]))
938     lex_offset++;
939
940   if(check_command) {
941     return grab_command();
942   }
943
944   if((len = grab_number(&yylval.val)) != 0) {
945     lex_offset += len;
946     return NUM;
947   }
948
949   for(i = 0; i < sizeof(infix_operators) / sizeof(*infix_operators); i++) {
950     if(n_strncmp(infix_operators[i].name, lex_expression + lex_offset,
951                n_strlen(infix_operators[i].name)) == 0) {
952       lex_offset += n_strlen(infix_operators[i].name);
953       return infix_operators[i].token;
954     }
955   }
956
957   for(i = 0; i < sizeof(conditionlist) / sizeof(*conditionlist); i++) {
958     len = n_strlen(conditionlist[i].name);
959     if(len
960        && n_strncmp(conditionlist[i].name,
961                    lex_expression + lex_offset, len) == 0
962        && !(is_identifier(conditionlist[i].name[len-1])
963             && is_identifier(lex_expression[lex_offset + len]))) {
964
965       lex_offset += len;
966       yylval.cond.condfunc = conditionlist[i].condfunc;
967       yylval.cond.opposite = conditionlist[i].opposite;
968       return CONDITION;
969     }
970   }
971
972   if((len = infix_find_file(&yylval.filenum, lex_expression + lex_offset)) != 0) {
973     lex_offset += len;
974     return DFILE;
975   }
976
977
978   for(len = 0; is_identifier(lex_expression[lex_offset + len]); len++)
979     ;
980
981   if(!len)
982     return lex_expression[lex_offset++];
983
984   for(i = 0; i < sizeof(infix_keywords) / sizeof(*infix_keywords); i++) {
985     if(n_strmatch(infix_keywords[i].name, lex_expression + lex_offset, len)) {
986       lex_offset += len;
987       return infix_keywords[i].token;
988     }
989   }
990
991   for(longer = len; is_longer_identifier(lex_expression[lex_offset + longer]); longer++)
992     ;
993
994   if(infix_find_symbol(&yylval.val, lex_expression + lex_offset, longer)) {
995     lex_offset += longer;
996     return NUM;
997   }
998
999   if(infix_find_symbol(&yylval.val, lex_expression + lex_offset, len)) {
1000     lex_offset += len;
1001     return NUM;
1002   }
1003
1004   infix_print_string("Unknown identifier \"");
1005   for(i = 0; i < len; i++)
1006     infix_print_char(lex_expression[lex_offset + i]);
1007   infix_print_string("\"\n");
1008
1009   return 0;
1010 }
1011
1012 #endif /* DEBUGGING */