1 /*---------------------------------------------------------------------------
2  * LPC-Compiler: Preprocessor and Lexical Analysis.
3  *
4  *---------------------------------------------------------------------------
5  * The lexer is initialised by a call to init_lexer(). This function sets
6  * up the internal tables and also reads the permanent defines from
7  * the lpc_predefs list the caller set up before the call.
8  *
9  * A new compilation is set up by a call to start_new_file(), passing
10  * the filedescriptor of the file to compile as argument. Control is
11  * then passed to the parser in prolang, which calls yylex() here to
12  * get the next token. After the compilation is finished, end_new_file()
13  * performs the cleanup.
14  *
15  * The lexer also holds the table of instructions (instrs[]) and the
16  * driver's own ctype tables. Both are included from the file efun_defs.c
17  * which is generated by the program make_func during the building
18  * process.
19  *
20  * For an explanation of the datastructures look at the places of
21  * definition of the structures - it's too much to put here, too.
22  *---------------------------------------------------------------------------
23  */
24 
25 #include "driver.h"
26 #include "typedefs.h"
27 
28 #include "my-alloca.h"
29 #include <stdio.h>
30 #include <fcntl.h>
31 #include <ctype.h>
32 #include <stdarg.h>
33 #include <stddef.h>
34 #include <string.h>
35 #include <sys/types.h>
36 #include <sys/stat.h>
37 
38 #include "lex.h"
39 
40 #include "array.h"
41 #include "backend.h"
42 #include "closure.h"
43 #include "comm.h"
44 #include "exec.h"
45 #include "filestat.h"
46 #include "gcollect.h"
47 #include "hash.h"
48 #include "instrs.h"
49 #include "interpret.h"
50 #include "lang.h"
51 #include "main.h"
52 #include "mempools.h"
53 #include "mstrings.h"
54 #include "object.h"
55 #include "patchlevel.h"
56 #include "prolang.h"
57 #include "simulate.h"
58 #include "simul_efun.h"
59 #include "stdstrings.h"
60 #include "strfuns.h"
61 #include "svalue.h"
62 #include "wiz_list.h" /* wizlist_name[] */
63 #include "xalloc.h"
64 
65 #include "i-eval_cost.h"
66 
67 #include "../mudlib/sys/driver_hook.h"
68 
69 /* TODO: Implement the # and ## operators. With this, #define X(a) (a + "a")
70  * TODO:: can be made sane (X(b) -> 'b + "a"' instead of 'b + "b"').
71  * TODO: New predefs' __BASENAME__, __FUNCTION__.
72  * TODO: #define macro(a,b,...) -> ... is assigned to __VA_ARGS__ (see oncoming
73  * TODO:: C standard).
74  * TODO: Does Standard-C allow recursive macro expansion? If not, we
75  * TODO:: should disallow it, too.
76  */
77 
78 /* We can't use the EOF character directly, as in its (char) representation
79  * clashes with ISO-8859 character 0xFF. Instead we use ascii SOH (0x01),
80  * which in turn is not allowed as input character.
81  */
82 
83 #define CHAR_EOF ((char)0x01)
84 
85 /*-------------------------------------------------------------------------*/
86 
87 #define MLEN   4096
88   /* Maximum length of a macro text (definition)
89    */
90 
91 #define NSIZE  256
92   /* Maximum length of a macro (argument) name.
93    */
94 
95 #define NARGS 25
96   /* Max number of macro arguments
97    */
98 
99 #define EXPANDMAX 25000
100   /* Maximum number of expansions per line.
101    */
102 
103 #define MAXLINE 2048
104   /* Maximum length of an input line.
105    */
106 
107 #define MAX_ANSI_CONCAT 4096
108   /* Maximum length of an ANSI-style string literal concatenation.
109    */
110 
111 #define INC_OPEN_BUFSIZE 1024
112   /* Maximum length of an include filename.
113    */
114 
115 #ifndef DEFMAX
116 #    define DEFMAX 12000
117 #endif
118   /* Maximum length of an expanded macro.
119    */
120 
121 #define MAX_TOTAL_BUF 400000
122   /* Maximum length of macro expansion buffer
123    */
124 
125 #define DEFBUF_1STLEN (DEFMAX+MAXLINE+1)
126   /* Initial length of macro expansion buffer, enough
127    * to allow DEFMAX + an input line + '\0'
128    */
129 
130 /*-------------------------------------------------------------------------*/
131 
132 source_loc_t current_loc;
133   /* The current compilation location.
134    */
135 
136 int total_lines;
137   /* Total number of lines compiled so far (used to compute the average
138    * compiled lines/s)
139    */
140 
141 static const char *object_file;
142   /* Name of the file for which the lexer was originally called.
143    */
144 
145 Bool pragma_use_local_scopes;
146   /* True: treat all local scopes as one.
147    */
148 
149 Bool pragma_warn_missing_return;
150   /* True: generate a runtime warning if a value-returning function
151    * does end with an explicit return statement.
152    */
153 
154 Bool pragma_check_overloads;
155   /* TRUE if function redefinitions have to match the originals in their
156    * types. This pragma is meant mainly to ease the adaption of old
157    * mudlibs.
158    */
159 
160 Bool pragma_strict_types;
161   /* Type enforcing mode: PRAGMA_WEAK_TYPES, PRAGMA_STRONG_TYPES
162    * and PRAGMA_STRICT_TYPES.
163    */
164 
165 Bool pragma_save_types;
166   /* True: save argument types after compilation.
167    */
168 
169 Bool pragma_combine_strings;
170   /* True: perform '+'-addition of constant strings at compile time.
171    */
172 
173 Bool pragma_verbose_errors;
174   /* True: give info on the context of an error.
175    */
176 
177 Bool pragma_no_clone;
178   /* True: prevent the object from being clone.
179    */
180 
181 Bool pragma_no_inherit;
182   /* True: prevent the program from being inherited.
183    */
184 
185 Bool pragma_no_shadow;
186   /* True: prevent the program from being shadowed.
187    */
188 
189 Bool pragma_pedantic;
190   /* True: treat a number of sloppy language constructs as errors.
191    */
192 
193 Bool pragma_warn_deprecated;
194   /* True: warn if deprecated efuns are used.
195    */
196 
197 Bool pragma_range_check;
198   /* True: warn (at runtime) if array ranges are invalid.
199    */
200 
201 Bool pragma_share_variables;
202   /* TRUE: Share the blueprint's variables with its clones.
203    */
204 
205 Bool pragma_warn_empty_casts;
206   /* True: warn if a type is casted to itself.
207    */
208 
209 string_t *last_lex_string;
210   /* When lexing string literals, this is the (shared) string lexed
211    * so far. It is used to pass string values to lang.c and may be
212    * freed there.
213    */
214 
215 struct lpc_predef_s *lpc_predefs = NULL;
216   /* List of macros predefined by other parts of the driver, especially from
217    * main.c for the '-D' commandline option.
218    */
219 
220 static source_file_t * src_file_list = NULL;
221   /* List of source_file structures during a compile.
222    */
223 
224 static Mempool lexpool = NULL;
225   /* Fifopool to hold the allocations for the include and lpc_ifstate_t stacks.
226    */
227 
228 /*-------------------------------------------------------------------------*/
229 /* The lexer can take data from either a file or a string buffer.
230  * The handling is unified using the struct source_s structure.
231  * TODO: Use this source similar to auto-include to expand macros in the
232  * TODO:: the compile. This would make it easier to find errors caused
233  * TODO:: by macro replacements.
234  */
235 
236 typedef struct source_s
237 {
238     int        fd;       /* Filedescriptor or -1 */
239     string_t * str;      /* The source string (referenced), or NULL */
240     size_t     current;  /* Current position in .str */
241 } source_t;
242 
243 static source_t yyin;
244   /* Current input source.
245    */
246 
247 /*-------------------------------------------------------------------------*/
248 /* The lexer uses a combined file-input/macro-expansion buffer
249  * called defbuf[] of length <defbuf_len>. Within this buffer, the last
250  * MAXLINE bytes are reserved as (initial) file-input buffer, its beginning
251  * and end marked with the pointers linebufstart and linebufend. In this
252  * space, pointer outp points to the next character to process.
253  *
254  * The file-input buffer may contain several textlines, all terminated
255  * with a '\n'. After the last (complete) textline, a '\0' is set as
256  * sentinel. Usually this will overwrite the first character of the
257  * incomplete line right at the end of the input buffer, therefore this
258  * character is stored in the variable saved_char.
259  *
260  * When all lines in the buffer have been processed (ie. outp points to
261  * the '\0' sentinel), the remaining fragment of the yet incomplete line
262  * is copied _before_ linebufstart (and outp set accordingly), then
263  * the next MAXLINE bytes are read into the buffer starting at
264  * linebufstart.
265  *
266  * If there are less than MAXLINE bytes left to read, the end of the file
267  * is marked in the buffer with the CHAR_EOF character (a \0 sentinel is not
268  * necessary as compilation and thus lexing will end with the CHAR_EOF
269  * character).
270  *
271  * When including files, a new area of MAXLINE bytes is reserved in defbuf,
272  * which ends exactly at the current outp. The position of the current
273  * area is recorded with the current position of linebufstart relative to
274  * the end of defbuf. Obviously this can be repeated until the max size
275  * of defbuf (MAX_TOTAL_BUF) is reached.
276  *
277  * Macro expansions are done such that the replacement text for a macro
278  * copied right before outp (which at that time points at the character
279  * after the macro use), then outp is set back to point at the beginning
280  * of the added text, lexing the just expanded text next.
281  *
282 #ifndef USE_NEW_INLINES
283  * Functionals (inline functions) are somewhat similar to macros. When a
284  * definition '(: ... :)' is encountered, a copy of text between the
285  * delimiters is stored verbatim in the list of inline functions, starting at
286  * first_inline_fun. To the compiler the lexer returns L_INLINE_FUN with the
287  * synthetic identifier of the function. Whenever such functions are pending
288  * and the compiler is at a safe place to accept a function definition
289  * (signalled in insert_inline_fun_now), the text of the pending functions is
290  * inserted into the input stream like a macro.
291 #endif
292  */
293 
294 static char *defbuf = NULL;
295   /* The combined input/expansion buffer.
296    */
297 
298 static unsigned long defbuf_len = 0;
299   /* Current length of defbuf.
300    */
301 
302 static char *outp;
303   /* Pointer to the next character in defbuf[] to be processed.
304    */
305 
306 static char *linebufstart;
307   /* Begin of the input line buffer within defbuf[].
308    */
309 
310 static char *linebufend;
311   /* End of the input line buffer within defbuf[].
312    */
313 
314 static char saved_char;
315   /* The first character of the incomplete line after the last complete
316    * one in the input buffer. Saved here because in the buffer itself
317    * it is overwritten with '\0'.
318    */
319 
320 /*-------------------------------------------------------------------------*/
321 
322 static Bool lex_fatal;
323   /* True: lexer encountered fatal error.
324    */
325 
326 static svalue_t *inc_list;
327   /* An array of pathnames to search for <>-include files.
328    * This is a pointer to the vector.item[] held in the driver_hook[]
329    * array.
330    */
331 
332 static size_t inc_list_size;
333   /* The number of names in <inc_list>.
334    */
335 
336 static mp_int inc_list_maxlen;
337   /* The lenght of the longest name in <inc_list>.
338    */
339 
340 static int nexpands;
341   /* Number of macro expansions on this line so far.
342    */
343 
344 static char yytext[MAXLINE];
345   /* Temporary buffer used to collect data.
346    */
347 
348 
349 /*-------------------------------------------------------------------------*/
350 /* Enforce an appropriate range for ITABLE_SIZE
351  * The hash used in ident_s is of type short. Therefore the hash table must
352  * not contain more hash chains than SHRT_MAX.
353  */
354 #if ITABLE_SIZE < 256 || ITABLE_SIZE > SHRT_MAX
355 #error "ITABLE_SIZE must be within the range of 256 and SHRT_MAX (usually 32768)."
356 This is the end...
357 #endif
358 
359 static ident_t *ident_table[ITABLE_SIZE];
360   /* The lexer stores all encountered identifiers in a hashtable of struct
361    * idents. The table follows the usual structure: the index (hash value)
362    *  is computed from the name of the identifier, the indexed table element
363    * the points to the head of a chain of different identifier values with
364    * identical hash. The most recently used identifier is always moved to
365    * the head of the chain.
366    *
367    * The table is used to store all identifiers and their value: starting
368    * from efun names and reserved words (like 'while') over preprocessor
369    * macros to 'normal' lfun and variable names. The identifiers are
370    * distinguished by the .type field in the ident structure. Should one
371    * identifier used with several different types at the same time, one entry
372    * is generated for each type, and they are all linked together by their
373    * .inferior pointers into a list ordered by falling type value. The entry
374    * with the highest type value is the one put into the hashtable's chain.
375    */
376 
377 #if ITABLE_SIZE == 256
378 #    define identhash(s) chashstr((s), 12)
379 #    define identhash_n(s,l) chashstr((s), (l)>12 ? 12 : (l))
380 #else
381 #    define identhash(s) (whashstr((s), 12) % ITABLE_SIZE)
382 #    define identhash_n(s,l) (whashstr((s), (l)>12 ? 12 : (l)) % ITABLE_SIZE)
383 #endif
384   /* Hash an identifier name (c-string) into a table index.
385    */
386 
387   /* In addition to this, the lexer keeps two lists for all efuns and
388    * preprocessor defines: all_efuns and all_defines. These are linked
389    * together with the .next_all field in the ident structure.
390    */
391 
392 ident_t *all_efuns = NULL;
393   /* The list of efuns. */
394 
395 static ident_t *all_defines = NULL;
396   /* The list of all non-permanent macro defines.
397    * Entries with a NULL .name are undefined macros.
398    */
399 
400 static ident_t *permanent_defines = NULL;
401   /* The list of all permanent macro defines. */
402 
403 
404 static ident_t *undefined_permanent_defines = NULL;
405   /* 'Parking list' for permanent defines which have been #undef'ined.
406    * After the compilation is complete, they will be put back into
407    * the ident_table.
408    */
409 
410 #ifndef USE_NEW_INLINES
411 /*-------------------------------------------------------------------------*/
412 
413 struct inline_fun * first_inline_fun = NULL;
414   /* Linked list of the saved function text for inline functions.
415    */
416 
417 Bool insert_inline_fun_now = MY_FALSE;
418   /* This is TRUE when we are at a suitable point to insert the
419    * saved inline functions. Usually this is at the end of a function,
420    * or after a global variable definition.
421    */
422 
423 unsigned int next_inline_fun = 0;
424   /* The running count of inline functions, used to 'name' the next
425    * function to generate.
426    */
427 #endif /* USE_NEW_INLINES */
428 
429 /*-------------------------------------------------------------------------*/
430 
431 /* The stack to handle nested #if...#else...#endif constructs.
432  */
433 
434 typedef struct lpc_ifstate_s
435 {
436     struct lpc_ifstate_s *next;
437     int                   state;  /* which token to expect */
438 } lpc_ifstate_t;
439 
440 /* lpc_ifstate_t.state values: */
441 
442 #define EXPECT_ELSE  1
443 #define EXPECT_ENDIF 2
444 
445 static lpc_ifstate_t *iftop = NULL;
446 
447 /*-------------------------------------------------------------------------*/
448 
449 /* The stack to save important state information when handling
450  * nested includes.
451  */
452 
453 static struct incstate
454 {
455     struct incstate * next;
456 
457     source_t     yyin;           /* The current input source */
458     source_loc_t loc;            /* Current source location */
459     ptrdiff_t    linebufoffset;  /* Position of linebufstart */
460     mp_uint      inc_offset;     /* Handle returned by store_include_info() */
461     char         saved_char;
462 } *inctop = NULL;
463 
464 /*-------------------------------------------------------------------------*/
465 
466 /* Translation table of reserved words into the lexcodes assigned by yacc
467  * in lang.h.
468  */
469 
470 struct s_reswords
471 {
472     char *name;  /* The reserved word */
473     int   code;  /* The assigned code */
474 };
475 
476 static struct s_reswords reswords[]
477  = { { "break",          L_BREAK         }
478    , { "case",           L_CASE          }
479    , { "catch",          L_CATCH         }
480    , { "closure",        L_CLOSURE_DECL  }
481    , { "continue",       L_CONTINUE      }
482    , { "default",        L_DEFAULT       }
483    , { "do",             L_DO            }
484    , { "else",           L_ELSE          }
485    , { "float",          L_FLOAT_DECL    }
486    , { "for",            L_FOR           }
487    , { "foreach",        L_FOREACH       }
488 #ifdef USE_NEW_INLINES
489    , { "function",       L_FUNC          }
490 #endif
491    , { "if",             L_IF            }
492 #ifdef L_IN
493    , { "in",             L_IN            }
494 #endif
495    , { "inherit",        L_INHERIT       }
496    , { "int",            L_INT           }
497    , { "mapping",        L_MAPPING       }
498    , { "mixed",          L_MIXED         }
499    , { "nomask",         L_NO_MASK       }
500    , { "nosave",         L_NOSAVE        }
501    , { "deprecated",     L_DEPRECATED    }
502    , { "object",         L_OBJECT        }
503 #ifdef USE_PARSE_COMMAND
504    , { "parse_command",  L_PARSE_COMMAND }
505 #endif
506    , { "private",        L_PRIVATE       }
507    , { "protected",      L_PROTECTED     }
508    , { "public",         L_PUBLIC        }
509    , { "return",         L_RETURN        }
510    , { "sscanf",         L_SSCANF        }
511    , { "static",         L_STATIC        }
512    , { "status",         L_STATUS        }
513 #ifdef USE_STRUCTS
514    , { "struct",         L_STRUCT        }
515 #endif
516    , { "string",         L_STRING_DECL   }
517    , { "switch",         L_SWITCH        }
518    , { "symbol",         L_SYMBOL_DECL   }
519    , { "varargs",        L_VARARGS       }
520    , { "virtual",        L_VIRTUAL       }
521    , { "void",           L_VOID          }
522    , { "while",          L_WHILE         }
523    };
524 
525 /*-------------------------------------------------------------------------*/
526 
527 /* The definitions and tables for the preprocessor expression evaluator.
528  */
529 
530 
531 #define BNOT   1  /* Unary operator opcodes*/
532 #define LNOT   2
533 #define UMINUS 3
534 #define UPLUS  4
535 
536 #define MULT   1  /* Binary operator opcodes */
537 #define DIV    2
538 #define MOD    3
539 #define BPLUS  4
540 #define BMINUS 5
541 #define LSHIFT 6
542 #define RSHIFT 7
543 #define LESS   8
544 #define LEQ    9
545 #define GREAT 10
546 #define GEQ   11
547 #define EQ    12
548 #define NEQ   13
549 #define BAND  14
550 #define XOR   15
551 #define BOR   16
552 #define LAND  17
553 #define LOR   18
554 #define QMARK 19
555 
556   /* lookup table for initial operator characters.
557    * The table covers the characters [' '..'~'].
558    * 0 for no operator, else index into optab2.
559    */
560 static char _optab[]
561  = {0,6,0,0,0,46,50,0,0,0,2,18,0,14,0,10,0,0,0,0,0,0,0,0,0,0,0,0,22,42,32,68,
562     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,64,0,
563     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,57,0,1
564  };
565 
566   /* Lookup table for the complete operator data in a serial format.
567    *
568    * optab2[index-1] : operation code for unary operator, 0 for none.
569    * optab2[index+0 .. +3 .. +6 ...] :
570    * two character binary operators: second character, operation code, prio
571    * one character binary operator & end: 0,           operation code, prio
572    * end: 0, 0
573    *
574    * Note that some entries overlap.
575    */
576 static char optab2[]
577   = { BNOT, 0                                 /*  1: ~         */
578     ,         0,   MULT,   11                 /*  2: *         */
579     , LNOT,   '=', NEQ,     7                 /*  6: !, !=     */
580     , 0,      0,   DIV,    11                 /* 10: /         */
581     , UMINUS, 0,   BMINUS, 10                 /* 14: -x, x-y   */
582     , UPLUS,  0,   BPLUS,  10                 /* 18: +x, x+y   */
583     , 0,      '<', LSHIFT,  9, '=', LEQ,  8, 0, LESS,  8
584                                               /* 22: <<, <=, < */
585     , 0,      '>', RSHIFT,  9, '=', GEQ,  8, 0, GREAT, 8
586                                               /* 32: >>, >=, > */
587     , 0,      '=', EQ,      7                 /* 42: ==        */
588     , 0,      0,   MOD,    11                 /* 46: %         */
589     , 0,      '&', LAND,    3, 0,   BAND, 6   /* 50: &&, &     */
590     , 0,      '|', LOR,     2, 0,   BOR,  4   /* 57: ||, |     */
591     , 0,      0,   XOR,     5                 /* 64: ^         */
592     , 0,      0,   QMARK,   1                 /* 68: ?         */
593 };
594 
595 #define optab1(c) (_optab[(c)-' '])
596   /* Use optab1 to index _optab with raw characters.
597    */
598 
599 /*-------------------------------------------------------------------------*/
600 
601   /* A handy macro to statically determine the number of
602    * elements in an array.
603    */
604 #define NELEM(a) (sizeof (a) / sizeof (a)[0])
605 
606   /* Save the character in variable 'c' in the yytext buffer, if
607    * there is enough space left.
608    */
609 #define SAVEC \
610     if (yyp < yytext+MAXLINE-5)\
611        *yyp++ = (char)c;\
612     else {\
613        lexerror("Line too long");\
614        break;\
615     }
616 
617   /* The magic character used for function macros to mark the places
618    * in the replacement text where the macro arguments are to be
619    * inserted.
620    * The marking sequence for argument n is { '@', '@'+n+1 }, and
621    * the character '@' itself is stored as { '@', '@' }.
622    */
623 #define MARKS '@'
624 
625 /*-------------------------------------------------------------------------*/
626 /* Forward declarations */
627 
628 static INLINE int number(long);
629 static INLINE int string(char *, size_t);
630 static void handle_define(char *, Bool);
631 static void add_define(char *, short, char *, source_loc_t);
632 static void add_permanent_define(char *, short, void *, Bool);
633 static Bool expand_define(void);
634 static Bool _expand_define(struct defn*, ident_t*);
635 static INLINE void myungetc(char);
636 static int cond_get_exp(int, svalue_t *);
637 static int exgetc(void);
638 static char *get_current_file(char **);
639 static char *get_current_line(char **);
640 static char *get_version(char **);
641 static char *get_hostname(char **);
642 static char *get_domainname(char **);
643 static char *get_current_dir(char **);
644 static char *get_sub_path(char **);
645 static char *efun_defined(char **);
646 static void lexerrorf VARPROT((char *, ...), printf, 1, 2);
647 static void lexerror(char *);
648 static ident_t *lookup_define(char *);
649 
650 /*-------------------------------------------------------------------------*/
651 
652 #include "efun_defs.c"
653 
654 /* struct instr instrs[] = { ... };
655  *
656  * Information about all instructions and efuns, generated by make_func.
657  * Also included are the table for our own ctype functions.
658  *
659  * The numbers of arguments are used by the compiler.
660  * If min == max, then no information has to be coded about the
661  * actual number of arguments. Otherwise, the actual number of arguments
662  * will be stored in the byte after the instruction.
663  * A maximum value of -1 means unlimited maximum value.
664  *
665  * If an argument has type 0 (T_INVALID) specified, then no checks will
666  * be done at run time.
667  *
668  * The argument types are checked by the compiler if type checking is enabled,
669  * and always at runtime.
670  */
671 
672 /*-------------------------------------------------------------------------*/
673 void
init_lexer(void)674 init_lexer(void)
675 
676 /* Initialize the various lexer tables, including the predefined macros
677  * from the commandline given in lpc_predefs.
678  * The lpc_predefs list is deallocated by this call.
679  */
680 
681 {
682     size_t i, n;
683     char mtext[MLEN];
684 
685     /* Allocate enough memory for 20 nested includes/ifs */
686     lexpool = new_lifopool(size_lifopool( sizeof(lpc_ifstate_t)
687                                          +sizeof(struct incstate)));
688     if (!lexpool)
689         fatal("Out of memory.\n");
690 
691     current_loc.file = NULL;
692     current_loc.line = 0;
693 
694 
695     /* Clear the table of identifiers */
696     for (i = 0; i < ITABLE_SIZE; i++)
697         ident_table[i] = NULL;
698 
699     /* For every efun, create a global entry in ident_table[] */
700     for (n = 0; n < NELEM(instrs); n++)
701     {
702         ident_t *p;
703 
704         if (instrs[n].Default == -1)
705             continue;
706 
707         /* In !compat mode, skip certain efuns */
708         if (!compat_mode
709          && (   !strcmp(instrs[n].name, "creator")
710 #ifdef USE_DEPRECATED
711              ||  n == F_TRANSFER
712 #endif /* USE_DEPRECATED */
713             )
714            )
715             continue;
716 
717         p = make_shared_identifier(instrs[n].name, I_TYPE_GLOBAL, 0);
718         if (!p)
719             fatal("Out of memory\n");
720         if (p->type != I_TYPE_UNKNOWN)
721         {
722             fatal("Duplicate efun '%s'.\n", instrs[n].name);
723             /* NOTREACHED */
724             continue;
725         }
726         init_global_identifier(p, /* bVariable: */ MY_FALSE);
727         p->u.global.efun = (short)n;
728         p->next_all = all_efuns;
729         all_efuns = p;
730     }
731 
732     /* For every reserved word, create a global entry in ident_table[] */
733     for (i = 0; i < NELEM(reswords); i++)
734     {
735         ident_t *p;
736 
737         p = make_shared_identifier(reswords[i].name, I_TYPE_RESWORD, 0);
738         if (!p)
739             fatal("Out of memory\n");
740         p->type = I_TYPE_RESWORD;
741         p->u.code = reswords[i].code;
742     }
743 
744 
745     /* Add the standard permanent macro definitions */
746     /* TODO: Make the strings tabled */
747 
748     add_permanent_define("LPC3", -1, string_copy(""), MY_FALSE);
749     add_permanent_define("__LDMUD__", -1, string_copy(""), MY_FALSE);
750     if (compat_mode)
751     {
752         add_permanent_define("COMPAT_FLAG", -1, string_copy(""), MY_FALSE);
753         add_permanent_define("__COMPAT_MODE__", -1, string_copy(""), MY_FALSE);
754     }
755     add_permanent_define("__EUIDS__", -1, string_copy(""), MY_FALSE);
756 
757     if (allow_filename_spaces)
758         add_permanent_define("__FILENAME_SPACES__", -1, string_copy(""), MY_FALSE);
759     if (strict_euids)
760         add_permanent_define("__STRICT_EUIDS__", -1, string_copy(""), MY_FALSE);
761 
762     if (compat_mode)
763     {
764         mtext[0] = '"';
765         strcpy(mtext+1, master_name);
766         strcat(mtext+1, "\"");
767     }
768     else
769     {
770         mtext[0] = '"';
771         mtext[1] = '/';
772         strcpy(mtext+2, master_name);
773         strcat(mtext+2, "\"");
774     }
775 
776     add_permanent_define("__MASTER_OBJECT__", -1, string_copy(mtext), MY_FALSE);
777     add_permanent_define("__FILE__", -1, (void *)get_current_file, MY_TRUE);
778     add_permanent_define("__DIR__", -1, (void *)get_current_dir, MY_TRUE);
779     add_permanent_define("__PATH__", 1, (void *)get_sub_path, MY_TRUE);
780     add_permanent_define("__LINE__", -1, (void *)get_current_line, MY_TRUE);
781     add_permanent_define("__VERSION__", -1, (void *)get_version, MY_TRUE);
782     add_permanent_define("__VERSION_MAJOR__", -1, string_copy(VERSION_MAJOR), MY_FALSE);
783     add_permanent_define("__VERSION_MINOR__", -1, string_copy(VERSION_MINOR), MY_FALSE);
784     add_permanent_define("__VERSION_MICRO__", -1, string_copy(VERSION_MICRO), MY_FALSE);
785     add_permanent_define("__VERSION_PATCH__", -1, string_copy("0"), MY_FALSE);
786 
787     add_permanent_define("__HOST_NAME__", -1, (void *)get_hostname, MY_TRUE);
788     add_permanent_define("__DOMAIN_NAME__", -1, (void *)get_domainname, MY_TRUE);
789     add_permanent_define("__HOST_IP_NUMBER__", -1
790                         , (void*)get_host_ip_number, MY_TRUE);
791     sprintf(mtext, "%d", MAX_USER_TRACE);
792     add_permanent_define("__MAX_RECURSION__", -1, string_copy(mtext), MY_FALSE);
793     add_permanent_define("__EFUN_DEFINED__", 1, (void *)efun_defined, MY_TRUE);
794 #ifdef ERQ_DEMON
795     sprintf(mtext, "%d", ERQ_MAX_SEND);
796     add_permanent_define("__ERQ_MAX_SEND__", -1, string_copy(mtext), MY_FALSE);
797     sprintf(mtext, "%d", ERQ_MAX_REPLY);
798     add_permanent_define("__ERQ_MAX_REPLY__", -1, string_copy(mtext), MY_FALSE);
799 #endif
800     sprintf(mtext, "%"PRIdMPINT, get_memory_limit(MALLOC_HARD_LIMIT));
801     add_permanent_define("__MAX_MALLOC__", -1, string_copy(mtext), MY_FALSE);
802     sprintf(mtext, "%"PRId32, def_eval_cost);
803     add_permanent_define("__MAX_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
804     sprintf(mtext, "%ld", (long)CATCH_RESERVED_COST);
805     add_permanent_define("__CATCH_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
806     sprintf(mtext, "%ld", (long)MASTER_RESERVED_COST);
807     add_permanent_define("__MASTER_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
808     sprintf(mtext, "%ld", time_to_reset);
809     add_permanent_define("__RESET_TIME__", -1, string_copy(mtext), MY_FALSE);
810     sprintf(mtext, "%ld", time_to_cleanup);
811     add_permanent_define("__CLEANUP_TIME__", -1, string_copy(mtext), MY_FALSE);
812     sprintf(mtext, "%ld", alarm_time);
813     add_permanent_define("__ALARM_TIME__", -1, string_copy(mtext), MY_FALSE);
814     sprintf(mtext, "%ld", heart_beat_interval);
815     add_permanent_define("__HEART_BEAT_INTERVAL__", -1, string_copy(mtext), MY_FALSE);
816     if (synch_heart_beats)
817         add_permanent_define("__SYNCHRONOUS_HEART_BEAT__", -1, string_copy("1"), MY_FALSE);
818     sprintf(mtext, "%zu", (size_t)MAX_COMMAND_LENGTH - 1);
819     add_permanent_define("__MAX_COMMAND_LENGTH__", -1, string_copy(mtext),
820                          MY_FALSE);
821 #ifdef EVAL_COST_TRACE
822     add_permanent_define("__EVAL_COST_TRACE__", -1, string_copy("1"), MY_FALSE);
823 #endif
824 #ifdef HAS_IDN
825     add_permanent_define("__IDNA__", -1, string_copy("1"), MY_FALSE);
826 #endif
827 #ifdef USE_IPV6
828     add_permanent_define("__IPV6__", -1, string_copy("1"), MY_FALSE);
829 #endif
830 #ifdef USE_MCCP
831     add_permanent_define("__MCCP__", -1, string_copy("1"), MY_FALSE);
832 #endif
833 #ifdef USE_MYSQL
834     add_permanent_define("__MYSQL__", -1, string_copy("1"), MY_FALSE);
835 #endif
836 #ifdef USE_PGSQL
837     add_permanent_define("__PGSQL__", -1, string_copy("1"), MY_FALSE);
838 #endif
839 #ifdef USE_SQLITE
840     add_permanent_define("__SQLITE__", -1, string_copy("1"), MY_FALSE);
841 #endif
842 #ifdef USE_XML
843     add_permanent_define("__XML_DOM__", -1, string_copy("1"), MY_FALSE);
844 #endif
845 #ifdef USE_ALISTS
846     add_permanent_define("__ALISTS__", -1, string_copy("1"), MY_FALSE);
847 #endif
848     add_permanent_define("__PCRE__", -1, string_copy("1"), MY_FALSE);
849     add_permanent_define("__LPC_NOSAVE__", -1, string_copy("1"), MY_FALSE);
850 #ifdef USE_DEPRECATED
851     add_permanent_define("__DEPRECATED__", -1, string_copy("1"), MY_FALSE);
852 #endif
853 #ifdef USE_STRUCTS
854     add_permanent_define("__LPC_STRUCTS__", -1, string_copy("1"), MY_FALSE);
855 #endif
856 #ifdef USE_NEW_INLINES
857     add_permanent_define("__LPC_INLINE_CLOSURES__", -1, string_copy("1"), MY_FALSE);
858 #endif
859 #ifdef USE_ARRAY_CALLS
860     add_permanent_define("__LPC_ARRAY_CALLS__", -1, string_copy("1"), MY_FALSE);
861 #endif
862 #ifdef USE_TLS
863     add_permanent_define("__TLS__", -1, string_copy("1"), MY_FALSE);
864 #ifdef HAS_GNUTLS
865     add_permanent_define("__GNUTLS__", -1, string_copy("1"), MY_FALSE);
866 #endif
867 #ifdef HAS_OPENSSL
868     add_permanent_define("__OPENSSL__", -1, string_copy("1"), MY_FALSE);
869 #endif
870 #endif
871 #ifdef USE_GCRYPT
872     add_permanent_define("__GCRYPT__", -1, string_copy("1"), MY_FALSE);
873 #endif
874     if (wizlist_name[0] != '\0')
875     {
876         if (compat_mode)
877         {
878             mtext[0] = '"';
879             strcpy(mtext+1, wizlist_name);
880             strcat(mtext+1, "\"");
881         }
882         else
883         {
884             mtext[0] = '"';
885             mtext[1] = '/';
886             strcpy(mtext+2, wizlist_name);
887             strcat(mtext+2, "\"");
888         }
889         add_permanent_define("__WIZLIST__", -1, string_copy(mtext), MY_FALSE);
890     }
891 
892     sprintf(mtext, "(%"PRIdPINT")", PINT_MAX);
893     add_permanent_define("__INT_MAX__", -1, string_copy(mtext), MY_FALSE);
894     sprintf(mtext, "(%"PRIdPINT")", PINT_MIN);
895     add_permanent_define("__INT_MIN__", -1, string_copy(mtext), MY_FALSE);
896     sprintf(mtext, "(%g)", DBL_MAX);
897     add_permanent_define("__FLOAT_MAX__", -1, string_copy(mtext), MY_FALSE);
898     sprintf(mtext, "(%g)", DBL_MIN);
899     add_permanent_define("__FLOAT_MIN__", -1, string_copy(mtext), MY_FALSE);
900     sprintf(mtext, "%"PRIdMPINT, get_current_time());
901     add_permanent_define("__BOOT_TIME__", -1, string_copy(mtext), MY_FALSE);
902 
903     /* Add the permanent macro definitions given on the commandline */
904 
905     while (NULL != lpc_predefs)
906     {
907         char namebuf[NSIZE];
908         struct lpc_predef_s *tmpf;
909 
910         tmpf = lpc_predefs;
911         lpc_predefs = lpc_predefs->next;
912 
913         *mtext = '\0';
914         sscanf(tmpf->flag, "%[^=]=%[ -~=]", namebuf, mtext);
915         if ( strlen(namebuf) >= NSIZE )
916             fatal("-D%s: macroname too long (>%d)\n", tmpf->flag, NSIZE);
917         if ( strlen(mtext) >= MLEN )
918             fatal("-D%s: macrotext too long (>%d)\n", tmpf->flag, MLEN);
919         add_permanent_define(namebuf, -1, string_copy(mtext), MY_FALSE);
920 
921         xfree(tmpf->flag);
922         xfree(tmpf);
923     }
924 } /* init_lexer() */
925 
926 /*-------------------------------------------------------------------------*/
927 int
symbol_operator(const char * symbol,const char ** endp)928 symbol_operator (const char *symbol, const char **endp)
929 
930 /* Analyse the text starting at <symbol> (which points to the first character
931  * after the assumed "#'") if it describes a closure symbol. If yes, return
932  * the operator code and set *<endp> to the first character after the
933  * recognized operator.
934  * If no operator can be recognized, return -1 and set *<endp> to <symbol>.
935  *
936  * The function is called from ed.c and from symbol_efun().
937  *
938  * Recognized are the following operators:
939  *
940  *   #'+=     -> F_ADD_EQ
941  *   #'++     -> F_POST_INC
942  *   #'+      -> F_ADD
943  *   #'-=     -> F_SUB_EQ
944  *   #'--     -> F_POST_DEC
945  *   #'-      -> F_SUBTRACT
946  *   #'*=     -> F_MULT_EQ
947  *   #'*      -> F_MULTIPLY
948  *   #'/=     -> F_DIV_EQ
949  *   #'/      -> F_DIVIDE
950  *   #'%=     -> F_MOD_EQ
951  *   #'%      -> F_MOD
952  *   #',      -> F_POP_VALUE
953  *   #'^=     -> F_XOR_EQ
954  *   #'^      -> F_XOR
955  *   #'||     -> F_LOR
956  *   #'||=    -> F_LOR_EQ
957  *   #'|=     -> F_OR_EQ
958  *   #'|      -> F_OR
959  *   #'&&     -> F_LAND
960  *   #'&&=    -> F_LAND_EQ
961  *   #'&=     -> F_AND_EQ
962  *   #'&      -> F_AND
963  *   #'~      -> F_COMPL
964  *   #'<=     -> F_LE
965  *   #'<<=    -> F_LSH_EQ
966  *   #'<<     -> F_LSH
967  *   #'<      -> F_LT
968  *   #'>=     -> F_GE
969  *   #'>>=    -> F_RSH_EQ
970  *   #'>>>=   -> F_RSHL_EQ
971  *   #'>>>    -> F_RSHL
972  *   #'>>     -> F_RSH
973  *   #'>      -> F_GT
974  *   #'==     -> F_EQ
975  *   #'=      -> F_ASSIGN
976  *   #'!=     -> F_NE
977  *   #'!      -> F_NOT
978  *   #'?!     -> F_BRANCH_WHEN_NON_ZERO
979  *   #'?      -> F_BRANCH_WHEN_ZERO
980  *   #'[..]   -> F_RANGE
981  *   #'[..<]  -> F_NR_RANGE
982  *   #'[<..]  -> F_RN_RANGE
983  *   #'[<..<] -> F_RR_RANGE
984  *   #'[..>]  -> F_NA_RANGE
985  *   #'[>..]  -> F_AN_RANGE
986  *   #'[<..>] -> F_RA_RANGE
987  *   #'[>..<] -> F_AR_RANGE
988  *   #'[>..>] -> F_AA_RANGE
989  *   #'[..    -> F_NX_RANGE
990  *   #'[<..   -> F_RX_RANGE
991  *   #'[>..   -> F_AX_RANGE
992  *   #'[,]    -> F_MAP_INDEX
993  *   #'[      -> F_INDEX
994  *   #'[<     -> F_RINDEX
995  *   #'[>     -> F_AINDEX
996  *   #'({     -> F_AGGREGATE
997  *   #'([     -> F_M_CAGGREGATE
998 #ifdef USE_STRUCTS
999  *   #'->     -> F_S_INDEX
1000  *   #'(<     -> F_S_AGGREGATE
1001 #endif
1002  *
1003  * Note that all operators must have a instrs[].Default value of '0'.
1004  * If necessary, update the lex::init_lexer()::binary_operators[] to
1005  * include the operator values.
1006  */
1007 
1008 {
1009     char c;
1010     int ret;
1011 
1012     switch(*symbol)
1013     {
1014     case '+':
1015         c = symbol[1];
1016         if (c == '=')
1017         {
1018             symbol++;
1019             ret = F_ADD_EQ;
1020             break;
1021         }
1022         else if (c == '+')
1023         {
1024             symbol++;
1025             ret = F_POST_INC;
1026             break;
1027         }
1028         ret = F_ADD;
1029         break;
1030 
1031     case '-':
1032         c = symbol[1];
1033         if (c == '=')
1034         {
1035             symbol++;
1036             ret = F_SUB_EQ;
1037             break;
1038         }
1039         else if (c == '-')
1040         {
1041             symbol++;
1042             ret = F_POST_DEC;
1043             break;
1044         }
1045 #ifdef USE_STRUCTS
1046         else if (c == '>')
1047         {
1048             symbol++;
1049             ret = F_S_INDEX;
1050             break;
1051         }
1052 #endif /* USE_STRUCTS */
1053         ret = F_SUBTRACT;
1054         break;
1055 
1056     case '*':
1057         if (symbol[1] == '=')
1058         {
1059             symbol++;
1060             ret = F_MULT_EQ;
1061             break;
1062         }
1063         ret = F_MULTIPLY;
1064         break;
1065 
1066     case '/':
1067         if (symbol[1] == '=')
1068         {
1069             symbol++;
1070             ret = F_DIV_EQ;
1071             break;
1072         }
1073         ret = F_DIVIDE;
1074         break;
1075 
1076     case '%':
1077         if (symbol[1] == '=')
1078         {
1079             symbol++;
1080             ret = F_MOD_EQ;
1081             break;
1082         }
1083         ret = F_MOD;
1084         break;
1085 
1086     case ',':
1087         ret = F_POP_VALUE;
1088         break;
1089 
1090     case '^':
1091         if (symbol[1] == '=')
1092         {
1093             symbol++;
1094             ret = F_XOR_EQ;
1095             break;
1096         }
1097         ret = F_XOR;
1098         break;
1099 
1100     case '|':
1101         c = *++symbol;
1102         if (c == '|')
1103         {
1104             if (symbol[1] == '=')
1105             {
1106                 symbol++;
1107                 ret = F_LOR_EQ;
1108             }
1109             else
1110                 ret = F_LOR;
1111             break;
1112         }
1113         else if (c == '=')
1114         {
1115             ret = F_OR_EQ;
1116             break;
1117         }
1118         symbol--;
1119         ret = F_OR;
1120         break;
1121 
1122     case '&':
1123         c = *++symbol;
1124         if (c == '&')
1125         {
1126             if (symbol[1] == '=')
1127             {
1128                 symbol++;
1129                 ret = F_LAND_EQ;
1130             }
1131             else
1132                 ret = F_LAND;
1133             break;
1134         }
1135         else if (c == '=')
1136         {
1137             ret = F_AND_EQ;
1138             break;
1139         }
1140         symbol--;
1141         ret = F_AND;
1142         break;
1143 
1144     case '~':
1145         ret = F_COMPL;
1146         break;
1147 
1148     case '<':
1149         c = *++symbol;
1150         if (c == '=')
1151         {
1152             ret = F_LE;
1153             break;
1154         }
1155         else if (c == '<')
1156         {
1157             if (symbol[1] == '=')
1158             {
1159                 symbol++;
1160                 ret = F_LSH_EQ;
1161                 break;
1162             }
1163             ret = F_LSH;
1164             break;
1165         }
1166         symbol--;
1167         ret = F_LT;
1168         break;
1169 
1170     case '>':
1171         c = *++symbol;
1172         if (c == '=')
1173         {
1174             ret = F_GE;
1175             break;
1176         }
1177         else if (c == '>')
1178         {
1179             if (symbol[1] == '=')
1180             {
1181                 symbol++;
1182                 ret = F_RSH_EQ;
1183                 break;
1184             }
1185             if (symbol[1] == '>')
1186             {
1187                 symbol++;
1188                 if (symbol[1] == '=')
1189                 {
1190                     symbol++;
1191                     ret = F_RSHL_EQ;
1192                     break;
1193                 }
1194                 ret = F_RSHL;
1195                 break;
1196             }
1197             ret = F_RSH;
1198             break;
1199         }
1200         symbol--;
1201         ret = F_GT;
1202         break;
1203 
1204     case '=':
1205         if (symbol[1] == '=')
1206         {
1207             symbol++;
1208             ret = F_EQ;
1209             break;
1210         }
1211         ret = F_ASSIGN;
1212         break;
1213 
1214     case '!':
1215         if (symbol[1] == '=')
1216         {
1217             symbol++;
1218             ret = F_NE;
1219             break;
1220         }
1221         ret = F_NOT;
1222         break;
1223 
1224     case '?':
1225         if (symbol[1] == '!')
1226         {
1227             symbol++;
1228             ret = F_BRANCH_WHEN_NON_ZERO;
1229             break;
1230         }
1231         ret = F_BRANCH_WHEN_ZERO;
1232         break;
1233 
1234     case '[':
1235         c = *++symbol;
1236         if (c == '<')
1237         {
1238             if (symbol[1] == '.' && symbol[2] == '.')
1239             {
1240                 c = *(symbol+=3);
1241                 if (c == ']')
1242                 {
1243                     ret = F_RN_RANGE;
1244                     break;
1245                 }
1246                 else if (c == '>' && symbol[1] == ']')
1247                 {
1248                     symbol++;
1249                     ret = F_RA_RANGE;
1250                     break;
1251                 }
1252                 else if (c == '<' && symbol[1] == ']')
1253                 {
1254                     symbol++;
1255                     ret = F_RR_RANGE;
1256                     break;
1257                 }
1258                 symbol--;
1259                 ret = F_RX_RANGE;
1260                 break;
1261             }
1262             ret = F_RINDEX;
1263             break;
1264         }
1265         else if (c == '>')
1266         {
1267             if (symbol[1] == '.' && symbol[2] == '.')
1268             {
1269                 c = *(symbol+=3);
1270                 if (c == ']')
1271                 {
1272                     ret = F_AN_RANGE;
1273                     break;
1274                 }
1275                 else if (c == '>' && symbol[1] == ']')
1276                 {
1277                     symbol++;
1278                     ret = F_AA_RANGE;
1279                     break;
1280                 }
1281                 else if (c == '<' && symbol[1] == ']')
1282                 {
1283                     symbol++;
1284                     ret = F_AR_RANGE;
1285                     break;
1286                 }
1287                 symbol--;
1288                 ret = F_AX_RANGE;
1289                 break;
1290             }
1291             ret = F_AINDEX;
1292             break;
1293         }
1294         else if (c == '.' && symbol[1] == '.')
1295         {
1296             c = *(symbol+=2);
1297             if (c == ']') {
1298                 ret = F_RANGE;
1299                 break;
1300             } else if (c == '>' && symbol[1] == ']') {
1301                 symbol++;
1302                 ret = F_NA_RANGE;
1303                 break;
1304             } else if (c == '<' && symbol[1] == ']') {
1305                 symbol++;
1306                 ret = F_NR_RANGE;
1307                 break;
1308             }
1309             symbol--;
1310             ret = F_NX_RANGE;
1311             break;
1312         }
1313         else if (c == ',' && symbol[1] == ']')
1314         {
1315             symbol++;
1316             ret = F_MAP_INDEX;
1317             break;
1318         }
1319         symbol--;
1320         ret = F_INDEX;
1321         break;
1322 
1323     case '(':
1324         c = *++symbol;
1325         if (c == '{')
1326         {
1327             ret = F_AGGREGATE;
1328             break;
1329         }
1330         else if (c == '[')
1331         {
1332             ret = F_M_CAGGREGATE;
1333             break;
1334         }
1335 #ifdef USE_STRUCTS
1336         else if (c == '<')
1337         {
1338             ret = F_S_AGGREGATE;
1339             break;
1340         }
1341 #endif /* USE_STRUCTS */
1342         symbol--;
1343         /* FALL THROUGH */
1344     default:
1345         ret = -1;
1346         symbol--;
1347         break;
1348     }
1349 
1350     /* Symbol is not an operator */
1351     *endp = symbol+1;
1352     return ret;
1353 } /* symbol_operator() */
1354 
1355 /*-------------------------------------------------------------------------*/
1356 static INLINE int
symbol_resword(ident_t * p)1357 symbol_resword (ident_t *p)
1358 
1359 /* This function implements the resword lookup for closures.
1360  *
1361  * If ident <p> is a reserved word with a closure representation, return
1362  * the corresponding instruction code:
1363  *
1364  *   #'if          -> F_BRANCH_WHEN_ZERO
1365  *   #'do          -> F_BBRANCH_WHEN_NON_ZERO
1366  *   #'while       -> F_BBRANCH_WHEN_ZERO
1367  *   #'foreach     -> F_FOREACH
1368  *   #'continue    -> F_BRANCH
1369  *   #'default     -> F_CSTRING0
1370  *   #'switch      -> F_SWITCH
1371  *   #'break       -> F_BREAK
1372  *   #'return      -> F_RETURN
1373  *   #'sscanf      -> F_SSCANF
1374  *   #'catch       -> F_CATCH
1375  *
1376  * If ident <p> is not a reserved word, or a word without closure
1377  * representation, return 0.
1378  */
1379 
1380 {
1381     int code = 0;
1382 
1383     if (p->type != I_TYPE_RESWORD)
1384         return 0;
1385 
1386     switch(p->u.code)
1387     {
1388     default:
1389         /* Unimplemented reserved word */
1390         code = 0;
1391         break;
1392 
1393     case L_IF:
1394         code = F_BRANCH_WHEN_ZERO;
1395         break;
1396 
1397     case L_DO:
1398         code = F_BBRANCH_WHEN_NON_ZERO;
1399         break;
1400 
1401     case L_WHILE:
1402         /* the politically correct code was already taken, see above. */
1403         code = F_BBRANCH_WHEN_ZERO;
1404         break;
1405 
1406     case L_FOREACH:
1407         code = F_FOREACH;
1408         break;
1409 
1410     case L_CONTINUE:
1411         code = F_BRANCH;
1412         break;
1413 
1414     case L_DEFAULT:
1415         code = F_CSTRING0;
1416         break;
1417 
1418     case L_SWITCH:
1419         code = F_SWITCH;
1420         break;
1421     case L_BREAK:
1422         code = F_BREAK;
1423         break;
1424     case L_RETURN:
1425         code = F_RETURN;
1426         break;
1427     case L_SSCANF:
1428         code = F_SSCANF;
1429         break;
1430 #ifdef USE_PARSE_COMMAND
1431     case L_PARSE_COMMAND:
1432         code = F_PARSE_COMMAND;
1433         break;
1434 #endif
1435     case L_CATCH:
1436         code = F_CATCH;
1437         break;
1438     }
1439 
1440     return code;
1441 } /* symbol_resword() */
1442 
1443 /*-------------------------------------------------------------------------*/
1444 void
symbol_efun_str(const char * str,size_t len,svalue_t * sp,Bool is_efun)1445 symbol_efun_str (const char * str, size_t len, svalue_t *sp, Bool is_efun)
1446 
1447 /* This function implements the efun/operator/sefun part of efun
1448  * symbol_function().
1449  *
1450  * It is also called by parse_command to lookup the (simul)efuns find_living()
1451  * and find_player() at runtime, and by restore_svalue().
1452  *
1453  * The function takes the string <str> of length <len> and looks up the named
1454  * efun, sefun or operator. If the efun/operator is found, the value <sp> is
1455  * turned into the proper closure value, otherwise it is set to the numeric
1456  * value 0.  If <is_efun> is TRUE, <str> is resolved as an efun even if it
1457  * doesn't contain the 'efun::' prefix.
1458  *
1459  * inter_sp must be set properly before the call.
1460  *
1461  * Accepted symbols are:
1462  *
1463  *   #'<operator>: see lex::symbol_operator()
1464  *
1465  *   #'if          -> F_BRANCH_WHEN_ZERO       +CLOSURE_OPERATOR
1466  *   #'do          -> F_BBRANCH_WHEN_NON_ZERO  +CLOSURE_OPERATOR
1467  *   #'while       -> F_BBRANCH_WHEN_ZERO      +CLOSURE_OPERATOR
1468  *   #'foreach     -> F_FOREACH                +CLOSURE_OPERATOR
1469  *   #'continue    -> F_BRANCH                 +CLOSURE_OPERATOR
1470  *   #'default     -> F_CSTRING0               +CLOSURE_OPERATOR
1471  *   #'switch      -> F_SWITCH                 +CLOSURE_OPERATOR
1472  *   #'break       -> F_BREAK                  +CLOSURE_OPERATOR
1473  *   #'return      -> F_RETURN                 +CLOSURE_OPERATOR
1474  *   #'sscanf      -> F_SSCANF                 +CLOSURE_OPERATOR
1475  *   #'catch       -> F_CATCH                  +CLOSURE_OPERATOR
1476  *
1477  *   #'<efun>      -> F_<efun>                 +CLOSURE_EFUN
1478  *   #'<sefun>     -> <function-index>         +CLOSURE_SIMUL_EFUN
1479  */
1480 
1481 {
1482     Bool efun_override = is_efun;
1483 
1484     /* If the first character is alphanumeric, the string names a function,
1485      * otherwise an operator.
1486      */
1487     if (isalunum(*str))
1488     {
1489         /* It is a function or keyword.
1490          */
1491 
1492         ident_t *p;
1493 
1494         /* Take care of an leading efun override */
1495 
1496         if ( len >= 6 && !strncmp(str, "efun::", 6) )
1497         {
1498             str += 6;
1499             len -= 6;
1500             efun_override = MY_TRUE;
1501         }
1502 
1503         /* Lookup the identifier in the string in the global table
1504          * of identifers.
1505          */
1506         if ( !(p = make_shared_identifier_n(str, len, I_TYPE_GLOBAL, 0)) )
1507         {
1508             outofmem(len, "identifier");
1509         }
1510 
1511         /* Loop through the possible multiple definitions.
1512          */
1513         while (p->type > I_TYPE_GLOBAL)
1514         {
1515             /* Is it a reserved word? */
1516             if (p->type == I_TYPE_RESWORD)
1517             {
1518                 int code = symbol_resword(p);
1519 
1520                 if (!code)
1521                 {
1522                     /* Unimplemented reserved word */
1523                     if ( NULL != (p = p->inferior) )
1524                         continue;
1525                     goto undefined_function;
1526                 }
1527 
1528                 /* Got the reserved word: return the closure value */
1529 
1530                 sp->type = T_CLOSURE;
1531                 sp->x.closure_type = (short)(code + CLOSURE_OPERATOR);
1532                 sp->u.ob = ref_object(current_object, "symbol_efun");
1533                 return;
1534             }
1535             if ( !(p = p->inferior) )
1536                 break; /* Found a valid definition */
1537         }
1538 
1539         /* It is a real identifier */
1540 
1541         if (!p || p->type < I_TYPE_GLOBAL
1542          || (( efun_override || p->u.global.sim_efun < 0 )
1543              && p->u.global.efun < 0)
1544            )
1545         {
1546             /* But it's a (new) local identifier or a non-existing function */
1547             if (p && p->type == I_TYPE_UNKNOWN)
1548                 free_shared_identifier(p);
1549 
1550 undefined_function:
1551             put_number(sp, 0);
1552             return;
1553         }
1554 
1555         /* Attempting to override a 'nomask' simul efun?
1556          * Check it with a privilege violation.
1557          */
1558         if (efun_override && p->u.global.sim_efun >= 0
1559          && simul_efunp[p->u.global.sim_efun].flags & TYPE_MOD_NO_MASK)
1560         {
1561             svalue_t *res;
1562 
1563             push_ref_string(inter_sp, STR_NOMASK_SIMUL_EFUN);
1564             push_ref_valid_object(inter_sp, current_object, "nomask simul_efun");
1565             push_ref_string(inter_sp, p->name);
1566             res = apply_master(STR_PRIVILEGE, 3);
1567 
1568             if (!res || res->type != T_NUMBER || res->u.number < 0)
1569             {
1570             	/* Override attempt is fatal */
1571                 errorf(
1572                   "Privilege violation: nomask simul_efun %s\n",
1573                   get_txt(p->name)
1574                 );
1575             }
1576             else if (!res->u.number)
1577             {
1578             	/* Override attempt not fatal, but rejected nevertheless */
1579                 efun_override = MY_FALSE;
1580             }
1581         }
1582 
1583         /* Symbol is ok - create the closure value */
1584 
1585         sp->type = T_CLOSURE;
1586         if (!efun_override && p->u.global.sim_efun >= 0)
1587         {
1588             /* Handle non-overridden simul efuns */
1589 
1590             sp->x.closure_type = (short)(p->u.global.sim_efun + CLOSURE_SIMUL_EFUN);
1591             sp->u.ob = ref_object(current_object, "symbol_efun");
1592         }
1593         else
1594         {
1595             /* Handle efuns (possibly aliased).
1596              * We know that p->u.global.efun >= 0 here.
1597              */
1598             sp->x.closure_type = (short)(p->u.global.efun + CLOSURE_EFUN);
1599             if (sp->x.closure_type > LAST_INSTRUCTION_CODE + CLOSURE_EFUN)
1600                 sp->x.closure_type = (short)(CLOSURE_EFUN +
1601                   efun_aliases[
1602                     sp->x.closure_type - CLOSURE_EFUN - LAST_INSTRUCTION_CODE - 1]);
1603             sp->u.ob = ref_object(current_object, "symbol_efun");
1604         }
1605     }
1606     else
1607     {
1608         int i;
1609         const char *end;
1610 
1611         i = symbol_operator(str, &end);
1612         /* If there was a valid operator with trailing junk, *end, but i >= 0.
1613          * On the other hand, if we passed the empty string, i < 0, but !*end.
1614          * Thus, we have to test for (*end || i < 0) .
1615          */
1616 
1617         if (*end || i < 0)
1618         {
1619             put_number(sp, 0);
1620             return;
1621         }
1622         sp->type = T_CLOSURE;
1623         if (instrs[i].Default == -1) {
1624             sp->x.closure_type = (short)(i + CLOSURE_OPERATOR);
1625         } else {
1626             sp->x.closure_type = (short)(i + CLOSURE_EFUN);
1627         }
1628         sp->u.ob = ref_object(current_object, "symbol_efun");
1629     }
1630 } /* symbol_efun_str() */
1631 
1632 /*-------------------------------------------------------------------------*/
1633 void
symbol_efun(string_t * name,svalue_t * sp)1634 symbol_efun (string_t *name, svalue_t *sp)
1635 
1636 /* This function is a wrapper around symbol_efun_str(), taking a regular
1637  * string <name> as argument.
1638  */
1639 
1640 {
1641     symbol_efun_str(get_txt(name), mstrsize(name), sp, MY_FALSE);
1642 } /* symbol_efun() */
1643 
1644 /*-------------------------------------------------------------------------*/
1645 source_file_t *
new_source_file(const char * name,source_loc_t * parent)1646 new_source_file (const char * name, source_loc_t * parent)
1647 
1648 /* Create a new source_file structure for file <name>.
1649  *
1650  * If <name> is non-NULL, a new string is allocated and the content of <name>
1651  * is copied. If <name> is NULL, the caller has to set the filename in
1652  * the returned structure.
1653  *
1654  * If <parent> is non-NULL, it denotes the parent file location this source was
1655  * included from.
1656  *
1657  * Result is the new structure, or NULL if out of memory.
1658  *
1659  * Once allocated, the structure can be removed only through the general
1660  * cleanup routined cleanup_source_files().
1661  */
1662 
1663 {
1664     source_file_t * rc;
1665 
1666     rc = xalloc(sizeof(*rc));
1667     if (!rc)
1668         return NULL;
1669     if (name)
1670     {
1671         rc->name = string_copy(name);
1672         if (!rc->name)
1673         {
1674             xfree(rc);
1675             return NULL;
1676         }
1677     }
1678     else
1679         rc->name = NULL;
1680 
1681     if (parent)
1682         rc->parent = *parent;
1683     else
1684     {
1685         rc->parent.file = NULL;
1686         rc->parent.line = 0;
1687     }
1688 
1689     rc->next = src_file_list;
1690     src_file_list = rc;
1691 
1692     return rc;
1693 } /* new_source_file() */
1694 
1695 /*-------------------------------------------------------------------------*/
1696 static void
cleanup_source_files(void)1697 cleanup_source_files (void)
1698 
1699 /* Deallocate all listed source_file structures.
1700  */
1701 
1702 {
1703     source_file_t * this;
1704 
1705     while ((this = src_file_list) != NULL)
1706     {
1707         src_file_list = this->next;
1708 
1709         if (this->name)
1710             xfree(this->name);
1711         xfree(this);
1712     }
1713 
1714     current_loc.file = NULL;
1715     current_loc.line = 0;
1716 } /* cleanup_source_files() */
1717 
1718 /*-------------------------------------------------------------------------*/
1719 void
init_global_identifier(ident_t * ident,Bool bVariable)1720 init_global_identifier (ident_t * ident, Bool bVariable)
1721 
1722 /* The (newly created or to be reused) identifier <ident> is set up
1723  * to be a global identifier, with all the .global.* fields set to
1724  * a suitable default. The caller has to fill in the information specifying
1725  * what kind of global this is.
1726  *
1727  * <bVariable> is to be TRUE if the caller intends to use the identifier
1728  * for a (local or global) variable or lfun; and FALSE if it is for a
1729  * efun/sefun.
1730  *
1731  * The function is rather small, but having it here makes it easier to
1732  * guarantee that all fields are set to a proper default.
1733  */
1734 
1735 {
1736     ident->type = I_TYPE_GLOBAL;
1737     ident->u.global.function  = I_GLOBAL_FUNCTION_OTHER;
1738     if (bVariable)
1739         ident->u.global.variable  = I_GLOBAL_VARIABLE_OTHER;
1740     else
1741         ident->u.global.variable = I_GLOBAL_VARIABLE_FUN;
1742     ident->u.global.efun     = I_GLOBAL_EFUN_OTHER;
1743     ident->u.global.sim_efun = I_GLOBAL_SEFUN_OTHER;
1744 #ifdef USE_STRUCTS
1745     ident->u.global.struct_id = I_GLOBAL_STRUCT_NONE;
1746 #endif
1747 } /* init_global_identifier() */
1748 
1749 /*-------------------------------------------------------------------------*/
1750 ident_t *
lookfor_shared_identifier(const char * s,size_t len,int n,int depth,Bool bCreate)1751 lookfor_shared_identifier (const char *s, size_t len, int n, int depth, Bool bCreate)
1752 
1753 /* Aliases: make_shared_identifier(): bCreate passed as MY_TRUE
1754  *          find_shared_identifier(): bCreate passed as MY_FALSE
1755  *
1756  * Find and/or add identifier <s> with size <len> of type <n> to the
1757  * ident_table, and return a pointer to the found/generated struct ident.
1758  * Local identifiers (<n> == I_TYPE_LOCAL) are additionally distinguished
1759  * by their definition <depth>.
1760  *
1761  * If bCreate is FALSE, the function just checks if the given identfier
1762  * exists in the table. The identifier is considered found, if there
1763  * is an entry in the table for this very name, and with a type equal
1764  * or greater than <n>. If <n> is LOCAL and the found identifier is LOCAL
1765  * as well, the identifier is considered found if <depth> is equal or smaller
1766  * than the depth of the found identifier. The result is the pointer to the
1767  * found identifier, or NULL if not found.
1768  *
1769  * If bCreate is TRUE, the identifier is created if not found. If an
1770  * identifier with the same name but a lower type exists in the table,
1771  * it is shifted down: a new entry for this name created and put into the
1772  * table, the original entry is referenced by the .inferior pointer in the
1773  * new entry. The same happens when a new LOCAL of greater depth is
1774  * added to an existing LOCAL of smaller depth.  New generated
1775  * entries have their type set to I_TYPE_UNKNOWN regardless of <n>.
1776  * The result is the pointer to the found/new entry, or NULL when out
1777  * of memory.
1778  */
1779 
1780 {
1781     ident_t  *curr, *prev;
1782     int       h;
1783     string_t *str;
1784 
1785 #if defined(LEXDEBUG)
1786     printf("%s lookfor_shared_identifier called: %.*s\n", time_stamp(), len, s);
1787 #endif
1788 
1789     h = identhash_n(s, len);  /* the identifiers hash code */
1790 
1791     /* look for the identifier in the table */
1792 
1793     curr = ident_table[h];
1794     prev = NULL;
1795     while (curr)
1796     {
1797 #if defined(LEXDEBUG)
1798         printf("%s checking %s.\n", time_stamp(), get_txt(curr->name));
1799 #endif
1800         if (mstrsize(curr->name) == len
1801          && !strncmp(get_txt(curr->name), s, len)) /* found it */
1802         {
1803 #if defined(LEXDEBUG)
1804             printf("%s  -> found.\n", time_stamp());
1805 #endif
1806             /* Move the found entry to the head of the chain */
1807             if (prev) /* not at head of chain */
1808             {
1809                 prev->next = curr->next;
1810                 curr->next = ident_table[h];
1811                 ident_table[h] = curr;
1812             }
1813 
1814             /* If the found entry is of inferior type, shift it down */
1815             if (n > curr->type
1816              || (   I_TYPE_LOCAL == curr->type && I_TYPE_LOCAL == n
1817                  && depth > curr->u.local.depth)
1818                )
1819             {
1820                 if (bCreate)
1821                 {
1822                     ident_t *inferior = curr;
1823 
1824 #if defined(LEXDEBUG)
1825                     printf("%s     shifting down inferior.\n", time_stamp());
1826 #endif
1827                     curr = xalloc(sizeof *curr);
1828                     if ( NULL != curr )
1829                     {
1830                         curr->name = ref_mstring(inferior->name);
1831                         curr->next = inferior->next;
1832                         curr->type = I_TYPE_UNKNOWN;
1833                         curr->inferior = inferior;
1834                         curr->hash = (short)h;
1835                         ident_table[h] = curr;
1836                     }
1837                 }
1838                 else
1839                     curr = NULL;
1840             }
1841 
1842             /* Return the found (or generated) entry */
1843             return curr;
1844         }
1845 
1846         prev = curr;
1847         curr = curr->next;
1848     }
1849 
1850     if (bCreate)
1851     {
1852         /* Identifier is not in table, so create a new entry */
1853 
1854         str = new_n_tabled(s, len);
1855         if (!str)
1856             return NULL;
1857         curr = xalloc(sizeof *curr);
1858         if (!curr)
1859         {
1860             free_mstring(str);
1861             return NULL;
1862         }
1863 
1864         curr->name = str;
1865         curr->next = ident_table[h];
1866         curr->type = I_TYPE_UNKNOWN;
1867         curr->inferior = NULL;
1868         curr->hash = (short)h;
1869         ident_table[h] = curr;
1870     }
1871     /* else curr is NULL */
1872 
1873     return curr;
1874 } /* lookfor_shared_identifier() */
1875 
1876 /*-------------------------------------------------------------------------*/
1877 ident_t *
make_global_identifier(char * s,int n)1878 make_global_identifier (char *s, int n)
1879 
1880 /* Create an identifier <s> on level I_TYPE_GLOBAL, after searching for it
1881  * using type <n>.
1882  *
1883  * The difference to make_shared_identifier() is that if an identifier for
1884  * this name already exists and is of higher level than I_TYPE_GLOBAL (e.g.
1885  * somebody created a #define for this name), the function will insert
1886  * an appropriate I_TYPE_GLOBAL entry into the inferior list.
1887  *
1888  * Result is the pointer to the identifier, or NULL when out of memory
1889  * (yyerror() is called in that situation, too).
1890  */
1891 
1892 {
1893     ident_t *ip, *q;
1894 
1895     ip = make_shared_identifier(s, n, 0);
1896     if (!ip)
1897     {
1898         yyerrorf("Out of memory: identifer '%s'", s);
1899         return NULL;
1900     }
1901 
1902     if (ip->type > I_TYPE_GLOBAL)
1903     {
1904         /* Somebody created a #define with this name.
1905          * Back-insert an ident-table entry.
1906          */
1907         do {
1908             q = ip;
1909             ip = ip->inferior;
1910         } while (ip && ip->type > I_TYPE_GLOBAL);
1911 
1912         if (!ip)
1913         {
1914             ip = xalloc(sizeof(ident_t));
1915             if (!ip) {
1916                 yyerrorf("Out of memory: identifier (%zu bytes)",
1917                          sizeof(ident_t));
1918                 return NULL;
1919             }
1920             ip->name = ref_mstring(q->name);
1921             ip->type = I_TYPE_UNKNOWN;
1922             ip->inferior = NULL;
1923             ip->hash = q->hash;
1924             q->inferior = ip;
1925         }
1926     }
1927 
1928     return ip;
1929 } /* make_global_identifier() */
1930 
1931 /*-------------------------------------------------------------------------*/
1932 static INLINE void
free_identifier(ident_t * p)1933 free_identifier (ident_t *p)
1934 
1935 /* Deallocate the identifier <p> which must not be in any list or table
1936  * anymore.
1937  * It is a fatal error if it can't be found.
1938  */
1939 
1940 {
1941     free_mstring(p->name);
1942     xfree(p);
1943 } /* free_identifier() */
1944 
1945 /*-------------------------------------------------------------------------*/
1946 static INLINE void
unlink_shared_identifier(ident_t * p)1947 unlink_shared_identifier (ident_t *p)
1948 
1949 /* Unlink the identifier <p> (which may be an inferior entry ) from the
1950  * identifier table.
1951  * It is a fatal error if it can't be found.
1952  */
1953 
1954 {
1955     ident_t *curr, **q;
1956     int  h;
1957     string_t *s;
1958 
1959     h = p->hash;
1960 
1961     q = &ident_table[h];
1962     curr = *q;
1963     s = p->name;
1964 
1965 #if defined(LEXDEBUG)
1966     printf("%s unlinking '%s'\n", time_stamp(), get_txt(s));
1967     fflush(stdout);
1968 #endif
1969 
1970     /* Look for the hashed entry with the same name */
1971 
1972     while (curr)
1973     {
1974         if (curr->name == s
1975 #ifdef DEBUG
1976          || mstreq(curr->name, s)
1977 #endif
1978 
1979            ) /* found matching name */
1980         {
1981             ident_t *first = curr;
1982 
1983             /* Search the list of inferiors for entry <p> */
1984 
1985             while (curr)
1986             {
1987                 if (curr == p) /* this is the right one */
1988                 {
1989                     /* Remove the entry from the inferior list */
1990 
1991                     if (first == curr)
1992                     {
1993                         if (curr->inferior)
1994                         {
1995                             curr->inferior->next = curr->next;
1996                             *q = curr->inferior;
1997                             return; /* success */
1998                         }
1999                         *q = curr->next;
2000                         return;
2001                     }
2002 
2003                     *q = curr->inferior;
2004                     return; /* success */
2005                 }
2006                 q = &curr->inferior;
2007                 curr = *q;
2008             }
2009             fatal("free_shared_identifier: entry '%s' not found!\n"
2010                  , get_txt(p->name));
2011             /* NOTREACHED */
2012         }
2013 
2014         q = &curr->next;
2015         curr = *q;
2016     } /* not found */
2017 
2018     fatal("free_shared_identifier: name '%s' not found!\n", get_txt(p->name));
2019     /* NOTREACHED */
2020 } /* unlink_shared_identifier() */
2021 
2022 /*-------------------------------------------------------------------------*/
2023 void
free_shared_identifier(ident_t * p)2024 free_shared_identifier (ident_t *p)
2025 
2026 /* Remove the identifier <p> (which may be an inferior entry ) from the
2027  * identifier table.
2028  * It is a fatal error if it can't be found.
2029  */
2030 
2031 {
2032 #if defined(LEXDEBUG)
2033     printf("%s freeing '%s'\n", time_stamp(), get_txt(p->name));
2034     fflush(stdout);
2035 #endif
2036 
2037     unlink_shared_identifier(p);
2038     free_identifier(p);
2039 } /* free_shared_identifier() */
2040 
2041 /*-------------------------------------------------------------------------*/
2042 static void
realloc_defbuf(void)2043 realloc_defbuf (void)
2044 
2045 /* Increase the size of defbuf[] (unless it would exceed MAX_TOTAL_BUF).
2046  * The old content of defbuf[] is copied to the end of the new buffer.
2047  * outp is corrected to the new position, other pointers into defbuf
2048  * become invalid.
2049  */
2050 
2051 {
2052     char * old_defbuf = defbuf;
2053     size_t old_defbuf_len = defbuf_len;
2054     char * old_outp = outp;
2055     ptrdiff_t outp_off;
2056 
2057     if (MAX_TOTAL_BUF <= defbuf_len)
2058       return;
2059 
2060     outp_off = &defbuf[defbuf_len] - outp;
2061 
2062     /* Double the current size of defbuf, but top off at MAX_TOTAL_BUF. */
2063     if (defbuf_len > (MAX_TOTAL_BUF >> 1) )
2064     {
2065         defbuf_len = MAX_TOTAL_BUF;
2066     } else {
2067         defbuf_len <<= 1;
2068     }
2069     if (comp_flag)
2070         fprintf(stderr, "%s (reallocating defbuf from %zu (%td left) to %lu) "
2071                , time_stamp(), old_defbuf_len, (ptrdiff_t)(old_outp-defbuf)
2072                , defbuf_len);
2073     defbuf = xalloc(defbuf_len);
2074     memcpy(defbuf+defbuf_len-old_defbuf_len, old_defbuf, old_defbuf_len);
2075     xfree(old_defbuf);
2076     outp = &defbuf[defbuf_len] - outp_off;
2077 } /* realloc_defbuf() */
2078 
2079 /*-------------------------------------------------------------------------*/
2080 static void
set_input_source(int fd,string_t * str)2081 set_input_source (int fd, string_t * str)
2082 
2083 /* Set the current input source to <fd>/<str>.
2084  * If <str> is given, it will be referenced.
2085  */
2086 
2087 {
2088     yyin.fd = fd;
2089     yyin.str = str ? ref_mstring(str) : NULL;
2090     yyin.current = 0;
2091 } /* set_input_source() */
2092 
2093 /*-------------------------------------------------------------------------*/
2094 static void
close_input_source(void)2095 close_input_source (void)
2096 
2097 /* Close the current input source: a file is closed, a string is deallocated
2098  */
2099 
2100 {
2101     if (yyin.fd != -1)    close(yyin.fd);         yyin.fd = -1;
2102     if (yyin.str != NULL) free_mstring(yyin.str); yyin.str = NULL;
2103     yyin.current = 0;
2104 } /* close_input_source() */
2105 
2106 /*-------------------------------------------------------------------------*/
2107 static /* NO inline */ char *
_myfilbuf(void)2108 _myfilbuf (void)
2109 
2110 /* Read the next MAXLINE bytes from the input source <yyin> and store
2111  * them in the input-buffer. If there were the beginning of an incomplete
2112  * line left in the buffer, they are copied right before linebufstart.
2113  * The end of the last complete line in the buffer is marked with a '\0'
2114  * sentinel, or, if the file is exhausted, the end of data is marked
2115  * with the CHAR_EOF char.
2116  *
2117  * outp is set to point to the new data (which may be the copied remnants
2118  * from the incomplete line) and also returned as result.
2119  *
2120  * The function must not be called unless all lines in the buffer have
2121  * been processed. This macro */
2122 
2123 #define myfilbuf() (*outp?0:_myfilbuf())
2124 
2125  /* takes care of that.
2126   */
2127 
2128 {
2129     int i;
2130     char *p;
2131 
2132     /* Restore the data clobbered by the old sentinel */
2133     *outp = saved_char;
2134 
2135     /* Copy any remnants of an incomplete line before the buffer begin
2136      * and reset outp.
2137      */
2138     if (linebufend < outp)
2139         fatal("(lex.c) linebufend %p < outp %p\n", linebufend, outp);
2140     if (linebufend - outp)
2141         memcpy(outp-MAXLINE, outp, (size_t)(linebufend - outp));
2142     outp -= MAXLINE;
2143 
2144     *(outp-1) = '\n'; /* so an ungetc() gives a sensible result */
2145 
2146     /* Read the next block of data */
2147     p = linebufstart; /* == linebufend - MAXLINE */
2148     if (yyin.fd != -1)
2149         i = read(yyin.fd, p, MAXLINE);
2150     else
2151     {
2152         i = mstrsize(yyin.str) - yyin.current;
2153 
2154         if (i > MAXLINE)
2155             i = MAXLINE;
2156 
2157         memcpy(p, get_txt(yyin.str)+yyin.current, i);
2158         yyin.current += i;
2159     }
2160 
2161     if (i < MAXLINE)
2162     {
2163         /* End of file or error: put in the final EOF marker */
2164 
2165         if (i < 0)
2166         {
2167             i = 0;
2168         }
2169 
2170         p += i;
2171         if (p - outp ? p[-1] != '\n' : current_loc.line == 1)
2172             *p++ = '\n';
2173         *p++ = CHAR_EOF;
2174         return outp;
2175     }
2176 
2177     /* Buffer filled: mark the last line with the '\0' sentinel */
2178     p += i;
2179     while (*--p != '\n') NOOP; /* find last newline */
2180     if (p < linebufstart)
2181     {
2182         lexerror("line too long");
2183         *(p = linebufend-1) = '\n';
2184     }
2185     p++;
2186     saved_char = *p;
2187     *p = '\0';
2188 
2189     return outp;
2190 } /* _myfilbuf() */
2191 
2192 /*-------------------------------------------------------------------------*/
2193 static void
add_input(char * p)2194 add_input (char *p)
2195 
2196 /* Copy the text <p> into defbuf[] right before the current position of
2197  * outp and set outp back to point at the beginning of the new text.
2198  *
2199  * Main use is by the macro expansion routines.
2200  */
2201 {
2202     size_t l = strlen(p);
2203 
2204 #if defined(LEXDEBUG)
2205     if (l > 0)
2206         fprintf(stderr, "%s add '%s'\n", time_stamp(), p);
2207 #endif
2208     if ((ptrdiff_t)l > outp - &defbuf[10])
2209     {
2210         lexerror("Macro expansion buffer overflow");
2211         return;
2212     }
2213 
2214     outp -= l;
2215     strncpy(outp, p, l);
2216 }
2217 
2218 /*-------------------------------------------------------------------------*/
2219 static INLINE char
mygetc(void)2220 mygetc (void)
2221 
2222 /* Retrieve the next character from the file input buffer.
2223  */
2224 
2225 {
2226 #if 0
2227     fprintf(stderr, "c='%c' %x, ", *outp, *outp);
2228 #endif
2229 #if defined(LEXDEBUG)
2230     putc(*outp, stderr);
2231     fflush(stderr);
2232 #endif
2233     return *outp++;
2234 }
2235 
2236 /*-------------------------------------------------------------------------*/
2237 static INLINE void
myungetc(char c)2238 myungetc (char c)
2239 
2240 /* Store character <c> in the file input buffer so the next mygetc()
2241  * can retrieve it.
2242  */
2243 
2244 {
2245     *--outp = c;
2246 }
2247 
2248 /*-------------------------------------------------------------------------*/
2249 static INLINE Bool
gobble(char c)2250 gobble (char c)
2251 
2252 /* Skip the next character in the input buffer if it is <c> and return true.
2253  * If the next character is not <c>, don't advance in the buffer and
2254  * return false.
2255  */
2256 
2257 {
2258     if (c ==  mygetc())
2259         return MY_TRUE;
2260     --outp;
2261     return MY_FALSE;
2262 }
2263 
2264 /*-------------------------------------------------------------------------*/
2265 static void
lexerrorf(char * format,...)2266 lexerrorf (char *format, ...)
2267 
2268 /* Generate an lexerror() using printf()-style arguments.
2269  */
2270 
2271 {
2272     va_list va;
2273     char buff[5120];
2274     char fixed_fmt[1000];
2275 
2276     format = limit_error_format(fixed_fmt, sizeof(fixed_fmt), format);
2277     va_start(va, format);
2278     vsprintf(buff, format, va);
2279     va_end(va);
2280     lexerror(buff);
2281 } /* lexerrorf() */
2282 
2283 /*-------------------------------------------------------------------------*/
2284 static void
lexerror(char * s)2285 lexerror (char *s)
2286 
2287 /* The lexer encountered fatal error <s>. Print the error via yyerror()
2288  * and set lex_fatal.
2289  */
2290 
2291 {
2292     yyerror(s);
2293     lex_fatal = MY_TRUE;
2294 }
2295 
2296 /*-------------------------------------------------------------------------*/
2297 static Bool
skip_to(char * token,char * atoken)2298 skip_to (char *token, char *atoken)
2299 
2300 /* Skip the file linewise until one of the following preprocessor statements
2301  * is encountered:
2302  *   #<token> : returns true, outp is set to the following line.
2303  *   #<atoken>: returns false, outp is set to the following line.
2304  *   #elif    : returns false, the statement is rewritten to #if and
2305  *                outp is set to point to the '#' in the new statement.
2306  * If an end of file occurs, an error is generated and the function returns
2307  * true after setting outp to the character before the CHAR_EOF.
2308  *
2309  * Nested #if ... #endif blocks are skipped altogether.
2310  *
2311  * <atoken> may be the NULL pointer and is ignored in that case.
2312  */
2313 
2314 {
2315     char *p;  /* Local copy of outp */
2316     char *q;  /* The start of the preprocessor statement */
2317     char c;
2318     char nl = '\n';
2319     int nest; /* Current nesting depth of #if...#endif blocks */
2320 
2321     p = outp;
2322 
2323     for (nest = 0; ; ) {
2324         current_loc.line++;
2325         total_lines++;
2326         c = *p++;
2327 
2328         if (c == '#')
2329         {
2330             /* Parse the preprocessor statement */
2331 
2332             /* Set q to the first non-blank character of the keyword */
2333             while(lexwhite(*p++)) NOOP;
2334             q = --p;
2335 
2336             /* Mark the end of the preprocessor keyword with \0 */
2337             while (isalunum(*p++)) NOOP;
2338             c = *--p;  /* needed for eventual undos */
2339             *p = '\0';
2340 
2341             /* Set p to the first character of the next line */
2342             if (c != nl)
2343             {
2344                 while (*++p != nl) NOOP;
2345             }
2346             p++;
2347 
2348             /* Evaluate the token at <q> */
2349 
2350             if (strcmp(q, "if") == 0
2351              || strcmp(q, "ifdef") == 0
2352              || strcmp(q, "ifndef") == 0)
2353             {
2354                 nest++;
2355             }
2356             else if (nest > 0)
2357             {
2358                 if (strcmp(q, "endif") == 0)
2359                     nest--;
2360             }
2361             else
2362             {
2363                 if (strcmp(q, token) == 0)
2364                 {
2365                     *(p-1) = nl;
2366                     outp = p;
2367                     if (!*p)
2368                     {
2369                         _myfilbuf();
2370                     }
2371                     return MY_TRUE;
2372                 }
2373                 else if (atoken)
2374                 {
2375                     if (strcmp(q, atoken) == 0)
2376                     {
2377                         *(p-1) = nl;
2378                         outp = p;
2379                         if (!*p) {
2380                             _myfilbuf();
2381                         }
2382                         return MY_FALSE;
2383                     }
2384                     else if (strcmp(q, "elif") == 0)
2385                     {
2386                         /* Morph the 'elif' into '#if' and reparse it */
2387                         current_loc.line--;
2388                         total_lines--;
2389                         q[0] = nl;
2390                         q[1] = '#';
2391                         q[4] = c;   /* undo the '\0' */
2392                         outp = q+1;
2393                         return MY_FALSE;
2394                     }
2395                 }
2396             }
2397         }
2398         else /* not a preprocessor statement */
2399         {
2400             if (c == CHAR_EOF)
2401             {
2402                 outp = p - 2;
2403                 current_loc.line--;
2404                 total_lines--;
2405                 lexerror("Unexpected end of file while skipping");
2406                 return MY_TRUE;
2407             }
2408 
2409             /* Skip the rest of the line */
2410             while (c != nl) c = *p++;
2411         }
2412 
2413         /* Read new data from the file if necessary */
2414         if (!*p)
2415         {
2416             outp = p;
2417             p = _myfilbuf();
2418         }
2419     } /* for () */
2420 
2421     /* NOTREACHED */
2422 } /* skip_to() */
2423 
2424 /*-------------------------------------------------------------------------*/
2425 static void
handle_cond(Bool c)2426 handle_cond (Bool c)
2427 
2428 /* Evaluate the boolean condition <c> of a preprocessor #if statement.
2429  * If necessary, skip to the condition branch to read next, and/or
2430  * push a new state onto the ifstate-stack.
2431  */
2432 {
2433     lpc_ifstate_t *p;
2434 
2435     if (c || skip_to("else", "endif")) {
2436         p = mempool_alloc(lexpool, sizeof(lpc_ifstate_t));
2437         p->next = iftop;
2438         iftop = p;
2439         p->state = c ? EXPECT_ELSE : EXPECT_ENDIF;
2440     }
2441 } /* handle_cond() */
2442 
2443 /*-------------------------------------------------------------------------*/
2444 static Bool
start_new_include(int fd,string_t * str,char * name,char * name_ext,char delim)2445 start_new_include (int fd, string_t * str
2446                   , char * name, char * name_ext, char delim)
2447 
2448 /* The lexer is about to read data from an included source (either file
2449  * <fd> or string <str> which will be referenced) - handle setting up the
2450  * include information. <name> is the name of the file to be read, <name_ext>
2451  * is NULL or a string to add to <name> as " (<name_ext>)", <delim> is the
2452  * delimiter ('"', '>' or ')') of the include filename.
2453  *
2454  * Return TRUE on success, FALSE if something failed.
2455  */
2456 
2457 {
2458     struct incstate *is, *ip;
2459     source_file_t * src_file;
2460     size_t namelen;
2461     int inc_depth;
2462     ptrdiff_t linebufoffset;
2463 
2464     /* Prepare defbuf for a (nested) include */
2465     linebufoffset = linebufstart - &defbuf[defbuf_len];
2466     if (outp - defbuf < 3*MAXLINE)
2467     {
2468         realloc_defbuf();
2469         /* linebufstart is invalid now */
2470         if (outp - defbuf < 2*MAXLINE)
2471         {
2472             lexerror("Maximum total buffer size exceeded");
2473             return MY_FALSE;
2474         }
2475     }
2476 
2477     /* Copy the current state, but don't put it on the stack
2478      * yet in case we run into an error further down.
2479      */
2480     is = mempool_alloc(lexpool, sizeof(struct incstate));
2481     if (!is) {
2482         lexerror("Out of memory");
2483         return MY_FALSE;
2484     }
2485 
2486     src_file = new_source_file(NULL, &current_loc);
2487     if (!src_file)
2488     {
2489         mempool_free(lexpool, is);
2490         lexerror("Out of memory");
2491         return MY_FALSE;
2492     }
2493 
2494     is->yyin = yyin;
2495     is->loc = current_loc;
2496     is->linebufoffset = linebufoffset;
2497     is->saved_char = saved_char;
2498     is->next = inctop;
2499 
2500 
2501     /* Copy the new filename into src_file */
2502 
2503     namelen = strlen(name);
2504     if (name_ext != NULL)
2505         namelen += 3 + strlen(name_ext);
2506 
2507     src_file->name = xalloc(namelen+1);
2508     if (!src_file->name)
2509     {
2510         mempool_free(lexpool, is);
2511         lexerror("Out of memory");
2512         return MY_FALSE;
2513     }
2514     strcpy(src_file->name, name);
2515     if (name_ext)
2516     {
2517         strcat(src_file->name, " (");
2518         strcat(src_file->name, name_ext);
2519         strcat(src_file->name, ")");
2520     }
2521 
2522     /* Now it is save to put the saved state onto the stack*/
2523     inctop = is;
2524 
2525     /* Compute the include depth and store the include information */
2526     for (inc_depth = 0, ip = inctop; ip; ip = ip->next)
2527         inc_depth++;
2528 
2529     if (name_ext)
2530         inctop->inc_offset = store_include_info(name_ext, src_file->name, delim, inc_depth);
2531     else
2532         inctop->inc_offset = store_include_info(name, src_file->name, delim, inc_depth);
2533 
2534     /* Initialise the rest of the lexer state */
2535     current_loc.file = src_file;
2536     current_loc.line = 0;
2537     linebufend   = outp - 1; /* allow trailing zero */
2538     linebufstart = linebufend - MAXLINE;
2539     *(outp = linebufend) = '\0';
2540     set_input_source(fd, str);
2541     _myfilbuf();
2542 
2543     return MY_TRUE;
2544 } /* start_new_include() */
2545 
2546 /*-------------------------------------------------------------------------*/
2547 static void
add_auto_include(const char * obj_file,const char * cur_file,Bool sys_include)2548 add_auto_include (const char * obj_file, const char *cur_file, Bool sys_include)
2549 
2550 /* A new file <cur_file> was opened while compiling object <object_file>.
2551  * Add the auto-include information if available.
2552  *
2553  * If <cur_file> is NULL, then the <object_file> itself has just been
2554  * opened, otherwise <cur_file> is an included file. In the latter case,
2555  * flag <sys_include> purveys if it was a <>-type include.
2556  *
2557  * The global <current_loc.line> must be valid and will be modified.
2558  */
2559 
2560 {
2561     string_t * auto_include_string = NULL;
2562 
2563     if (driver_hook[H_AUTO_INCLUDE].type == T_STRING
2564      && cur_file == NULL
2565        )
2566     {
2567         auto_include_string = driver_hook[H_AUTO_INCLUDE].u.str;
2568     }
2569     else if (driver_hook[H_AUTO_INCLUDE].type == T_CLOSURE)
2570     {
2571         svalue_t *svp;
2572 
2573         /* Setup and call the closure */
2574         push_c_string(inter_sp, obj_file);
2575         if (cur_file != NULL)
2576         {
2577             push_c_string(inter_sp, (char *)cur_file);
2578             push_number(inter_sp, sys_include ? 1 : 0);
2579         }
2580         else
2581         {
2582             push_number(inter_sp, 0);
2583             push_number(inter_sp, 0);
2584         }
2585         svp = secure_apply_lambda(driver_hook+H_AUTO_INCLUDE, 3);
2586         if (svp && svp->type == T_STRING)
2587         {
2588             auto_include_string = svp->u.str;
2589         }
2590     }
2591 
2592     if (auto_include_string != NULL)
2593     {
2594         /* The auto include string is handled like a normal include */
2595         if (cur_file != NULL)   /* Otherwise we already are at line 1 */
2596             current_loc.line++; /* Make sure to restore to line 1 */
2597         (void)start_new_include(-1, auto_include_string
2598                                , current_loc.file->name, "auto include", ')');
2599         if (cur_file == NULL)   /* Otherwise #include will increment it */
2600             current_loc.line++; /* Make sure to start at line 1 */
2601     }
2602 } /* add_auto_include() */
2603 
2604 /*-------------------------------------------------------------------------*/
2605 static void
merge(char * name,mp_int namelen,char * deststart)2606 merge (char *name, mp_int namelen, char *deststart)
2607 
2608 /* Take the given include file <name> of length <namelen>, make it
2609  * a proper absolute pathname and store it into the buffer <deststart>.
2610  * This buffer must be at least INC_OPEN_BUFSIZE bytes big.
2611  * On a failure, return the empty string in *deststart.
2612  *
2613  * If <name> is a relative pathname, it is interpreted to the location
2614  * of <currentfile>. './' and '../' sequences in the name are properly
2615  * resolved (includes from above the mudlib are caught).
2616  */
2617 
2618 {
2619     char *from;  /* Next character in <name> to process */
2620     char *dest;  /* Destination pointer into <deststart> */
2621 
2622     from = name;
2623 
2624     /* If <name> is an absolute pathname, skip any leading '/'.
2625      * Else extract the pathpart from <currentfile>, put
2626      * it into the destination buffer and set dest to point after it.
2627      */
2628     if (*from == '/')
2629     {
2630         /* absolute path */
2631 
2632         dest = deststart;
2633         do from++; while (*from == '/');
2634     }
2635     else
2636     {
2637         /* relative path */
2638 
2639         char *cp, *dp;
2640 
2641         dest = (dp = deststart) - 1;
2642         for (cp = current_loc.file->name; *cp; *dp++ = *cp++)
2643         {
2644             if (*cp == '/')
2645                 dest = dp;
2646         }
2647         dest++;
2648     }
2649 
2650     /* Make sure the bufferlimits are not overrun. */
2651     if ((dest - deststart) + namelen >= INC_OPEN_BUFSIZE)
2652     {
2653         *deststart = '\0';
2654         return;
2655     }
2656 
2657     /* Append the <name> to the buffer starting at <dest>,
2658      * collapsing './' and '../' sequences while doing it.
2659      */
2660     for (;;)
2661     {
2662         /* <from> now points to the character after the last '/'.
2663          */
2664 
2665         if (*from == '.')
2666         {
2667             if (from[1] == '.' && from[2] == '/')
2668             {
2669                 /* '../': remove the pathpart copied last */
2670 
2671                 if (dest == deststart)
2672                 {
2673                     /* including from above mudlib is NOT allowed */
2674                     *deststart = '\0';
2675                     return;
2676                 }
2677 
2678                 for (--dest;;)
2679                 {
2680                     if (*--dest == '/')
2681                     {
2682                         dest++;
2683                         break;
2684                     }
2685                     if (dest == deststart)
2686                         break;
2687                 }
2688                 from += 3;
2689                 continue;
2690 
2691             } else if (from[1] == '/')
2692             {
2693                 /* just skip these two characters */
2694 
2695                 from += 2;
2696                 continue;
2697             }
2698         }
2699 
2700         /* Copy all characters up to and including the next '/'
2701          * from <name> into the destination buffer.
2702          * Return when at the end of the name.
2703          */
2704 
2705         {
2706             char c;
2707 
2708             do {
2709                 c = *from++;
2710                 *dest++ = c;
2711                 if (!c)
2712                   return;
2713             } while (c != '/');
2714             while (*from == '/')
2715                 from++;
2716         }
2717     } /* for (;;) */
2718 
2719     /* NOTREACHED */
2720 } /* merge() */
2721 
2722 /*-------------------------------------------------------------------------*/
2723 static int
open_include_file(char * buf,char * name,mp_int namelen,char delim)2724 open_include_file (char *buf, char *name, mp_int namelen, char delim)
2725 
2726 /* Open the include file <name> (length <namelen>) and return the file
2727  * descriptor. On failure, generate an error message and return -1.
2728  *
2729  * <buf> is a buffer of size INC_OPEN_BUFSIZE and may be used to
2730  * generate the real filename - <name> is just the name given in the
2731  * #include statement.
2732  *
2733  * <delim> is '"' for #include ""-type includes, and '>' else.
2734  * Relative "-includes are searched relative to the current file.
2735  * <-includes are searched in the path(s) defined by the H_INCLUDE_DIRS
2736  * driver hook.
2737  */
2738 
2739 {
2740     int fd;
2741     int i;
2742     struct stat aStat;
2743 
2744     /* First, try to call master->include_file().
2745      * Since simulate::load_object() makes sure that the master has been
2746      * loaded, this test can only fail when the master is compiled.
2747      */
2748     if (master_ob && !(master_ob->flags & O_DESTRUCTED)
2749      && (!EVALUATION_TOO_LONG())
2750        )
2751     {
2752         svalue_t *res;
2753 
2754         push_c_string(inter_sp, name);
2755 
2756         if (!compat_mode)
2757         {
2758             char * filename;
2759             filename = alloca(strlen(current_loc.file->name)+2);
2760             *filename = '/';
2761             strcpy(filename+1, current_loc.file->name);
2762             push_c_string(inter_sp, filename);
2763         }
2764         else
2765             push_c_string(inter_sp, current_loc.file->name);
2766 
2767         push_number(inter_sp, (delim == '"') ? 0 : 1);
2768         res = apply_master(STR_INCLUDE_FILE, 3);
2769 
2770         if (res && !(res->type == T_NUMBER && !res->u.number))
2771         {
2772             /* We got a result - either a new name or a "reject it"
2773              * value.
2774              */
2775 
2776             char * cp;
2777 
2778             if (res->type != T_STRING)
2779             {
2780                 yyerrorf("Illegal to include file '%s'.", name);
2781                 return -1;
2782             }
2783 
2784             if (mstrsize(res->u.str) >= INC_OPEN_BUFSIZE)
2785             {
2786                 yyerrorf("Include name '%s' too long.", get_txt(res->u.str));
2787                 return -1;
2788             }
2789 
2790             for (cp = get_txt(res->u.str); *cp == '/'; cp++) NOOP;
2791 
2792             if (!legal_path(cp))
2793             {
2794                 yyerrorf("Illegal path '%s'.", get_txt(res->u.str));
2795                 return -1;
2796             }
2797 
2798             strcpy(buf, cp);
2799             if (!stat(buf, &aStat)
2800              && S_ISREG(aStat.st_mode)
2801              && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
2802             {
2803                 FCOUNT_INCL(buf);
2804                 return fd;
2805             }
2806             if (errno == EMFILE) lexerror("File descriptors exhausted");
2807 #if ENFILE
2808             if (errno == ENFILE) lexerror("File table overflow");
2809 #endif
2810 
2811             /* If we come here, we fail: file not found */
2812             return -1;
2813         }
2814     }
2815     else if (EVALUATION_TOO_LONG())
2816     {
2817         yyerrorf("Can't call master::%s for '%s': eval cost too big"
2818                 , get_txt(STR_INCLUDE_FILE), name);
2819     }
2820 
2821     /* The master apply didn't succeed, try the manual handling */
2822 
2823     if (delim == '"') /* It's a "-include */
2824     {
2825         /* Merge the <name> with the current filename. */
2826         merge(name, namelen, buf);
2827 
2828         /* Test the file and open it */
2829         if (!stat(buf, &aStat)
2830          && S_ISREG(aStat.st_mode)
2831          && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0)
2832         {
2833             FCOUNT_INCL(buf);
2834             return fd;
2835         }
2836 
2837         if (errno == EMFILE)
2838             lexerror("File descriptors exhausted");
2839 #ifdef ENFILE
2840         if (errno == ENFILE)
2841             lexerror("File table overflow");
2842 #endif
2843         /* Include not found - fall back onto <> search pattern */
2844     }
2845 
2846     /* Handle a '<'-include. */
2847 
2848     if (driver_hook[H_INCLUDE_DIRS].type == T_POINTER)
2849     {
2850         char * cp;
2851 
2852         /* H_INCLUDE_DIRS is a vector of include directories.
2853          */
2854 
2855         if (namelen + inc_list_maxlen >= INC_OPEN_BUFSIZE)
2856         {
2857             yyerror("Include name too long.");
2858             return -1;
2859         }
2860 
2861         for (cp = name; *cp == '/'; cp++) NOOP;
2862 
2863         /* The filename must not specifiy parent directories */
2864         if (!check_no_parentdirs(cp))
2865             return -1;
2866 
2867         /* Search all include dirs specified.
2868          */
2869         for (i = 0; (size_t)i < inc_list_size; i++)
2870         {
2871             char * iname;
2872             sprintf(buf, "%s%s", get_txt(inc_list[i].u.str), name);
2873             for (iname = buf; *iname == '/'; iname++) NOOP;
2874             if (!stat(iname, &aStat)
2875              && S_ISREG(aStat.st_mode)
2876              && (fd = ixopen(iname, O_RDONLY|O_BINARY)) >= 0 )
2877             {
2878                 FCOUNT_INCL(iname);
2879                 return fd;
2880             }
2881             if (errno == EMFILE) lexerror("File descriptors exhausted");
2882 #if ENFILE
2883             if (errno == ENFILE) lexerror("File table overflow");
2884 #endif
2885         }
2886 
2887         /* If we come here, the include file was not found */
2888     }
2889     else if (driver_hook[H_INCLUDE_DIRS].type == T_CLOSURE)
2890     {
2891         /* H_INCLUDE_DIRS is a function generating the full
2892          * include file name.
2893          */
2894 
2895         svalue_t *svp;
2896 
2897         /* Setup and call the closure */
2898         push_c_string(inter_sp, name);
2899         push_c_string(inter_sp, current_loc.file->name);
2900         if (driver_hook[H_INCLUDE_DIRS].x.closure_type == CLOSURE_LAMBDA)
2901         {
2902             free_object(driver_hook[H_INCLUDE_DIRS].u.lambda->ob, "open_include_file");
2903             driver_hook[H_INCLUDE_DIRS].u.lambda->ob = ref_object(current_object, "open_include_file");
2904         }
2905         svp = secure_apply_lambda(&driver_hook[H_INCLUDE_DIRS], 2);
2906 
2907         /* The result must be legal relative pathname */
2908 
2909         if (svp && svp->type == T_STRING
2910          && mstrsize(svp->u.str) < INC_OPEN_BUFSIZE)
2911         {
2912             char * cp;
2913 
2914             for (cp = get_txt(svp->u.str); *cp == '/'; cp++) NOOP;
2915             strcpy(buf, cp);
2916             if (legal_path(buf))
2917             {
2918                 if (!stat(buf, &aStat)
2919                  && S_ISREG(aStat.st_mode)
2920                  && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
2921                 {
2922                     FCOUNT_INCL(buf);
2923                     return fd;
2924                 }
2925                 if (errno == EMFILE) lexerror("File descriptors exhausted");
2926 #if ENFILE
2927                 if (errno == ENFILE) lexerror("File table overflow");
2928 #endif
2929             }
2930         }
2931 
2932         /* If we come here, the include file was not found */
2933     }
2934 
2935     /* File not found */
2936     return -1;
2937 } /* open_include_file() */
2938 
2939 /*-------------------------------------------------------------------------*/
2940 #ifdef USE_NEW_INLINES
2941 void *
get_include_handle(void)2942 get_include_handle (void)
2943 
2944 /* Helper function for inline closures: return the current inctop
2945  * setting so that the compiler can check if a closures spans files.
2946  */
2947 
2948 {
2949     return (void*)inctop;
2950 } /* get_include_handle() */
2951 #endif /* USE_NEW_INLINES */
2952 
2953 /*-------------------------------------------------------------------------*/
2954 static INLINE void
handle_include(char * name)2955 handle_include (char *name)
2956 
2957 /* Handle an #include statement, <name> points to the first non-blank
2958  * character after the '#include'.
2959  * If the include succeeds, a new incstate is created and pushed
2960  * onto the include stack. Else an error message is generated.
2961  */
2962 
2963 {
2964     char *p;
2965     int   fd;        /* fd of new include file */
2966     char  delim;     /* Filename end-delimiter ('"' or '>'). */
2967     char *old_outp;  /* Save the original outp */
2968     Bool  in_buffer = MY_FALSE; /* True if macro was expanded */
2969     char  buf[INC_OPEN_BUFSIZE];
2970 
2971 #if 0
2972     if (nbuf) {
2973         lexerror("Internal preprocessor error");
2974         return;
2975     }
2976 #endif
2977     old_outp = outp;
2978 
2979     /* If <name> doesn't start with '"' or '<', assume that it
2980      * is a macro. Attempt to expand these macros until <name>
2981      * starts with a proper delimiter.
2982      */
2983     while (*name != '"' && *name != '<')
2984     {
2985         char c;
2986         ident_t *d;
2987 
2988         /* Locate the end of the macro and look it up */
2989         for (p = name; isalunum(*p); p++) NOOP;
2990         c = *p;
2991         *p = '\0';
2992         d = lookup_define(name);
2993         *p = c;
2994 
2995         /* Prepare to expand the macro */
2996         if (in_buffer)
2997         {
2998             outp = p;
2999         }
3000         else
3001         {
3002             myungetc('\n');
3003             add_input(p);
3004             in_buffer = MY_TRUE;
3005         }
3006 
3007         /* Expand the macro */
3008         if (!d || !_expand_define(&d->u.define, d) ) {
3009             yyerror("Missing leading \" or < in #include");
3010             return;
3011         }
3012 
3013         /* Set name to the first non-blank of the expansion */
3014         name = outp;
3015         while (lexwhite(*name))
3016             name++;
3017     }
3018 
3019     /* Store the delimiter and set p to the closing delimiter */
3020     delim = (char)((*name++ == '"') ? '"' : '>');
3021     for(p = name; *p && *p != delim; p++) NOOP;
3022 
3023     if (!*p) {
3024         yyerror("Missing trailing \" or > in #include");
3025         outp = old_outp;
3026         return;
3027     }
3028     *p = '\0';
3029 
3030 
3031     /* For "-includes, look for following macros or "<path>"
3032      * fragments on the same line and append these to the <name>.
3033      * The new name is created in the yytext[] buffer (if at all).
3034      */
3035 
3036     if (delim == '"')
3037     {
3038         char *q;
3039 
3040         q = p + 1;
3041         for (;;)
3042         {
3043             /* Find the first non-blank character after p */
3044             while(lexwhite(*q))
3045                 q++;
3046             if (!*q || *q == '\n')
3047                 break;
3048 
3049             /* First, try to expand a macros */
3050             while (*q != delim)
3051             {
3052                 char *r, c;
3053                 ident_t *d;
3054 
3055                 /* Set r to the first blank after the macro name */
3056                 for (r = q; isalunum(*r); r++) NOOP;
3057 
3058                 /* Lookup the macro */
3059                 c = *r;
3060                 *r = '\0';
3061                 d = lookup_define(q);
3062                 *r = c;
3063 
3064                 /* Prepare to expand the macro */
3065                 if (in_buffer)
3066                 {
3067                     outp = r;
3068                     if (name != yytext)
3069                     {
3070                         if ( (p - name) >= MAXLINE - 1)
3071                         {
3072                             yyerror("Include name too long.");
3073                             outp = old_outp;
3074                             return;
3075                         }
3076                         *p = '\0';
3077                         strcpy(yytext, name);
3078                         p += yytext - name;
3079                         name = yytext;
3080                     }
3081                 }
3082                 else
3083                 {
3084                     myungetc('\n');
3085                     add_input(r);
3086                     in_buffer = MY_TRUE;
3087                 }
3088 
3089                 /* Expand the macro */
3090                 if (!d || !_expand_define(&d->u.define, d) ) {
3091                     yyerror("Missing leading \" in #include");
3092                     outp = old_outp;
3093                     return;
3094                 }
3095                 q = outp;
3096 
3097                 /* Skip the blanks until the next macro/filename */
3098                 while (lexwhite(*q))
3099                     q++;
3100             }
3101 
3102             /* Second, try to parse a string literal */
3103             while (*++q && *q != delim)
3104             {
3105                 if ( (p - name) >= MAXLINE - 1)
3106                 {
3107                     yyerror("Include name too long.");
3108                     outp = old_outp;
3109                     return;
3110                 }
3111                 *p++ = *q;
3112             }
3113             if (!*q++) {
3114                 yyerror("Missing trailing \" in #include");
3115                 outp = old_outp;
3116                 return;
3117             }
3118         } /* for (;;) */
3119     } /* if (delim == '"') */
3120 
3121     /* p now points to the character after the parsed filename */
3122 
3123     outp = old_outp;  /* restore outp */
3124     *p = '\0';        /* mark the end of the filename */
3125 
3126     /* Open the include file, put the current lexer state onto
3127      * the incstack, and set up for the new file.
3128      */
3129     if ((fd = open_include_file(buf, name, p - name, delim)) >= 0)
3130     {
3131         if (!start_new_include(fd, NULL, buf, NULL, delim))
3132             return;
3133         add_auto_include(object_file, current_loc.file->name, delim != '"');
3134     }
3135     else
3136     {
3137         yyerrorf("Cannot #include '%s'", name);
3138     }
3139 } /* handle_include() */
3140 
3141 /*-------------------------------------------------------------------------*/
3142 static void
skip_comment(void)3143 skip_comment (void)
3144 
3145 /* Skip a block comment (/ * ... * /). The function is entered with outp
3146  * pointing to the first character after the comment introducer, and left
3147  * with outp pointing to the first character after the comment end delimiter.
3148  */
3149 
3150 {
3151     register char c, *p;
3152 
3153     p = outp;
3154     for(;;)
3155     {
3156         /* Skip everything until the next '*' */
3157         while((c =  *p++) != '*')
3158         {
3159             if (c == '\n') {
3160                 store_line_number_info();
3161                 nexpands = 0;
3162                 if ((c = *p) == CHAR_EOF) {
3163                     outp = p - 1;
3164                     lexerror("End of file (or 0x01 character) in a comment");
3165                     return;
3166                 }
3167                 current_loc.line++;
3168                 if (!c)
3169                 {
3170                     outp = p;
3171                     p = _myfilbuf();
3172                 }
3173             }
3174         } /* while (c == '*') */
3175 
3176         /* Skip all '*' until we find '/' or something else */
3177         do
3178         {
3179             if ((c = *p++) == '/')
3180             {
3181                 outp = p;
3182                 return;
3183             }
3184 
3185             if (c == '\n') {
3186                 store_line_number_info();
3187                 nexpands = 0;
3188                 if ((c = *p) == CHAR_EOF)
3189                 {
3190                     outp = p - 1;
3191                     lexerror("End of file (or 0x01 character) in a comment");
3192                     return;
3193                 }
3194                 current_loc.line++;
3195                 if (!c)
3196                 {
3197                     outp = p;
3198                     p = _myfilbuf();
3199                 }
3200                 c = '\0'; /* Make sure to terminate the '*' loop */
3201             }
3202         } while(c == '*');
3203     } /* for() */
3204 
3205     /* NOTREACHED */
3206 } /* skip_comment() */
3207 
3208 /*-------------------------------------------------------------------------*/
3209 static char *
skip_pp_comment(char * p)3210 skip_pp_comment (char *p)
3211 
3212 /* Skip a '//' line comment. <p> points to the first character after
3213  * the comment introducer, the function returns a pointer to the first
3214  * character after the terminating newline. If the comment is ended
3215  * prematurely by the end of file, the returned pointer will point at the
3216  * EOF character.
3217  * Note that a '\<newline>' lineend does not terminate the comment.
3218  */
3219 
3220 {
3221     char c;
3222 
3223     for (;;)
3224     {
3225         c = *p++;
3226         if (CHAR_EOF == c)
3227         {
3228             return p-1;
3229         }
3230         if (c == '\n')
3231         {
3232             store_line_number_info();
3233             current_loc.line++;
3234             if (p[-2] == '\\')
3235             {
3236                 if (!*p)
3237                 {
3238                     outp = p;
3239                     p = _myfilbuf();
3240                 }
3241                 continue;
3242             }
3243             nexpands = 0;
3244             if (!*p)
3245             {
3246                 outp = p;
3247                 p = _myfilbuf();
3248             }
3249             return p;
3250         }
3251     }
3252 
3253     /* NOTREACHED */
3254 } /* skip_pp_comment() */
3255 
3256 /*-------------------------------------------------------------------------*/
3257 static void
deltrail(char * sp)3258 deltrail (char *sp)
3259 
3260 /* Look for the first blank character in the text starting at <sp> and
3261  * set it to '\0'. The function is used to isolate the next word
3262  * in '#' statements.
3263  */
3264 
3265 {
3266     char *p;
3267 
3268     p = sp;
3269     if (!*p)
3270     {
3271         lexerror("Illegal # command");
3272     }
3273     else
3274     {
3275         while(*p && !isspace((unsigned char)*p))
3276             p++;
3277         *p = '\0';
3278     }
3279 } /* deltrail() */
3280 
3281 /*-------------------------------------------------------------------------*/
3282 static void
handle_pragma(char * str)3283 handle_pragma (char *str)
3284 
3285 /* Handle the pragma <str>. Unknown pragmas are ignored.
3286  * One pragma string can contain multiple actual pragmas, separated
3287  * with comma (and additional spaces).
3288  */
3289 
3290 {
3291     char * base, * next;
3292 
3293 #if defined(LEXDEBUG)
3294     printf("%s handle pragma:'%s'\n", time_stamp(), str);
3295 #endif
3296 
3297     /* Loop over the pragma(s).
3298      * If valid, base points to the first character of the pragma name,
3299      * or to spaces before it.
3300      */
3301     for ( base = str, next = NULL
3302         ; base != NULL && *base != '\0' && *base != '\r'
3303         ; base = next
3304         )
3305     {
3306         size_t namelen;
3307         Bool validPragma;
3308 
3309         /* Skip spaces */
3310         base = base + strspn(base, " \t\r");
3311         if ('\0' == *base || '\r' == *base)
3312             break;
3313 
3314         /* Find next delimiter, if any, and determine the
3315          * length of the pragma name.
3316          */
3317         next = strpbrk(base, " \t,\r");
3318         if (NULL == next)
3319             namelen = strlen(base);
3320         else
3321             namelen = next - base;
3322 
3323         /* Evaluate the found pragma name */
3324         validPragma = MY_FALSE;
3325 
3326         if (namelen == 0)
3327         {
3328             if (master_ob)
3329             {
3330                 yywarnf("Empty #pragma");
3331             }
3332             else
3333             {
3334                 debug_message("Warning: Empty #pragma"
3335                               ": file %s, line %d\n"
3336                              , current_loc.file->name, current_loc.line);
3337             }
3338             validPragma = MY_TRUE; /* Since we already issued a warning */
3339         }
3340         else if (strncmp(base, "strict_types", namelen) == 0)
3341         {
3342             pragma_strict_types = PRAGMA_STRICT_TYPES;
3343             instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_UNKNOWN;
3344             instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_UNKNOWN;
3345             validPragma = MY_TRUE;
3346         }
3347         else if (strncmp(base, "strong_types", namelen) == 0)
3348         {
3349             pragma_strict_types = PRAGMA_STRONG_TYPES;
3350             instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
3351             instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
3352             validPragma = MY_TRUE;
3353         }
3354         else if (strncmp(base, "weak_types", namelen) == 0)
3355         {
3356             pragma_strict_types = PRAGMA_WEAK_TYPES;
3357             instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
3358             instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
3359             validPragma = MY_TRUE;
3360         }
3361         else if (strncmp(base, "save_types", namelen) == 0)
3362         {
3363             pragma_save_types = MY_TRUE;
3364             validPragma = MY_TRUE;
3365         }
3366         else if (strncmp(base, "combine_strings", namelen) == 0)
3367         {
3368             pragma_combine_strings = MY_TRUE;
3369             validPragma = MY_TRUE;
3370         }
3371         else if (strncmp(base, "no_combine_strings", namelen) == 0)
3372         {
3373             pragma_combine_strings = MY_FALSE;
3374             validPragma = MY_TRUE;
3375         }
3376         else if (strncmp(base, "verbose_errors", namelen) == 0)
3377         {
3378             pragma_verbose_errors = MY_TRUE;
3379             validPragma = MY_TRUE;
3380         }
3381         else if (strncmp(base, "no_clone", namelen) == 0)
3382         {
3383             pragma_no_clone = MY_TRUE;
3384             validPragma = MY_TRUE;
3385         }
3386         else if (strncmp(base, "no_inherit", namelen) == 0)
3387         {
3388             pragma_no_inherit = MY_TRUE;
3389             validPragma = MY_TRUE;
3390         }
3391         else if (strncmp(base, "no_shadow", namelen) == 0)
3392         {
3393             pragma_no_shadow = MY_TRUE;
3394             validPragma = MY_TRUE;
3395         }
3396         else if (strncmp(base, "pedantic", namelen) == 0)
3397         {
3398             pragma_pedantic = MY_TRUE;
3399             validPragma = MY_TRUE;
3400         }
3401         else if (strncmp(base, "sloppy", namelen) == 0)
3402         {
3403             pragma_pedantic = MY_FALSE;
3404             validPragma = MY_TRUE;
3405         }
3406         else if (strncmp(base, "no_local_scopes", namelen) == 0)
3407         {
3408             pragma_use_local_scopes = MY_FALSE;
3409             validPragma = MY_TRUE;
3410         }
3411         else if (strncmp(base, "local_scopes", namelen) == 0)
3412         {
3413             pragma_use_local_scopes = MY_TRUE;
3414             validPragma = MY_TRUE;
3415         }
3416         else if (strncmp(base, "warn_missing_return", namelen) == 0)
3417         {
3418             pragma_warn_missing_return = MY_TRUE;
3419             validPragma = MY_TRUE;
3420         }
3421         else if (strncmp(base, "no_warn_missing_return", namelen) == 0)
3422         {
3423             pragma_warn_missing_return = MY_FALSE;
3424             validPragma = MY_TRUE;
3425         }
3426         else if (strncmp(base, "warn_function_inconsistent", namelen) == 0)
3427         {
3428             pragma_check_overloads = MY_TRUE;
3429             validPragma = MY_TRUE;
3430         }
3431         else if (strncmp(base, "no_warn_function_inconsistent", namelen) == 0)
3432         {
3433             pragma_check_overloads = MY_FALSE;
3434             validPragma = MY_TRUE;
3435         }
3436         else if (strncmp(base, "warn_deprecated", namelen) == 0)
3437         {
3438             pragma_warn_deprecated = MY_TRUE;
3439             validPragma = MY_TRUE;
3440         }
3441         else if (strncmp(base, "no_warn_deprecated", namelen) == 0)
3442         {
3443             pragma_warn_deprecated = MY_FALSE;
3444             validPragma = MY_TRUE;
3445         }
3446         else if (strncmp(base, "range_check", namelen) == 0)
3447         {
3448             pragma_range_check = MY_TRUE;
3449             validPragma = MY_TRUE;
3450         }
3451         else if (strncmp(base, "no_range_check", namelen) == 0)
3452         {
3453             pragma_range_check = MY_FALSE;
3454             validPragma = MY_TRUE;
3455         }
3456         else if (strncmp(base, "warn_empty_casts", namelen) == 0)
3457         {
3458             pragma_warn_empty_casts = MY_TRUE;
3459             validPragma = MY_TRUE;
3460         }
3461         else if (strncmp(base, "no_warn_empty_casts", namelen) == 0)
3462         {
3463             pragma_warn_empty_casts = MY_FALSE;
3464             validPragma = MY_TRUE;
3465         }
3466         else if (strncmp(base, "share_variables", namelen) == 0)
3467         {
3468             if (variables_defined)
3469             {
3470                 yywarnf("Can't use #pragma share_variables after defining "
3471                         "variables");
3472             }
3473             else
3474                 pragma_share_variables = MY_TRUE;
3475             validPragma = MY_TRUE;
3476         }
3477         else if (strncmp(base, "init_variables", namelen) == 0)
3478         {
3479             if (variables_defined)
3480             {
3481                 yywarnf("Can't use #pragma init_variables after defining "
3482                         "variables");
3483             }
3484             else
3485                 pragma_share_variables = MY_FALSE;
3486             validPragma = MY_TRUE;
3487         }
3488 #if defined( DEBUG ) && defined ( TRACE_CODE )
3489         else if (strncmp(base, "set_code_window", namelen) == 0)
3490         {
3491             set_code_window();
3492             validPragma = MY_TRUE;
3493         }
3494         else if (strncmp(base, "show_code_window", namelen) == 0)
3495         {
3496             show_code_window();
3497             validPragma = MY_TRUE;
3498         }
3499 #endif
3500 
3501         /* Advance next to the next scanning position so that the
3502          * for loop increment works.
3503          */
3504         if (NULL != next)
3505         {
3506             /* Skip spaces */
3507             next = next + strspn(next, " \t\r");
3508 
3509             if (',' == *next)
3510             {
3511                 /* Skip the one allowed comma.
3512                  * We allow the comma to be followed by lineend
3513                  */
3514                 next++;
3515             }
3516             else if ('\0' != *next && '\r' != *next)
3517             {
3518                 if (master_ob)
3519                 {
3520                     yywarnf("Missing comma between #pragma options");
3521                 }
3522                 else
3523                 {
3524                     debug_message("Warning: Missing comma between #pragma options"
3525                                   ": file %s, line %d\n"
3526                                  , current_loc.file->name, current_loc.line);
3527                 }
3528             }
3529 
3530             if ('\0' == *next || '\r' == *next)
3531             {
3532                 /* End of string */
3533                 next = NULL;
3534             }
3535 
3536             /* If next now points to something else but space or a pragma
3537              * name, the next loop iteration will complain about an illegal
3538              * pragma.
3539              */
3540         }
3541 
3542         /* Finally check if the pragma was valid */
3543         if (!validPragma)
3544         {
3545             if (master_ob)
3546             {
3547                 /* Calling yywarnf() without a master can cause the game
3548                  * to shut down, because yywarnf() eventually tries to call
3549                  * a master lfun.
3550                  */
3551                 yywarnf("Unknown #pragma '%.*s'", (int)namelen, base);
3552             }
3553             else
3554             {
3555                 debug_message("Warning: Unknown #pragma '%.*s': file %s, line %d\n"
3556                              , (int)namelen, base, current_loc.file->name, current_loc.line);
3557             }
3558         }
3559 
3560     } /* for (base) */
3561 } /* handle_pragma() */
3562 
3563 /*-------------------------------------------------------------------------*/
3564 static INLINE int
number(long i)3565 number (long i)
3566 
3567 /* Return a number to yacc: set yylval.number to <i> and return L_NUMBER.
3568  */
3569 
3570 {
3571 #ifdef LEXDEBUG
3572     printf("%s returning number %d.\n", time_stamp(), i);
3573 #endif
3574     yylval.number = i;
3575     return L_NUMBER;
3576 } /* number() */
3577 
3578 /*-------------------------------------------------------------------------*/
3579 static INLINE char *
parse_numeric_escape(char * cp,unsigned char * p_char)3580 parse_numeric_escape (char * cp, unsigned char * p_char)
3581 
3582 /* Parse a character constant in one of the following formats:
3583  *   <decimal>      (max 3 digits)
3584  *   0o<octal>      (max 3 digits)
3585  *   0x<sedecimal>  (max 2 digits)
3586  *   x<sedecimal>   (max 2 digits)
3587  *   0b<binary>     (max 8 digits)
3588  *
3589  * with <cp> pointing to the first character. The function parses
3590  * until the first illegal character, but at max the given number of
3591  * digits.
3592  *
3593  * The parsed number is stored in *<p_num>, the function returns the pointer
3594  * to the first character after the number.
3595  * If no valid character constant could be found, NULL is returned.
3596  */
3597 
3598 {
3599     char c;
3600     int num_digits = 3;
3601     unsigned long l;
3602     unsigned long base = 10;
3603 
3604     c = *cp++;
3605 
3606     if ('0' == c)
3607     {
3608         /* '0' introduces decimal, octal, binary and sedecimal numbers, or it
3609          * can be a float.
3610          *
3611          * Sedecimals are handled in a following if-clause to allow the
3612          * two possible prefixes.
3613          */
3614 
3615         c = *cp++;
3616 
3617         switch (c)
3618         {
3619         case 'X': case 'x':
3620             /* Sedecimal number are handled below - here just fall
3621              * through.
3622              */
3623             NOOP;
3624             break;
3625 
3626         case 'b': case 'B':
3627           {
3628             c = *cp++;
3629             num_digits = 8;
3630             base = 2;
3631             break;
3632           }
3633 
3634         case 'o': case 'O':
3635             c = *cp++;
3636             base = 8;
3637             num_digits = 3;
3638             break;
3639 
3640         default:
3641             c = '0';
3642             cp--;
3643             break;
3644         } /* switch(c) */
3645     } /* if ('0' == c) */
3646 
3647     if ( c == 'X' || c == 'x' )
3648     {
3649         if (!leXdigit(*cp))
3650         {
3651             yywarn("Character constant used with no valid digits");
3652             return NULL;
3653         }
3654 
3655         /* strtol() gets the sign bit wrong,
3656          * strtoul() isn't portable enough.
3657          * TODO: strtoul should be portable enough today... Re-check if we
3658          * TODO::require C99.
3659          */
3660         num_digits = 2;
3661         l = 0;
3662         while(leXdigit(c = *cp++) && num_digits-- > 0)
3663         {
3664             if (c > '9')
3665                 c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
3666             l <<= 4;
3667             l += c - '0';
3668         }
3669     }
3670     else
3671     {
3672         /* Parse a normal number from here */
3673 
3674         l = c - '0';
3675         /* l is unsigned. So any c smaller than '0' will be wrapped into
3676          * positive values and be larger then base as well. Therefore an
3677          * additional comparison of l < 0 is not explicitly needed here. */
3678         if  (l > base)
3679         {
3680             yywarn("Character constant used with no valid digits");
3681             return NULL;
3682         }
3683         while (lexdigit(c = *cp++) && c < (char)('0'+base) && --num_digits > 0)
3684               l = l * base + (c - '0');
3685     }
3686 
3687     if (l >= 256)
3688         yywarn("Character constant out of range (> 255)");
3689 
3690     *p_char = l & 0xff;
3691     return cp-1;
3692 
3693 } /* parse_numeric_escape() */
3694 
3695 /*-------------------------------------------------------------------------*/
3696 static INLINE char *
parse_number(char * cp,unsigned long * p_num,Bool * p_overflow)3697 parse_number (char * cp, unsigned long * p_num, Bool * p_overflow)
3698 
3699 /* Parse a positive integer number in one of the following formats:
3700  *   <decimal>
3701  *   0o<octal>
3702  *   0x<sedecimal>
3703  *   x<sedecimal>
3704  *   0b<binary>
3705  *
3706  * with <cp> pointing to the first character.
3707  *
3708  * The parsed number is stored in *<p_num>, the function returns the pointer
3709  * to the first character after the number. If the parsed number exceeded
3710  * the numerical limits, *<p_overflow> is set to TRUE, otherwise to FALSE.
3711  *
3712  * The function is also available to the other parts of the driver.
3713  */
3714 
3715 {
3716     char c;
3717     unsigned long l;
3718     unsigned long base = 10;
3719     unsigned long max_shiftable = ULONG_MAX / base;
3720 
3721     *p_overflow = MY_FALSE;
3722     c = *cp++;
3723 
3724     if ('0' == c)
3725     {
3726         /* '0' introduces decimal, octal, binary and sedecimal numbers, or it
3727          * can be a float.
3728          *
3729          * Sedecimals are handled in a following if-clause to allow the
3730          * two possible prefixes.
3731          */
3732 
3733         c = *cp++;
3734 
3735         switch (c)
3736         {
3737         case 'X': case 'x':
3738             /* Sedecimal number are handled below - here just fall
3739              * through.
3740              */
3741             NOOP;
3742             break;
3743 
3744         case 'b': case 'B':
3745           {
3746             l = 0;
3747             max_shiftable = ULONG_MAX / 2;
3748             --cp;
3749             while('0' == (c = *++cp) || '1' == c)
3750             {
3751                 *p_overflow = *p_overflow || (l > max_shiftable);
3752                 l <<= 1;
3753                 l += c - '0';
3754             }
3755 
3756             *p_num = *p_overflow ? LONG_MAX : l;
3757             return cp;
3758           }
3759 
3760         case 'o': case 'O':
3761             c = '0';
3762             base = 8;
3763             max_shiftable = ULONG_MAX / base;
3764             break;
3765 
3766         default:
3767             /* If some non-digit follows, it's just the number 0.
3768              */
3769             if (!lexdigit(c))
3770             {
3771                 *p_num = 0;
3772                 return cp-1;
3773             }
3774             break;
3775         } /* switch(c) */
3776     } /* if ('0' == c) */
3777 
3778     if ( c == 'X' || c == 'x' )
3779     {
3780 
3781         /* strtol() gets the sign bit wrong,
3782          * strtoul() isn't portable enough.
3783          */
3784         max_shiftable = ULONG_MAX / 16;
3785         l = 0;
3786         --cp;
3787         while(leXdigit(c = *++cp))
3788         {
3789             *p_overflow = *p_overflow || (l > max_shiftable);
3790             if (c > '9')
3791                 c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
3792             l <<= 4;
3793             l += c - '0';
3794         }
3795         *p_num = *p_overflow ? LONG_MAX : l;
3796         return cp;
3797     }
3798 
3799     /* Parse a normal number from here */
3800 
3801     max_shiftable = ULONG_MAX / base;
3802     l = c - '0';
3803     while (lexdigit(c = *cp++) && c < (char)('0'+base))
3804     {
3805         *p_overflow = *p_overflow || (l > max_shiftable);
3806         c -= '0';
3807         l = l * base + c;
3808         *p_overflow = *p_overflow || (l < (unsigned long)c);
3809     }
3810 
3811     *p_num = *p_overflow ? LONG_MAX : l;
3812     return cp-1;
3813 
3814 } /* parse_number() */
3815 
3816 /*-------------------------------------------------------------------------*/
3817 char *
lex_parse_number(char * cp,unsigned long * p_num,Bool * p_overflow)3818 lex_parse_number (char * cp, unsigned long * p_num, Bool * p_overflow)
3819 
3820 /* Parse a positive integer number in one of the following formats:
3821  *   <decimal>
3822  *   0o<octal>
3823  *   0x<sedecimal>
3824  *   0b<binary>
3825  *
3826  * with <cp> pointing to the first character.
3827  *
3828  * The parsed number is stored in *<p_num>, the function returns the pointer
3829  * to the first character after the number. If the parsed number exceeded
3830  * the numerical limits, *<p_overflow> is set to TRUE, otherwise to FALSE.
3831  *
3832  * If the string is not a number, p_num will be unchanged, and cp will
3833  * be returned.
3834  */
3835 
3836 {
3837     char c = *cp;
3838 
3839     *p_overflow = MY_FALSE;
3840 
3841     if (isdigit(c))
3842     {
3843         cp = parse_number(cp, p_num, p_overflow);
3844     }
3845     return cp;
3846 } /* lex_parse_number() */
3847 
3848 /*-------------------------------------------------------------------------*/
3849 static INLINE char *
parse_escaped_char(char * cp,char * p_char)3850 parse_escaped_char (char * cp, char * p_char)
3851 
3852 /* Parse the sequence for an escaped character:
3853  *
3854  *   \a : Bell (0x07)
3855  *   \b : Backspace (0x08)
3856  *   \e : Escape (0x1b)
3857  *   \f : Formfeed (0x0c)
3858  *   \n : Newline (0x0a)
3859  *   \r : Carriage-Return (0x0d)
3860  *   \t : Tab (0x09)
3861  *   \<decimal>, \0o<octal>, \x<sedecimal>, \0x<sedecimal>, \0b<binary>:
3862  *        the character with the given code.
3863  *   \<other printable character> : the printable character
3864  *
3865  * with <cp> pointing to the character after the '\'.
3866  *
3867  * The parsed character is stored in *<p_char>, the function returns the
3868  * pointer to the first character after the sequence.
3869  *
3870  * If the sequence is not one of the recognized sequences, NULL is returned.
3871  */
3872 
3873 {
3874     char c;
3875 
3876     switch (c = *cp++)
3877     {
3878     case '\n':
3879     case CHAR_EOF:
3880         return NULL; break;
3881 
3882     case 'a': c = '\007'; break;
3883     case 'b': c = '\b';   break;
3884     case 'e': c = '\033'; break;
3885     case 'f': c = '\014'; break;
3886     case 'n': c = '\n';   break;
3887     case 'r': c = '\r';   break;
3888     case 't': c = '\t';   break;
3889     case '0': case '1': case '2': case '3': case '4':
3890     case '5': case '6': case '7': case '8': case '9':
3891     case 'x': case 'X':
3892       {
3893         char * cp2;
3894 
3895         /* If no valid escaped character is found, treat the sequence
3896          * as a normal escaped character.
3897          */
3898         cp2 = parse_numeric_escape(cp-1, (unsigned char *)&c);
3899         if (cp2 != NULL)
3900             cp = cp2;
3901       }
3902     } /* switch() */
3903 
3904     *p_char = c;
3905     return cp;
3906 } /* parse_escaped_char() */
3907 
3908 /*-------------------------------------------------------------------------*/
3909 static void
add_lex_string(char * str,size_t slen)3910 add_lex_string (char *str, size_t slen)
3911 
3912 /* Add <str> with length <slen> to the global <last_lex_string> in order
3913  * to implement Standard-C style string concatenation.
3914  */
3915 
3916 {
3917     size_t len1;
3918     string_t *new;
3919 
3920     len1 = mstrsize(last_lex_string);
3921     if (len1+slen > MAX_ANSI_CONCAT)
3922     {
3923         /* Without this test, compilation would still terminate eventually,
3924          * thus it would still be 'correct', but it could take several hours.
3925          */
3926         lexerror("Too long ansi style string concatenation");
3927         /* leave the old string, ignore the new addition */
3928         return;
3929     }
3930     new = mstr_add_txt(last_lex_string, str, slen);
3931     if (!new)
3932     {
3933         lexerrorf("Out of memory for string concatenation (%zu bytes)",
3934                   len1+slen);
3935     }
3936     free_mstring(last_lex_string);
3937     last_lex_string = make_tabled(new);
3938 } /* add_lex_string() */
3939 
3940 /*-------------------------------------------------------------------------*/
3941 static INLINE int
string(char * str,size_t slen)3942 string (char *str, size_t slen)
3943 
3944 /* Return a string to yacc: set last_lex_string to <str> of length <slen>
3945  * and return L_STRING.
3946  * If there is a string in last_lex_string already, <str> is appended
3947  * and yylex() is called recursively to allow ANSI string concatenation.
3948  */
3949 
3950 {
3951     if (last_lex_string)
3952     {
3953         add_lex_string(str,  slen);
3954         return yylex();
3955     }
3956     else
3957     {
3958         last_lex_string = new_n_tabled(str, slen);
3959         if (!last_lex_string)
3960         {
3961             lexerrorf("Out of memory for string literal (%zu bytes)",
3962                       slen);
3963         }
3964     }
3965     return L_STRING;
3966 } /* string() */
3967 
3968 /*-------------------------------------------------------------------------*/
3969 static INLINE int
closure(char * in_yyp)3970 closure (char *in_yyp)
3971 
3972 /* The lexer has found a closure token (#'...), with <in_yyp> pointing
3973  * to the quote.  Parse the token into yylval and return the proper
3974  * token code.
3975  */
3976 {
3977     register char * yyp = in_yyp;
3978 
3979     register char c;
3980     ident_t *p;
3981     char *wordstart = ++yyp;
3982     char *super_name = NULL;
3983     Bool efun_override;  /* True if 'efun::' is specified. */
3984 
3985     /* Set yyp to the last character of the functionname
3986      * after the #'.
3987      */
3988     do
3989         c = *yyp++;
3990     while (isalunum(c));
3991     c = *--yyp;
3992     /* the assignment is good for the data flow analysis :-} */
3993 
3994     /* Just one character? It must be an operator */
3995     if (yyp == wordstart && *yyp != ':')
3996     {
3997         int i;
3998 
3999         if ((i = symbol_operator(yyp, (const char **)&outp)) < 0)
4000             yyerror("Missing function name after #'");
4001         yylval.closure.number = i + CLOSURE_EFUN_OFFS;
4002         yylval.closure.inhIndex = 0;
4003         return L_CLOSURE;
4004     }
4005 
4006     /* Test for an inherited function name specification.
4007      * If found, set super_name to the inherit name, and
4008      * reset wordstart/yyp to point to the name after the '::'.
4009      */
4010     if (':' == *yyp && ':' == *(yyp+1))
4011     {
4012         super_name = wordstart;
4013         wordstart = yyp += 2;
4014         do
4015             c = *yyp++;
4016         while (isalunum(c));
4017         c = *--yyp;
4018     }
4019 
4020     /* Test for the 'efun::' override.
4021      */
4022     efun_override = MY_FALSE;
4023     if (super_name != NULL && !strncmp(super_name, "efun::", 6))
4024     {
4025         efun_override = MY_TRUE;
4026         super_name = NULL;
4027     }
4028 
4029     outp = yyp;
4030 
4031     /* Lookup the name parsed from the text */
4032 
4033     if (super_name != NULL)
4034     {
4035         short ix;
4036         unsigned short inhIndex;
4037         funflag_t flags;
4038 
4039         *yyp = '\0'; /* c holds the char at this place */
4040         *(wordstart-2) = '\0';
4041         ix = find_inherited_function(super_name, wordstart, &inhIndex, &flags);
4042         inhIndex++;
4043         if (ix < 0)
4044         {
4045             yyerrorf("Undefined function: %.50s::%.50s"
4046                     , super_name, wordstart);
4047             ix = CLOSURE_EFUN_OFFS;
4048         }
4049         *yyp = c;
4050         *(wordstart-2) = ':';
4051 
4052         yylval.closure.number = ix;
4053         yylval.closure.inhIndex = inhIndex;
4054         // check for deprecated functions
4055         // this is done here, because here we directly have the flags of the inherited function.
4056         if (flags & TYPE_MOD_DEPRECATED)
4057         {
4058             yywarnf("Creating lfun closure to deprecated function %.50s::%.50s",
4059                     super_name, wordstart);
4060         }
4061 
4062         return L_CLOSURE;
4063     }
4064 
4065     p = make_shared_identifier_n(wordstart, yyp-wordstart, I_TYPE_GLOBAL, 0);
4066     if (!p) {
4067         lexerror("Out of memory");
4068         return 0;
4069     }
4070 
4071     /* #' can be used only on identifiers with global visibility
4072      * or better. Look along the .inferior chain for such an
4073      * identifier. If the identifier happens to be a reserved
4074      * word, the better for us.
4075      */
4076     while (p->type > I_TYPE_GLOBAL)
4077     {
4078         if (p->type == I_TYPE_RESWORD)
4079         {
4080             int code = symbol_resword(p);
4081 
4082             if (!code)
4083             {
4084                 /* There aren't efuns with reswords as names, and
4085                  * it is impossible to define local / global vars
4086                  * or functions with such a name.
4087                  * Thus, !p->inferior .
4088                  */
4089                 yyerrorf(
4090                   "No closure associated with reserved word '%s'",
4091                   get_txt(p->name)
4092                 );
4093             }
4094 
4095             yylval.closure.number = code + CLOSURE_EFUN_OFFS;
4096             yylval.closure.inhIndex = 0;
4097             return L_CLOSURE;
4098         }
4099         if ( !(p = p->inferior) )
4100             break;
4101     } /* while (p->type > I_TYPE_GLOBAL */
4102 
4103     /* Did we find a suitable identifier? */
4104     if (!p || p->type < I_TYPE_GLOBAL)
4105     {
4106         if (p && p->type == I_TYPE_UNKNOWN)
4107             free_shared_identifier(p);
4108         c = *yyp;
4109         *yyp = '\0';
4110         yyerrorf("Undefined function: %.50s", wordstart);
4111         *yyp = c;
4112         yylval.closure.number = CLOSURE_EFUN_OFFS;
4113         yylval.closure.inhIndex = 0;
4114         return L_CLOSURE;
4115     }
4116 
4117     /* An attempt to override a nomask simul-efun causes
4118      * a privilege violation. If the master decides to allow
4119      * this attempt, the efun-override will still be deactivated
4120      * (iow: a nomask simul-efun overrules an efun override).
4121      */
4122     if (efun_override
4123      && p->u.global.sim_efun >= 0
4124      && simul_efunp[p->u.global.sim_efun].flags & TYPE_MOD_NO_MASK
4125      && p->u.global.efun >= 0
4126      && master_ob
4127      && (!EVALUATION_TOO_LONG())
4128        )
4129     {
4130         svalue_t *res;
4131 
4132         push_ref_string(inter_sp, STR_NOMASK_SIMUL_EFUN);
4133         push_c_string(inter_sp, current_loc.file->name);
4134         push_ref_string(inter_sp, p->name);
4135         res = apply_master(STR_PRIVILEGE, 3);
4136         if (!res || res->type != T_NUMBER || res->u.number < 0)
4137         {
4138             yyerrorf(
4139               "Privilege violation: nomask simul_efun %s",
4140               get_txt(p->name)
4141             );
4142             efun_override = MY_FALSE;
4143         }
4144         else if (!res->u.number)
4145         {
4146             efun_override = MY_FALSE;
4147         }
4148     }
4149     else if (EVALUATION_TOO_LONG())
4150     {
4151         yyerrorf("Can't call master::%s for "
4152                  "'nomask simul_efun %s': eval cost too big"
4153                 , get_txt(STR_PRIVILEGE), get_txt(p->name));
4154         efun_override = MY_FALSE;
4155     }
4156 
4157     /* The code will be L_CLOSURE, now determine the right
4158      * closure number to put into yylval.closure.number.
4159      * The number is usually the index in the appropriate
4160      * table, plus an offset indicating the type of the closure.
4161      *
4162      * The switch() serves just as a simple try... environment.
4163      */
4164     yylval.closure.inhIndex = 0;
4165     switch(0) { default:
4166         if (!efun_override)
4167         {
4168 
4169             /* lfun? */
4170             if (p->u.global.function >= 0)
4171             {
4172                 int i;
4173 
4174                 i = p->u.global.function;
4175                 yylval.closure.number = i;
4176                 if (i >= CLOSURE_IDENTIFIER_OFFS)
4177                     yyerrorf(
4178                       "Too high function index of %s for #'",
4179                       get_txt(p->name)
4180                     );
4181                 break;
4182             }
4183 
4184             /* simul-efun? */
4185             if (p->u.global.sim_efun >= 0) {
4186                 yylval.closure.number =
4187                   p->u.global.sim_efun + CLOSURE_SIMUL_EFUN_OFFS;
4188                 break;
4189             }
4190         }
4191 
4192         /* efun? */
4193         if (p->u.global.efun >= 0)
4194         {
4195             yylval.closure.number =
4196               p->u.global.efun + CLOSURE_EFUN_OFFS;
4197             if (yylval.closure.number >
4198                 LAST_INSTRUCTION_CODE + CLOSURE_EFUN_OFFS)
4199             {
4200                 yylval.closure.number =
4201                   efun_aliases[
4202                     yylval.closure.number - CLOSURE_EFUN_OFFS
4203                       - LAST_INSTRUCTION_CODE - 1
4204                   ] + CLOSURE_EFUN_OFFS;
4205             }
4206             break;
4207         }
4208 
4209         /* object variable? */
4210         if (p->u.global.variable >= 0)
4211         {
4212             if (p->u.global.variable & VIRTUAL_VAR_TAG) {
4213                 /* Handling this would require an extra coding of
4214                  * this closure type, and special treatment in
4215                  * replace_program_lambda_adjust(). Also deprecated-check in the
4216                  * L_CLOSURE rule in prolang.y must be adjusted.
4217                  */
4218                 yyerrorf("closure of virtual variable");
4219                 yylval.closure.number = CLOSURE_IDENTIFIER_OFFS;
4220                 break;
4221             }
4222             yylval.closure.number =
4223               p->u.global.variable + num_virtual_variables +
4224               CLOSURE_IDENTIFIER_OFFS;
4225             break;
4226         }
4227 
4228         /* None of these all */
4229         c = *yyp;
4230         *yyp = 0;
4231         yyerrorf("Undefined function: %.50s", wordstart);
4232         *yyp = c;
4233         yylval.closure.number = CLOSURE_EFUN_OFFS;
4234 
4235         break;
4236     }
4237     return L_CLOSURE;
4238 } /* closure() */
4239 
4240 /*-------------------------------------------------------------------------*/
4241 static char *
handle_preprocessor_statement(char * in_yyp)4242 handle_preprocessor_statement (char * in_yyp)
4243 
4244 /* The lexer has found a preprocessor statement (<newline>#), an <in_yyp>
4245  * is pointing to the character after the '#'. Parse the statement and return
4246  * the new character pointer.
4247  */
4248 
4249 {
4250     register char * yyp = in_yyp;
4251 
4252     register char c;
4253     char *sp = NULL; /* Begin of second word */
4254     Bool quote; /* In "" string? */
4255     size_t wlen;  /* Length of the preproc keyword */
4256     char last;
4257       /* Character last read, used to implement \-sequences */
4258 
4259     /* Copy the first/only line of the preprocessor statement
4260      * from the input buffer into yytext[] while stripping
4261      * comments.
4262      */
4263 
4264     /* Skip initial blanks */
4265     outp = yyp;
4266     yyp = yytext;
4267     do {
4268         c = mygetc();
4269     } while (lexwhite(c));
4270 
4271     wlen = 0;
4272     for (quote = MY_FALSE, last = '\0';;)
4273     {
4274 
4275         /* Skip comments */
4276         while (!quote && c == '/')
4277         {
4278             char c2;
4279 
4280             if ( (c2 = mygetc()) == '*')
4281             {
4282                 skip_comment();
4283                 c = mygetc();
4284             }
4285             else if (c2 == '/')
4286             {
4287                 outp = skip_pp_comment(outp);
4288                 current_loc.line--;
4289                 c = '\n';
4290             }
4291             else
4292             {
4293                 --outp;
4294                 break;
4295             }
4296         }
4297 
4298         /* If the last character was '\', take this one as
4299          * as it is, else interpret this character.
4300          */
4301         if (last == '\\')
4302             last = '\0';
4303         else if (c == '"')
4304             quote = !quote;
4305         else
4306             last = c;
4307 
4308         /* Remember end of the first word in the line */
4309         if (!sp && !isalunum(c))
4310         {
4311             sp = yyp;
4312             wlen = yyp - yytext;
4313         }
4314 
4315         if (c == '\n')
4316         {
4317             break;
4318         }
4319         SAVEC;
4320         c = mygetc();
4321     }
4322 
4323     /* Terminate the line copied to yytext[] */
4324     *yyp = '\0';
4325 
4326     /* Remember the end of the first word.
4327      * Let sp point to the next word then.
4328      */
4329     if (sp)
4330     {
4331         while(lexwhite(*sp))
4332         {
4333             sp++;
4334         }
4335     }
4336     else
4337     {
4338         /* No end found in the copy loop - the next 'word'
4339          * will be the terminating '\0'.
4340          */
4341         sp = yyp;
4342         wlen = yyp - yytext;
4343     }
4344 
4345     /* Evaluate the preprocessor statement */
4346     if (strncmp("include", yytext, wlen) == 0)
4347     {
4348         /* Calling myfilbuf() before handle_include() is a waste
4349          * of time and memory. However, since the include
4350          * attempt might fail, we have to call it afterwards
4351          * to make sure that the lex can continue.
4352          */
4353         handle_include(sp);
4354         myfilbuf();
4355     }
4356     else
4357     {
4358        /* Make sure there is enough data in the buffer. */
4359        myfilbuf();
4360 
4361     if (strncmp("define", yytext, wlen) == 0)
4362     {
4363         if (*sp == '\0')
4364             yyerror("Missing definition in #define");
4365         else
4366             handle_define(sp, quote);
4367     }
4368     else if (strncmp("if", yytext, wlen) == 0)
4369     {
4370         int cond;
4371         svalue_t sv;
4372 
4373         myungetc('\n');
4374         add_input(sp);
4375         cond = cond_get_exp(0, &sv);
4376         free_svalue(&sv);
4377         if (mygetc() != '\n')
4378         {
4379             yyerror("Condition too complex in #if");
4380             while (mygetc() != '\n') NOOP;
4381         }
4382         else
4383             handle_cond(cond);
4384     }
4385     else if (strncmp("ifdef", yytext, wlen) == 0)
4386     {
4387         deltrail(sp);
4388         handle_cond(lookup_define(sp) != 0);
4389     }
4390     else if (strncmp("ifndef", yytext, wlen) == 0)
4391     {
4392         deltrail(sp);
4393         handle_cond(lookup_define(sp) == 0);
4394     }
4395     else if (strncmp("else", yytext, wlen) == 0)
4396     {
4397         if (*sp != '\0')
4398         {
4399             if (pragma_pedantic)
4400                 yyerror("Unrecognized #else (trailing characters)");
4401             else
4402                 yywarn("Unrecognized #else (trailing characters)");
4403         }
4404 
4405         if (iftop && iftop->state == EXPECT_ELSE)
4406         {
4407             lpc_ifstate_t *p = iftop;
4408 
4409             iftop = p->next;
4410             mempool_free(lexpool, p);
4411             skip_to("endif", NULL);
4412         }
4413         else
4414         {
4415             yyerror("Unexpected #else");
4416         }
4417     }
4418     else if (strncmp("elif", yytext, wlen) == 0)
4419     {
4420         if (iftop && iftop->state == EXPECT_ELSE)
4421         {
4422             lpc_ifstate_t *p = iftop;
4423 
4424             iftop = p->next;
4425             mempool_free(lexpool, p);
4426             skip_to("endif", NULL);
4427         }
4428         else
4429         {
4430             yyerror("Unexpected #elif");
4431         }
4432     }
4433     else if (strncmp("endif", yytext, wlen) == 0)
4434     {
4435         if (*sp != '\0')
4436         {
4437             if (pragma_pedantic)
4438                 yyerror("Unrecognized #endif (trailing characters)");
4439             else
4440                 yywarn("Unrecognized #endif (trailing characters)");
4441         }
4442 
4443         if (iftop
4444          && (   iftop->state == EXPECT_ENDIF
4445              || iftop->state == EXPECT_ELSE))
4446         {
4447             lpc_ifstate_t *p = iftop;
4448 
4449             iftop = p->next;
4450             mempool_free(lexpool, p);
4451         }
4452         else
4453         {
4454             yyerror("Unexpected #endif");
4455         }
4456     }
4457     else if (strncmp("undef", yytext, wlen) == 0)
4458     {
4459         ident_t *p, **q;
4460         int h;
4461 
4462         deltrail(sp);
4463 
4464         /* Lookup identifier <sp> in the ident_table and
4465          * remove it there if it is a #define'd identifier.
4466          * If it is a permanent define, park the ident
4467          * structure in the undefined_permanent_defines list.
4468          */
4469         h = identhash(sp);
4470         for (q = &ident_table[h]; NULL != ( p= *q); q=&p->next)
4471         {
4472             if (strcmp(sp, get_txt(p->name)))
4473                 continue;
4474 
4475             if (p->type != I_TYPE_DEFINE) /* failure */
4476                 break;
4477 
4478             if (!p->u.define.permanent)
4479             {
4480 #if defined(LEXDEBUG)
4481                 fprintf(stderr, "%s #undef define '%s' %d '%s'\n"
4482                        , time_stamp(), get_txt(p->name)
4483                        , p->u.define.nargs
4484                        , p->u.define.exps.str);
4485                 fflush(stderr);
4486 #endif
4487                 if (p->inferior)
4488                 {
4489                     p->inferior->next = p->next;
4490                     *q = p->inferior;
4491                 }
4492                 else
4493                 {
4494                     *q = p->next;
4495                 }
4496                 xfree(p->u.define.exps.str);
4497                 free_mstring(p->name);
4498                 p->name = NULL;
4499                     /* mark for later freeing by all_defines */
4500                 /* success */
4501                 break;
4502            }
4503            else
4504            {
4505                 if (p->inferior)
4506                 {
4507                     p->inferior->next = p->next;
4508                     *q = p->inferior;
4509                 }
4510                 else
4511                 {
4512                     *q = p->next;
4513                 }
4514                 p->next = undefined_permanent_defines;
4515                 undefined_permanent_defines = p;
4516                 /* success */
4517                 break;
4518             }
4519         }
4520     }
4521     else if (strncmp("echo", yytext, wlen) == 0)
4522     {
4523         fprintf(stderr, "%s %s\n", time_stamp(), sp);
4524     }
4525     else if (strncmp("pragma", yytext, wlen) == 0)
4526     {
4527         handle_pragma(sp);
4528     }
4529     else if (strncmp("line", yytext, wlen) == 0)
4530     {
4531         char * end;
4532         long new_line;
4533 
4534         deltrail(sp);
4535         new_line = strtol(sp, &end, 0);
4536         if (end == sp || *end != '\0')
4537             yyerror("Unrecognised #line directive");
4538         if (new_line < current_loc.line)
4539             store_line_number_backward(current_loc.line - new_line);
4540         current_loc.line = new_line - 1;
4541     }
4542     else
4543     {
4544         yyerror("Unrecognised # directive");
4545     }} /* if() { else if () {} } */
4546 
4547     store_line_number_info();
4548     nexpands = 0;
4549     current_loc.line++;
4550     total_lines++;
4551 
4552     return outp;
4553 } /* handle_preprocessor_statement() */
4554 
4555 /*-------------------------------------------------------------------------*/
4556 static INLINE int
yylex1(void)4557 yylex1 (void)
4558 
4559 /* Lex the next lexical element starting from outp and return its code.
4560  * For single characters, this is the character code itself. Multi-character
4561  * elements return the associated code define in lang.h.
4562  * Illegal characters are returned as spaces.
4563  * If the lexer runs into a fatal error or the end of file, -1 is returned.
4564  *
4565  * <depth> is the current nesting depth for local scopes, needed for
4566  * correct lookup of local identifiers.
4567  *
4568  * Some elements return additional information:
4569  *   L_ASSIGN:  yylval.number is the type of assignment operation
4570  *              e.g. F_ADD_EQ for '+='.
4571  *              '=' itself is returned as F_ASSIGN.
4572  *   L_NUMBER:  yylval.number is the parsed whole number or char constant.
4573  *   L_FLOAT:   yylval.float_number is the parsed float number.
4574  *   L_STRING:  last_lex_string is the (tabled) parsed string literal.
4575  *   L_CLOSURE: yylval.closure.number/.inhIndex identifies the closure. See
4576  *              the source for which value means what (it's a bit longish).
4577  *   L_QUOTED_AGGREGATE: yylval.number is the number of quotes
4578  *   L_SYMBOL:  yylval.symbol.name is the (shared) name of the symbol,
4579  *              yylval.symbol.quotes the number of quotes.
4580  */
4581 
4582 {
4583     register char *yyp;
4584     register char c;
4585 
4586 #define TRY(c, t) if (*yyp == (c)) {yyp++; outp = yyp; return t;}
4587 
4588 #ifndef USE_NEW_INLINES
4589     /* If we are at a point suitable for inline function insertion,
4590      * do it.
4591      * Note: It is not strictly necessary to insert all of them
4592      * at once, since the compiler will set insert_inline_fun_now
4593      * again as soon as it is finished with this one.
4594      */
4595     if (insert_inline_fun_now)
4596     {
4597         struct inline_fun * fun;
4598         char buf[80];
4599 
4600         sprintf(buf, "#line %d\n", current_loc.line);
4601         insert_inline_fun_now = MY_FALSE;
4602         while (first_inline_fun)
4603         {
4604             fun = first_inline_fun->next;
4605             if (first_inline_fun->buf.length)
4606             {
4607                 strbuf_add(&(first_inline_fun->buf), buf);
4608                 add_input(first_inline_fun->buf.buf);
4609                 strbuf_free(&(first_inline_fun->buf));
4610             }
4611             xfree(first_inline_fun);
4612             first_inline_fun = fun;
4613         }
4614     }
4615 #endif /* USE_NEW_INLINES */
4616 
4617     yyp = outp;
4618 
4619     for(;;) {
4620         switch((unsigned char)(c = *yyp++))
4621         {
4622 
4623         /* --- End Of File --- */
4624 
4625         case CHAR_EOF:
4626 
4627             if (inctop)
4628             {
4629                 /* It's the end of an included file: return the previous
4630                  * file
4631                  */
4632                 struct incstate *p;
4633                 Bool was_string_source = (yyin.fd == -1);
4634 
4635                 p = inctop;
4636 
4637                 /* End the lexing of the included file */
4638                 close_input_source();
4639                 nexpands = 0;
4640                 store_include_end(p->inc_offset, p->loc.line);
4641 
4642                 /* Restore the previous state */
4643                 current_loc = p->loc;
4644                 if (!was_string_source)
4645                     current_loc.line++;
4646 
4647                 yyin = p->yyin;
4648                 saved_char = p->saved_char;
4649                 inctop = p->next;
4650                 *linebufend = '\n';
4651                 yyp = linebufend + 1;
4652                 linebufstart = &defbuf[defbuf_len] + p->linebufoffset;
4653                 linebufend   = linebufstart + MAXLINE;
4654                 mempool_free(lexpool, p);
4655                 if (!*yyp)
4656                 {
4657                     outp = yyp;
4658                     yyp = _myfilbuf();
4659                 }
4660                 break;
4661             }
4662 
4663             /* Here it's the end of the main file */
4664 
4665             if (iftop)
4666             {
4667                 /* Oops, pending #if!
4668                  * Note the error and clean up the if-stack.
4669                  */
4670                 lpc_ifstate_t *p = iftop;
4671 
4672                 yyerror(p->state == EXPECT_ENDIF ? "Missing #endif" : "Missing #else");
4673                 while(iftop)
4674                 {
4675                     p = iftop;
4676                     iftop = p->next;
4677                     mempool_free(lexpool, p);
4678                 }
4679             }
4680 
4681             /* Return the EOF condition */
4682             outp = yyp-1;
4683             return -1;
4684 
4685 
4686         /* --- Newline --- */
4687 
4688         case '\n':
4689             {
4690                 store_line_number_info();
4691                 nexpands = 0;
4692                 current_loc.line++;
4693                 total_lines++;
4694                 if (!*yyp)
4695                 {
4696                     outp = yyp;
4697                     yyp = _myfilbuf();
4698                 }
4699             }
4700             break;
4701 
4702 
4703         /* --- Other line markers --- */
4704 
4705         case 0x1a: /* Used by some MSDOS editors as EOF */
4706         case '\r':
4707             *(yyp-1) = *(yyp-2);
4708             break;
4709 
4710 
4711         /* --- White space --- */
4712 
4713         case ' ':
4714         case '\t':
4715         case '\f':
4716         case '\v':
4717             break;
4718 
4719 
4720         /* --- Multi-Char Operators --- */
4721         case '+':
4722             switch(c = *yyp++)
4723             {
4724             case '+': outp = yyp;
4725                       return L_INC;
4726             case '=': yylval.number = F_ADD_EQ;
4727                       outp = yyp;
4728                       return L_ASSIGN;
4729             default:  yyp--;
4730             }
4731             outp = yyp;
4732             return '+';
4733 
4734         case '-':
4735             switch(c = *yyp++)
4736             {
4737             case '>': outp = yyp;
4738                       return L_ARROW;
4739             case '-': outp = yyp;
4740                       return L_DEC;
4741             case '=': yylval.number = F_SUB_EQ;
4742                       outp = yyp;
4743                       return L_ASSIGN;
4744             default:  yyp--;
4745             }
4746             outp = yyp;
4747             return '-';
4748 
4749         case '&':
4750             switch(c = *yyp++)
4751             {
4752             case '&':
4753                 switch(c = *yyp++)
4754                 {
4755                 case '=': yylval.number = F_LAND_EQ;
4756                           outp = yyp;
4757                           return L_ASSIGN;
4758                 default:  yyp--;
4759                 }
4760                 outp = yyp;
4761                 return L_LAND;
4762             case '=': yylval.number = F_AND_EQ;
4763                       outp = yyp;
4764                       return L_ASSIGN;
4765             default:  yyp--;
4766             }
4767             outp = yyp;
4768             return '&';
4769 
4770         case '|':
4771             switch(c = *yyp++)
4772             {
4773             case '|':
4774                 switch(c = *yyp++)
4775                 {
4776                 case '=': yylval.number = F_LOR_EQ;
4777                           outp = yyp;
4778                           return L_ASSIGN;
4779                 default:  yyp--;
4780                 }
4781                 outp = yyp;
4782                 return L_LOR;
4783             case '=': yylval.number = F_OR_EQ;
4784                       outp = yyp;
4785                       return L_ASSIGN;
4786             default:  yyp--;
4787             }
4788             outp = yyp;
4789             return '|';
4790 
4791         case '^':
4792             if (*yyp == '=')
4793             {
4794                 yyp++;
4795                 yylval.number = F_XOR_EQ;
4796                 outp = yyp;
4797                 return L_ASSIGN;
4798             }
4799             outp = yyp;
4800             return '^';
4801 
4802         case '<':
4803             c = *yyp++;;
4804             if (c == '<')
4805             {
4806                 if (*yyp == '=')
4807                 {
4808                     yyp++;
4809                     yylval.number = F_LSH_EQ;
4810                     outp = yyp;
4811                     return L_ASSIGN;
4812                 }
4813                 outp = yyp;
4814                 return L_LSH;
4815             }
4816             if (c == '=') {
4817                 outp=yyp;
4818                 return L_LE;
4819             }
4820             yyp--;
4821             outp = yyp;
4822             return '<';
4823 
4824         case '>':
4825             c = *yyp++;
4826             if (c == '>')
4827             {
4828                 if (*yyp == '=')
4829                 {
4830                     yyp++;
4831                     yylval.number = F_RSH_EQ;
4832                     outp = yyp;
4833                     return L_ASSIGN;
4834                 }
4835                 if (*yyp == '>')
4836                 {
4837                     yyp++;
4838                     if (*yyp == '=')
4839                     {
4840                         yyp++;
4841                         yylval.number = F_RSHL_EQ;
4842                         outp = yyp;
4843                         return L_ASSIGN;
4844                     }
4845                     outp = yyp;
4846                     return L_RSHL;
4847                 }
4848                 outp = yyp;
4849                 return L_RSH;
4850             }
4851             if (c == '=')
4852             {
4853                 outp = yyp;
4854                 return L_GE;
4855             }
4856             yyp--;
4857             outp = yyp;
4858             return '>';
4859 
4860         case '*':
4861             if (*yyp == '=')
4862             {
4863                 yyp++;
4864                 yylval.number = F_MULT_EQ;
4865                 outp = yyp;
4866                 return L_ASSIGN;
4867             }
4868             outp = yyp;
4869             return '*';
4870 
4871         case '%':
4872             if (*yyp == '=') {
4873                 yyp++;
4874                 yylval.number = F_MOD_EQ;
4875                 outp = yyp;
4876                 return L_ASSIGN;
4877             }
4878             outp = yyp;
4879             return '%';
4880 
4881         case '/':
4882             c = *yyp++;
4883             if (c == '*')
4884             {
4885                 outp = yyp;
4886                 skip_comment();
4887                 yyp = outp;
4888                 if (lex_fatal)
4889                 {
4890                     return -1;
4891                 }
4892                 break;
4893             }
4894             if (c == '/')
4895             {
4896                 yyp = skip_pp_comment(yyp);
4897                 break;
4898             }
4899             if (c == '=')
4900             {
4901                 yylval.number = F_DIV_EQ;
4902                 outp = yyp;
4903                 return L_ASSIGN;
4904             }
4905             yyp--;
4906             outp = yyp;
4907             return '/';
4908 
4909         case '=':
4910             TRY('=', L_EQ);
4911             yylval.number = F_ASSIGN;
4912             outp = yyp;
4913             return L_ASSIGN;
4914 
4915         case '!':
4916             TRY('=', L_NE);
4917             outp = yyp;
4918             return L_NOT;
4919 
4920         case '.':
4921             if (yyp[0] == '.' && yyp[1] == '.')
4922             {
4923                 yyp += 2;
4924                 outp = yyp;
4925                 return L_ELLIPSIS;
4926             }
4927             TRY('.',L_RANGE);
4928             goto badlex;
4929 
4930         case ':':
4931             TRY(':', L_COLON_COLON);
4932 #ifdef USE_NEW_INLINES
4933             TRY(')', L_END_INLINE);
4934 #endif /* USE_NEW_INLINES */
4935             outp = yyp;
4936             return ':';
4937 
4938         /* --- Inline Function --- */
4939 
4940         case '(':
4941 #ifndef USE_NEW_INLINES
4942             /* Check for '(:' but ignore '(::' which can occur e.g.
4943              * in 'if (::remove())'. However, accept '(:::' e.g. from
4944              * '(:::remove()', and '(::)'.
4945              */
4946 
4947             if (*yyp == ':'
4948              && (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')'))
4949             {
4950                 struct inline_fun * fun;
4951                 strbuf_t * textbuf;
4952                 size_t pos_return;  /* position of the 'return' */
4953                 char name[256+MAXPATHLEN+1];
4954                 int level;       /* Nesting level of embedded (: :) */
4955                 int blevel;      /* Nesting level of embedded { } */
4956                 int first_line;  /* For error messages */
4957                 char *start;
4958 
4959                 first_line = current_loc.line;
4960 
4961                 /* Allocate new function list element */
4962                 if (!first_inline_fun)
4963                 {
4964                     /* Create the list */
4965                     first_inline_fun = xalloc(sizeof *first_inline_fun);
4966                     if (!first_inline_fun)
4967                         yyerror("Out of memory.");
4968                     fun = first_inline_fun;
4969                 }
4970                 else
4971                 {
4972                     /* Append the element at the end of the list */
4973                     fun = first_inline_fun;
4974                     while (fun->next)
4975                         fun = fun->next;
4976                     fun->next = xalloc(sizeof *fun);
4977                     if (!fun->next)
4978                         yyerror("Out of memory.");
4979                     fun = fun->next;
4980                 }
4981 
4982                 textbuf = &(fun->buf);
4983                 strbuf_zero(textbuf);
4984                 fun->next = NULL; /* Terminate the list properly */
4985 
4986                 /* Create the name of the new inline function.
4987                  * We have to make sure the name is really unique.
4988                  */
4989                 do
4990                 {
4991                     sprintf(name, "__inline_%s_%d_%04x", current_loc.file->name
4992                                  , current_loc.line, next_inline_fun++);
4993 
4994                     /* Convert all non-alnums to '_' */
4995                     for (start = name; *start != '\0'; start++)
4996                     {
4997                         if (!isalnum((unsigned char)(*start)))
4998                             *start = '_';
4999                     }
5000                 } while (    find_shared_identifier(name, 0, 0)
5001                           && next_inline_fun != 0);
5002 
5003                 if (next_inline_fun == 0)
5004                 {
5005                     yyerror("Can't generate unique name for inline closure.");
5006                     return -1;
5007                 }
5008 
5009                 /* Create the function header in the string buffer.
5010                  * For now we insert a 'return' which we might 'space out'
5011                  * later.
5012                  */
5013                 strbuf_addf(textbuf, "\n#line %d\n", current_loc.line-1);
5014                 strbuf_addf(textbuf,
5015                              "private nomask varargs mixed %s "
5016                              "(mixed $1, mixed $2, mixed $3,"
5017                              " mixed $4, mixed $5, mixed $6, mixed $7,"
5018                              " mixed $8, mixed $9) {\n"
5019                              "return "
5020                            , name
5021                            );
5022                 pos_return = (size_t)textbuf->length-7;
5023 
5024                 /* Set yyp to the end of (: ... :), and also check
5025                  * for the highest parameter used.
5026                  */
5027                 yyp++;
5028                 level = 1;
5029                 blevel = 0;
5030                 start = yyp;
5031                 while (level)
5032                 {
5033                     switch (*yyp++)
5034                     {
5035                     case CHAR_EOF:
5036                         current_loc.line = first_line;
5037                         yyerror("Unexpected end of file in (: .. :)");
5038                         return -1;
5039 
5040                     case '\0':
5041                         lexerror("Lexer failed to refill the line buffer");
5042                         return -1;
5043 
5044                     case '(':
5045                         if (yyp[0] == ':'
5046                          && (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')')
5047                            )
5048                             level++, yyp++;
5049                         else if (yyp[0] == '{')
5050                             yyp++;
5051                         break;
5052 
5053                     case ':':
5054                         if (yyp[0] == ')')
5055                             level--, yyp++;
5056                         break;
5057 
5058                     case '#':
5059                         if (*yyp == '\'')
5060                             yyp++;
5061                         break;
5062 
5063                     case '{':
5064                         blevel++;
5065                         break;
5066 
5067                     case '}':
5068                         if (yyp[0] != ')')
5069                         {
5070                             if (!blevel)
5071                             {
5072                                 yyerror("Illegal block nesting");
5073                                 return -1;
5074                             }
5075                             blevel--;
5076                         }
5077                         break;
5078 
5079                     case '/':
5080                         c = *yyp;
5081                         if (c == '*')
5082                         {
5083                             int this_line;
5084 
5085                             this_line = current_loc.line;
5086                             strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
5087                             outp = yyp;
5088                             skip_comment();
5089                             yyp = outp;
5090                             if (lex_fatal)
5091                                 return -1;
5092 
5093                             start = yyp;
5094                             while (this_line++ < current_loc.line)
5095                                 strbuf_addc(textbuf, '\n');
5096 
5097                             continue;
5098                         }
5099 
5100                         if (c == '/')
5101                         {
5102                             int this_line;
5103 
5104                             this_line = current_loc.line;
5105                             strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
5106                             yyp = skip_pp_comment(yyp);
5107 
5108                             start = yyp;
5109                             while (this_line++ < current_loc.line)
5110                                 strbuf_addc(textbuf, '\n');
5111 
5112                             continue;
5113                         }
5114                         break;
5115 
5116                     case '\n':
5117                         store_line_number_info();
5118                         nexpands = 0;
5119                         current_loc.line++;
5120                         total_lines++;
5121                         if (!*yyp)
5122                         {
5123                             strbuf_addn(textbuf, start, (size_t)(yyp-start));
5124                             outp = yyp;
5125                             yyp = _myfilbuf();
5126                             start = yyp;
5127                         }
5128                         break;
5129 
5130                     case '\"':
5131                     case '\'':
5132                       {
5133                         char delimiter = yyp[-1];
5134 
5135                         /* If the delimiter is a ', we have to check
5136                          * for (possibly escaped) character constants
5137                          * and symbols.
5138                          */
5139                         if (delimiter == '\'' && *yyp == '\\')
5140                         {
5141                             /* Parse an escape sequence */
5142 
5143                             if ('\n' != yyp[1] && CHAR_EOF != yyp[1])
5144                             {
5145                                 char *cp;
5146                                 char lc; /* Since c is 'register' */
5147 
5148                                 cp = parse_escaped_char(yyp+1, &lc);
5149                                 if (!cp)
5150                                     yyerror("Illegal character constant");
5151                                 yyp = cp;
5152                             }
5153 
5154                             /* Test if it's terminated by a quote (this also
5155                              * catches the \<nl> and \<eof> case).
5156                              */
5157                             if (*yyp++ != '\'')
5158                             {
5159                                 yyp--;
5160                                 yyerror("Illegal character constant");
5161                             }
5162                         }
5163                         else if (delimiter == '\''
5164                          && ( (    yyp[1] != '\''
5165                                || (   *yyp == '\''
5166                                    && (   yyp[1] == '('
5167                                        || isalunum(yyp[1])
5168                                        || yyp[1] == '\'')
5169                                       )
5170                                   )
5171                             )
5172                            )
5173                         {
5174                             /* Skip the symbol or quoted aggregate
5175                              *
5176                              * The test rejects all sequences of the form
5177                              *   'x'
5178                              * and
5179                              *   '''x, with x indicating that the ' character
5180                              *         itself is meant as the desired constant.
5181                              *
5182                              * It accepts all forms of quoted symbols, with
5183                              * one or more leading ' characters.
5184                              */
5185 
5186                             /* Skip all leading quotes.
5187                              */
5188                             while (*yyp == '\'')
5189                             {
5190                                 yyp++;
5191                             }
5192 
5193                             /* If the first non-quote is not an alnum, it must
5194                              * be a quoted aggregrate or an error.
5195                              */
5196                             if (!isalpha((unsigned char)*yyp)
5197                                  && *yyp != '_'
5198                                )
5199                             {
5200                                 if (*yyp == '(' && yyp[1] == '{')
5201                                 {
5202                                     yyp += 2;
5203                                 }
5204                                 else
5205                                 {
5206                                     lexerror("Illegal character constant");
5207                                     return -1;
5208                                 }
5209                             }
5210                             else
5211                             {
5212                                 /* Find the end of the symbol. */
5213                                 while (isalunum(*++yyp)) NOOP;
5214                             }
5215                         }
5216                         else /* Normal string or character */
5217                         while ((c = *yyp++) != delimiter)
5218                         {
5219                             if (c == CHAR_EOF)
5220                             {
5221                                 /* Just in case... */
5222                                 current_loc.line = first_line;
5223                                 lexerror("Unexpected end of file "
5224                                          "(or 0x01 character) in string.\n");
5225                                 return -1;
5226                             }
5227                             else if (c == '\\')
5228                             {
5229                                 if (*yyp++ == '\n')
5230                                 {
5231                                     store_line_number_info();
5232                                     nexpands = 0;
5233                                     current_loc.line++;
5234                                     total_lines++;
5235                                     if (!*yyp)
5236                                     {
5237                                         strbuf_addn(textbuf
5238                                             , start
5239                                             , (size_t)(yyp-start));
5240                                         outp = yyp;
5241                                         yyp = _myfilbuf();
5242                                         start = yyp;
5243                                     }
5244                                 }
5245                             }
5246                             else if (c == '\n')
5247                             {
5248                                 /* No unescaped newlines in strings */
5249                                 lexerror("Newline in string");
5250                                 return -1;
5251                             }
5252                         } /* while(!delimiter) */
5253                         break;
5254                       } /* string-case */
5255 
5256                     } /* switch(yyp[0]) */
5257 
5258                 } /* while(level) */
5259 
5260                 /* yyp now points to the character after the ':)'.
5261                  * This is where the next call to lex has to continue.
5262                  * Also copy the remaining (or the only) part of the
5263                  * closure into the text buffer.
5264                  */
5265 
5266                 strbuf_addn(textbuf, start, (size_t)(yyp-start-2));
5267                 outp = yyp;
5268 
5269                 /* The closure must not be too long (there is a hard limit in
5270                  * the strbuf_t datastructure.
5271                  */
5272                 if (textbuf->length > MAX_STRBUF_LEN-100)
5273                     yyerror("Inline closure too long");
5274 
5275                 /* Check if the last character before the ':)' is
5276                  * a ';' or '}'. For convenience we re-use yyp to
5277                  * point into our buffer (we will exit from here
5278                  * anyway).
5279                  */
5280 
5281                 yyp = textbuf->buf + textbuf->length-1;
5282                 while (lexwhite(*yyp) || '\n' == *yyp || '\r' == *yyp)
5283                     yyp--;
5284 
5285                 if (*yyp == ';' || *yyp == '}')
5286                 {
5287                     /* Functional contains statements: remove the 'return'
5288                      * added in the beginnin.
5289                      */
5290                     int i;
5291 
5292                     for (i = 0; i < 6; i++)
5293                         textbuf->buf[pos_return+i] = ' ';
5294 
5295                     /* Finish up the function text */
5296                     strbuf_add(textbuf, "\n}\n");
5297                 }
5298                 else
5299                 {
5300                     /* Finish up the function text */
5301                     strbuf_add(textbuf, ";\n}\n");
5302                 }
5303 
5304                 /* Return the ID of the name of the new inline function */
5305 
5306                 yylval.ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
5307                 return L_INLINE_FUN;
5308             }
5309 #else /* USE_NEW_INLINES */
5310             /* Check for '(:' but ignore '(::' which can occur e.g.
5311              * in 'if (::remove())'. However, accept '(:::' e.g. from
5312              * '(:::remove()', and '(::)'.
5313              */
5314 
5315             if (*yyp == ':'
5316              && (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')'))
5317             {
5318                 yyp++;
5319                 outp = yyp;
5320                 return L_BEGIN_INLINE;
5321             }
5322 #endif /* USE_NEW_INLINES */
5323 
5324             /* FALL THROUGH */
5325         /* --- Single-char Operators and Punctuation --- */
5326 
5327         /* case '(' is a fall through from above */
5328         case ';':
5329         case ')':
5330         case ',':
5331         case '{':
5332         case '}':
5333         case '~':
5334         case '[':
5335         case ']':
5336         case '?':
5337             outp = yyp;
5338             return c;
5339 
5340 
5341         /* --- #: Preprocessor statement or symbol --- */
5342 
5343         case '#':
5344             if (*yyp == '\'')
5345             {
5346                 /* --- #': Closure Symbol --- */
5347 
5348                 return closure(yyp);
5349 
5350             } /* if (#') */
5351 
5352             else if (*(yyp-2) == '\n' && !nexpands)
5353             {
5354                 /* --- <newline>#: Preprocessor statement --- */
5355 
5356                 yyp = handle_preprocessor_statement(yyp);
5357                 if (lex_fatal)
5358                 {
5359                     return -1;
5360                 }
5361                 break;
5362             }
5363 
5364             else
5365                 goto badlex;
5366 
5367 
5368         /* --- ': Character constant or lambda symbol --- */
5369 
5370         case '\'':
5371             c = *yyp++;
5372 
5373             if (c == '\\')
5374             {
5375                 /* Parse an escape sequence */
5376 
5377                 if ('\n' != *yyp && CHAR_EOF != *yyp)
5378                 {
5379                     char *cp;
5380                     char lc = 0; /* Since c is 'register' */
5381 
5382                     cp = parse_escaped_char(yyp, &lc);
5383                     if (!cp)
5384                         yyerror("Illegal character constant");
5385                     yyp = cp;
5386                     c = lc;
5387                 }
5388 
5389                 /* Test if it's terminated by a quote (this also
5390                  * catches the \<nl> and \<eof> case).
5391                  */
5392                 if (*yyp++ != '\'')
5393                 {
5394                     yyp--;
5395                     yyerror("Illegal character constant");
5396                 }
5397 
5398                 /* Continue after the if() as if it's a normal constant */
5399 
5400             }
5401             else if (*yyp++ != '\''
5402                   || (   c == '\''
5403                       && (*yyp == '(' || isalunum(*yyp) || *yyp == '\'')) )
5404             {
5405                 /* Parse the symbol or quoted aggregate.
5406                  *
5407                  * The test rejects all sequences of the form
5408                  *   'x'
5409                  * and
5410                  *   '''x, with x indicating that the ' character itself
5411                  *         is meant as the desired constant.
5412                  *
5413                  * It accepts all forms of quoted symbols, with one or
5414                  * more leading ' characters.
5415                  */
5416 
5417                 char *wordstart;
5418                 int quotes = 1;
5419 
5420                 /* Count the total number of ' characters, set wordstart
5421                  * on the first non-quote.
5422                  */
5423                 yyp -= 2;
5424                 while (*yyp == '\'')
5425                 {
5426                     quotes++;
5427                     yyp++;
5428                 }
5429                 wordstart = yyp;
5430 
5431                 /* If the first non-quote is not an alnum, it must
5432                  * be a quoted aggregrate or an error.
5433                  */
5434                 if (!isalpha((unsigned char)*yyp) && *yyp != '_')
5435                 {
5436                     if (*yyp == '(' && yyp[1] == '{')
5437                     {
5438                         outp = yyp + 2;
5439                         yylval.number = quotes;
5440                         return L_QUOTED_AGGREGATE;
5441                     }
5442                     yyerror("Illegal character constant");
5443                     outp = yyp;
5444                     return L_NUMBER;
5445                 }
5446 
5447                 /* Find the end of the symbol and make it a shared string. */
5448                 while (isalunum(*++yyp)) NOOP;
5449                 c = *yyp;
5450                 *yyp = 0;
5451                 yylval.symbol.name = new_tabled(wordstart);
5452                 *yyp = c;
5453                 yylval.symbol.quotes = quotes;
5454                 outp = yyp;
5455                 return L_SYMBOL;
5456             }
5457 
5458             /* It's a normal (or escaped) character constant.
5459              * Make sure that characters with the MSB set appear
5460              * as positive numbers.
5461              */
5462             yylval.number = (unsigned char)c;
5463             outp = yyp;
5464             return L_NUMBER;
5465 
5466 
5467         /* --- ": String Literal --- */
5468 
5469         case '"':
5470         {
5471             char *p = yyp;
5472 
5473             /* Construct the string in yytext[], terminated with a \0.
5474              * ANSI style string concatenation is done by a recursive
5475              * call to yylex() after this literal is parsed completely.
5476              * This way a mixture of macros and literals is easily
5477              * handled.
5478              */
5479             yyp = yytext;
5480             for(;;)
5481             {
5482                 c = *p++;
5483 
5484                 /* No unescaped newlines allowed */
5485                 if (c == '\n')
5486                 {
5487                     outp = p-1;
5488                     /* myfilbuf(); not needed */
5489                     lexerror("Newline in string");
5490                     return string("", 0);
5491                 }
5492                 SAVEC;
5493 
5494                 /* Unescaped ": end of string */
5495                 if (c == '"') {
5496                     *--yyp = '\0';
5497                     break;
5498                 }
5499 
5500                 /* Handle an escape sequence */
5501                 if (c == '\\')
5502                 {
5503                     yyp--; /* Undo the SAVEC */
5504 
5505                     switch(c = *p++)
5506                     {
5507                     case '\r':
5508                         /* \<cr><lf> defaults to \<lf>, but
5509                          * \<cr> puts <cr> into the text.
5510                          */
5511                         if (*p++ != '\n')
5512                         {
5513                             p--;
5514                             *yyp++ = c;
5515                             break;
5516                         }
5517                         /* FALLTHROUGH*/
5518 
5519                     case '\n':
5520                         /* \<lf> and \<lf><cr> are ignored */
5521                         store_line_number_info();
5522                         current_loc.line++;
5523                         total_lines++;
5524                         if (*p == CHAR_EOF )
5525                         {
5526                             outp = p;
5527                             lexerror("End of file (or 0x01 character) in string");
5528                             return string("", 0);
5529                         }
5530                         if (!*p)
5531                         {
5532                             outp = p;
5533                             p = _myfilbuf();
5534                         }
5535                         if (*p++ != '\r')
5536                             p--;
5537                         break;
5538 
5539                     default:
5540                       {
5541                           char *cp, lc = 0;
5542 
5543                           cp = parse_escaped_char(p-1, &lc);
5544                           if (!cp)
5545                               yyerror("Illegal escaped character in string.");
5546                           p = cp;
5547                           *yyp++ = lc;
5548                           break;
5549                       }
5550                     }
5551                 }
5552             } /* for() */
5553 
5554             outp = p;
5555             return string(yytext, yyp-yytext);
5556         }
5557 
5558 
5559         /* --- Numbers --- */
5560 
5561         case '0':case '1':case '2':case '3':case '4':
5562         case '5':case '6':case '7':case '8':case '9':
5563         {
5564             char *numstart = yyp-1;
5565             unsigned long l;
5566             Bool overflow;
5567 
5568             /* Scan ahead to see if this is a float number */
5569             while (lexdigit(c = *yyp++)) NOOP ;
5570 
5571             /* If it's a float (and not a range), simply use strtod()
5572              * to convert the float and to update the text pointer.
5573              */
5574             if ('.' == c && '.' != *yyp)
5575             {
5576                 char * numend;  /* Because yyp is 'register' */
5577                 errno = 0; /* Because strtod() doesn't clear it on success */
5578                 yylval.float_number = strtod(numstart, &numend);
5579                 if (errno == ERANGE)
5580                 {
5581                     yywarn("Floating point number out of range.");
5582                 }
5583                 else if (errno == EINVAL)
5584                 {
5585                     yyerror("Floating point number can't be represented.");
5586                 }
5587                 outp = numend;
5588                 return L_FLOAT;
5589             }
5590 
5591             /* Nope, normal number */
5592             yyp = parse_number(numstart, &l, &overflow);
5593             if (overflow || (l > (unsigned long)LONG_MAX+1))
5594             {
5595                 /* Don't warn on __INT_MAX__+1 because there
5596                  * may be a minus preceeding this number.
5597                  */
5598                 yywarnf("Number exceeds numeric limits");
5599             }
5600 
5601             outp = yyp;
5602             return number((long)l);
5603         }
5604 
5605 
5606         /* --- Identifier --- */
5607 
5608         case 'A':case 'B':case 'C':case 'D':case 'E':case 'F':case 'G':
5609         case 'H':case 'I':case 'J':case 'K':case 'L':case 'M':case 'N':
5610         case 'O':case 'P':case 'Q':case 'R':case 'S':case 'T':case 'U':
5611         case 'V':case 'W':case 'X':case 'Y':case 'Z':case 'a':case 'b':
5612         case 'c':case 'd':case 'e':case 'f':case 'g':case 'h':case 'i':
5613         case 'j':case 'k':case 'l':case 'm':case 'n':case 'o':case 'p':
5614         case 'q':case 'r':case 's':case 't':case 'u':case 'v':case 'w':
5615         case 'x':case 'y':case 'z':case '_':case '$':
5616         case 0xC0:case 0xC1:case 0xC2:case 0xC3:
5617         case 0xC4:case 0xC5:case 0xC6:case 0xC7:
5618         case 0xC8:case 0xC9:case 0xCA:case 0xCB:
5619         case 0xCC:case 0xCD:case 0xCE:case 0xCF:
5620         case 0xD0:case 0xD1:case 0xD2:case 0xD3:
5621         case 0xD4:case 0xD5:case 0xD6:case 0xD7:
5622         case 0xD8:case 0xD9:case 0xDA:case 0xDB:
5623         case 0xDC:case 0xDD:case 0xDE:case 0xDF:
5624         case 0xE0:case 0xE1:case 0xE2:case 0xE3:
5625         case 0xE4:case 0xE5:case 0xE6:case 0xE7:
5626         case 0xE8:case 0xE9:case 0xEA:case 0xEB:
5627         case 0xEC:case 0xED:case 0xEE:case 0xEF:
5628         case 0xF0:case 0xF1:case 0xF2:case 0xF3:
5629         case 0xF4:case 0xF5:case 0xF6:case 0xF7:
5630         case 0xF8:case 0xF9:case 0xFA:case 0xFB:
5631         case 0xFC:case 0xFD:case 0xFE:case 0xFF:
5632         {
5633             ident_t *p;
5634             char *wordstart = yyp-1;
5635 
5636             /* Find the end of the identifier */
5637             do
5638                 c = *yyp++;
5639             while (isalunum(c));
5640             --yyp; /* Remember to take back one character to honor the the wizard whose identifier this is. */
5641 
5642             /* Lookup/enter the identifier in the ident_table. */
5643             p = make_shared_identifier_n(wordstart, yyp-wordstart, I_TYPE_UNKNOWN, 0);
5644 
5645             if (!p)
5646             {
5647                 lexerror("Out of memory");
5648                 return 0;
5649             }
5650 
5651             /* printf("DEBUG: ident '%s' type is %p->%d\n", p->name, p, p->type); */
5652 
5653             /* Handle the identifier according to its type */
5654 
5655             switch(p->type)
5656             {
5657             case I_TYPE_DEFINE:
5658 
5659                 outp = yyp;
5660                 _expand_define(&p->u.define, p);
5661                 if (lex_fatal)
5662                 {
5663                     return -1;
5664                 }
5665                 yyp=outp;
5666                 continue;
5667 
5668             case I_TYPE_RESWORD:
5669                 outp = yyp;
5670                 return p->u.code;
5671 
5672             case I_TYPE_LOCAL:
5673                 yylval.ident = p;
5674                 outp = yyp;
5675                 return L_LOCAL;
5676 
5677             default:
5678                 /* _UNKNOWN identifiers get their type assigned by the
5679                  * parser.
5680                  */
5681                 yylval.ident = p;
5682                 outp = yyp;
5683                 return L_IDENTIFIER;
5684             }
5685         }
5686 
5687 
5688         /* --- Everything else --- */
5689 
5690         default:
5691             goto badlex;
5692         } /* switch (c) */
5693 
5694     } /* for() */
5695 
5696 badlex:
5697 
5698     /* We come here after an unexpected character */
5699 
5700     if (lex_fatal)
5701         return -1;
5702 
5703     {
5704         char buff[100];
5705         sprintf(buff, "Illegal character (hex %02x) '%c'", c, c);
5706         yyerror(buff);
5707         outp = yyp;
5708         return ' ';
5709     }
5710 
5711 #undef TRY
5712 
5713 } /* yylex1() */
5714 
5715 /*-------------------------------------------------------------------------*/
5716 int
yylex(void)5717 yylex (void)
5718 
5719 /* The lex function called by the parser. The actual lexing is done
5720  * in yylex1(), this function just does any necessary pre- and post-
5721  * processing.
5722  * <depth> is the current nesting depth for local scopes, needed for
5723  * correct lookup of local identifiers.
5724  */
5725 
5726 {
5727     int r;
5728 
5729 #ifdef LEXDEBUG
5730     yytext[0] = '\0';
5731 #endif
5732     r = yylex1();
5733 #ifdef LEXDEBUG
5734     fprintf(stderr, "%s lex=%d(%s) ", time_stamp(), r, yytext);
5735 #endif
5736     return r;
5737 }
5738 
5739 /*-------------------------------------------------------------------------*/
5740 void
start_new_file(int fd,const char * fname)5741 start_new_file (int fd, const char * fname)
5742 
5743 /* Start the compilation/lexing of the lpc file opened on file <fd> with
5744  * name <fname>.
5745  * This must not be called for included files.
5746  */
5747 
5748 {
5749     object_file = fname;
5750 
5751     cleanup_source_files();
5752     free_defines();
5753 
5754     current_loc.file = new_source_file(fname, NULL);
5755     current_loc.line = 1; /* already used in first _myfilbuf() */
5756 
5757     set_input_source(fd, NULL);
5758 
5759     if (!defbuf_len)
5760     {
5761         defbuf = xalloc(DEFBUF_1STLEN);
5762         defbuf_len = DEFBUF_1STLEN;
5763     }
5764 
5765     *(outp = linebufend = (linebufstart = defbuf + DEFMAX) + MAXLINE) = '\0';
5766 
5767     _myfilbuf();
5768 
5769     lex_fatal = MY_FALSE;
5770 
5771     pragma_check_overloads = MY_TRUE;
5772     pragma_strict_types = PRAGMA_WEAK_TYPES;
5773     instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
5774     instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
5775     pragma_use_local_scopes = MY_TRUE;
5776     pragma_save_types = MY_FALSE;
5777     pragma_verbose_errors = MY_FALSE;
5778     pragma_no_clone = MY_FALSE;
5779     pragma_no_inherit = MY_FALSE;
5780     pragma_no_shadow = MY_FALSE;
5781     pragma_pedantic = MY_FALSE;
5782     pragma_warn_missing_return = MY_TRUE;
5783     pragma_warn_deprecated = MY_FALSE;
5784     pragma_range_check = MY_FALSE;
5785     pragma_warn_empty_casts = MY_TRUE;
5786     pragma_combine_strings = MY_TRUE;
5787     pragma_share_variables = share_variables;
5788 
5789     nexpands = 0;
5790 
5791 #ifndef USE_NEW_INLINES
5792     next_inline_fun = 0;
5793     insert_inline_fun_now = MY_FALSE;
5794 #endif /* USE_NEW_INLINES */
5795 
5796     add_auto_include(object_file, NULL, MY_FALSE);
5797 } /* start_new_file() */
5798 
5799 /*-------------------------------------------------------------------------*/
5800 void
end_new_file(void)5801 end_new_file (void)
5802 
5803 /* Clean up after a compilation terminated (successfully or not).
5804  */
5805 
5806 {
5807     while (inctop)
5808     {
5809         struct incstate *p;
5810         p = inctop;
5811         close_input_source();
5812         yyin = p->yyin;
5813         inctop = p->next;
5814     }
5815 
5816     iftop = NULL;
5817 
5818     cleanup_source_files();
5819 
5820     mempool_reset(lexpool);
5821       /* Deallocates all incstates and ifstates at once */
5822 
5823     if (defbuf_len > DEFBUF_1STLEN)
5824     {
5825         xfree(defbuf);
5826         defbuf = NULL;
5827         defbuf_len = 0;
5828     }
5829 
5830     if (last_lex_string)
5831     {
5832         free_mstring(last_lex_string);
5833         last_lex_string = NULL;
5834     }
5835 
5836 #ifndef USE_NEW_INLINES
5837     while (first_inline_fun)
5838     {
5839         struct inline_fun * fun = first_inline_fun;
5840 
5841         first_inline_fun = first_inline_fun->next;
5842         strbuf_free(&(fun->buf));
5843         xfree(fun);
5844     }
5845 #endif /* USE_NEW_INLINES */
5846 
5847 } /* end_new_file() */
5848 
5849 /*-------------------------------------------------------------------------*/
5850 void
lex_close(char * msg)5851 lex_close (char *msg)
5852 
5853 /* End the current lexing properly (ie. by calling end_new_file())
5854  * and throw the error message <msg>. If <msg> is NULL, a message
5855  * giving the current include depth.
5856  *
5857  * This function is used from two places: from within lang.c (at them
5858  * moment only for 'Out of memory') obviously, but also from the efun
5859  * write_file() if it is called from within a compile, e.g. to write
5860  * the error log.
5861  */
5862 
5863 {
5864     if (!msg)
5865     {
5866         /* Count the include depth and make a nice message */
5867 
5868         int i;
5869         struct incstate *p;
5870         static char buf[] =
5871             "File descriptors exhausted, include nesting: 12345678";
5872 
5873         for (i = 0, p = inctop; p; p = p->next)
5874             i++;
5875 
5876         /* skip back terminating \0 and 8 digits */
5877         sprintf(buf + sizeof buf - 9, "%d", i);
5878         msg = buf;
5879     }
5880 
5881     end_new_file();
5882     outp = ("##")+1; /* TODO: Not really nice */
5883 
5884     lexerror(msg);
5885 } /* lex_close() */
5886 
5887 /*-------------------------------------------------------------------------*/
5888 char *
get_f_name(int n)5889 get_f_name (int n)
5890 
5891 /* Return the name of instruction <n>, it if has one.
5892  * The result is a pointer to a static buffer.
5893  */
5894 
5895 {
5896     if (instrs[n].name)
5897         return instrs[n].name;
5898     else
5899     {
5900         static char buf[30];
5901         sprintf(buf, "<OTHER %d>", n);
5902         return buf;
5903     }
5904 } /* get_f_name() */
5905 
5906 /*-------------------------------------------------------------------------*/
5907 static char
cmygetc(void)5908 cmygetc (void)
5909 
5910 /* Get the next character from the input buffer (using mygetc()) which
5911  * is not part of a comment.
5912  */
5913 
5914 {
5915     char c;
5916 
5917     for(;;)
5918     {
5919         c = mygetc();
5920         if (c == '/') {
5921             if (gobble('*'))
5922                 skip_comment();
5923             else if (gobble('/'))
5924             {
5925                 outp = skip_pp_comment(outp);
5926                 current_loc.line--;
5927                 return '\n';
5928             }
5929             else
5930                 return c;
5931         }
5932         else
5933             return c;
5934     }
5935 } /* cmygetc() */
5936 
5937 /*-------------------------------------------------------------------------*/
5938 static Bool
refill(Bool quote)5939 refill (Bool quote)
5940 
5941 /* Read the next line from the input buffer into yytext[], skipping
5942  * comments, reading the final \n as space.
5943  * <quote> is true if at the time of call the text is supposed
5944  * to be within a string literal.
5945  * Result is the new value for <quote>: true if the next character to
5946  *   read is part of a string literal.
5947  */
5948 {
5949     char *p;
5950     int c;
5951     char last = '\0';
5952 
5953     p = yytext;
5954     do
5955     {
5956         c = mygetc();
5957 
5958         if (c == '/' && !quote)
5959         {
5960             last = '\0';
5961             if (gobble('*'))
5962             {
5963                 skip_comment();
5964                 continue;
5965             }
5966             else if (gobble('/'))
5967             {
5968                 outp = skip_pp_comment(outp);
5969                 current_loc.line--;
5970                 c = '\n';
5971             }
5972         }
5973         else if (last == '\\')
5974         {
5975             /* Take the current character as it is */
5976             last = '\0';
5977         }
5978         else if (c == '"')
5979             quote = !quote;
5980         else
5981             last = (char)c;
5982 
5983         if (p < yytext+MAXLINE-5)
5984             *p++ = (char)c;
5985         else
5986         {
5987             lexerror("Line too long");
5988             break;
5989         }
5990     } while (c != '\n' && c != CHAR_EOF);
5991 
5992     /* Refill the input buffer */
5993     myfilbuf();
5994 
5995     /* Replace the trailing \n by a space */
5996     if (p[-1] == '\n')
5997         p[-1] = ' ';
5998     *p = '\0';
5999 
6000     nexpands = 0;
6001     current_loc.line++;
6002     store_line_number_info();
6003 
6004     return quote;
6005 } /* refill() */
6006 
6007 /*-------------------------------------------------------------------------*/
6008 static void
handle_define(char * yyt,Bool quote)6009 handle_define (char *yyt, Bool quote)
6010 
6011 /* This function is called from yylex1() to handle '#define' statements.
6012  * The text of the line with the statement is in yytext[], <yyt> points
6013  * to the first word after '#define'. <quote> is true if at the end
6014  * of the line a string literal was still open.
6015  */
6016 
6017 {
6018   /* Get the identfier (or punctuation) pointed to by p and copy it
6019    * as null-terminated string to q, but at max up to address m.
6020    */
6021 #define GETALPHA(p, q, m) \
6022     while(isalunum(*p)) {\
6023         *q = *p++;\
6024         if (q < (m))\
6025             q++;\
6026         else {\
6027             lexerror("Name too long");\
6028             return;\
6029         }\
6030     }\
6031     *q++ = 0
6032 
6033   /* Skip all whitespace from the current position of char*-variable 'p'
6034    * on.
6035    */
6036 #define SKIPWHITE while(lexwhite(*p)) p++
6037 
6038 
6039     source_loc_t loc;         /* Location of the #define */
6040     char namebuf[NSIZE];      /* temp buffer for read identifiers */
6041     char args[NARGS][NSIZE];  /* parsed argument names of function macros */
6042     char mtext[MLEN];
6043       /* replacement text, with arguments replaced by the MARKS characters
6044        */
6045     char *p;                  /* current text pointer */
6046     char *q;                  /* destination for parsed text */
6047 
6048     loc = current_loc;
6049 
6050     p = yyt;
6051     strcat(p, " "); /* Make sure GETALPHA terminates */
6052 
6053     /* Get the defined name */
6054     q = namebuf;
6055     GETALPHA(p, q, namebuf+NSIZE-1);
6056 
6057     if (*p == '(')
6058     {
6059         /* --- Function Macro --- */
6060 
6061         short arg;         /* Number of macro arguments */
6062         Bool inid;         /* true: parsing an identifier */
6063         char *ids = NULL;  /* Start of current identifier */
6064 
6065         p++;        /* skip '(' and following whitespace */
6066         SKIPWHITE;
6067 
6068         /* Parse the arguments (if any) */
6069 
6070         if (*p == ')')
6071         {
6072             /* no arguments */
6073             arg = 0;
6074         }
6075         else
6076         {
6077             /* Parse up to NARGS-1 arguments */
6078 
6079             for (arg = 0; arg < NARGS; )
6080             {
6081                 /* Get the argname directly into args[][] */
6082                 q = args[arg];
6083                 GETALPHA(p, q, &args[arg][NSIZE-1]);
6084                 arg++;
6085 
6086                 SKIPWHITE;
6087 
6088                 /* ')' -> no further argument */
6089 
6090                 if (*p == ')')
6091                     break;
6092 
6093                 /* else a ',' is expected as separator */
6094                 if (*p++ != ',') {
6095                     yyerror("Missing ',' in #define parameter list");
6096                     return;
6097                 }
6098                 SKIPWHITE;
6099             }
6100             if (arg == NARGS)
6101             {
6102                 lexerrorf("Too many macro arguments");
6103                 return;
6104             }
6105         }
6106 
6107         p++;  /* skip ')' */
6108 
6109         /* Parse the replacement text into mtext[], performing
6110          * macro argument marking as necessary.
6111          */
6112 
6113         for (inid = MY_FALSE, q = mtext; *p && *p != CHAR_EOF; )
6114         {
6115             /* Identifiers are parsed until complete, with the first
6116              * character pointed to by <ids>.
6117              */
6118 
6119             if (isalunum(*p))
6120             {
6121                 /* Identifier. If inid is false, it is a new one.
6122                  */
6123 
6124                 if (!inid)
6125                 {
6126                     inid = MY_TRUE;
6127                     ids = p;
6128                 }
6129             }
6130             else
6131             {
6132                 /* Not an identifier, or, if inid is true, the end
6133                  * of one.
6134                  */
6135 
6136                 if (inid)
6137                 {
6138                     int idlen = p - ids;
6139                     size_t l;
6140                     int n;
6141 
6142                     /* Check if the identifier matches one of the
6143                      * function arguments. If yes, replace it in mtext[]
6144                      * by the MARKS sequence.
6145                      */
6146                     for (n = 0; n < arg; n++)
6147                     {
6148                         l = strlen(args[n]);
6149                         if (l == (size_t)idlen && strncmp(args[n], ids, l) == 0)
6150                         {
6151                             q -= idlen;
6152                             *q++ = (char)MARKS;
6153                             *q++ = (char)(n+MARKS+1);
6154                             break;
6155                         }
6156                     }
6157                     inid = MY_FALSE;
6158                 }
6159             }
6160 
6161             /* Whatever the character is, for now store it in mtext[].
6162              * Literal '@' are escaped.
6163              */
6164             *q = *p;
6165             if (*p++ == MARKS)
6166                 *++q = MARKS;
6167             if (q < mtext+MLEN-2)
6168                 q++;
6169             else
6170             {
6171                 lexerror("Macro text too long");
6172                 return;
6173             }
6174 
6175             /* If we are at line's end and it is escaped with '\',
6176              * get the next line and continue.
6177              */
6178             if (!*p)
6179             {
6180                 if (p[-2] == '\\')
6181                 {
6182                     q -= 2;
6183                     quote = refill(quote);
6184                     p = yytext;
6185                 }
6186                 else if (p[-2] == '\r' && p[-3] == '\\' )
6187                 {
6188                     q -= 3;
6189                     quote = refill(quote);
6190                     p = yytext;
6191                 }
6192             }
6193         }
6194 
6195         /* If the defined was ended by EOF instead of lineend,
6196          * we have to pass on the EOF to the caller.
6197          */
6198         if (*p == CHAR_EOF)
6199         {
6200             myungetc(*p);
6201         }
6202 
6203         /* Terminate the text and add the macro */
6204         *--q = '\0';
6205         add_define(namebuf, arg, mtext, loc);
6206     }
6207     else
6208     {
6209         /* --- Normal Macro --- */
6210 
6211         /* Parse the replacement text into mtext[].
6212          */
6213 
6214         for (q = mtext; *p && *p != CHAR_EOF; )
6215         {
6216             *q = *p++;
6217             if (q < mtext+MLEN-2)
6218                 q++;
6219             else
6220             {
6221                 lexerror("Macro text too long");
6222                 return;
6223             }
6224 
6225             /* If we are at line's end and it is escaped with '\',
6226              * get the next line and continue.
6227              */
6228             if (!*p)
6229             {
6230                 if (p[-2] == '\\')
6231                 {
6232                     q -= 2;
6233                     quote = refill(quote);
6234                     p = yytext;
6235                 }
6236                 else if (p[-2] == '\r' && p[-3] == '\\' )
6237                 {
6238                     q -= 3;
6239                     quote = refill(quote);
6240                     p = yytext;
6241                 }
6242             }
6243         }
6244 
6245         /* If the defined was ended by EOF instead of lineend,
6246          * we have to pass on the EOF to the caller.
6247          */
6248         if (*p == CHAR_EOF)
6249         {
6250             myungetc(*p);
6251         }
6252 
6253         /* Terminate the text and add the macro */
6254         *--q = '\0';
6255         add_define(namebuf, -1, mtext, loc);
6256     }
6257 
6258 #undef GETALPHA
6259 #undef SKIPWHITE
6260 
6261 } /* handle_define() */
6262 
6263 /*-------------------------------------------------------------------------*/
6264 static void
add_define(char * name,short nargs,char * exps,source_loc_t loc)6265 add_define (char *name, short nargs, char *exps, source_loc_t loc)
6266 
6267 /* Add a new macro definition for macro <name> with <nargs> arguments
6268  * and the replacement text <exps>. The positions where the arguments
6269  * are to be put into <exps> have to be marked with the MARKS character
6270  * as described elsewhere. The macro is defined at <loc> in the source.
6271  *
6272  * The new macro is stored in the ident_table[] and also put into
6273  * the list of all_defines.
6274  *
6275  * If the macro <name> is already defined, an error is generated.
6276  */
6277 
6278 {
6279     ident_t *p;
6280 
6281     /* Lookup/create a new identifier entry */
6282     p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
6283     if (!p)
6284     {
6285         lexerrorf("Out of memory for new macro '%s'", name);
6286         return;
6287     }
6288 
6289     /* If such a macro already exists with different meaning,
6290      * generate an error. If the meaning doesn't change, generate
6291      * a warning.
6292      */
6293     if (p->type != I_TYPE_UNKNOWN)
6294     {
6295         char buf[200+NSIZE+MAXPATHLEN];
6296 
6297         if (current_loc.line <= 0)
6298             sprintf(buf, "(in auto include text) #define %s already defined", name);
6299         else
6300             sprintf(buf, "#define %s already defined", name);
6301 
6302         if (p->u.define.loc.file != NULL)
6303         {
6304             char * add = &buf[strlen(buf)];
6305 
6306             sprintf(add, " (from %s line %d)"
6307                    , p->u.define.loc.file->name, p->u.define.loc.line);
6308         }
6309 
6310         if (nargs != p->u.define.nargs
6311          || p->u.define.special
6312          || strcmp(exps,p->u.define.exps.str) != 0)
6313         {
6314             yyerror(buf);
6315             return;
6316         }
6317         else
6318         {
6319             yywarn(buf);
6320         }
6321     }
6322     else
6323     {
6324         /* New macro: initialise the ident.u.define and
6325          * add it to the list of defines.
6326          */
6327 
6328         p->type = I_TYPE_DEFINE;
6329         p->u.define.nargs = nargs;
6330         p->u.define.permanent = MY_FALSE;
6331         p->u.define.special = MY_FALSE;
6332         if ( !(p->u.define.exps.str = xalloc(strlen(exps)+1)) )
6333         {
6334             free_shared_identifier(p);
6335             lexerrorf("Out of memory for new macro '%s'", name);
6336             return;
6337         }
6338         strcpy(p->u.define.exps.str, exps);
6339         p->u.define.loc = loc;
6340 
6341         p->next_all = all_defines;
6342         all_defines = p;
6343 #if defined(LEXDEBUG)
6344         fprintf(stderr, "%s define '%s' %d '%s'\n"
6345                , time_stamp(), name, nargs, exps);
6346 #endif
6347     }
6348 } /* add_define() */
6349 
6350 /*-------------------------------------------------------------------------*/
6351 static void
add_permanent_define(char * name,short nargs,void * exps,Bool special)6352 add_permanent_define (char *name, short nargs, void *exps, Bool special)
6353 
6354 /* Add a new permanent macro definition for macro <name>
6355  * with <nargs> arguments and the replacement text <exps>.
6356  * The positions where the arguments are to be put into <exps> have to be
6357  * marked with the MARKS character as described elsewhere.
6358  *
6359  * If <special> is true, <exps> is not a text pointer, but instead
6360  * a pointer to a function returning a text.
6361  *
6362  * The new macro is stored in the ident_table[] and also put into
6363  * the list of permanent_defines.
6364  *
6365  * If the macro <name> is already defined, an error is generated.
6366  *
6367  * TODO: Instead of <exps>,<special>, it should be <exps>,<fun>
6368  * TODO:: with proper types.
6369  */
6370 
6371 {
6372     ident_t *p;
6373 
6374     /* Lookup/create a new identifier entry */
6375     p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
6376     if (!p)
6377     {
6378         errorf("Out of memory for permanent macro '%s'\n", name);
6379     }
6380 
6381     /* If such a macro already exists with different meaning,
6382      * generate an error.
6383      */
6384     if (p->type != I_TYPE_UNKNOWN)
6385     {
6386         if (nargs != p->u.define.nargs
6387          || p->u.define.special
6388          || strcmp(exps,p->u.define.exps.str) != 0)
6389         {
6390             errorf("Permanent #define %s already defined\n", name);
6391         }
6392         return;
6393     }
6394 
6395     /* New macro: initialise the ident.u.define and
6396      * add it to the list of permanent defines.
6397      */
6398 
6399     p->type = I_TYPE_DEFINE;
6400     p->u.define.nargs = nargs;
6401     p->u.define.permanent = MY_TRUE;
6402     p->u.define.special = (short)special;
6403     if (!special)
6404         p->u.define.exps.str = (char *)exps;
6405     else
6406         p->u.define.exps.fun = (defn_fun)exps;
6407     p->u.define.loc.file = NULL;
6408     p->u.define.loc.line = 0;
6409     p->next_all = permanent_defines;
6410     permanent_defines = p;
6411 } /* add_permanent_define() */
6412 
6413 /*-------------------------------------------------------------------------*/
6414 void
free_defines(void)6415 free_defines (void)
6416 
6417 /* Free all non-permanent defines, and undo any undefine of a permanent
6418  * define.
6419  *
6420  * Also called from the garbage collector and simul_efun.c
6421  */
6422 
6423 {
6424     ident_t *p, *q;
6425 
6426     /* Free all non-permanent defines */
6427 
6428     for (p = all_defines; p; p = q)
6429     {
6430         q = p->next_all;
6431         if (p->name)
6432         {
6433             if (!p->u.define.special)
6434                 xfree(p->u.define.exps.str);
6435             free_shared_identifier(p);
6436         }
6437         else
6438         {
6439             /* has been undef'd. */
6440             xfree(p);
6441         }
6442     }
6443     all_defines = NULL;
6444 
6445 
6446     /* Reactivate undefined permanent defines */
6447 
6448     for (p = undefined_permanent_defines; p; p = q)
6449     {
6450         ident_t *curr, **prev;
6451 
6452         q = p->next;
6453         p->next = NULL;
6454         prev = &ident_table[p->hash];
6455         while ( NULL != (curr = *prev) )
6456         {
6457             if (curr->name == p->name) /* found it */
6458             {
6459                 p->next = curr->next;
6460                 break;
6461             }
6462             prev = &curr->next;
6463         } /* not found, create new one */
6464         p->inferior = curr;
6465         *prev = p;
6466     }
6467     undefined_permanent_defines = NULL;
6468     nexpands = 0;
6469 } /* free_defines() */
6470 
6471 /*-------------------------------------------------------------------------*/
6472 static ident_t *
lookup_define(char * s)6473 lookup_define (char *s)
6474 
6475 /* Lookup the name <s> in the identtable and return a pointer to its
6476  * ident structure if it is a define. Return NULL else.
6477  */
6478 
6479 {
6480     ident_t *curr, *prev;
6481     int h;
6482 
6483     h = identhash(s);
6484 
6485     curr = ident_table[h];
6486     prev = 0;
6487     while (curr)
6488     {
6489         if (!strcmp(get_txt(curr->name), s)) /* found it */
6490         {
6491             if (prev) /* not at head of list */
6492             {
6493                 prev->next = curr->next;
6494                 curr->next = ident_table[h];
6495                 ident_table[h] = curr;
6496             }
6497             if (curr->type == I_TYPE_DEFINE)
6498                 return curr;
6499             return NULL;
6500         }
6501         prev = curr;
6502         curr = curr->next;
6503     } /* not found */
6504 
6505     return NULL;
6506 } /* lookup_define() */
6507 
6508 
6509 /*-------------------------------------------------------------------------*/
6510 static Bool
expand_define(void)6511 expand_define (void)
6512 
6513 /* Check if yytext[] holds a macro and expand it if it is.
6514  * Return true if it was expanded, false if not.
6515  */
6516 
6517 {
6518     ident_t *p;
6519 
6520     p = lookup_define(yytext);
6521     if (!p) {
6522         return MY_FALSE;
6523     }
6524     return _expand_define(&p->u.define, p);
6525 } /* expand_define() */
6526 
6527 /*-------------------------------------------------------------------------*/
6528 static Bool
_expand_define(struct defn * p,ident_t * macro)6529 _expand_define (struct defn *p, ident_t * macro)
6530 
6531 /* Expand the macro <p> and add_input() the expanded text.
6532  * For function macros, the function expects the next non-white character
6533  * in the input buffer to be the opening '(' of the argument list.
6534  * <macro> is the struct ident_s entry and is needed just for error
6535  * messages.
6536  *
6537  * Return true if the expansion was successfull, false if not.
6538  */
6539 
6540 {
6541   /* Skip the whitespace in the input buffer until the next non-blank
6542    * and store that one in variable <c>.
6543    */
6544 #define SKIPW \
6545     for(;;) {\
6546         do {\
6547             c = cmygetc();\
6548         } while(lexwhite(c));\
6549         if (c == '\n') {\
6550             myfilbuf();\
6551             store_line_number_info();\
6552             current_loc.line++;\
6553             total_lines++;\
6554         } else break;\
6555     }
6556 
6557     static char *expbuf = NULL;
6558       /* The arguments of a function macro, separated by '\0' characters.
6559        */
6560     static char *buf = NULL;
6561       /* Construction buffer for the expanded macro text.
6562        */
6563 
6564       /* Both buffers are allocated on the first call to the
6565        * function and reused thereafter. Putting them on the
6566        * stack would make _expand_define() reentrant, but
6567        * very slow on systems without proper alloca().
6568        * Right now the only possibility for a recursive call
6569        * is an error during the expansion, with error handling requesting
6570        * another expansion. In this case, reentrancy is not an issue
6571        * because after returning from the error, the function itself
6572        * returns immediately.
6573        *
6574        * But should the need ever arise, the old fragments may be
6575        * changed to implement a stack of buffers. Using the stack-mempool
6576        * allocator, this could even be efficient.
6577        */
6578 
6579 #if 0
6580     static int mutex = 0;
6581       /* TODO: The mutex may be used to implement a stack of buffers if needed.
6582        */
6583 #endif
6584 
6585     char *args[NARGS];
6586       /* Pointers into expbuf[] to the beginning of the actual
6587        * macro arguments.
6588        */
6589     char *q;  /* Pointer into expbuf[] when parsing the args */
6590     char *e;  /* Pointer to replacement text */
6591     char *b;  /* Pointer into buf[] when expanding */
6592     char *r;  /* Next character to read from input buffer */
6593 
6594 #if 0
6595     /* TODO: This was a test for recursive calls. If a stack of buffers is
6596      * TODO:: needed, this code fragments allow an easy implementation,
6597      * TODO:: especially because the DEMUTEX macros are already where
6598      * TODO:: they have to be.
6599      */
6600     if (mutex++)
6601     {
6602         lexerror("Recursive call to _expand_define()");
6603         mutex--;
6604         return 0;
6605     }
6606 #define DEMUTEX mutex--
6607 #else
6608 #define DEMUTEX NOOP
6609 #endif
6610 
6611     /* Allocate the buffers if not done already */
6612     if (!expbuf)
6613         expbuf = pxalloc(DEFMAX);
6614     if (!buf)
6615         buf = pxalloc(DEFMAX);
6616     if (!expbuf || !buf) {
6617         lexerror("Stack overflow");
6618         DEMUTEX;
6619         return 0;
6620     }
6621 
6622     /* No more than EXPANDMAX expansions per line */
6623     if (nexpands++ > EXPANDMAX)
6624     {
6625         lexerror("Too many macro expansions");
6626         DEMUTEX;
6627         return MY_FALSE;
6628     }
6629 
6630     if (p->nargs == -1)
6631     {
6632         /* --- Normal Macro --- */
6633 
6634         if (!p->special)
6635         {
6636             add_input(p->exps.str);
6637         }
6638         else
6639         {
6640             e = (*p->exps.fun)(NULL);
6641             if (!e) {
6642                 lexerror("Out of memory");
6643                 DEMUTEX;
6644                 return 0;
6645             }
6646             add_input(e);
6647             xfree(e);
6648         }
6649 
6650         /* That's it. Jump to the function's end now. */
6651     }
6652     else
6653     {
6654         /* --- Function Macro --- */
6655 
6656         int c;
6657         int brakcnt = 0; /* Number of pending open '[' */
6658         int parcnt = 0;  /* Number of pending open' (' */
6659         Bool dquote = MY_FALSE; /* true: in "" */
6660         Bool squote = MY_FALSE; /* true: in '' */
6661         int n;           /* Number of parsed macro arguments */
6662 
6663         /* Look for the argument list */
6664         SKIPW;
6665         if (c != '(') {
6666             yyerrorf("Macro '%s': Missing '(' in call", get_txt(macro->name));
6667             DEMUTEX;
6668             return MY_FALSE;
6669         }
6670 
6671         /* Parse the macro arguments and store them in args[].
6672          * This is a bit complex as we have to care for character
6673          * constants, string literals, parentheses, symbols and
6674          * comments.
6675          */
6676 
6677         SKIPW;
6678         if (c == ')')
6679             n = 0;  /* No args */
6680         else
6681         {
6682             /* Setup */
6683             r = outp;
6684             *--r = (char)c;
6685             q = expbuf;
6686             args[0] = q;
6687 
6688             for (n = 0;;)
6689             {
6690                 if (q >= expbuf + DEFMAX - 5)
6691                 {
6692                     lexerrorf("Macro '%s': argument overflow", get_txt(macro->name));
6693                     DEMUTEX;
6694                     return MY_FALSE;
6695                 }
6696 
6697                 switch(c = *r++)
6698                 {
6699                   case '"' :
6700                     /* Begin of string literal, or '"' constant */
6701                     if (!squote)
6702                         dquote = !dquote;
6703                     *q++ = (char)c;
6704                     continue;
6705 
6706                   case '#':
6707                     /* Outside of strings it must be a #'symbol.
6708                      */
6709                     *q++ = (char)c;
6710                     if (!squote && !dquote && *r == '\'')
6711                     {
6712                         r++;
6713                         *q++ = '\'';
6714                         if (isalunum(c = *r))
6715                         {
6716                             do {
6717                                 *q++ = (char)c;
6718                                 ++r;
6719                             } while (isalunum(c = *r));
6720                         }
6721                         else
6722                         {
6723                             const char *end;
6724 
6725                             if (symbol_operator(r, &end) < 0)
6726                             {
6727                                 yyerror("Missing function name after #'");
6728                             }
6729                             strncpy(q, r, (size_t)(end - r));
6730                             q += end - r;
6731                             r = (char *)end;
6732                         }
6733                     }
6734                     continue;
6735 
6736                   case '\'':
6737                     /* Begin of character constant or quoted symbol.
6738                      */
6739                     if ( !dquote
6740                      && (!isalunum(*r) || r[1] == '\'')
6741                      && (*r != '(' || r[1] != '{') )
6742                     {
6743                         squote = !squote;
6744                     }
6745                     *q++ = (char)c;
6746                     continue;
6747 
6748                   case '[' :
6749                     /* Begin of array/mapping index.
6750                      */
6751                     if (!squote && !dquote)
6752                         brakcnt++;
6753                     *q++ = (char)c;
6754                     continue;
6755 
6756                   case ']' :
6757                     /* End of array/mapping index.
6758                      */
6759                     if (!squote && !dquote && brakcnt > 0)
6760                     {
6761                         brakcnt--;
6762                     }
6763                     *q++ = (char)c;
6764                     continue;
6765 
6766                   case '(' :
6767                     /* Begin of nested expression.
6768                      */
6769                     if (!squote && !dquote)
6770                         parcnt++;
6771                     *q++ = (char)c;
6772                     continue;
6773 
6774                   case ')' :
6775                     /* End of nested expression.
6776                      */
6777                     if (!squote && !dquote)
6778                     {
6779                         parcnt--;
6780                         if (parcnt < 0)
6781                         {
6782                             /* We found the end of the argument list. Remove
6783                              * trailing whitespace and terminate the arg. */
6784                             while( lexwhite(*(--q)) ) ;
6785                             ++q; // last non-whitespace char, increase by one
6786                             *q++ = '\0'; // then terminate the arg.
6787                             n++;
6788                             break;
6789                         }
6790                     }
6791                     *q++ = (char)c;
6792                     continue;
6793 
6794                   case '\\':
6795                     /* In strings, escaped sequence.
6796                      */
6797                     *q++ = (char)c;
6798                     if (squote || dquote)
6799                     {
6800                         c = *r++;
6801                         if (c == '\r')
6802                             c = *r++;
6803                         if (c == '\n')  /* nope! This wracks consistency! */
6804                         {
6805                             store_line_number_info();
6806                             current_loc.line++;
6807                             total_lines++;
6808                             if (!*r)
6809                             {
6810                                 outp = r;
6811                                 r = _myfilbuf();
6812                             }
6813                             q--;        /* alas, long strings should work. */
6814                             continue;
6815                         }
6816                         if (c == CHAR_EOF) /* can't quote THAT */
6817                         {
6818                             r--;
6819                             continue;
6820                         }
6821                         *q++ = (char)c;
6822                     }
6823                     continue;
6824 
6825                   case '\n':
6826                     /* Next line.
6827                      */
6828                     store_line_number_info();
6829                     current_loc.line++;
6830                     total_lines++;
6831                     *q++ = ' ';
6832                     if (!*r) {
6833                         outp = r;
6834                         r = _myfilbuf();
6835                     }
6836                     if (squote || dquote) {
6837                         lexerror("Newline in string");
6838                         DEMUTEX;
6839                         return MY_FALSE;
6840                     }
6841                     continue;
6842 
6843                   case ',':
6844                     /* Argument separation
6845                      */
6846                     if (!parcnt && !dquote && !squote && !brakcnt)
6847                     {
6848                         /* Remove trailing whitespace and terminate the arg. */
6849                         while( lexwhite(*(--q)) ) NOOP;
6850                         ++q; // last non-whitespace char, increase by one
6851                         *q++ = '\0'; // then terminate the arg.
6852                         // I don't skip the leading whitespace for the next
6853                         // argument because there may be things like
6854                         // linebreaks between two args which I don't want to
6855                         // deal with in this case. This will be done below.
6856                         args[++n] = q;
6857                         if (n == NARGS - 1)
6858                         {
6859                             lexerror("Maximum macro argument count exceeded");
6860                             DEMUTEX;
6861                             return MY_FALSE;
6862                         }
6863                         continue;
6864                     }
6865                     *q++ = (char)c;
6866                     continue;
6867 
6868                   case CHAR_EOF:
6869                         lexerror("Unexpected end of file (or a spurious 0x01 character)");
6870                         DEMUTEX;
6871                         return MY_FALSE;
6872 
6873                   case '/':
6874                     /* Probable comment
6875                      */
6876                     if (!squote && !dquote)
6877                     {
6878                         if ( (c = *r++) == '*')
6879                         {
6880                             outp = r;
6881                             skip_comment();
6882                             r = outp;
6883                         }
6884                         else if ( c == '/')
6885                         {
6886                             r = skip_pp_comment(r);
6887                         }
6888                         else
6889                         {
6890                             --r;
6891                             *q++ = '/';
6892                         }
6893                         continue;
6894                     }
6895 
6896                   default:
6897                     *q++ = (char)c;
6898                     continue;
6899                 } /* end switch */
6900 
6901                 /* The only way to come here is in the case ')' when the
6902                  * end of the argument list is detected. Hence, we can
6903                  * break the for().
6904                  */
6905                 break;
6906             } /* for(n = 0..NARGS) */
6907             outp = r;
6908         } /* if (normal or function macro) */
6909 
6910         /* Proper number of arguments? */
6911         if (n != p->nargs)
6912         {
6913             yyerrorf("Macro '%s': Wrong number of arguments", get_txt(macro->name));
6914             DEMUTEX;
6915             return MY_FALSE;
6916         }
6917 
6918         /* (Don't) handle dynamic function macros */
6919         if (p->special)
6920         {
6921             (void)(*p->exps.fun)(args);
6922             DEMUTEX;
6923             return MY_TRUE;
6924         }
6925 
6926         /* Construct the expanded macro text in buf[] by simple
6927          * copy and replace.
6928          */
6929 
6930         b = buf;
6931         e = p->exps.str;
6932         while (*e)
6933         {
6934             if (*e == MARKS)
6935             {
6936                 if (*++e == MARKS)
6937                     *b++ = *e++;
6938                 else
6939                 {
6940                     q = args[*e++ - MARKS - 1];
6941                     // the args may have leading whitespace (see above),
6942                     // we skip it here.
6943                     while(lexwhite(*q)) ++q;
6944 
6945                     for ( ; *q ; )
6946                     {
6947                         *b++ = *q++;
6948                         if (b >= buf+DEFMAX)
6949                         {
6950                             lexerror("Macro expansion overflow");
6951                             DEMUTEX;
6952                             return MY_FALSE;
6953                         }
6954                     }
6955                 }
6956             }
6957             else
6958             {
6959                 *b++ = *e++;
6960                 if (b >= buf+DEFMAX)
6961                 {
6962                     lexerror("Macro expansion overflow");
6963                     DEMUTEX;
6964                     return MY_FALSE;
6965                 }
6966             }
6967         }
6968 
6969         /* Terminate the expanded text and add it to the input */
6970         *b++ = '\0';
6971         add_input(buf);
6972     }
6973 
6974     /* That's it. */
6975 
6976     DEMUTEX;
6977     return MY_TRUE;
6978 
6979 #undef SKIPW
6980 }
6981 
6982 /*-------------------------------------------------------------------------*/
6983 static int
exgetc(void)6984 exgetc (void)
6985 
6986 /* Get the first character of the next element of a condition
6987  * and return it, leaving the input pointing to the rest of it.
6988  * Comments are skipped, identifiers not defined as macros are
6989  * replaced with ' 0 ', the predicate 'defined(<name>)' is
6990  * replaced with ' 0 ' or ' 1 ' depending on the result.
6991  */
6992 
6993 {
6994 #define SKPW         do c = (unsigned char)mygetc(); while(lexwhite(c)); myungetc((char)c)
6995   /* Skip the whitespace in the input buffer until the first non-blank.
6996    * End with the input pointing to this non-blank.
6997    */
6998 
6999     register unsigned char c;
7000     register char *yyp;
7001 
7002     c = (unsigned char)mygetc();
7003     for (;;)
7004     {
7005         if ( isalpha(c) || c=='_' )
7006         {
7007             /* It's an identifier, maybe a macro name, maybe it's
7008              * an 'defined()' predicate.
7009              */
7010 
7011             /* Get the full identifier in yytext[] */
7012             yyp = yytext;
7013             do {
7014                 SAVEC;
7015                 c=(unsigned char)mygetc();
7016             } while ( isalunum(c) );
7017             myungetc((char)c);
7018 
7019             *yyp='\0';
7020             if (strcmp(yytext, "defined") == 0)
7021             {
7022                 /* handle the 'defined' predicate */
7023                 do c = (unsigned char)mygetc(); while(lexwhite(c));
7024                 if (c != '(')
7025                 {
7026                     yyerror("Missing ( in defined");
7027                     continue;
7028                 }
7029                 do c = (unsigned char)mygetc(); while(lexwhite(c));
7030                 yyp=yytext;
7031                 while ( isalunum(c) )
7032                 {
7033                     SAVEC;
7034                     c=(unsigned char)mygetc();
7035                 }
7036                 *yyp='\0';
7037                 while(lexwhite(c)) c = (unsigned char)mygetc();
7038                 if (c != ')') {
7039                     yyerror("Missing ) in defined");
7040                     continue;
7041                 }
7042                 SKPW;
7043                 if (lookup_define(yytext))
7044                     add_input(" 1 ");
7045                 else
7046                     add_input(" 0 ");
7047             }
7048             else
7049             {
7050                 /* Simple identifier */
7051                 if (!expand_define())
7052                     add_input(" 0 ");
7053             }
7054             c = (unsigned char)mygetc();
7055         }
7056         else if (c == '\\' && (*outp == '\n' || *outp == '\r'))
7057         {
7058             /* Escaped new line: read the next line, strip
7059              * all comments, and then add the result again
7060              * for reparsing.
7061              */
7062 
7063             Bool quote;
7064 
7065             outp++;
7066             if (outp[-1] == '\r' && *outp == '\n')
7067                 outp++;
7068             yyp = yytext;
7069             for(quote = MY_FALSE;;)
7070             {
7071                 c = (unsigned char)mygetc();
7072                 if (c == '"')
7073                     quote = !quote;
7074                 while(!quote && c == '/') { /* handle comments cpp-like */
7075                     char c2;
7076 
7077                     if ( (c2 = mygetc()) == '*') {
7078                         skip_comment();
7079                         c=(unsigned char)mygetc();
7080                     } else if (c2 == '/') {
7081                         outp = skip_pp_comment(outp);
7082                         current_loc.line--;
7083                         c = '\n';
7084                     } else {
7085                         --outp;
7086                         break;
7087                     }
7088                 }
7089                 SAVEC;
7090                 if (c == '\n') {
7091                     break;
7092                 }
7093             }
7094             *yyp = '\0';
7095             current_loc.line++;
7096             total_lines++;
7097             add_input(yytext);
7098             nexpands = 0;
7099             c = (unsigned char)mygetc();
7100         }
7101         else
7102         {
7103             break;
7104         }
7105     }
7106 
7107     return c;
7108 
7109 #undef SKPW
7110 } /* exgetc() */
7111 
7112 /*-------------------------------------------------------------------------*/
7113 static int
cond_get_exp(int priority,svalue_t * svp)7114 cond_get_exp (int priority, svalue_t *svp)
7115 
7116 /* Evaluate the expression in the input buffer at a priority of at least
7117  * <priority> and store the result in <svp> (which is assumed to be
7118  * invalid at the time of call).
7119  * Return the result if it is numeric, or a truthvalue for string
7120  * expressions.
7121  *
7122  * The function assumes to be called at the proper beginning of
7123  * an expression, i.e. if it encounters an operator even before a value,
7124  * it must be unary.
7125  */
7126 
7127 {
7128     int c;
7129     int value = 0;
7130     int value2, x;
7131     svalue_t sv2;
7132 
7133     svp->type = T_INVALID;
7134     do c = exgetc(); while ( lexwhite(c) );
7135 
7136     /* Evaluate the first value */
7137 
7138     if (c == '(')
7139     {
7140         /* It's a parenthesized subexpression */
7141 
7142         value = cond_get_exp(0, svp);
7143 
7144         do c = exgetc(); while ( lexwhite(c) );
7145         if ( c != ')' )
7146         {
7147             yyerror("parentheses not paired in #if");
7148             if (c == '\n')
7149                 myungetc('\n');
7150         }
7151     }
7152     else if ( ispunct(c) )
7153     {
7154         /* It is a string or an unary operator */
7155 
7156         if (c == '"')
7157         {
7158             /* Get the string */
7159 
7160             char *p, *q;
7161 
7162             q = p = outp;
7163             for (;;)
7164             {
7165                 c = *p++;
7166                 if (c == '"')
7167                 {
7168                     break;
7169                 }
7170                 if (c == '\n')
7171                 {
7172                     yyerror("unexpected end of string in #if");
7173                     put_ref_string(svp, STR_EMPTY);
7174                     return 0;
7175                 }
7176                 if (c == '\\')
7177                 {
7178                     c = *p++;
7179                     if (c == '\n')
7180                     {
7181                         current_loc.line++;
7182                         *--p = '"';
7183                         break;
7184                     }
7185                 }
7186                 *q++ = (char)c;
7187             }
7188             *q = '\0';
7189             put_c_string(svp, outp);
7190             outp = p;
7191         }
7192         else
7193         {
7194             /* Is it really an operator? */
7195             x = optab1(c);
7196             if (!x)
7197             {
7198                 yyerror("illegal character in #if");
7199                 return 0;
7200             }
7201 
7202             /* Get the value for this unary operator */
7203             value = cond_get_exp(12, svp);
7204 
7205             /* Evaluate the operator */
7206             switch ( optab2[x-1] )
7207             {
7208               case BNOT  : value = ~value; break;
7209               case LNOT  : value = !value; break;
7210               case UMINUS: value = -value; break;
7211               case UPLUS : value =  value; break;
7212               default :
7213                 yyerror("illegal unary operator in #if");
7214                 free_svalue(svp);
7215                 svp->type = T_NUMBER;
7216                 return 0;
7217             }
7218 
7219             if (svp->type != T_NUMBER)
7220             {
7221                 yyerror("illegal type to unary operator in #if");
7222                 free_svalue(svp);
7223                 svp->type = T_NUMBER;
7224                 return 0;
7225             }
7226             svp->u.number = value;
7227         }
7228     }
7229     else
7230     {
7231         /* It must be a number */
7232 
7233         int base;
7234 
7235         if ( !lexdigit(c) )
7236         {
7237             if (c == '\n')
7238             {
7239                 yyerror("missing expression in #if");
7240                 myungetc('\n');
7241             }
7242             else
7243                 yyerror("illegal character in #if");
7244             return 0;
7245         }
7246 
7247         value = 0;
7248 
7249         /* Determine the base of the number */
7250         if (c != '0')
7251             base=10;
7252         else
7253         {
7254             c = mygetc();
7255             if (c == 'x' || c == 'X')
7256             {
7257                 base = 16;
7258                 c = mygetc();
7259             }
7260             else
7261                 base = 8;
7262         }
7263 
7264         /* Now parse the number */
7265         for(;;)
7266         {
7267             if ( isdigit(c) )      x = -'0';
7268             else if ( isupper(c) ) x = -'A'+10;
7269             else if ( islower(c) ) x = -'a'+10;
7270             else break;
7271             x += c;
7272             if (x > base)
7273                 break;
7274             value = value * base + x;
7275             c = mygetc();
7276         }
7277         myungetc((char)c);
7278         put_number(svp, value);
7279     }
7280 
7281 
7282     /* Now evaluate the following <binop> <expr> pairs (if any) */
7283 
7284     for (;;)
7285     {
7286         do c=exgetc(); while ( lexwhite(c) );
7287 
7288         /* An operator or string must come next */
7289         if ( !ispunct(c) )
7290             break;
7291 
7292         /* If it's a string, make it a string addition */
7293         if (c == '"')
7294         {
7295             myungetc('"');
7296             c = '+';
7297         }
7298 
7299         /* Can it be an operator at all? */
7300         x = optab1(c);
7301         if (!x)
7302             break;
7303 
7304         /* See if the optab[] defines an operator for these characters
7305          */
7306         value2 = mygetc();
7307         for (;;x+=3)
7308         {
7309             if (!optab2[x])
7310             {
7311                 myungetc((char)value2);
7312                 if (!optab2[x+1])
7313                 {
7314                     yyerror("illegal operator use in #if");
7315                     return 0;
7316                 }
7317                 break;
7318             }
7319             if (value2 == optab2[x])
7320                 break;
7321         }
7322 
7323         /* If the priority of the operator is too low, we are done
7324          * with this (sub)expression.
7325          */
7326         if (priority >= optab2[x+2])
7327         {
7328             if (optab2[x])
7329                 myungetc((char)value2);
7330             break;
7331         }
7332 
7333         /* Get the second operand */
7334         value2 = cond_get_exp(optab2[x+2], &sv2);
7335 
7336         /* Evaluate the operands:
7337          *   Full set of operations for numbers.
7338          *   Addition and lexicographic comparisons for strings.
7339          */
7340         if (svp->type == T_NUMBER && sv2.type == T_NUMBER)
7341         {
7342             switch (optab2[x+1])
7343             {
7344               case MULT   : value *= value2;                break;
7345               case DIV    : if (!value2) lexerror("Division by zero");
7346                             else value /= value2;         break;
7347               case MOD    : if (!value2) lexerror("Division by zero");
7348                             else value %= value2;         break;
7349               case BPLUS  : value += value2;                break;
7350               case BMINUS : value -= value2;                break;
7351               case LSHIFT : if ((uint)value2 > MAX_SHIFT) value = 0;
7352                             else value <<= value2; break;
7353               case RSHIFT : value >>= (uint)value2 > MAX_SHIFT ? (int)MAX_SHIFT : value2;
7354                             break;
7355               case LESS   : value = value <  value2;        break;
7356               case LEQ    : value = value <= value2;        break;
7357               case GREAT  : value = value >  value2;        break;
7358               case GEQ    : value = value >= value2;        break;
7359               case EQ     : value = value == value2;        break;
7360               case NEQ    : value = value != value2;        break;
7361               case BAND   : value &= value2;                break;
7362               case XOR    : value ^= value2;                break;
7363               case BOR    : value |= value2;                break;
7364               case LAND   : value = value && value2;        break;
7365               case LOR    : value = value || value2;        break;
7366               case QMARK  :
7367                   do c=exgetc(); while( lexwhite(c) );
7368                   if (c != ':')
7369                   {
7370                       yyerror("'?' without ':' in #if");
7371                       myungetc((char)c);
7372                       return 0;
7373                   }
7374                   if (value)
7375                   {
7376                       *svp = sv2;
7377                       cond_get_exp(1, &sv2);
7378                       free_svalue(&sv2);
7379                       value = value2;
7380                   }
7381                   else
7382                       value = cond_get_exp(1, svp);
7383                   break;
7384             } /* switch() */
7385         }
7386         else if (svp->type == T_STRING && sv2.type == T_STRING)
7387         {
7388             x = optab2[x+1];
7389             if (x == BPLUS)
7390             {
7391                 svp->u.str = mstr_append(svp->u.str, sv2.u.str);
7392                 free_string_svalue(&sv2);
7393             }
7394             else
7395             {
7396                 value = mstrcmp(svp->u.str, sv2.u.str);
7397                 free_string_svalue(svp);
7398                 svp->type = T_NUMBER;
7399                 free_string_svalue(&sv2);
7400                 switch (x)
7401                 {
7402                   case LESS   : value = value <  0; break;
7403                   case LEQ    : value = value <= 0; break;
7404                   case GREAT  : value = value >  0; break;
7405                   case GEQ    : value = value >= 0; break;
7406                   case EQ     : value = value == 0; break;
7407                   case NEQ    : value = value != 0; break;
7408                   default:
7409                     yyerror("illegal operator use in #if");
7410                     return 0;
7411                 }
7412                 put_number(svp, value);
7413             }
7414         }
7415         else
7416         {
7417             yyerror("operands in #if won't match");
7418             free_svalue(svp);
7419             svp->type = T_NUMBER;
7420             free_svalue(&sv2);
7421             return 0;
7422         }
7423     }
7424     myungetc((char)c);
7425     return value;
7426 } /* cond_get_expr() */
7427 
7428 /*-------------------------------------------------------------------------*/
7429 void
set_inc_list(vector_t * v)7430 set_inc_list (vector_t *v)
7431 
7432 /* EFUN: set_driver_hook(H_INCLUDE_DIRS, ({ list }) )
7433  *
7434  * Set the list of pathnames to search for <>-include files to the
7435  * names in <v>.
7436  *
7437  * The function takes ownership of v->item[], but replaces all string
7438  * values by its own copies. Since the original v is held in
7439  * the driver_hook[] array, this is safe to do.
7440  */
7441 
7442 {
7443     size_t i;
7444     char *p;
7445     svalue_t *svp;
7446     mp_int len, max;
7447 
7448     /* Count and test the passed pathnames */
7449 
7450     svp = v->item;
7451     for (i = 0, max = 0; i < (size_t)VEC_SIZE(v); i++, svp++)
7452     {
7453         string_t *new;
7454         if (svp->type != T_STRING)
7455         {
7456             errorf("H_INCLUDE_DIRS argument has a non-string array element\n");
7457         }
7458 
7459         /* Set p to the beginning of the pathname, skipping leading
7460          * '/' and './'.
7461          */
7462         p = get_txt(svp->u.str);
7463         for(;;) {
7464             if (*p == '/')
7465                 p++;
7466             else if (*p == '.' && p[1] == '/')
7467                 p += 2;
7468             else
7469                 break;
7470         }
7471 
7472         /* Is the path legal? */
7473         if (!legal_path(p))
7474         {
7475             errorf("H_INCLUDE_DIRS path contains '..'\n");
7476         }
7477         if (*p == '.' && !p[1])
7478             errorf("H_INCLUDE_DIRS path is a single prefix dot\n");
7479 
7480         len = (mp_int)strlen(p);
7481         if (max < len)
7482             max = len;
7483         if (len >= 2 && p[len -1] == '.' && p[len - 2] == '/')
7484             errorf("H_INCLUDE_DIRS path ends in single prefix dot\n");
7485 
7486         /* Get and store our own copy of the pathname */
7487         new = unshare_mstring(svp->u.str);
7488         if (!new)
7489             errorf("Out of memory\n");
7490 
7491         put_string(svp, new); /* dup() already freed it */
7492     }
7493 
7494     inc_list = v->item;
7495     inc_list_size = VEC_SIZE(v);
7496     inc_list_maxlen = max;
7497 } /* set_inc_list() */
7498 
7499 /*-------------------------------------------------------------------------*/
7500 static char *
get_current_file(char ** args UNUSED)7501 get_current_file (char ** args UNUSED)
7502 
7503 /* Dynamic macro __FILE__: return the name of the current file.
7504  * In compat mode, don't return a leading slash.
7505  */
7506 
7507 {
7508 #ifdef __MWERKS__
7509 #    pragma unused(args)
7510 #endif
7511     char *buf;
7512 
7513     buf = xalloc(strlen(current_loc.file->name)+4);
7514     if (!buf)
7515         return NULL;
7516     if (compat_mode)
7517         sprintf(buf, "\"%s\"", current_loc.file->name);
7518     else
7519         sprintf(buf, "\"/%s\"", current_loc.file->name);
7520     return buf;
7521 } /* get_current_file() */
7522 
7523 /*-------------------------------------------------------------------------*/
7524 static char *
get_current_dir(char ** args UNUSED)7525 get_current_dir (char ** args UNUSED)
7526 
7527 /* Dynamic macro __DIR__: return the directory of the current file.
7528  * In compat mode, don't return a leading slash.
7529  */
7530 
7531 {
7532 #ifdef __MWERKS__
7533 #    pragma unused(args)
7534 #endif
7535     char *buf;
7536     int len;
7537 
7538     buf = current_loc.file->name + strlen(current_loc.file->name);
7539     while (*(--buf) != '/' && buf >= current_loc.file->name) NOOP;
7540     len = (buf - current_loc.file->name) + 1;
7541     buf = xalloc(len + 4);
7542     if (!buf)
7543         return NULL;
7544     if (compat_mode)
7545         sprintf(buf, "\"%.*s\"", len, current_loc.file->name);
7546     else
7547         sprintf(buf, "\"/%.*s\"", len, current_loc.file->name);
7548     return buf;
7549 } /* get_current_dir() */
7550 
7551 /*-------------------------------------------------------------------------*/
7552 static char *
get_sub_path(char ** args)7553 get_sub_path (char ** args)
7554 
7555 /* Dynamic macro __PATH__(n): return the directory of the current file,
7556  * where n is the number of directories to pop off from the right.
7557  * In compat mode, don't return a leading slash.
7558  */
7559 
7560 {
7561     char *buf;
7562     int len, rm;
7563 
7564     rm = 0;
7565     sscanf(*args, "%d", &rm);
7566     if (rm < 0)
7567         rm = 0;
7568     buf = current_loc.file->name + strlen(current_loc.file->name);
7569     while (rm >= 0 && buf >= current_loc.file->name)
7570         if (*(--buf) == '/')
7571             rm--;
7572     len = (buf - current_loc.file->name) + 1;
7573     buf = alloca(len + 4);
7574     if (compat_mode)
7575         sprintf(buf, "\"%.*s\"", len, current_loc.file->name);
7576     else
7577         sprintf(buf, "\"/%.*s\"", len, current_loc.file->name);
7578     add_input(buf);
7579     return NULL;
7580 } /* get_sub_path() */
7581 
7582 /*-------------------------------------------------------------------------*/
7583 static char *
get_current_line(char ** args UNUSED)7584 get_current_line (char ** args UNUSED)
7585 
7586 /* Dynamic macro __LINE__: return the number of the current line.
7587  */
7588 
7589 {
7590 #ifdef __MWERKS__
7591 #    pragma unused(args)
7592 #endif
7593     char *buf;
7594 
7595     buf = xalloc(12);
7596     if (!buf)
7597         return NULL;
7598     sprintf(buf, "%d", current_loc.line);
7599     return buf;
7600 } /* get_current_line() */
7601 
7602 /*-------------------------------------------------------------------------*/
7603 static char *
get_version(char ** args UNUSED)7604 get_version(char ** args UNUSED)
7605 
7606 /* Dynamic macro __VERSION__: return the driver version.
7607  */
7608 
7609 {
7610 #ifdef __MWERKS__
7611 #    pragma unused(args)
7612 #endif
7613     char *buf;
7614     size_t len;
7615 
7616     len = strlen(DRIVER_VERSION LOCAL_LEVEL);
7617     buf = xalloc(3 + len);
7618     if (!buf) return 0;
7619     buf[0] = '"';
7620     strcpy(buf+1, DRIVER_VERSION LOCAL_LEVEL);
7621     buf[len+1] = '"';
7622     buf[len+2] = '\0';
7623     return buf;
7624 } /* get_version() */
7625 
7626 /*-------------------------------------------------------------------------*/
7627 static char *
get_hostname(char ** args UNUSED)7628 get_hostname (char ** args UNUSED)
7629 
7630 /* Dynamic macro __HOSTNAME__: return the hostname.
7631  */
7632 
7633 {
7634 #ifdef __MWERKS__
7635 #    pragma unused(args)
7636 #endif
7637     char *tmp, *buf;
7638 
7639     tmp = query_host_name();
7640     buf = xalloc(strlen(tmp)+3);
7641     if (!buf) return 0;
7642     sprintf(buf, "\"%s\"", tmp);
7643     return buf;
7644 } /* get_hostname() */
7645 
7646 /*-------------------------------------------------------------------------*/
7647 static char *
get_domainname(char ** args UNUSED)7648 get_domainname (char ** args UNUSED)
7649 
7650 /* Dynamic macro __DOMAINNAME__: return the domainname.
7651  */
7652 
7653 {
7654 #ifdef __MWERKS__
7655 #    pragma unused(args)
7656 #endif
7657     char *buf;
7658 
7659     buf = xalloc(strlen(domain_name)+3);
7660     if (!buf)
7661         return 0;
7662     sprintf(buf, "\"%s\"", domain_name);
7663     return buf;
7664 } /* get_domainname() */
7665 
7666 /*-------------------------------------------------------------------------*/
7667 static char *
efun_defined(char ** args)7668 efun_defined (char **args)
7669 
7670 /* Dynamic macro __EFUN_DEFINE__(name): test if the efun is defined
7671  * and add ' 0 ' or ' 1 ' depending on the result.
7672  */
7673 
7674 {
7675     ident_t *p;
7676 
7677     p = make_shared_identifier(args[0], I_TYPE_GLOBAL, 0);
7678     if (!p)
7679     {
7680         lexerror("Out of memory");
7681         return NULL;
7682     }
7683 
7684     while (p->type > I_TYPE_GLOBAL)
7685     {
7686         if ( !(p = p->inferior) )
7687             break;
7688     }
7689 
7690     add_input(
7691       (p && p->type == I_TYPE_GLOBAL && p->u.global.efun >= 0) ?
7692         " 1 " : " 0 "
7693     );
7694 
7695     if (p && p->type == I_TYPE_UNKNOWN)
7696         free_shared_identifier(p);
7697 
7698     return NULL;
7699 } /* efun_defined() */
7700 
7701 /*-------------------------------------------------------------------------*/
7702 void
remove_unknown_identifier(void)7703 remove_unknown_identifier (void)
7704 
7705 /* Remove all identifiers from the ident_table[] which are of
7706  * type I_TYPE_UNKNOWN.
7707  */
7708 
7709 {
7710     int i;
7711     ident_t *id, *next;
7712 
7713     for (i = ITABLE_SIZE; --i >= 0; )
7714     {
7715         id = ident_table[i];
7716         for ( ; id; id = next)
7717         {
7718             next = id->next;
7719             if (id->type == I_TYPE_UNKNOWN)
7720                 free_shared_identifier(id);
7721         }
7722     }
7723 } /* remove_unknown_identifier() */
7724 
7725 /*-------------------------------------------------------------------------*/
7726 size_t
show_lexer_status(strbuf_t * sbuf,Bool verbose UNUSED)7727 show_lexer_status (strbuf_t * sbuf, Bool verbose UNUSED)
7728 
7729 /* Return the amount of memory used by the lexer.
7730  */
7731 
7732 {
7733 #if defined(__MWERKS__)
7734 #    pragma unused(verbose)
7735 #endif
7736     size_t sum;
7737     ident_t *p;
7738     int i;
7739 
7740     sum = 0;
7741 
7742     /* Count the space used by identifiers and defines */
7743     for (i = ITABLE_SIZE; --i >= 0; )
7744     {
7745         p = ident_table[i];
7746         for ( ; p; p = p->next) {
7747             sum += sizeof(*p);
7748             if (p->name && p->type == I_TYPE_DEFINE && !p->u.define.special)
7749                 sum += strlen(p->u.define.exps.str)+1;
7750         }
7751     }
7752 
7753     sum += mempool_size(lexpool);
7754     sum += defbuf_len;
7755     sum += 2 * DEFMAX; /* for the buffers in _expand_define() */
7756 
7757     if (sbuf)
7758         strbuf_addf(sbuf, "Lexer structures\t\t\t %9zu\n", sum);
7759     return sum;
7760 } /* show_lexer_status() */
7761 
7762 /*-------------------------------------------------------------------------*/
7763 #ifdef GC_SUPPORT
7764 
7765 static INLINE void
count_ident_refs(ident_t * id)7766 count_ident_refs (ident_t *id)
7767 
7768 /* GC support: count all references held by one identifier (ignoring
7769  * inferiors).
7770  */
7771 
7772 {
7773     count_ref_from_string(id->name);
7774     note_malloced_block_ref(id);
7775 } /* count_ident_refs() */
7776 
7777 /*-------------------------------------------------------------------------*/
7778 void
count_lex_refs(void)7779 count_lex_refs (void)
7780 
7781 /* GC support: count all references held by the lexer.
7782  */
7783 
7784 {
7785     int i;
7786     ident_t *id;
7787 
7788     /* Identifier */
7789     for (i = ITABLE_SIZE; --i >= 0; )
7790     {
7791         id = ident_table[i];
7792         for ( ; id; id = id->next)
7793         {
7794             ident_t *id2;
7795             count_ident_refs(id);
7796             for (id2 = id->inferior; id2 != NULL; id2 = id2->next)
7797             {
7798                 count_ident_refs(id2);
7799             }
7800         }
7801     }
7802 
7803     for (id = permanent_defines; id; id = id->next_all)
7804     {
7805         if (!id->u.define.special)
7806             note_malloced_block_ref(id->u.define.exps.str);
7807     }
7808 
7809     if (defbuf_len)
7810         note_malloced_block_ref(defbuf);
7811 
7812     if (lexpool)
7813         mempool_note_refs(lexpool);
7814 }
7815 #endif /* GC_SUPPORT */
7816 
7817 /*-------------------------------------------------------------------------*/
7818 char *
lex_error_context(void)7819 lex_error_context (void)
7820 
7821 /* Create the current lexing context in a static buffer and return its
7822  * pointer.
7823  */
7824 
7825 {
7826     static char buf[21];
7827     char *end;
7828     mp_int len;
7829 
7830     if (!pragma_verbose_errors)
7831         return "";
7832 
7833     strcpy(buf, ((signed char)yychar == -1 || yychar == CHAR_EOF)
7834                 ? (len = 6, " near ")
7835                 : (len = 8, " before "));
7836 
7837     if (!yychar || !*outp)
7838     {
7839         strcpy(buf+len, "end of line");
7840     }
7841     else if ((signed char)*outp == -1 || *outp == CHAR_EOF)
7842     {
7843         strcpy(buf+len, "end of file");
7844     }
7845     else
7846     {
7847         ssize_t left;
7848 
7849         left = linebufend - outp;
7850         if (left > (ssize_t)sizeof(buf) - 3 - len)
7851             left = sizeof(buf) - 3 - len;
7852         if (left < 1)
7853             buf[0] = '\0';
7854         else
7855         {
7856             buf[len] = '\'';
7857             strncpy(buf + len + 1, outp, left);
7858             buf[len + left + 1] = '\'';
7859             buf[len + left + 2] = '\0';
7860             if ( NULL != (end = strchr(buf, '\n')) )
7861             {
7862                 *end = '\'';
7863                 *(end+1) = '\0';
7864                 if (buf[len+1] == '\'')
7865                     strcpy(buf+len, "end of line");
7866             }
7867             if ( NULL != (end = strchr(buf, -1)) )
7868             {
7869                 *end = '\'';
7870                 *(end+1) = '\0';
7871                 if (buf[len+1] == '\'')
7872                     strcpy(buf+len, "end of file");
7873             }
7874         }
7875     }
7876     return buf;
7877 } /* lex_error_context() */
7878 
7879 /*-------------------------------------------------------------------------*/
7880 svalue_t *
f_expand_define(svalue_t * sp)7881 f_expand_define (svalue_t *sp)
7882 
7883 /* EFUN expand_define()
7884  *
7885  *   string expand_define (string name)
7886  *   string expand_define (string name, string arg, ...)
7887  *
7888  * Expands the macro <name> with the argument(s) <arg>... (default is
7889  * one empty string "").
7890  * Result is the expanded macro, or 0 if there is no macro with
7891  * that name.
7892  *
7893  * This efun is applicable only while an object is compiled,
7894  * therefore its usage is restricted to a few functions like the
7895  * H_INCLUDE_DIRS driver hook, or the masters runtime_error()
7896  * function.
7897  * TODO: Right now, only one arg is evaluated.
7898  */
7899 
7900 {
7901     char *arg, *end;
7902     string_t *res;
7903     ident_t *d;
7904 
7905     /* Get the arguments from the stack */
7906 
7907     if (sp->type == T_STRING)
7908     {
7909         arg = get_txt(sp->u.str);
7910         /* TODO: Concatenate all strings on the stack */
7911     }
7912     else /* it's the number 0 */
7913         arg = "";
7914 
7915     res = NULL;
7916 
7917     /* If we are compiling, lookup the given name and store
7918      * the expansion in res.
7919      */
7920     if (current_loc.file  && current_loc.file->name
7921      && outp > defbuf && outp <= &defbuf[defbuf_len])
7922     {
7923         myungetc('\n');
7924         end = outp;
7925         add_input(arg);
7926         d = lookup_define(get_txt(sp[-1].u.str));
7927         if (d && _expand_define(&d->u.define, d) )
7928         {
7929             *end = '\0';
7930             res = new_mstring(outp);
7931             *end = '\n';  /* Restore the newline character */
7932         }
7933         outp = &end[1];
7934     }
7935     free_svalue(sp);
7936     free_svalue(--sp);
7937 
7938     /* Return the result */
7939     if (!res)
7940     {
7941         put_number(sp, 0);
7942     }
7943     else
7944     {
7945         put_string(sp, res);
7946     }
7947 
7948     return sp;
7949 } /* f_expand_define() */
7950 
7951 /***************************************************************************/
7952 
7953