ldmud-3.2.9/doc/
ldmud-3.2.9/doc/efun/
ldmud-3.2.9/mud/
ldmud-3.2.9/mud/heaven7/
ldmud-3.2.9/mud/heaven7/lib/
ldmud-3.2.9/mud/lp-245/
ldmud-3.2.9/mud/lp-245/banish/
ldmud-3.2.9/mud/lp-245/doc/
ldmud-3.2.9/mud/lp-245/doc/examples/
ldmud-3.2.9/mud/lp-245/doc/sefun/
ldmud-3.2.9/mud/lp-245/log/
ldmud-3.2.9/mud/lp-245/obj/Go/
ldmud-3.2.9/mud/lp-245/players/lars/
ldmud-3.2.9/mud/lp-245/room/death/
ldmud-3.2.9/mud/lp-245/room/maze1/
ldmud-3.2.9/mud/lp-245/room/sub/
ldmud-3.2.9/mud/lp-245/secure/
ldmud-3.2.9/mud/morgengrauen/
ldmud-3.2.9/mud/morgengrauen/lib/
ldmud-3.2.9/mud/sticklib/
ldmud-3.2.9/mud/sticklib/src/
ldmud-3.2.9/mudlib/uni-crasher/
ldmud-3.2.9/pkg/
ldmud-3.2.9/pkg/debugger/
ldmud-3.2.9/pkg/diff/
ldmud-3.2.9/pkg/misc/
ldmud-3.2.9/src/autoconf/
ldmud-3.2.9/src/bugs/
ldmud-3.2.9/src/bugs/MudCompress/
ldmud-3.2.9/src/bugs/b-020916-files/
ldmud-3.2.9/src/bugs/doomdark/
ldmud-3.2.9/src/bugs/ferrycode/ferry/
ldmud-3.2.9/src/bugs/ferrycode/obj/
ldmud-3.2.9/src/bugs/psql/
ldmud-3.2.9/src/done/
ldmud-3.2.9/src/done/order_alist/
ldmud-3.2.9/src/done/order_alist/obj/
ldmud-3.2.9/src/done/order_alist/room/
ldmud-3.2.9/src/gcc/
ldmud-3.2.9/src/gcc/2.7.0/
ldmud-3.2.9/src/gcc/2.7.1/
ldmud-3.2.9/src/hosts/
ldmud-3.2.9/src/hosts/GnuWin32/
ldmud-3.2.9/src/hosts/amiga/NetIncl/
ldmud-3.2.9/src/hosts/amiga/NetIncl/netinet/
ldmud-3.2.9/src/hosts/amiga/NetIncl/sys/
ldmud-3.2.9/src/hosts/i386/
ldmud-3.2.9/src/hosts/msdos/byacc/
ldmud-3.2.9/src/hosts/msdos/doc/
ldmud-3.2.9/src/hosts/os2/
ldmud-3.2.9/src/hosts/win32/
ldmud-3.2.9/src/util/
ldmud-3.2.9/src/util/erq/
ldmud-3.2.9/src/util/indent/hosts/next/
ldmud-3.2.9/src/util/xerq/
ldmud-3.2.9/src/util/xerq/lpc/
ldmud-3.2.9/src/util/xerq/lpc/www/
/*---------------------------------------------------------------------------
 * LPC-Compiler: Preprocessor and Lexical Analysis.
 *
 *---------------------------------------------------------------------------
 * The lexer is initialised by a call to init_lexer(). This function sets
 * up the internal tables and also reads the permanent defines from
 * the lpc_predefs list the caller set up before the call.
 *
 * A new compilation is set up by a call to start_new_file(), passing
 * the filedescriptor of the file to compile as argument. Control is
 * then passed to the parser in prolang, which calls yylex() here to
 * get the next token. After the compilation is finished, end_new_file()
 * performs the cleanup.
 *
 * The lexer also holds the table of instructions (instrs[]) and the
 * driver's own ctype tables. Both are included from the file efun_defs.c
 * which is generated by the program make_func during the building
 * process.
 *
 * For an explanation of the datastructures look at the places of
 * definition of the structures - it's too much to put here, too.
 *---------------------------------------------------------------------------
 */

#include "driver.h"
#include "typedefs.h"

#include "my-alloca.h"
#include <stdio.h>
#include <fcntl.h>
#include <ctype.h>
#include <stdarg.h>
#include <stddef.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifdef OS2
#include <io.h>
#endif

#include "lex.h"

#include "array.h"
#include "backend.h"
#include "closure.h"
#include "comm.h"
#include "exec.h"
#include "filestat.h"
#include "gcollect.h"
#include "hash.h"
#include "instrs.h"
#include "interpret.h"
#include "lang.h"
#include "main.h"
#include "mempools.h"
#include "object.h"
#include "patchlevel.h"
#include "prolang.h"
#include "simulate.h"
#include "simul_efun.h"
#include "stdstrings.h"
#include "stralloc.h"
#include "strfuns.h"
#include "wiz_list.h" /* wizlist_name[] */
#include "xalloc.h"

#include "../mudlib/sys/driver_hook.h"

/* TODO: Use get_host_name() instead of gethostname()
 * TODO: Implement the # and ## operators.
 * TODO: New predefs' __BASENAME__, __FUNCTION__.
 * TODO: #define macro(a,b,...) -> ... is assigned to __VA_ARGS__ (see oncoming
 * TODO:: C standard).
 * TODO: Does Standard-C allow recursive macro expansion? If not, we
 * TODO:: should disallow it, too.
 */

#if defined(AMIGA) && !defined(__GNUC__)
#    include "hosts/amiga/socket.h"
#endif

/* We can't use the EOF character directly, as in its (char) representation
 * clashes with ISO-8859 character 0xFF. Instead we use ascii SOH (0x01),
 * which in turn is not allowed as input character.
 */

#define CHAR_EOF ((char)0x01)

/*-------------------------------------------------------------------------*/

#define MLEN   4096
  /* Maximum length of a macro text (definition)
   */

#define NSIZE  256
  /* Maximum length of a macro (argument) name.
   */

#define NARGS 25
  /* Max number of macro arguments
   */

#define EXPANDMAX 25000
  /* Maximum number of expansions per line.
   */

#define MAXLINE 2048
  /* Maximum length of an input line.
   */

#define MAX_ANSI_CONCAT 4096
  /* Maximum length of an ANSI-style string literal concatenation.
   */

#define INC_OPEN_BUFSIZE 1024
  /* Maximum length of an include filename.
   */

#ifndef DEFMAX
#    define DEFMAX 12000
#endif
  /* Maximum length of an expanded macro.
   */

#define MAX_TOTAL_BUF 400000
  /* Maximum length of macro expansion buffer
   */

#define DEFBUF_1STLEN (DEFMAX+MAXLINE+1)
  /* Initial length of macro expansion buffer, enough
   * to allow DEFMAX + an input line + '\0'
   */

/*-------------------------------------------------------------------------*/

int current_line;
  /* Number of the current line.
   */

int total_lines;
  /* Total number of lines compiled so far (used to compute the average
   * compiled lines/s)
   */

char *current_file;
  /* Name of the file currently compiled.
   */

static char *object_file;
  /* Name of the file for which the lexer was originally called.
   */

Bool pragma_use_local_scopes;
  /* True: treat all local scopes as one.
   */

int pragma_strict_types;
  /* Type enforcing mode: PRAGMA_WEAK_TYPES, PRAGMA_STRONG_TYPES
   * and PRAGMA_STRICT_TYPES.
   */
Bool pragma_save_types;
  /* True: save argument types after compilation.
   */
Bool pragma_combine_strings;
  /* True: perform '+'-addition of constant strings at compile time.
   */
Bool pragma_verbose_errors;
  /* True: give info on the context of an error.
   */

Bool pragma_no_clone;
  /* True: prevent the object from being clone.
   */

Bool pragma_no_inherit;
  /* True: prevent the program from being inherited.
   */

Bool pragma_no_shadow;
  /* True: prevent the program from being shadowed.
   */

Bool pragma_pedantic;
  /* True: treat a number of sloppy language constructs as errors.
   */

Bool pragma_warn_deprecated;
  /* True: warn if deprecated efuns are used.
   */

char *last_lex_string;
  /* When lexing string literals, this is the (shared) string lexed
   * so far. It is used to pass string values to lang.c and may be
   * freed there.
   */

struct lpc_predef_s *lpc_predefs = NULL;
  /* List of macros predefined by other parts of the driver, especially from
   * main.c for the '-D' commandline option.
   */

static Mempool lexpool = NULL;
  /* Fifopool to hold the allocations for the include and lpc_ifstate_t stacks.
   */

/*-------------------------------------------------------------------------*/
/* The lexer can take data from either a file or a string buffer.
 * The handling is unified using the struct source_s structure.
 * TODO: Use this source similar to auto-include to expand macros in the
 * TODO:: the compile. This would make it easier to find errors caused
 * TODO:: by macro replacements.
 */

typedef struct source_s
{
    int fd;         /* Filedescriptor or -1 */
    char * buf;     /* Start pointer of the allocated text buffer or NULL */
    char * current; /* Current position in buf[] */
} source_t;

static source_t yyin;
  /* Current input source.
   */

/*-------------------------------------------------------------------------*/
/* The lexer uses a combined file-input/macro-expansion buffer
 * called defbuf[] of length <defbuf_len>. Within this buffer, the last
 * MAXLINE bytes are reserved as (initial) file-input buffer, its beginning
 * and end marked with the pointers linebufstart and linebufend. In this
 * space, pointer outp points to the next character to process.
 *
 * The file-input buffer may contain several textlines, all terminated
 * with a '\n'. After the last (complete) textline, a '\0' is set as
 * sentinel. Usually this will overwrite the first character of the
 * incomplete line right at the end of the input buffer, therefore this
 * character is stored in the variable saved_char.
 *
 * When all lines in the buffer have been processed (ie. outp points to
 * the '\0' sentinel), the remaining fragment of the yet incomplete line
 * is copied _before_ linebufstart (and outp set accordingly), then
 * the next MAXLINE bytes are read into the buffer starting at
 * linebufstart.
 *
 * If there are less than MAXLINE bytes left to read, the end of the file
 * is marked in the buffer with the CHAR_EOF character (a \0 sentinel is not
 * necessary as compilation and thus lexing will end with the CHAR_EOF
 * character).
 *
 * When including files, a new area of MAXLINE bytes is reserved in defbuf,
 * which ends exactly at the current outp. The position of the current
 * area is recorded with the current position of linebufstart relative to
 * the end of defbuf. Obviously this can be repeated until the max size
 * of defbuf (MAX_TOTAL_BUF) is reached.
 *
 * Macro expansions are done such that the replacement text for a macro
 * copied right before outp (which at that time points at the character
 * after the macro use), then outp is set back to point at the beginning
 * of the added text, lexing the just expanded text next.
 *
 * Functionals (inline functions) are somewhat similar to macros. When a
 * definition '(: ... :)' is encountered, a copy of text between the
 * delimiters is stored verbatim in the list of inline functions, starting at
 * first_inline_fun. To the compiler the lexer returns L_INLINE_FUN with the
 * synthetic identifier of the function. Whenever such functions are pending
 * and the compiler is at a safe place to accept a function definition
 * (signalled in insert_inline_fun_now), the text of the pending functions is
 * inserted into the input stream like a macro.
 */

static char *defbuf = NULL;
  /* The combined input/expansion buffer.
   */

static unsigned long defbuf_len = 0;
  /* Current length of defbuf.
   */

static char *outp;
  /* Pointer to the next character in defbuf[] to be processed.
   */

static char *linebufstart;
  /* Begin of the input line buffer within defbuf[].
   */

static char *linebufend;
  /* End of the input line buffer within defbuf[].
   */

static char saved_char;
  /* The first character of the incomplete line after the last complete
   * one in the input buffer. Saved here because in the buffer itself
   * it is overwritten with '\0'.
   */

/*-------------------------------------------------------------------------*/

static Bool lex_fatal;
  /* True: lexer encountered fatal error.
   */

static svalue_t *inc_list;
  /* An array of pathnames to search for <>-include files.
   * This is a pointer to the vector.item[] held in the driver_hook[]
   * array.
   */

static size_t inc_list_size;
  /* The number of names in <inc_list>.
   */

static mp_int inc_list_maxlen;
  /* The lenght of the longest name in <inc_list>.
   */

static int nexpands;
  /* Number of macro expansions on this line so far.
   */

static char yytext[MAXLINE];
  /* Temporary buffer used to collect data.
   */


/*-------------------------------------------------------------------------*/

static ident_t *ident_table[ITABLE_SIZE];
  /* The lexer stores all encountered identifiers in a hashtable of struct
   * idents. The table follows the usual structure: the index (hash value)
   *  is computed from the name of the identifier, the indexed table element
   * the points to the head of a chain of different identifier values with
   * identical hash. The most recently used identifier is always moved to
   * the head of the chain.
   *
   * The table is used to store all identifiers and their value: starting
   * from efun names and reserved words (like 'while') over preprocessor
   * macros to 'normal' lfun and variable names. The identifiers are
   * distinguished by the .type field in the ident structure. Should one
   * identifier used with several different types at the same time, one entry
   * is generated for each type, and they are all linked together by their
   * .inferior pointers into a list ordered by falling type value. The entry
   * with the highest type value is the one put into the hashtable's chain.
   */

#if ITABLE_SIZE == 256
#    define identhash(s) chashstr((s), 12)
#else
#    define identhash(s) (whashstr((s), 12) % ITABLE_SIZE)
#endif
  /* Hash an identifier name into a table index.
   */

  /* In addition to this, the lexer keeps two lists for all efuns and
   * preprocessor defines: all_efuns and all_defines. These are linked
   * together with the .next_all field in the ident structure.
   */

ident_t *all_efuns = NULL;
  /* The list of efuns. */

static ident_t *all_defines = NULL;
  /* The list of all non-permanent macro defines.
   * Entries with a NULL .name are undefined macros.
   */

static ident_t *permanent_defines = NULL;
  /* The list of all permanent macro defines. */


static ident_t *undefined_permanent_defines = NULL;
  /* 'Parking list' for permanent defines which have been #undef'ined.
   * After the compilation is complete, they will be put back into
   * the ident_table.
   */

/*-------------------------------------------------------------------------*/

struct inline_fun * first_inline_fun = NULL;
  /* Linked list of the saved function text for inline functions.
   */

Bool insert_inline_fun_now = MY_FALSE;
  /* This is TRUE when we are at a suitable point to insert the
   * saved inline functions. Usually this is at the end of a function,
   * or after a global variable definition.
   */

unsigned int next_inline_fun = 0;
  /* The running count of inline functions, used to 'name' the next
   * function to generate.
   */

/*-------------------------------------------------------------------------*/

/* The stack to handle nested #if...#else...#endif constructs.
 */

typedef struct lpc_ifstate_s
{
    struct lpc_ifstate_s *next;
    int                   state;  /* which token to expect */
} lpc_ifstate_t;

/* lpc_ifstate_t.state values: */

#define EXPECT_ELSE  1
#define EXPECT_ENDIF 2

static lpc_ifstate_t *iftop = NULL;

/*-------------------------------------------------------------------------*/

/* The stack to save important state information when handling
 * nested includes.
 */

static struct incstate
{
    struct incstate * next;

    source_t    yyin;           /* The current input source */
    int         line;           /* Current line */
    char      * file;           /* Filename */
    ptrdiff_t   linebufoffset;  /* Position of linebufstart */
    mp_uint     inc_offset;     /* Handle returned by store_include_info() */
    int pragma_strict_types;    /* Saved pragma_strict_types.
                                 * If set to PRAGMA_KEEP_TYPES, the pragma
                                 * setting at the end of the include file
                                 * will not be reset.
                                 * TODO: Remove this altogether as it has
                                 * TODO:: already been done in 3.3
                                 */
    char saved_char;
} *inctop = NULL;

/*-------------------------------------------------------------------------*/

/* Translation table of reserved words into the lexcodes assigned by yacc
 * in lang.h.
 */

struct s_reswords
{
    char *name;  /* The reserved word */
    int   code;  /* The assigned code */
};

static struct s_reswords reswords[]
 = { { "break",          L_BREAK         }
   , { "case",           L_CASE          }
   , { "catch",          L_CATCH         }
   , { "closure",        L_CLOSURE_DECL  }
   , { "continue",       L_CONTINUE      }
   , { "default",        L_DEFAULT       }
   , { "do",             L_DO            }
   , { "else",           L_ELSE          }
   , { "float",          L_FLOAT_DECL    }
   , { "for",            L_FOR           }
   , { "foreach",        L_FOREACH       }
   , { "if",             L_IF            }
#ifdef L_IN
   , { "in",             L_IN            }
#endif
   , { "inherit",        L_INHERIT       }
   , { "int",            L_INT           }
   , { "mapping",        L_MAPPING       }
   , { "mixed",          L_MIXED         }
   , { "nomask",         L_NO_MASK       }
#ifdef USE_LPC_NOSAVE
   , { "nosave",         L_NOSAVE        }
#endif
   , { "object",         L_OBJECT        }
#ifdef SUPPLY_PARSE_COMMAND
   , { "parse_command",  L_PARSE_COMMAND }
#endif
   , { "private",        L_PRIVATE       }
   , { "protected",      L_PROTECTED     }
   , { "public",         L_PUBLIC        }
   , { "return",         L_RETURN        }
   , { "sscanf",         L_SSCANF        }
   , { "static",         L_STATIC        }
   , { "status",         L_STATUS        }
   , { "string",         L_STRING_DECL   }
   , { "switch",         L_SWITCH        }
   , { "symbol",         L_SYMBOL_DECL   }
   , { "varargs",        L_VARARGS       }
   , { "virtual",        L_VIRTUAL       }
   , { "void",           L_VOID          }
   , { "while",          L_WHILE         }
   };

/*-------------------------------------------------------------------------*/

/* The definitions and tables for the preprocessor expression evaluator.
 */


#define BNOT   1  /* Unary operator opcodes*/
#define LNOT   2
#define UMINUS 3
#define UPLUS  4

#define MULT   1  /* Binary operator opcodes */
#define DIV    2
#define MOD    3
#define BPLUS  4
#define BMINUS 5
#define LSHIFT 6
#define RSHIFT 7
#define LESS   8
#define LEQ    9
#define GREAT 10
#define GEQ   11
#define EQ    12
#define NEQ   13
#define BAND  14
#define XOR   15
#define BOR   16
#define LAND  17
#define LOR   18
#define QMARK 19

  /* lookup table for initial operator characters.
   * The table covers the characters [' '..'~'].
   * 0 for no operator, else index into optab2.
   */
static char _optab[]
 = {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,
    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,
    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
 };

  /* Lookup table for the complete operator data in a serial format.
   *
   * optab2[index-1] : operation code for unary operator, 0 for none.
   * optab2[index+0 .. +3 .. +6 ...] :
   * two character binary operators: second character, operation code, prio
   * one character binary operator & end: 0,           operation code, prio
   * end: 0, 0
   *
   * Note that some entries overlap.
   */
static char optab2[]
  = { BNOT, 0                                 /*  1: ~         */
    ,         0,   MULT,   11                 /*  2: *         */
    , LNOT,   '=', NEQ,     7                 /*  6: !, !=     */
    , 0,      0,   DIV,    11                 /* 10: /         */
    , UMINUS, 0,   BMINUS, 10                 /* 14: -x, x-y   */
    , UPLUS,  0,   BPLUS,  10                 /* 18: +x, x+y   */
    , 0,      '<', LSHIFT,  9, '=', LEQ,  8, 0, LESS,  8
                                              /* 22: <<, <=, < */
    , 0,      '>', RSHIFT,  9, '=', GEQ,  8, 0, GREAT, 8
                                              /* 32: >>, >=, > */
    , 0,      '=', EQ,      7                 /* 42: ==        */
    , 0,      0,   MOD,    11                 /* 46: %         */
    , 0,      '&', LAND,    3, 0,   BAND, 6   /* 50: &&, &     */
    , 0,      '|', LOR,     2, 0,   BOR,  4   /* 57: ||, |     */
    , 0,      0,   XOR,     5                 /* 64: ^         */
    , 0,      0,   QMARK,   1                 /* 68: ?         */
};

#define optab1(c) (_optab[(c)-' '])
  /* Use optab1 to index _optab with raw characters.
   */

/*-------------------------------------------------------------------------*/

  /* A handy macro to statically determine the number of
   * elements in an array.
   */
#define NELEM(a) (sizeof (a) / sizeof (a)[0])

  /* Save the character in variable 'c' in the yytext buffer, if
   * there is enough space left.
   */
#define SAVEC \
    if (yyp < yytext+MAXLINE-5)\
       *yyp++ = (char)c;\
    else {\
       lexerror("Line too long");\
       break;\
    }

  /* The magic character used for function macros to mark the places
   * in the replacement text where the macro arguments are to be
   * inserted.
   * The marking sequence for argument n is { '@', '@'+n+1 }, and
   * the character '@' itself is stored as { '@', '@' }.
   */
#define MARKS '@'

/*-------------------------------------------------------------------------*/
/* Forward declarations */

static INLINE int number(long);
static INLINE int string(char *);
static void handle_define(char *, Bool);
static void add_define(char *, short, char *);
static void add_permanent_define(char *, short, void *, Bool);
static Bool expand_define(void);
static Bool _expand_define(struct defn*, ident_t*);
static INLINE void myungetc(char);
static int cond_get_exp(int, svalue_t *);
static int exgetc(void);
static char *get_current_file(char **);
static char *get_current_line(char **);
static char *get_version(char **);
static char *get_hostname(char **);
static char *get_domainname(char **);
static char *get_current_dir(char **);
static char *get_sub_path(char **);
static char *efun_defined(char **);
static void lexerrorf VARPROT((char *, ...), printf, 1, 2);
static void lexerror(char *);
static ident_t *lookup_define(char *);

/*-------------------------------------------------------------------------*/

#include "efun_defs.c"

/* struct instr instrs[] = { ... };
 *
 * Information about all instructions and efuns, generated by make_func.
 * Also included are the table for our own ctype functions.
 *
 * The numbers of arguments are used by the compiler.
 * If min == max, then no information has to be coded about the
 * actual number of arguments. Otherwise, the actual number of arguments
 * will be stored in the byte after the instruction.
 * A maximum value of -1 means unlimited maximum value.
 *
 * If an argument has type 0 (T_INVALID) specified, then no checks will
 * be done at run time.
 *
 * The argument types are checked by the compiler if type checking is enabled,
 * and always at runtime.
 */

/*-------------------------------------------------------------------------*/
void
init_lexer(void)

/* Initialize the various lexer tables, including the predefined macros
 * from the commandline given in lpc_predefs.
 * The lpc_predefs list is deallocated by this call.
 */

{
    size_t i, n;
    char mtext[MLEN];
    static short binary_operators[]
      = { F_ADD, F_SUBTRACT, F_MULTIPLY, F_DIVIDE, F_MOD
        , F_LT, F_GT, F_EQ, F_GE, F_LE, F_NE
        , F_OR, F_XOR, F_LSH, F_RSH, F_RSHL
        , F_INDEX, F_RINDEX, F_NX_RANGE, F_RX_RANGE
        , F_EXTRACT2
        };
    static short ternary_operators[]
      = { F_RANGE, F_NR_RANGE, F_RR_RANGE, F_RN_RANGE
        , F_MAP_INDEX
        };

    /* Allocate enough memory for 20 nested includes/ifs */
    lexpool = new_fifopool(fifopool_size(sizeof(lpc_ifstate_t), 20)
                           + fifopool_size(sizeof(struct incstate), 20));
    if (!lexpool)
        fatal("Out of memory.\n");

    /* Clear the table of identifiers */
    for (i = 0; i < ITABLE_SIZE; i++)
        ident_table[i] = NULL;

    /* For every efun, create a global entry in ident_table[] */
    for (n = 0; n < NELEM(instrs); n++)
    {
        ident_t *p;

#if defined(AMIGA) && defined(_DCC) && defined(DICE30)
        if (n >= NELEM(instrs)-1)
            continue;
#endif

        if (instrs[n].Default == -1)
            continue;

        p = make_shared_identifier(instrs[n].name, I_TYPE_GLOBAL, 0);
        if (!p)
            fatal("Out of memory\n");
        if (p->type != I_TYPE_UNKNOWN)
        {
            fatal("Duplicate efun '%s'.\n", instrs[n].name);
            /* NOTREACHED */
            continue;
        }
        p->type = I_TYPE_GLOBAL;
        p->u.global.efun     =  (short)n;
        p->u.global.sim_efun = I_GLOBAL_SEFUN_OTHER;
        p->u.global.function = I_GLOBAL_FUNCTION_EFUN;
        p->u.global.variable = I_GLOBAL_VARIABLE_FUN;
        p->next_all = all_efuns;
        all_efuns = p;
    }

    /* For every reserved word, create a global entry in ident_table[] */
    for (i = 0; i < NELEM(reswords); i++)
    {
        ident_t *p;

#if defined(AMIGA) && defined(_DCC) && defined(DICE30)
        if (i >= NELEM(reswords)-1)
            continue;
#endif

        p = make_shared_identifier(reswords[i].name, I_TYPE_RESWORD, 0);
        if (!p)
            fatal("Out of memory\n");
        p->type = I_TYPE_RESWORD;
        p->u.code = reswords[i].code;
    }

    /* Operators are difficult to specify properly in func_spec syntax,
     * therefore update their instrs[] entries manually.
     */
    for (i = 0; i < NELEM(binary_operators); i++)
    {
        n = (unsigned)binary_operators[i];
        instrs[n].min_arg = instrs[n].max_arg = 2;
        instrs[n].Default = 0;
        instrs[n].ret_type = TYPE_ANY;
    }
    for (i=0; i<NELEM(ternary_operators); i++)
    {
        n = (unsigned)ternary_operators[i];
        instrs[n].min_arg = instrs[n].max_arg = 3;
        instrs[n].Default = 0;
        instrs[n].ret_type = TYPE_ANY;
    }
    n = F_AND;
        instrs[n].min_arg = instrs[n].max_arg = 2;
        instrs[n].ret_type = TYPE_ANY;
    n = F_COMPL;
        instrs[n].min_arg = instrs[n].max_arg = 1;
        instrs[n].Default = 0;
        instrs[n].ret_type = TYPE_ANY;
    n = F_NOT;
        instrs[n].min_arg = instrs[n].max_arg = 1;
        instrs[n].ret_type = TYPE_ANY;


    /* Add the standard permanent macro definitions */

    add_permanent_define("LPC3", -1, string_copy(""), MY_FALSE);
    add_permanent_define("__LDMUD__", -1, string_copy(""), MY_FALSE);
    if (compat_mode)
    {
        add_permanent_define("COMPAT_FLAG", -1, string_copy(""), MY_FALSE);
        add_permanent_define("__COMPAT_MODE__", -1, string_copy(""), MY_FALSE);
    }
    add_permanent_define("__EUIDS__", -1, string_copy(""), MY_FALSE);
    if (strict_euids)
        add_permanent_define("__STRICT_EUIDS__", -1, string_copy(""), MY_FALSE);

    if (compat_mode)
    {
        mtext[0] = '"';
        strcpy(mtext+1, master_name);
        strcat(mtext+1, "\"");
    }
    else
    {
        mtext[0] = '"';
        mtext[1] = '/';
        strcpy(mtext+2, master_name);
        strcat(mtext+2, "\"");
    }
    add_permanent_define("__MASTER_OBJECT__", -1, string_copy(mtext), MY_FALSE);
    add_permanent_define("__FILE__", -1, (void *)get_current_file, MY_TRUE);
    add_permanent_define("__DIR__", -1, (void *)get_current_dir, MY_TRUE);
    add_permanent_define("__PATH__", 1, (void *)get_sub_path, MY_TRUE);
    add_permanent_define("__LINE__", -1, (void *)get_current_line, MY_TRUE);
    add_permanent_define("__VERSION__", -1, (void *)get_version, MY_TRUE);
    add_permanent_define("__VERSION_MAJOR__", -1, string_copy(VERSION_MAJOR), MY_FALSE);
    add_permanent_define("__VERSION_MINOR__", -1, string_copy(VERSION_MINOR), MY_FALSE);
    add_permanent_define("__VERSION_MICRO__", -1, string_copy(VERSION_MICRO), MY_FALSE);
    if (IS_RELEASE())
        add_permanent_define("__VERSION_PATCH__", -1, string_copy("0"), MY_FALSE);
    else
        add_permanent_define("__VERSION_PATCH__", -1, string_copy(VERSION_PATCH), MY_FALSE);

    add_permanent_define("__HOST_NAME__", -1, (void *)get_hostname, MY_TRUE);
    add_permanent_define("__DOMAIN_NAME__", -1, (void *)get_domainname, MY_TRUE);
    add_permanent_define("__HOST_IP_NUMBER__", -1
                        , (void*)get_host_ip_number, MY_TRUE);
    sprintf(mtext, "%d", MAX_USER_TRACE);
    add_permanent_define("__MAX_RECURSION__", -1, string_copy(mtext), MY_FALSE);
    add_permanent_define("__EFUN_DEFINED__", 1, (void *)efun_defined, MY_TRUE);
#ifdef ERQ_DEMON
    sprintf(mtext, "%d", ERQ_MAX_SEND);
    add_permanent_define("__ERQ_MAX_SEND__", -1, string_copy(mtext), MY_FALSE);
    sprintf(mtext, "%d", ERQ_MAX_REPLY);
    add_permanent_define("__ERQ_MAX_REPLY__", -1, string_copy(mtext), MY_FALSE);
#endif
    sprintf(mtext, "%ld", (long)def_eval_cost);
    add_permanent_define("__MAX_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
    sprintf(mtext, "%ld", (long)CATCH_RESERVED_COST);
    add_permanent_define("__CATCH_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
    sprintf(mtext, "%ld", (long)MASTER_RESERVED_COST);
    add_permanent_define("__MASTER_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
    sprintf(mtext, "%ld", (long)TIME_TO_RESET);
    add_permanent_define("__RESET_TIME__", -1, string_copy(mtext), MY_FALSE);
    sprintf(mtext, "%ld", (long)TIME_TO_CLEAN_UP);
    add_permanent_define("__CLEANUP_TIME__", -1, string_copy(mtext), MY_FALSE);
#ifdef USE_IPV6
    add_permanent_define("__IPV6__", -1, string_copy(""), MY_FALSE);
#endif
#ifdef USE_MYSQL
    add_permanent_define("__MYSQL__", -1, string_copy(""), MY_FALSE);
#endif
#ifdef USE_LPC_NOSAVE
    add_permanent_define("__LPC_NOSAVE__", -1, string_copy(""), MY_FALSE);
#endif
#ifdef USE_DEPRECATED
    add_permanent_define("__DEPRECATED__", -1, string_copy(""), MY_FALSE);
#endif
    if (wizlist_name[0] != '\0')
    {
        if (compat_mode)
        {
            mtext[0] = '"';
            strcpy(mtext+1, wizlist_name);
            strcat(mtext+1, "\"");
        }
        else
        {
            mtext[0] = '"';
            mtext[1] = '/';
            strcpy(mtext+2, wizlist_name);
            strcat(mtext+2, "\"");
        }
        add_permanent_define("__WIZLIST__", -1, string_copy(mtext), MY_FALSE);
    }
    {
        char buf[200];

        sprintf(buf, "(%ld)", PINT_MAX);
        add_permanent_define("__INT_MAX__", -1, string_copy(buf), MY_FALSE);
        sprintf(buf, "(%ld)", PINT_MIN);
        add_permanent_define("__INT_MIN__", -1, string_copy(buf), MY_FALSE);
        sprintf(buf, "(%g)", FLT_MAX);
        add_permanent_define("__FLOAT_MAX__", -1, string_copy(buf), MY_FALSE);
        sprintf(buf, "(%g)", FLT_MIN);
        add_permanent_define("__FLOAT_MIN__", -1, string_copy(buf), MY_FALSE);
    }

    /* Add the permanent macro definitions given on the commandline */

    while (NULL != lpc_predefs)
    {
        char namebuf[NSIZE];
        struct lpc_predef_s *tmpf;

        tmpf = lpc_predefs;
        lpc_predefs = lpc_predefs->next;

        *mtext = '\0';
        sscanf(tmpf->flag, "%[^=]=%[ -~=]", namebuf, mtext);
        if ( strlen(namebuf) >= NSIZE )
            fatal("-D%s: macroname too long (>%d)\n", tmpf->flag, NSIZE);
        if ( strlen(mtext) >= MLEN )
            fatal("-D%s: macrotext too long (>%d)\n", tmpf->flag, MLEN);
        add_permanent_define(namebuf, -1, string_copy(mtext), MY_FALSE);

        xfree(tmpf->flag);
        xfree(tmpf);
    }
} /* init_lexer() */

/*-------------------------------------------------------------------------*/
ident_t *
lookfor_shared_identifier (char *s, int n, int depth, Bool bCreate)

/* Aliases: make_shared_identifier(): bCreate passed as MY_TRUE
 *          find_shared_identifier(): bCreate passed as MY_FALSE
 *
 * Find and/or add identifier <s> of type <n> to the ident_table, and
 * return a pointer to the found/generated struct ident. Local identifiers
 * (<n> == I_TYPE_LOCAL) are additionally distinguished by their definition
 * <depth>.
 *
 * If bCreate is FALSE, the function just checks if the given identfier
 * exists in the table. The identifier is considered found, if there
 * is an entry in the table for this very name, and with a type equal
 * or greater than <n>. If <n> is LOCAL and the found identifier is LOCAL
 * as well, the identifier is considered found if <depth> is equal or smaller
 * than the depth of the found identifier. The result is the pointer to the
 * found identifier, or NULL if not found.
 *
 * If bCreate is TRUE, the identifier is created if not found. If an
 * identifier with the same name but a lower type exists in the table,
 * it is shifted down: a new entry for this name created and put into the
 * table, the original entry is referenced by the .inferior pointer in the
 * new entry. The same happens when a new LOCAL of greater depth is
 * added to an existing LOCAL of smaller depth.  New generated
 * entries have their type set to I_TYPE_UNKNOWN regardless of <n>.
 * The result is the pointer to the found/new entry, or NULL when out
 * of memory.
 */

{
    ident_t *curr, *prev;
    int   h;
    char *str;

#if defined(LEXDEBUG)
    printf("%s lookfor_shared_identifier called: %s\n", time_stamp(), s);
#endif

    h = identhash(s);  /* the identifiers hash code */

    /* look for the identifier in the table */

    curr = ident_table[h];
    prev = NULL;
    while (curr)
    {
#if defined(LEXDEBUG)
        printf("%s checking %s.\n", time_stamp(), curr->name);
#endif
        if (!strcmp(curr->name, s)) /* found it */
        {
#if defined(LEXDEBUG)
            printf("%s found.\n", time_stamp());
#endif
            /* Move the found entry to the head of the chain */
            if (prev) /* not at head of chain */
            {
                prev->next = curr->next;
                curr->next = ident_table[h];
                ident_table[h] = curr;
            }

            /* If the found entry is of inferior type, shift it down
             * resp. consider it 'not found'.
             */
            if (n > curr->type
             || (   I_TYPE_LOCAL == curr->type && I_TYPE_LOCAL == n
                 && depth > curr->u.local.depth)
               )
            {
                if (bCreate)
                {
                    ident_t *inferior = curr;

#if defined(LEXDEBUG)
                    printf("%s shifting down inferior.\n", time_stamp());
#endif
                    curr = xalloc(sizeof *curr);
                    if ( NULL != curr )
                    {
                        curr->name = ref_string(inferior->name);
                        curr->next = inferior->next;
                        curr->type = I_TYPE_UNKNOWN;
                        curr->inferior = inferior;
                        curr->hash = (short)h;
                        ident_table[h] = curr;
                    }
                }
                else
                    curr = NULL;
            }

            /* Return the found (or generated) entry */
            return curr;
        }

        prev = curr;
        curr = curr->next;
    }

    if (bCreate)
    {
        /* Identifier is not in table, so create a new entry */

        str = make_shared_string(s);
        if (!str)
            return NULL;
        curr = xalloc(sizeof *curr);
        if (!curr)
        {
            free_string(str);
            return NULL;
        }

        curr->name = str;
        curr->next = ident_table[h];
        curr->type = I_TYPE_UNKNOWN;
        curr->inferior = NULL;
        curr->hash = (short)h;
        ident_table[h] = curr;
    }
    /* else curr is NULL */

    return curr;
} /* lookfor_shared_identifier() */

/*-------------------------------------------------------------------------*/
ident_t *
make_global_identifier (char *s, int n)

/* Create an identifier <s> on level I_TYPE_GLOBAL, after searching for it
 * using type <n>.
 *
 * The difference to make_shared_identifier() is that if an identifier for
 * this name already exists and is of higher level than I_TYPE_GLOBAL (e.g.
 * somebody created a #define for this name), the function will insert
 * an appropriate I_TYPE_GLOBAL entry into the inferior list.
 *
 * Result is the pointer to the identifier, or NULL when out of memory
 * (yyerror() is called in that situation, too).
 */

{
    ident_t *ip, *q;

    ip = make_shared_identifier(s, n, 0);
    if (!ip)
    {
        yyerrorf("Out of memory: identifer '%s'", s);
        return NULL;
    }

    if (ip->type > I_TYPE_GLOBAL)
    {
        /* Somebody created a #define with this name.
         * Back-insert an ident-table entry.
         */
        do {
            q = ip;
            ip = ip->inferior;
        } while (ip && ip->type > I_TYPE_GLOBAL);

        if (!ip)
        {
            ip = xalloc(sizeof(ident_t));
            if (!ip) {
                yyerrorf("Out of memory: identifier (%lu bytes)"
                        , (unsigned long) sizeof(ident_t));
                return NULL;
            }
            ip->name = ref_string(q->name);
            ip->type = I_TYPE_UNKNOWN;
            ip->inferior = NULL;
            ip->hash = q->hash;
            q->inferior = ip;
        }
    }

    return ip;
} /* make_global_identifier() */

/*-------------------------------------------------------------------------*/
static INLINE void
free_identifier (ident_t *p)

/* Deallocate the identifier <p> which must not be in any list or table
 * anymore.
 * It is a fatal error if it can't be found.
 */

{
    free_string(p->name);
    xfree(p);
} /* free_identifier() */

/*-------------------------------------------------------------------------*/
static INLINE void
unlink_shared_identifier (ident_t *p)

/* Unlink the identifier <p> (which may be an inferior entry ) from the
 * identifier table.
 * It is a fatal error if it can't be found.
 */

{
    ident_t *curr, **q;
    int  h;
    char *s;

    h = p->hash;

    q = &ident_table[h];
    curr = *q;
    s = p->name;

#if defined(LEXDEBUG)
    printf("%s unlinking '%s'\n", time_stamp(), s);
    fflush(stdout);
#endif

    /* Look for the hashed entry with the same name */

    while (curr)
    {
        if (curr->name == s
#ifdef DEBUG
         || !strcmp(curr->name, s)
#endif

           ) /* found matching name */
        {
            ident_t *first = curr;

            /* Search the list of inferiors for entry <p> */

            while (curr)
            {
                if (curr == p) /* this is the right one */
                {
                    /* Remove the entry from the inferior list */

                    if (first == curr)
                    {
                        if (curr->inferior)
                        {
                            curr->inferior->next = curr->next;
                            *q = curr->inferior;
                            return;
                        }
                        *q = curr->next;
                        return;
                    }

                    *q = curr->inferior;
                    return;
                }
                q = &curr->inferior;
                curr = *q;
            }

            fatal("free_shared_identifier: inferior '%s' not found!\n", p->name);
            return;
            /* NOTREACHED */
        }

        q = &curr->next;
        curr = *q;
    } /* not found */

    fatal("free_shared_identifier: name '%s' not found!\n", p->name);
    /* NOTREACHED */
} /* unlink_shared_identifier() */

/*-------------------------------------------------------------------------*/
void
free_shared_identifier (ident_t *p)

/* Remove the identifier <p> (which may be an inferior entry ) from the
 * identifier table.
 * It is a fatal error if it can't be found.
 */

{
#if defined(LEXDEBUG)
    printf("%s freeing '%s'\n", time_stamp(), p->name);
    fflush(stdout);
#endif

    unlink_shared_identifier(p);
    free_identifier(p);
} /* free_shared_identifier() */

/*-------------------------------------------------------------------------*/
static void
realloc_defbuf (void)

/* Increase the size of defbuf[] (unless it would exceed MAX_TOTAL_BUF).
 * The old content of defbuf[] is copied to the end of the new buffer.
 * outp is corrected to the new position, other pointers into defbuf
 * become invalid.
 */

{
    char * old_defbuf = defbuf;
    size_t old_defbuf_len = defbuf_len;
    char * old_outp = outp;
    ptrdiff_t outp_off;

    if (MAX_TOTAL_BUF <= defbuf_len)
      return;

    outp_off = &defbuf[defbuf_len] - outp;

    /* Double the current size of defbuf, but top off at MAX_TOTAL_BUF. */
    if (defbuf_len > (MAX_TOTAL_BUF >> 1) )
    {
        defbuf_len = MAX_TOTAL_BUF;
    } else {
        defbuf_len <<= 1;
    }
    if (comp_flag)
        fprintf(stderr, "%s (reallocating defbuf from %ld (%ld left) to %ld) "
               , time_stamp(), (long)old_defbuf_len, (long)(old_outp-defbuf)
               , defbuf_len);
    defbuf = xalloc(defbuf_len);
    memcpy(defbuf+defbuf_len-old_defbuf_len, old_defbuf, old_defbuf_len);
    xfree(old_defbuf);
    outp = &defbuf[defbuf_len] - outp_off;
} /* realloc_defbuf() */

/*-------------------------------------------------------------------------*/
static void
set_input_source (int fd, char * buf)

/* Set the current input source to <fd>/<buf>.
 */

{
    yyin.fd = fd;
    yyin.buf = buf;
    yyin.current = buf;
} /* set_input_source() */

/*-------------------------------------------------------------------------*/
static void
close_input_source (void)

/* Close the current input source: a file is closed, a string is deallocated
 */

{
    if (yyin.fd != -1)    close(yyin.fd);  yyin.fd = -1;
    if (yyin.buf != NULL) xfree(yyin.buf); yyin.buf = NULL;
    yyin.current = NULL;
} /* close_input_source() */

/*-------------------------------------------------------------------------*/
static /* NO inline */ char *
_myfilbuf (void)

/* Read the next MAXLINE bytes from the input source <yyin> and store
 * them in the input-buffer. If there were the beginning of an incomplete
 * line left in the buffer, they are copied right before linebufstart.
 * The end of the last complete line in the buffer is marked with a '\0'
 * sentinel, or, if the file is exhausted, the end of data is marked
 * with the CHAR_EOF char.
 *
 * outp is set to point to the new data (which may be the copied remnants
 * from the incomplete line) and also returned as result.
 *
 * The function must not be called unless all lines in the buffer have
 * been processed. This macro */

#define myfilbuf() (*outp?0:_myfilbuf())

 /* takes care of that.
  */

{
    int i;
    char *p;

    /* Restore the data clobbered by the old sentinel */
    *outp = saved_char;

    /* Copy any remnants of an incomplete line before the buffer begin
     * and reset outp.
     */
    if (linebufend < outp)
        fatal("(lex.c) linebufend %p < outp %p\n", linebufend, outp);
    if (linebufend - outp)
        memcpy(outp-MAXLINE, outp, (size_t)(linebufend - outp));
    outp -= MAXLINE;

    *(outp-1) = '\n'; /* so an ungetc() gives a sensible result */

    /* Read the next block of data */
    p = linebufstart; /* == linebufend - MAXLINE */
    if (yyin.fd != -1)
        i = read(yyin.fd, p, MAXLINE);
    else
    {
        i = strlen(yyin.current);

        if (i > MAXLINE)
            i = MAXLINE;

        memcpy(p, yyin.current, i);
        yyin.current += i;
    }

    if (i < MAXLINE)
    {
        /* End of file or error: put in the final EOF marker */

        if (i < 0)
        {
            i = 0;
        }

        p += i;
        if (p - outp ? p[-1] != '\n' : current_line == 1)
            *p++ = '\n';
        *p++ = CHAR_EOF;
        return outp;
    }

    /* Buffer filled: mark the last line with the '\0' sentinel */
    p += i;
    while (*--p != '\n') NOOP; /* find last newline */
    if (p < linebufstart)
    {
        lexerror("line too long");
        *(p = linebufend-1) = '\n';
    }
    p++;
    saved_char = *p;
    *p = '\0';

    return outp;
} /* _myfilbuf() */

/*-------------------------------------------------------------------------*/
static void
add_input (char *p)

/* Copy the text <p> into defbuf[] right before the current position of
 * outp and set outp back to point at the beginning of the new text.
 *
 * Main use is by the macro expansion routines.
 */
{
    size_t l = strlen(p);

#if defined(LEXDEBUG)
    if (l > 0)
        fprintf(stderr, "%s add '%s'\n", time_stamp(), p);
#endif
    if ((ptrdiff_t)l > outp - &defbuf[10])
    {
        lexerror("Macro expansion buffer overflow");
        return;
    }

    outp -= l;
    strncpy(outp, p, l);
}

/*-------------------------------------------------------------------------*/
static INLINE char
mygetc (void)

/* Retrieve the next character from the file input buffer.
 */

{
#if 0
    fprintf(stderr, "c='%c' %x, ", *outp, *outp);
#endif
#if defined(LEXDEBUG)
    putc(*outp, stderr);
    fflush(stderr);
#endif
    return *outp++;
}

/*-------------------------------------------------------------------------*/
static INLINE void
myungetc (char c)

/* Store character <c> in the file input buffer so the next mygetc()
 * can retrieve it.
 */

{
    *--outp = c;
}

/*-------------------------------------------------------------------------*/
static INLINE Bool
gobble (char c)

/* Skip the next character in the input buffer if it is <c> and return true.
 * If the next character is not <c>, don't advance in the buffer and
 * return false.
 */

{
    if (c ==  mygetc())
        return MY_TRUE;
    --outp;
    return MY_FALSE;
}

/*-------------------------------------------------------------------------*/
static void
lexerrorf (char *format, ...)

/* Generate an lexerror() using printf()-style arguments.
 */

{
    va_list va;
    char buff[5120];
    char fixed_fmt[1000];

    format = limit_error_format(fixed_fmt, sizeof(fixed_fmt), format);
    va_start(va, format);
    vsprintf(buff, format, va);
    va_end(va);
    lexerror(buff);
} /* lexerrorf() */

/*-------------------------------------------------------------------------*/
static void
lexerror (char *s)

/* The lexer encountered fatal error <s>. Print the error via yyerror()
 * and set lex_fatal.
 */

{
    yyerror(s);
    lex_fatal = MY_TRUE;
}

/*-------------------------------------------------------------------------*/
static Bool
skip_to (char *token, char *atoken)

/* Skip the file linewise until one of the following preprocessor statements
 * is encountered:
 *   #<token> : returns true, outp is set to the following line.
 *   #<atoken>: returns false, outp is set to the following line.
 *   #elif    : returns false, the statement is rewritten to #if and
 *                outp is set to point to the '#' in the new statement.
 * If an end of file occurs, an error is generated and the function returns
 * true after setting outp to the character before the CHAR_EOF.
 *
 * Nested #if ... #endif blocks are skipped altogether.
 *
 * <atoken> may be the NULL pointer and is ignored in that case.
 */

{
    char *p;  /* Local copy of outp */
    char *q;  /* The start of the preprocessor statement */
    char c;
    char nl = '\n';
    int nest; /* Current nesting depth of #if...#endif blocks */

    p = outp;

    for (nest = 0; ; ) {
        current_line++;
        total_lines++;
        c = *p++;

        if (c == '#')
        {
            /* Parse the preprocessor statement */

            /* Set q to the first non-blank character of the keyword */
            while(lexwhite(*p++)) NOOP;
            q = --p;

            /* Mark the end of the preprocessor keyword with \0 */
            while (isalunum(*p++)) NOOP;
            c = *--p;  /* needed for eventual undos */
            *p = '\0';

            /* Set p to the first character of the next line */
            if (c != nl)
            {
                while (*++p != nl) NOOP;
            }
            p++;

            /* Evaluate the token at <q> */

            if (strcmp(q, "if") == 0
             || strcmp(q, "ifdef") == 0
             || strcmp(q, "ifndef") == 0)
            {
                nest++;
            }
            else if (nest > 0)
            {
                if (strcmp(q, "endif") == 0)
                    nest--;
            }
            else
            {
                if (strcmp(q, token) == 0)
                {
                    *(p-1) = nl;
                    outp = p;
                    if (!*p)
                    {
                        _myfilbuf();
                    }
                    return MY_TRUE;
                }
                else if (atoken)
                {
                    if (strcmp(q, atoken) == 0)
                    {
                        *(p-1) = nl;
                        outp = p;
                        if (!*p) {
                            _myfilbuf();
                        }
                        return MY_FALSE;
                    }
                    else if (strcmp(q, "elif") == 0)
                    {
                        /* Morph the 'elif' into '#if' and reparse it */
                        current_line--;
                        total_lines--;
                        q[0] = nl;
                        q[1] = '#';
                        q[4] = c;   /* undo the '\0' */
                        outp = q+1;
                        return MY_FALSE;
                    }
                }
            }
        }
        else /* not a preprocessor statement */
        {
            if (c == CHAR_EOF)
            {
                outp = p - 2;
                current_line--;
                total_lines--;
                lexerror("Unexpected end of file while skipping");
                return MY_TRUE;
            }

            /* Skip the rest of the line */
            while (c != nl) c = *p++;
        }

        /* Read new data from the file if necessary */
        if (!*p)
        {
            outp = p;
            p = _myfilbuf();
        }
    } /* for () */

    /* NOTREACHED */
} /* skip_to() */

/*-------------------------------------------------------------------------*/
static void
handle_cond (Bool c)

/* Evaluate the boolean condition <c> of a preprocessor #if statement.
 * If necessary, skip to the condition branch to read next, and/or
 * push a new state onto the ifstate-stack.
 */
{
    lpc_ifstate_t *p;

    if (c || skip_to("else", "endif")) {
        p = mempool_alloc(lexpool, sizeof(lpc_ifstate_t));
        p->next = iftop;
        iftop = p;
        p->state = c ? EXPECT_ELSE : EXPECT_ENDIF;
    }
}


/*-------------------------------------------------------------------------*/
static Bool
start_new_include (int fd, char * buf, char * name, char * name_ext, char delim)

/* The lexer is about to read data from an included source (either file
 * <fd> or allocated string <buf>) - handle setting up the include
 * information. <name> is the name of the file to be read, <name_ext>
 * is NULL or a string to add to <name> as " (<name_ext>)", <delim> is
 * the delimiter ('"', '>' or ')') of the include filename.
 *
 * Return TRUE on success, FALSE if something failed.
 */

{
    struct incstate *is, *ip;
    size_t namelen;
    int inc_depth;
    ptrdiff_t linebufoffset;

    /* Prepare defbuf for a (nested) include */
    linebufoffset = linebufstart - &defbuf[defbuf_len];
    if (outp - defbuf < 3*MAXLINE)
    {
        realloc_defbuf();
        /* linebufstart is invalid now */
        if (outp - defbuf < 2*MAXLINE)
        {
            lexerror("Maximum total buffer size exceeded");
            return MY_FALSE;
        }
    }

    /* Copy the current state, but don't put it on the stack
     * yet in case we run into an error further down.
     */
    is = mempool_alloc(lexpool, sizeof(struct incstate));
    if (!is) {
        lexerror("Out of memory");
        return MY_FALSE;
    }

    is->yyin = yyin;
    is->line = current_line;
    is->file = current_file;
    is->linebufoffset = linebufoffset;
    is->saved_char = saved_char;
    is->next = inctop;
    is->pragma_strict_types = pragma_strict_types;

    /* Copy the new filename into current_file */

    namelen = strlen(name);
    if (name_ext != NULL)
        namelen += 3 + strlen(name_ext);

    current_file = xalloc(namelen+1);
    if (!current_file)
    {
        current_file = is->file;
        xfree(is);
        lexerror("Out of memory");
        return MY_FALSE;
    }
    strcpy(current_file, name);
    if (name_ext)
    {
        strcat(current_file, " (");
        strcat(current_file, name_ext);
        strcat(current_file, ")");
    }

    /* Now it is save to put the saved state onto the stack*/
    inctop = is;

    /* Compute the include depth and store the include information */
    for (inc_depth = 0, ip = inctop; ip; ip = ip->next)
        inc_depth++;

    if (name_ext)
        inctop->inc_offset = store_include_info(name_ext, current_file, delim, inc_depth);
    else
        inctop->inc_offset = store_include_info(name, current_file, delim, inc_depth);

    /* Initialise the rest of the lexer state */
    pragma_strict_types = PRAGMA_WEAK_TYPES;
    instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
    current_line = 0;
    linebufend   = outp - 1; /* allow trailing zero */
    linebufstart = linebufend - MAXLINE;
    *(outp = linebufend) = '\0';
    set_input_source(fd, buf);
    _myfilbuf();

    return MY_TRUE;
} /* start_new_include() */

/*-------------------------------------------------------------------------*/
static void
add_auto_include (const char * obj_file, const char *cur_file, Bool sys_include)

/* A new file <cur_file> was opened while compiling object <object_file>.
 * Add the auto-include information if available.
 *
 * If <cur_file> is NULL, then the <object_file> itself has just been
 * opened, otherwise <cur_file> is an included file. In the latter case,
 * flag <sys_include> purveys if it was a <>-type include.
 *
 * The global <current_line> must be valid and will be modified.
 */

{
    char * auto_include_string = NULL;

    if (driver_hook[H_AUTO_INCLUDE].type == T_STRING
     && cur_file == NULL
       )
    {
        auto_include_string = driver_hook[H_AUTO_INCLUDE].u.string;

    }
    else if (driver_hook[H_AUTO_INCLUDE].type == T_CLOSURE)
    {
        svalue_t *svp;

        /* Setup and call the closure */
        push_volatile_string((char *)obj_file);
        if (cur_file != NULL)
        {
            push_volatile_string((char *)cur_file);
            push_number(sys_include ? 1 : 0);
        }
        else
        {
            push_number(0);
            push_number(0);
        }
        svp = secure_call_lambda(driver_hook+H_AUTO_INCLUDE, 3);
        if (svp && svp->type == T_STRING)
        {
            auto_include_string = svp->u.string;
        }
    }

    if (auto_include_string != NULL)
    {
        /* The auto include string is handled like a normal include */
        current_line++; /* Make sure to restore to line 1 */
        (void)start_new_include(-1, string_copy(auto_include_string)
                               , current_file, "auto include", ')');
        inctop->pragma_strict_types = PRAGMA_KEEP_TYPES;
        current_line++; /* Make sure to start at line 1 */
    }
} /* add_auto_include() */

/*-------------------------------------------------------------------------*/
static void
merge (char *name, mp_int namelen, char *deststart)

/* Take the given include file <name> of length <namelen>, make it
 * a proper absolute pathname and store it into the buffer <deststart>.
 * This buffer must be at least INC_OPEN_BUFSIZE bytes big.
 * On a failure, return the empty string in *deststart.
 *
 * If <name> is a relative pathname, it is interpreted to the location
 * of <currentfile>. './' and '../' sequences in the name are properly
 * resolved (includes from above the mudlib are caught).
 */

{
    char *from;  /* Next character in <name> to process */
    char *dest;  /* Destination pointer into <deststart> */

    from = name;

    /* If <name> is an absolute pathname, skip any leading '/'.
     * Else extract the pathpart from <currentfile>, put
     * it into the destination buffer and set dest to point after it.
     */
    if (*from == '/')
    {
        /* absolute path */

        dest = deststart;
        do from++; while (*from == '/');
    }
    else
    {
        /* relative path */

        char *cp, *dp;

        dest = (dp = deststart) - 1;
        for (cp = current_file; *cp; *dp++ = *cp++)
        {
            if (*cp == '/')
                dest = dp;
        }
        dest++;
    }

    /* Make sure the bufferlimits are not overrun. */
    if ((dest - deststart) + namelen >= INC_OPEN_BUFSIZE)
    {
        *deststart = '\0';
        return;
    }

    /* Append the <name> to the buffer starting at <dest>,
     * collapsing './' and '../' sequences while doing it.
     */
    for (;;)
    {
        /* <from> now points to the character after the last '/'.
         */

        if (*from == '.')
        {
            if (from[1] == '.' && from[2] == '/')
            {
                /* '../': remove the pathpart copied last */

                if (dest == deststart)
                {
                    /* including from above mudlib is NOT allowed */
                    *deststart = '\0';
                    return;
                }

                for (--dest;;)
                {
                    if (*--dest == '/')
                    {
                        dest++;
                        break;
                    }
                    if (dest == deststart)
                        break;
                }
                from += 3;
                continue;

            } else if (from[1] == '/')
            {
                /* just skip these two characters */

                from += 2;
                continue;
            }
        }

        /* Copy all characters up to and including the next '/'
         * from <name> into the destination buffer.
         * Return when at the end of the name.
         */

        {
            char c;

            do {
                c = *from++;
                *dest++ = c;
                if (!c)
                  return;
            } while (c != '/');
            while (*from == '/')
                from++;
        }
    } /* for (;;) */

    /* NOTREACHED */
} /* merge() */

/*-------------------------------------------------------------------------*/
static int
open_include_file (char *buf, char *name, mp_int namelen, char delim)

/* Open the include file <name> (length <namelen>) and return the file
 * descriptor. On failure, generate an error message and return -1.
 *
 * <buf> is a buffer of size INC_OPEN_BUFSIZE and may be used to
 * generate the real filename - <name> is just the name given in the
 * #include statement.
 *
 * <delim> is '"' for #include ""-type includes, and '>' else.
 * Relative "-includes are searched relative to the current file.
 * <-includes are searched in the path(s) defined by the H_INCLUDE_DIRS
 * driver hook.
 */

{
    int fd;
    int i;
    struct stat aStat;

    /* First, try to call master->include_file().
     * Since simulate::load_object() makes sure that the master has been
     * loaded, this test can only fail when the master is compiled.
     */
    if (master_ob && !(master_ob->flags & O_DESTRUCTED)
     && (!EVALUATION_TOO_LONG())
       )
    {
        svalue_t *res;

        push_string_malloced(name);

        if (!compat_mode)
        {
            char * filename;
            filename = alloca(strlen(current_file)+2);
            *filename = '/';
            strcpy(filename+1, current_file);
            push_volatile_string(filename);
        }
        else
            push_volatile_string(current_file);

        push_number((delim == '"') ? 0 : 1);
        res = apply_master(STR_INCLUDE_FILE, 3);

        if (res && !(res->type == T_NUMBER && !res->u.number))
        {
            /* We got a result - either a new name or a "reject it"
             * value.
             */

            char * cp;

            if (res->type != T_STRING)
            {
                yyerrorf("Illegal to include file '%s'.", name);
                return -1;
            }

            if (strlen(res->u.string) >= INC_OPEN_BUFSIZE)
            {
                yyerror("Include name too long.");
                return -1;
            }

            for (cp = res->u.string; *cp == '/'; cp++) NOOP;

            if (!legal_path(cp))
            {
                yyerrorf("Illegal path '%s'.", res->u.string);
                return -1;
            }

            strcpy(buf, cp);
            if (!stat(buf, &aStat)
             && S_ISREG(aStat.st_mode)
             && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
            {
                FCOUNT_INCL(buf);
                return fd;
            }
            if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
            if (errno == ENFILE) lexerror("File table overflow");
#endif

            /* If we come here, we fail: file not found */
            return -1;
        }
    }
    else if (EVALUATION_TOO_LONG())
    {
        yyerrorf("Can't call master::%s for '%s': eval cost too big"
                , STR_INCLUDE_FILE, name);
    }

    /* The master apply didn't succeed, try the manual handling */

    if (delim == '"') /* It's a "-include */
    {
        /* Merge the <name> with the <current_file> name. */
        merge(name, namelen, buf);

        /* Test the file and open it */
        if (!stat(buf, &aStat)
         && S_ISREG(aStat.st_mode)
         && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0)
        {
            FCOUNT_INCL(buf);
            return fd;
        }

        if (errno == EMFILE)
            lexerror("File descriptors exhausted");
#ifdef ENFILE
        if (errno == ENFILE)
            lexerror("File table overflow");
#endif
        /* Include not found - fall back onto <> search pattern */
    }

    /* Handle a '<'-include. */

    if (driver_hook[H_INCLUDE_DIRS].type == T_POINTER)
    {
        char * cp;

        /* H_INCLUDE_DIRS is a vector of include directories.
         */

        if (namelen + inc_list_maxlen >= INC_OPEN_BUFSIZE)
        {
            yyerror("Include name too long.");
            return -1;
        }

        for (cp = name; *cp == '/'; cp++) NOOP;

        /* The filename must not specifiy parent directories */
        if (!check_no_parentdirs(cp))
            return -1;

        /* Search all include dirs specified.
         */
        for (i = 0; i < inc_list_size; i++)
        {
            char * iname;
            sprintf(buf, "%s%s", inc_list[i].u.string, cp);
            for (iname = buf; *iname == '/'; iname++) NOOP;
            if (!stat(iname, &aStat)
             && S_ISREG(aStat.st_mode)
             && (fd = ixopen(iname, O_RDONLY|O_BINARY)) >= 0 )
            {
                FCOUNT_INCL(iname);
                return fd;
            }
            if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
            if (errno == ENFILE) lexerror("File table overflow");
#endif
        }

        /* If we come here, the include file was not found */
    }
    else if (driver_hook[H_INCLUDE_DIRS].type == T_CLOSURE)
    {
        /* H_INCLUDE_DIRS is a function generating the full
         * include file name.
         */

        svalue_t *svp;

        /* Setup and call the closure */
        push_string_malloced(name);
        push_volatile_string(current_file);
        if (driver_hook[H_INCLUDE_DIRS].x.closure_type == CLOSURE_LAMBDA)
            driver_hook[H_INCLUDE_DIRS].u.lambda->ob = current_object;
        svp = secure_call_lambda(&driver_hook[H_INCLUDE_DIRS], 2);

        /* The result must be legal relative pathname */

        if (svp && svp->type == T_STRING
         && strlen(svp->u.string) < INC_OPEN_BUFSIZE)
        {
            char * cp;

            for (cp = svp->u.string; *cp == '/'; cp++) NOOP;
            strcpy(buf, cp);
            if (legal_path(buf))
            {
                if (!stat(buf, &aStat)
                 && S_ISREG(aStat.st_mode)
                 && (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
                {
                    FCOUNT_INCL(buf);
                    return fd;
                }
                if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
                if (errno == ENFILE) lexerror("File table overflow");
#endif
            }
        }

        /* If we come here, the include file was not found */
    }

    /* File not found */
    return -1;
} /* open_include_file() */

/*-------------------------------------------------------------------------*/
static INLINE void
handle_include (char *name)

/* Handle an #include statement, <name> points to the first non-blank
 * character after the '#include'.
 * If the include succeeds, a new incstate is created and pushed
 * onto the include stack. Else an error message is generated.
 */

{
    char *p;
    int   fd;        /* fd of new include file */
    char  delim;     /* Filename end-delimiter ('"' or '>'). */
    char *old_outp;  /* Save the original outp */
    Bool  in_buffer = MY_FALSE; /* True if macro was expanded */
    char  buf[INC_OPEN_BUFSIZE];

#if 0
    if (nbuf) {
        lexerror("Internal preprocessor error");
        return;
    }
#endif
    old_outp = outp;

    /* If <name> doesn't start with '"' or '<', assume that it
     * is a macro. Attempt to expand these macros until <name>
     * starts with a proper delimiter.
     */
    while (*name != '"' && *name != '<')
    {
        char c;
        ident_t *d;

        /* Locate the end of the macro and look it up */
        for (p = name; isalunum(*p); p++) NOOP;
        c = *p;
        *p = '\0';
        d = lookup_define(name);
        *p = c;

        /* Prepare to expand the macro */
        if (in_buffer)
        {
            outp = p;
        }
        else
        {
            myungetc('\n');
            add_input(p);
            in_buffer = MY_TRUE;
        }

        /* Expand the macro */
        if (!d || !_expand_define(&d->u.define, d) ) {
            yyerror("Missing leading \" or < in #include");
            return;
        }

        /* Set name to the first non-blank of the expansion */
        name = outp;
        while (lexwhite(*name))
            name++;
    }

    /* Store the delimiter and set p to the closing delimiter */
    delim = (char)((*name++ == '"') ? '"' : '>');
    for(p = name; *p && *p != delim; p++) NOOP;

    if (!*p) {
        yyerror("Missing trailing \" or > in #include");
        outp = old_outp;
        return;
    }
    *p = '\0';


    /* For "-includes, look for following macros or "<path>"
     * fragments on the same line and append these to the <name>.
     * The new name is created in the yytext[] buffer (if at all).
     */

    if (delim == '"')
    {
        char *q;

        q = p + 1;
        for (;;)
        {
            /* Find the first non-blank character after p */
            while(lexwhite(*q))
                q++;
            if (!*q || *q == '\n')
                break;

            /* First, try to expand a macros */
            while (*q != delim)
            {
                char *r, c;
                ident_t *d;

                /* Set r to the first blank after the macro name */
                for (r = q; isalunum(*r); r++) NOOP;

                /* Lookup the macro */
                c = *r;
                *r = '\0';
                d = lookup_define(q);
                *r = c;

                /* Prepare to expand the macro */
                if (in_buffer)
                {
                    outp = r;
                    if (name != yytext)
                    {
                        if ( (p - name) >= MAXLINE - 1)
                        {
                            yyerror("Include name too long.");
                            outp = old_outp;
                            return;
                        }
                        *p = '\0';
                        strcpy(yytext, name);
                        p += yytext - name;
                        name = yytext;
                    }
                }
                else
                {
                    myungetc('\n');
                    add_input(r);
                    in_buffer = MY_TRUE;
                }

                /* Expand the macro */
                if (!d || !_expand_define(&d->u.define, d) ) {
                    yyerror("Missing leading \" in #include");
                    outp = old_outp;
                    return;
                }
                q = outp;

                /* Skip the blanks until the next macro/filename */
                while (lexwhite(*q))
                    q++;
            }

            /* Second, try to parse a string literal */
            while (*++q && *q != delim)
            {
                if ( (p - name) >= MAXLINE - 1)
                {
                    yyerror("Include name too long.");
                    outp = old_outp;
                    return;
                }
                *p++ = *q;
            }
            if (!*q++) {
                yyerror("Missing trailing \" in #include");
                outp = old_outp;
                return;
            }
        } /* for (;;) */
    } /* if (delim == '"') */

    /* p now points to the character after the parsed filename */

    outp = old_outp;  /* restore outp */
    *p = '\0';        /* mark the end of the filename */

    /* Open the include file, put the current lexer state onto
     * the incstack, and set up for the new file.
     */
    if ((fd = open_include_file(buf, name, p - name, delim)) >= 0)
    {
        if (!start_new_include(fd, NULL, buf, NULL, delim))
            return;

        add_auto_include(object_file, current_file, delim != '"');
    }
    else
    {
        yyerrorf("Cannot #include '%s'", name);
    }
} /* handle_include() */

/*-------------------------------------------------------------------------*/
static void
skip_comment (void)

/* Skip a block comment (/ * ... * /). The function is entered with outp
 * pointing to the first character after the comment introducer, and left
 * with outp pointing to the first character after the comment end delimiter.
 */

{
    register char c, *p;

    p = outp;
    for(;;)
    {
        /* Skip everything until the next '*' */
        while((c =  *p++) != '*')
        {
            if (c == '\n') {
                store_line_number_info();
                nexpands = 0;
                if ((c = *p) == CHAR_EOF) {
                    outp = p - 1;
                    lexerror("End of file (or 0x01 character) in a comment");
                    return;
                }
                current_line++;
                if (!c)
                {
                    outp = p;
                    p = _myfilbuf();
                }
            }
        } /* while (c == '*') */

        /* Skip all '*' until we find '/' or something else */
        do
        {
            if ((c = *p++) == '/')
            {
                outp = p;
                return;
            }

            if (c == '\n') {
                store_line_number_info();
                nexpands = 0;
                if ((c = *p) == CHAR_EOF)
                {
                    outp = p - 1;
                    lexerror("End of file (or 0x01 character) in a comment");
                    return;
                }
                current_line++;
                if (!c)
                {
                    outp = p;
                    p = _myfilbuf();
                }
                c = '\0'; /* Make sure to terminate the '*' loop */
            }
        } while(c == '*');
    } /* for() */

    /* NOTREACHED */
} /* skip_comment() */

/*-------------------------------------------------------------------------*/
static char *
skip_pp_comment (char *p)

/* Skip a '//' line comment. <p> points to the first character after
 * the comment introducer, the function returns a pointer to the first
 * character after the terminating newline. If the comment is ended
 * prematurely by the end of file, the returned pointer will point at the
 * EOF character.
 * Note that a '\<newline>' lineend does not terminate the comment.
 */

{
    char c;

    for (;;)
    {
        c = *p++;
        if (CHAR_EOF == c)
        {
            return p-1;
        }
        if (c == '\n')
        {
            store_line_number_info();
            current_line++;
            if (p[-2] == '\\')
            {
                if (!*p)
                {
                    outp = p;
                    p = _myfilbuf();
                }
                continue;
            }
            nexpands = 0;
            if (!*p)
            {
                outp = p;
                p = _myfilbuf();
            }
            return p;
        }
    }

    /* NOTREACHED */
} /* skip_pp_comment() */

/*-------------------------------------------------------------------------*/
static void
deltrail (char *sp)

/* Look for the first blank character in the text starting at <sp> and
 * set it to '\0'. The function is used to isolate the next word
 * in '#' statements.
 */

{
    char *p;

    p = sp;
    if (!*p)
    {
        lexerror("Illegal # command");
    }
    else
    {
        while(*p && !isspace((unsigned char)*p))
            p++;
        *p = '\0';
    }
}

/*-------------------------------------------------------------------------*/
static void
handle_pragma (char *str)

/* Handle the pragma <str>. Unknown pragmas are ignored.
 * One pragma string can contain multiple actual pragmas, separated
 * with comma (and additional spaces).
 */

{
    char * base, * next;

#if defined(LEXDEBUG)
    printf("%s handle pragma:'%s'\n", time_stamp(), str);
#endif

    /* Loop over the pragma(s).
     * If valid, base points to the first character of the pragma name,
     * or to spaces before it.
     */
    for ( base = str, next = NULL
        ; base != NULL && *base != '\0' && *base != '\r'
        ; base = next
        )
    {
        size_t namelen;
        Bool validPragma;

        /* Skip spaces */
        base = base + strspn(base, " \t\r");
        if ('\0' == *base || '\r' == *base)
            break;

        /* Find next delimiter, if any, and determine the
         * length of the pragma name.
         */
        next = strpbrk(base, " \t,\r");
        if (NULL == next)
            namelen = strlen(base);
        else
            namelen = next - base;

        /* Evaluate the found pragma name */
        validPragma = MY_FALSE;

        if (namelen == 0)
        {
            if (master_ob)
            {
                yywarnf("Empty #pragma");
            }
            else
            {
                debug_message("Warning: Empty #pragma"
                              ": file %s, line %d\n"
                             , current_file, current_line);
            }
            validPragma = MY_TRUE; /* Since we already issued a warning */
        }
        else if (strncmp(base, "strict_types", namelen) == 0)
        {
            pragma_strict_types = PRAGMA_STRICT_TYPES;
            instrs[F_CALL_OTHER].ret_type = TYPE_UNKNOWN;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "strong_types", namelen) == 0)
        {
            pragma_strict_types = PRAGMA_STRONG_TYPES;
            instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "weak_types", namelen) == 0)
        {
            pragma_strict_types = PRAGMA_WEAK_TYPES;
            instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "save_types", namelen) == 0)
        {
            pragma_save_types = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "combine_strings", namelen) == 0)
        {
            pragma_combine_strings = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_combine_strings", namelen) == 0)
        {
            pragma_combine_strings = MY_FALSE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "verbose_errors", namelen) == 0)
        {
            pragma_verbose_errors = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_clone", namelen) == 0)
        {
            pragma_no_clone = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_inherit", namelen) == 0)
        {
            pragma_no_inherit = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_shadow", namelen) == 0)
        {
            pragma_no_shadow = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "pedantic", namelen) == 0)
        {
            pragma_pedantic = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "sloppy", namelen) == 0)
        {
            pragma_pedantic = MY_FALSE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_local_scopes", namelen) == 0)
        {
            pragma_use_local_scopes = MY_FALSE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "local_scopes", namelen) == 0)
        {
            pragma_use_local_scopes = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "warn_deprecated", namelen) == 0)
        {
            pragma_warn_deprecated = MY_TRUE;
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "no_warn_deprecated", namelen) == 0)
        {
            pragma_warn_deprecated = MY_FALSE;
            validPragma = MY_TRUE;
        }
#if defined( DEBUG ) && defined ( TRACE_CODE )
        else if (strncmp(base, "set_code_window", namelen) == 0)
        {
            set_code_window();
            validPragma = MY_TRUE;
        }
        else if (strncmp(base, "show_code_window", namelen) == 0)
        {
            show_code_window();
            validPragma = MY_TRUE;
        }
#endif

        /* Advance next to the next scanning position so that the
         * for loop increment works.
         */
        if (NULL != next)
        {
            /* Skip spaces */
            next = next + strspn(next, " \t\r");

            if (',' == *next)
            {
                /* Skip the one allowed comma.
                 * We allow the comma to be followed by lineend
                 */
                next++;
            }
            else if ('\0' != *next && '\r' != *next)
            {
                if (master_ob)
                {
                    yywarnf("Missing comma between #pragma options");
                }
                else
                {
                    debug_message("Warning: Missing comma between #pragma options"
                                  ": file %s, line %d\n"
                                 , current_file, current_line);
                }
            }

            if ('\0' == *next || '\r' == *next)
            {
                /* End of string */
                next = NULL;
            }

            /* If next now points to something else but space or a pragma
             * name, the next loop iteration will complain about an illegal
             * pragma.
             */
        }

        /* Finally check if the pragma was valid */
        if (!validPragma)
        {
            if (master_ob)
            {
                /* Calling yywarnf() without a master can cause the game
                 * to shut down, because yywarnf() eventually tries to call
                 * a master lfun.
                 */
                yywarnf("Unknown #pragma '%.*s'", (int)namelen, base);
            }
            else
            {
                debug_message("Warning: Unknown #pragma '%.*s': file %s, line %d\n"
                             , (int)namelen, base, current_file, current_line);
            }
        }

    } /* for (base) */
} /* handle_pragma() */

/*-------------------------------------------------------------------------*/
static INLINE int
number (long i)

/* Return a number to yacc: set yylval.number to <i> and return L_NUMBER.
 */

{
#ifdef LEXDEBUG
    printf("%s returning number %d.\n", time_stamp(), i);
#endif
    yylval.number = i;
    return L_NUMBER;
}

/*-------------------------------------------------------------------------*/
static INLINE char *
parse_numeric_escape (char * cp, unsigned char * p_char)

/* Parse a character constant in one of the following formats:
 *   <decimal>      (max 3 digits)
 *   0o<octal>      (max 3 digits)
 *   0x<sedecimal>  (max 2 digits)
 *   x<sedecimal>   (max 2 digits)
 *   0b<binary>     (max 8 digits)
 *
 * with <cp> pointing to the first character. The function parses
 * until the first illegal character, but at max the given number of
 * digits.
 *
 * The parsed number is stored in *<p_num>, the function returns the pointer
 * to the first character after the number.
 * If no valid character constant could be found, NULL is returned.
 */

{
    char c;
    int num_digits = 3;
    unsigned long l;
    unsigned long base = 10;

    c = *cp++;

    if ('0' == c)
    {
        /* '0' introduces decimal, octal, binary and sedecimal numbers, or it
         * can be a float.
         *
         * Sedecimals are handled in a following if-clause to allow the
         * two possible prefixes.
         */

        c = *cp++;

        switch (c)
        {
        case 'X': case 'x':
            /* Sedecimal number are handled below - here just fall
             * through.
             */
            NOOP;
            break;

        case 'b': case 'B':
          {
            c = *cp++;
            num_digits = 8;
            base = 2;
            break;
          }

        case 'o': case 'O':
            c = *cp++;
            base = 8;
            num_digits = 3;
            break;

        default:
            c = '0';
            cp--;
            break;
        } /* switch(c) */
    } /* if ('0' == c) */

    if ( c == 'X' || c == 'x' )
    {
        if (!leXdigit(*cp))
        {
            yywarn("Character constant used with no valid digits");
            return NULL;
        }

        /* strtol() gets the sign bit wrong,
         * strtoul() isn't portable enough.
         */
        num_digits = 2;
        l = 0;
        while(leXdigit(c = *cp++) && num_digits-- > 0)
        {
            if (c > '9')
                c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
            l <<= 4;
            l += c - '0';
        }
    }
    else
    {
        /* Parse a normal number from here */

        l = c - '0';
        if  (l > base) /* remember: l is unsigned */
        {
            yywarn("Character constant used with no valid digits");
            return NULL;
        }
        while (lexdigit(c = *cp++) && c < '0'+base && --num_digits > 0)
              l = l * base + (c - '0');
    }

    if (l >= 256)
        yywarn("Character constant out of range (> 255)");

    *p_char = l & 0xff;
    return cp-1;

} /* parse_numeric_escape() */

/*-------------------------------------------------------------------------*/
static INLINE char *
parse_number (char * cp, unsigned long * p_num)

/* Parse a positive integer number in one of the following formats:
 *   <decimal>
 *   0o<octal>
 *   0x<sedecimal>
 *   x<sedecimal>
 *   0b<binary>
 *
 * with <cp> pointing to the first character.
 *
 * The parsed number is stored in *<p_num>, the function returns the pointer
 * to the first character after the number.
 */

{
    char c;
    unsigned long l;
    unsigned long base = 10;

    c = *cp++;

    if ('0' == c)
    {
        /* '0' introduces decimal, octal, binary and sedecimal numbers, or it
         * can be a float.
         *
         * Sedecimals are handled in a following if-clause to allow the
         * two possible prefixes.
         */

        c = *cp++;

        switch (c)
        {
        case 'X': case 'x':
            /* Sedecimal number are handled below - here just fall
             * through.
             */
            NOOP;
            break;

        case 'b': case 'B':
          {
            l = 0;
            --cp;
            while('0' == (c = *++cp) || '1' == c)
            {
                l <<= 1;
                l += c - '0';
            }

            *p_num = l;
            return cp;
          }

        case 'o': case 'O':
            c = '0';
            base = 8;
            break;

        default:
            /* If some non-digit follows, it's just the number 0.
             */
            if (!lexdigit(c))
            {
                *p_num = 0;
                return cp-1;
            }
            break;
        } /* switch(c) */
    } /* if ('0' == c) */

    if ( c == 'X' || c == 'x' )
    {

        /* strtol() gets the sign bit wrong,
         * strtoul() isn't portable enough.
         */
        l = 0;
        --cp;
        while(leXdigit(c = *++cp))
        {
            if (c > '9')
                c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
            l <<= 4;
            l += c - '0';
        }
        *p_num = l;
        return cp;
    }

    /* Parse a normal number from here */

    l = c - '0';
    while (lexdigit(c = *cp++) && c < '0'+base) l = l * base + (c - '0');

    *p_num = l;
    return cp-1;

} /* parse_number() */

/*-------------------------------------------------------------------------*/
static INLINE char *
parse_escaped_char (char * cp, char * p_char)

/* Parse the sequence for an escaped character:
 *
 *   \a : Bell (0x07)
 *   \b : Backspace (0x08)
 *   \e : Escape (0x1b)
 *   \f : Formfeed (0x0c)
 *   \n : Newline (0x0a)
 *   \r : Carriage-Return (0x0d)
 *   \t : Tab (0x09)
 *   \<decimal>, \0o<octal>, \x<sedecimal>, \0x<sedecimal>, \0b<binary>:
 *        the character with the given code.
 *   \<other printable character> : the printable character
 *
 * with <cp> pointing to the character after the '\'.
 *
 * The parsed character is stored in *<p_char>, the function returns the
 * pointer to the first character after the sequence.
 *
 * If the sequence is not one of the recognized sequences, NULL is returned.
 */

{
    char c;

    switch (c = *cp++)
    {
    case '\n':
    case CHAR_EOF:
        return NULL; break;

    case 'a': c = '\007'; break;
    case 'b': c = '\b';   break;
    case 'e': c = '\033'; break;
    case 'f': c = '\014'; break;
    case 'n': c = '\n';   break;
    case 'r': c = '\r';   break;
    case 't': c = '\t';   break;
    case '0': case '1': case '2': case '3': case '4':
    case '5': case '6': case '7': case '8': case '9':
    case 'x': case 'X':
      {
        char * cp2;

        /* If no valid escaped character is found, treat the sequence
         * as a normal escaped character.
         */
        cp2 = parse_numeric_escape(cp-1, (unsigned char *)&c);
        if (cp2 != NULL)
            cp = cp2;
      }
    } /* switch() */

    *p_char = c;
    return cp;
} /* parse_escaped_char() */

/*-------------------------------------------------------------------------*/
static void
add_lex_string (char *str)

/* Add <str> to the global <last_lex_string> in order to implement
 * Standard-C style string concatenation.
 */

{
    size_t len1, len3;
    char *tmp;

    len1 = strlen(last_lex_string);
    len3 = len1 + strlen(str) + 1;
    if (len3 > MAX_ANSI_CONCAT)
    {
        /* Without this test, compilation would still terminate eventually,
         * thus it would still be 'correct', but it could take several hours.
         */
        lexerror("Too long ansi style string concatenation");
        /* leave the old string, ignore the new addition */
        return;
    }
    tmp = alloca(len3);
    strcpy(tmp, last_lex_string);
    strcpy(tmp + len1, str);
    free_string(last_lex_string);
    last_lex_string = make_shared_string(tmp);
}

/*-------------------------------------------------------------------------*/
static INLINE int
string (char *str)

/* Return a string to yacc: set last_lex_string to <str> and return L_STRING.
 * If there is a string in last_lex_string already, <str> is appended
 * and yylex() is called recursively to allow ANSI string concatenation.
 */

{
    if (last_lex_string)
    {
        add_lex_string(str);
        return yylex();
    }
    else
    {
        last_lex_string = make_shared_string(str);
    }
    return L_STRING;
}

/*-------------------------------------------------------------------------*/
static INLINE int
yylex1 (void)

/* Lex the next lexical element starting from outp and return its code.
 * For single characters, this is the character code itself. Multi-character
 * elements return the associated code define in lang.h.
 * Illegal characters are returned as spaces.
 * If the lexer runs into a fatal error or the end of file, -1 is returned.
 *
 * <depth> is the current nesting depth for local scopes, needed for
 * correct lookup of local identifiers.
 *
 * Some elements return additional information:
 *   L_ASSIGN:  yylval.number is the type of assignment operation
 *              e.g. F_ADD_EQ for '+='.
 *              '=' itself is returned as F_ASSIGN.
 *   L_NUMBER:  yylval.number is the parsed whole number or char constant.
 *   L_FLOAT:   yylval.float_number is the parsed float number.
 *   L_STRING:  last_lex_string is the (shared) parsed string literal.
 *   L_CLOSURE: yylval.closure.number identifies the closure. See the
 *              source for which value means what (it's a bit longish).
 *   L_QUOTED_AGGREGATE: yylval.number is the number of quotes
 *   L_SYMBOL:  yylval.symbol.name is the (shared) name of the symbol,
 *              yylval.symbol.quotes the number of quotes.
 */

{
    register char *yyp;
    register char c;

#define TRY(c, t) if (*yyp == (c)) {yyp++; outp = yyp; return t;}

    /* If we are at a point suitable for inline function insertion,
     * do it.
     * Note: It is not strictly necessary to insert all of them
     * at once, since the compiler will set insert_inline_fun_now
     * again as soon as it is finished with this one.
     */
    if (insert_inline_fun_now)
    {
        struct inline_fun * fun;
        char buf[80];

        sprintf(buf, "#line %d\n", current_line);
        insert_inline_fun_now = MY_FALSE;
        while (first_inline_fun)
        {
            fun = first_inline_fun->next;
            if (first_inline_fun->buf.length)
            {
                strbuf_add(&(first_inline_fun->buf), buf);
                add_input(first_inline_fun->buf.buf);
                strbuf_free(&(first_inline_fun->buf));
            }
            xfree(first_inline_fun);
            first_inline_fun = fun;
        }
    }

    yyp = outp;

    for(;;) {
        switch((unsigned char)(c = *yyp++))
        {

        /* --- End Of File --- */

        case CHAR_EOF:

            if (inctop)
            {
                /* It's the end of an included file: return the previous
                 * file
                 */

                static char call_other_return_types[]
                  = { /* PRAGMA_WEAK_TYPES:   */ TYPE_ANY
                    , /* PRAGMA_STRONG_TYPES: */ TYPE_ANY
                    , /* PRAGMA_STRICT_TYPES: */ TYPE_UNKNOWN };

                struct incstate *p;
                Bool was_string_source = (yyin.fd == -1);

                p = inctop;

                /* End the lexing of the included file */
                close_input_source();
                xfree(current_file);
                nexpands = 0;

                /* Restore the previous state */
                current_file = p->file;
                current_line = p->line;

                if (!was_string_source)
                    current_line++;
                store_include_end(p->inc_offset);

                if (was_string_source)
                {
                    /* 'string' includes are supposed to be inline
                     * so correct the line number information to take out
                     * the assumed newlines.
                     * This has to be done after store_include_end()
                     * since that function may remove all line number
                     * information since the start of the include.
                     */
                    current_line -= 1;
                    store_line_number_backward(1);
                }

                if (p->pragma_strict_types != PRAGMA_KEEP_TYPES)
                {
                    pragma_strict_types = p->pragma_strict_types;
                    instrs[F_CALL_OTHER].ret_type =
                        call_other_return_types[pragma_strict_types];
                }
                yyin = p->yyin;
                saved_char = p->saved_char;
                inctop = p->next;
                *linebufend = '\n';
                yyp = linebufend + 1;
                linebufstart = &defbuf[defbuf_len] + p->linebufoffset;
                linebufend   = linebufstart + MAXLINE;
                mempool_free(lexpool, p);
                if (!*yyp)
                {
                    outp = yyp;
                    yyp = _myfilbuf();
                }
                break;
            }

            /* Here it's the end of the main file */

            if (iftop)
            {
                /* Oops, pending #if!
                 * Note the error and clean up the if-stack.
                 */
                lpc_ifstate_t *p = iftop;

                yyerror(p->state == EXPECT_ENDIF ? "Missing #endif" : "Missing #else");
                while(iftop)
                {
                    p = iftop;
                    iftop = p->next;
                    mempool_free(lexpool, p);
                }
            }

            /* Return the EOF condition */
            outp = yyp-1;
            return -1;


        /* --- Newline --- */

        case '\n':
            {
                store_line_number_info();
                nexpands = 0;
                current_line++;
                total_lines++;
                if (!*yyp)
                {
                    outp = yyp;
                    yyp = _myfilbuf();
                }
            }
            break;


        /* --- Other line markers --- */

        case 0x1a: /* Used by some MSDOS editors as EOF */
        case '\r':
            *(yyp-1) = *(yyp-2);
            break;


        /* --- White space --- */

        case ' ':
        case '\t':
        case '\f':
        case '\v':
            break;


        /* --- Multi-Char Operators --- */
        case '+':
            switch(c = *yyp++)
            {
            case '+': outp = yyp;
                      return L_INC;
            case '=': yylval.number = F_ADD_EQ;
                      outp = yyp;
                      return L_ASSIGN;
            default:  yyp--;
            }
            outp = yyp;
            return '+';

        case '-':
            switch(c = *yyp++)
            {
            case '>': outp = yyp;
                      return L_ARROW;
            case '-': outp = yyp;
                      return L_DEC;
            case '=': yylval.number = F_SUB_EQ;
                      outp = yyp;
                      return L_ASSIGN;
            default:  yyp--;
            }
            outp = yyp;
            return '-';

        case '&':
            switch(c = *yyp++)
            {
            case '&':
                switch(c = *yyp++)
                {
                case '=': yylval.number = F_LAND_EQ;
                          outp = yyp;
                          return L_ASSIGN;
                default:  yyp--;
                }
                outp = yyp;
                return L_LAND;
            case '=': yylval.number = F_AND_EQ;
                      outp = yyp;
                      return L_ASSIGN;
            default:  yyp--;
            }
            outp = yyp;
            return '&';

        case '|':
            switch(c = *yyp++)
            {
            case '|':
                switch(c = *yyp++)
                {
                case '=': yylval.number = F_LOR_EQ;
                          outp = yyp;
                          return L_ASSIGN;
                default:  yyp--;
                }
                outp = yyp;
                return L_LOR;
            case '=': yylval.number = F_OR_EQ;
                      outp = yyp;
                      return L_ASSIGN;
            default:  yyp--;
            }
            outp = yyp;
            return '|';

        case '^':
            if (*yyp == '=')
            {
                yyp++;
                yylval.number = F_XOR_EQ;
                outp = yyp;
                return L_ASSIGN;
            }
            outp = yyp;
            return '^';

        case '<':
            c = *yyp++;;
            if (c == '<')
            {
                if (*yyp == '=')
                {
                    yyp++;
                    yylval.number = F_LSH_EQ;
                    outp = yyp;
                    return L_ASSIGN;
                }
                outp = yyp;
                return L_LSH;
            }
            if (c == '=') {
                outp=yyp;
                return L_LE;
            }
            yyp--;
            outp = yyp;
            return '<';

        case '>':
            c = *yyp++;
            if (c == '>')
            {
                if (*yyp == '=')
                {
                    yyp++;
                    yylval.number = F_RSH_EQ;
                    outp = yyp;
                    return L_ASSIGN;
                }
                if (*yyp == '>')
                {
                    yyp++;
                    if (*yyp == '=')
                    {
                        yyp++;
                        yylval.number = F_RSHL_EQ;
                        outp = yyp;
                        return L_ASSIGN;
                    }
                    outp = yyp;
                    return L_RSHL;
                }
                outp = yyp;
                return L_RSH;
            }
            if (c == '=')
            {
                outp = yyp;
                return L_GE;
            }
            yyp--;
            outp = yyp;
            return '>';

        case '*':
            if (*yyp == '=')
            {
                yyp++;
                yylval.number = F_MULT_EQ;
                outp = yyp;
                return L_ASSIGN;
            }
            outp = yyp;
            return '*';

        case '%':
            if (*yyp == '=') {
                yyp++;
                yylval.number = F_MOD_EQ;
                outp = yyp;
                return L_ASSIGN;
            }
            outp = yyp;
            return '%';

        case '/':
            c = *yyp++;
            if (c == '*')
            {
                outp = yyp;
                skip_comment();
                yyp = outp;
                if (lex_fatal)
                {
                    return -1;
                }
                break;
            }
            if (c == '/')
            {
                yyp = skip_pp_comment(yyp);
                break;
            }
            if (c == '=')
            {
                yylval.number = F_DIV_EQ;
                outp = yyp;
                return L_ASSIGN;
            }
            yyp--;
            outp = yyp;
            return '/';

        case '=':
            TRY('=', L_EQ);
            yylval.number = F_ASSIGN;
            outp = yyp;
            return L_ASSIGN;

        case '!':
            TRY('=', L_NE);
            outp = yyp;
            return L_NOT;

        case '.':
            TRY('.',L_RANGE);
            goto badlex;

        case ':':
            TRY(':', L_COLON_COLON);
            outp = yyp;
            return ':';


        /* --- Inline Function --- */

        case '(':
            /* Check for '(:' but ignore '(::' which can occur e.g.
             * in 'if (::remove())'. However, accept '(:::' e.g. from
             * '(:::remove()', and '(::)'.
             */

            if (*yyp == ':'
             && (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')'))
            {
                struct inline_fun * fun;
                strbuf_t * textbuf;
                size_t pos_return;  /* position of the 'return' */
                char name[256+MAXPATHLEN+1];
                int level;       /* Nesting level of embedded (: :) */
                int blevel;      /* Nesting level of embedded { } */
                int first_line;  /* For error messages */
                char *start;

                first_line = current_line;

                /* Allocate new function list element */
                if (!first_inline_fun)
                {
                    /* Create the list */
                    first_inline_fun = xalloc(sizeof *first_inline_fun);
                    if (!first_inline_fun)
                        yyerror("Out of memory.");
                    fun = first_inline_fun;
                }
                else
                {
                    /* Append the element at the end of the list */
                    fun = first_inline_fun;
                    while (fun->next)
                        fun = fun->next;
                    fun->next = xalloc(sizeof *fun);
                    if (!fun->next)
                        yyerror("Out of memory.");
                    fun = fun->next;
                }

                textbuf = &(fun->buf);
                strbuf_zero(textbuf);
                fun->next = NULL; /* Terminate the list properly */

                /* Create the name of the new inline function.
                 * We have to make sure the name is really unique.
                 */
                do
                {
                    sprintf(name, "__inline_%s_%d_%04x", current_file
                                 , current_line, next_inline_fun++);

                    /* Convert all non-alnums to '_' */
                    for (start = name; *start != '\0'; start++)
                    {
                        if (!isalnum((unsigned char)(*start)))
                            *start = '_';
                    }
                } while (    find_shared_identifier(name, 0, 0)
                          && next_inline_fun != 0);

                if (next_inline_fun == 0)
                {
                    yyerror("Can't generate unique name for inline closure.");
                    return -1;
                }

                /* Create the function header in the string buffer.
                 * For now we insert a 'return' which we might 'space out'
                 * later.
                 */
                strbuf_addf(textbuf, "\n#line %d\n", current_line-1);
                strbuf_addf(textbuf,
                             "private nomask varargs mixed %s "
                             "(mixed $1, mixed $2, mixed $3,"
                             " mixed $4, mixed $5, mixed $6, mixed $7,"
                             " mixed $8, mixed $9) {\n"
                             "return "
                           , name
                           );
                pos_return = (size_t)textbuf->length-7;

                /* Set yyp to the end of (: ... :), and also check
                 * for the highest parameter used.
                 */
                yyp++;
                level = 1;
                blevel = 0;
                start = yyp;
                while (level)
                {
                    switch (*yyp++)
                    {
                    case CHAR_EOF:
                        current_line = first_line;
                        yyerror("Unexpected end of file in (: .. :)");
                        return -1;

                    case '\0':
                        lexerror("Lexer failed to refill the line buffer");
                        return -1;

                    case '(':
                        if (yyp[0] == ':'
                         && (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')')
                           )
                            level++, yyp++;
                        else if (yyp[0] == '{')
                            yyp++;
                        break;

                    case ':':
                        if (yyp[0] == ')')
                            level--, yyp++;
                        break;

                    case '#':
                        if (*yyp == '\'')
                            yyp++;
                        break;

                    case '{':
                        blevel++;
                        break;

                    case '}':
                        if (yyp[0] != ')')
                        {
                            if (!blevel)
                            {
                                yyerror("Illegal block nesting");
                                return -1;
                            }
                            blevel--;
                        }
                        break;

                    case '/':
                        c = *yyp;
                        if (c == '*')
                        {
                            int this_line;

                            this_line = current_line;
                            strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
                            outp = yyp;
                            skip_comment();
                            yyp = outp;
                            if (lex_fatal)
                                return -1;

                            start = yyp;
                            while (this_line++ < current_line)
                                strbuf_addc(textbuf, '\n');

                            continue;
                        }

                        if (c == '/')
                        {
                            int this_line;

                            this_line = current_line;
                            strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
                            yyp = skip_pp_comment(yyp);

                            start = yyp;
                            while (this_line++ < current_line)
                                strbuf_addc(textbuf, '\n');

                            continue;
                        }
                        break;

                    case '\n':
                        store_line_number_info();
                        nexpands = 0;
                        current_line++;
                        total_lines++;
                        if (!*yyp)
                        {
                            strbuf_addn(textbuf, start, (size_t)(yyp-start));
                            outp = yyp;
                            yyp = _myfilbuf();
                            start = yyp;
                        }
                        break;

                    case '\"':
                    case '\'':
                      {
                        char delimiter = yyp[-1];

                        /* If the delimiter is a ', we have to check
                         * for (possibly escaped) character constants
                         * and symbols.
                         */
                        if (delimiter == '\'' && *yyp == '\\')
                        {
                            /* Parse an escape sequence */

                            if ('\n' != yyp[1] && CHAR_EOF != yyp[1])
                            {
                                char *cp;
                                char lc; /* Since c is 'register' */

                                cp = parse_escaped_char(yyp+1, &lc);
                                if (!cp)
                                    yyerror("Illegal character constant");
                                yyp = cp;
                            }

                            /* Test if it's terminated by a quote (this also
                             * catches the \<nl> and \<eof> case).
                             */
                            if (*yyp++ != '\'')
                            {
                                yyp--;
                                yyerror("Illegal character constant");
                            }
                        }
                        else if (delimiter == '\''
                         && ( (    yyp[1] != '\''
                               || (   *yyp == '\''
                                   && (   yyp[1] == '('
                                       || isalunum(yyp[1])
                                       || yyp[1] == '\'')
                                      )
                                  )
                            )
                           )
                        {
                            /* Skip the symbol or quoted aggregate
                             *
                             * The test rejects all sequences of the form
                             *   'x'
                             * and
                             *   '''x, with x indicating that the ' character
                             *         itself is meant as the desired constant.
                             *
                             * It accepts all forms of quoted symbols, with
                             * one or more leading ' characters.
                             */

                            /* Skip all leading quotes.
                             */
                            while (*yyp == '\'')
                            {
                                yyp++;
                            }

                            /* If the first non-quote is not an alnum, it must
                             * be a quoted aggregrate or an error.
                             */
                            if (!isalpha((unsigned char)*yyp)
                                 && *yyp != '_'
                               )
                            {
                                if (*yyp == '(' && yyp[1] == '{')
                                {
                                    yyp += 2;
                                }
                                else
                                {
                                    lexerror("Illegal character constant");
                                    return -1;
                                }
                            }
                            else
                            {
                                /* Find the end of the symbol. */
                                while (isalunum(*++yyp)) NOOP;
                            }
                        }
                        else /* Normal string or character */
                        while ((c = *yyp++) != delimiter)
                        {
                            if (c == CHAR_EOF)
                            {
                                /* Just in case... */
                                current_line = first_line;
                                lexerror("Unexpected end of file "
                                         "(or 0x01 character) in string.\n");
                                return -1;
                            }
                            else if (c == '\\')
                            {
                                if (*yyp++ == '\n')
                                {
                                    store_line_number_info();
                                    nexpands = 0;
                                    current_line++;
                                    total_lines++;
                                    if (!*yyp)
                                    {
                                        strbuf_addn(textbuf
                                            , start
                                            , (size_t)(yyp-start));
                                        outp = yyp;
                                        yyp = _myfilbuf();
                                        start = yyp;
                                    }
                                }
                            }
                            else if (c == '\n')
                            {
                                /* No unescaped newlines in strings */
                                lexerror("Newline in string");
                                return -1;
                            }
                        } /* while(!delimiter) */
                        break;
                      } /* string-case */

                    } /* switch(yyp[0]) */

                } /* while(level) */

                /* yyp now points to the character after the ':)'.
                 * This is where the next call to lex has to continue.
                 * Also copy the remaining (or the only) part of the
                 * closure into the text buffer.
                 */

                strbuf_addn(textbuf, start, (size_t)(yyp-start-2));
                outp = yyp;

                /* The closure must not be too long (there is a hard limit in
                 * the strbuf_t datastructure.
                 */
                if (textbuf->length > MAX_STRBUF_LEN-100)
                    yyerror("Inline closure too long");

                /* Check if the last character before the ':)' is
                 * a ';' or '}'. For convenience we re-use yyp to
                 * point into our buffer (we will exit from here
                 * anyway).
                 */

                yyp = textbuf->buf + textbuf->length-1;
                while (lexwhite(*yyp) || '\n' == *yyp || '\r' == *yyp)
                    yyp--;

                if (*yyp == ';' || *yyp == '}')
                {
                    /* Functional contains statements: remove the 'return'
                     * added in the beginnin.
                     */
                    int i;

                    for (i = 0; i < 6; i++)
                        textbuf->buf[pos_return+i] = ' ';

                    /* Finish up the function text */
                    strbuf_add(textbuf, "\n}\n");
                }
                else
                {
                    /* Finish up the function text */
                    strbuf_add(textbuf, ";\n}\n");
                }

                /* Return the ID of the name of the new inline function */

                yylval.ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
                return L_INLINE_FUN;
            }

            /* FALL THROUGH */
        /* --- Single-char Operators and Punctuation --- */

        /* case '(' is a fall through from above */
        case ';':
        case ')':
        case ',':
        case '{':
        case '}':
        case '~':
        case '[':
        case ']':
        case '?':
            outp = yyp;
            return c;


        /* --- #: Preprocessor statement or symbol --- */

        case '#':
            if (*yyp == '\'')
            {
                /* --- #': Closure Symbol --- */

                ident_t *p;
                char *super_name = NULL;
                char *wordstart = ++yyp;
                Bool efun_override;  /* True if 'efun::' is specified. */

                /* Set yyp to the last character of the functionname
                 * after the #'.
                 */
                do
                    c = *yyp++;
                while (isalunum(c));
                c = *--yyp;
                /* the assignment is good for the data flow analysis :-} */

                /* Just one character? It must be an operator */
                if (yyp == wordstart && *yyp != ':')
                {
                    int i;

                    if ((i = symbol_operator(yyp, &outp)) < 0)
                        yyerror("Missing function name after #'");
                    yylval.closure.number = i + CLOSURE_EFUN_OFFS;
                    return L_CLOSURE;
                }

                /* Test for an inherited function name specification.
                 * If found, set super_name to the inherit name, and
                 * reset wordstart/yyp to point to the name after the '::'.
                 */
                if (':' == *yyp && ':' == *(yyp+1))
                {
                    super_name = wordstart;
                    wordstart = yyp += 2;
                    do
                        c = *yyp++;
                    while (isalunum(c));
                    c = *--yyp;
                }

                /* Test for the 'efun::' override.
                 */
                efun_override = MY_FALSE;
                if (super_name != NULL && !strncmp(super_name, "efun::", 6))
                {
                    efun_override = MY_TRUE;
                    super_name = NULL;
                }

                outp = yyp;

                /* Lookup the name parsed from the text */

                if (super_name != NULL)
                {
                    short ix;

                    *yyp = '\0'; /* c holds the char at this place */
                    *(wordstart-2) = '\0';
                    ix = find_inherited(super_name, wordstart);
                    if (ix < 0)
                    {
                        yyerrorf("Undefined function: %.50s::%.50s"
                                , super_name, wordstart);
                        ix = CLOSURE_EFUN_OFFS;
                    }
                    *yyp = c;
                    *(wordstart-2) = ':';

                    yylval.closure.number = ix;
                    return L_CLOSURE;
                }

                *yyp = '\0'; /* c holds the char at this place */
                p = make_shared_identifier(wordstart, I_TYPE_GLOBAL, 0);
                *yyp = c;
                if (!p) {
                    lexerror("Out of memory");
                    return 0;
                }

                /* #' can be used only on identifiers with global visibility
                 * or better. Look along the .inferior chain for such an
                 * identifier. If the identifier happens to be a reserved
                 * word, the better for us.
                 */
                while (p->type > I_TYPE_GLOBAL)
                {
                    if (p->type == I_TYPE_RESWORD)
                    {
                        int code;

                        switch(code = p->u.code)
                        {
                        default:
                            /* There aren't efuns with reswords as names, and
                             * it is impossible to define local / global vars
                             * or functions with such a name.
                             * Thus, !p->inferior .
                             */
                            yyerrorf(
                              "No closure associated with reserved word '%s'",
                              p->name
                            );
                            code = CLOSURE_EFUN_OFFS;
                            break;
                        case L_IF:
                            code = F_BRANCH_WHEN_ZERO+CLOSURE_EFUN_OFFS;
                            break;
                        case L_DO:
                            code =
                              F_BBRANCH_WHEN_NON_ZERO+CLOSURE_EFUN_OFFS;
                            break;
                        case L_WHILE:
                            /* the politically correct code was already taken,
                             * see above.
                             */
                            code = F_BBRANCH_WHEN_ZERO+CLOSURE_EFUN_OFFS;
                            break;
                        case L_FOREACH:
                            code = F_FOREACH+CLOSURE_EFUN_OFFS;
                            break;
                        case L_CONTINUE:
                            code = F_BRANCH+CLOSURE_EFUN_OFFS;
                            break;
                        case L_DEFAULT:
                            code = F_CSTRING0+CLOSURE_EFUN_OFFS;
                            /* as bogus as we can possibliy get :-) */
                            break;
                        case L_BREAK:
                            code = F_BREAK  + CLOSURE_EFUN_OFFS;
                            break;
                        case L_RETURN:
                            code = F_RETURN  + CLOSURE_EFUN_OFFS;
                            break;
#ifdef SUPPLY_PARSE_COMMAND
                        case L_PARSE_COMMAND:
                            code = F_PARSE_COMMAND  + CLOSURE_EFUN_OFFS;
                            break;
#endif
                        case L_SSCANF:
                            code = F_SSCANF  + CLOSURE_EFUN_OFFS;
                            break;
                        case L_CATCH:
                            code = F_CATCH  + CLOSURE_EFUN_OFFS;
                            break;
                        case L_SWITCH:
                            code = F_SWITCH  + CLOSURE_EFUN_OFFS;
                            break;
                        }
                        yylval.closure.number = code;
                        return L_CLOSURE;
                    }
                    if ( !(p = p->inferior) )
                        break;
                } /* while (p->type > I_TYPE_GLOBAL */

                /* Did we find a suitable identifier? */
                if (!p || p->type < I_TYPE_GLOBAL)
                {
                    if (p && p->type == I_TYPE_UNKNOWN)
                        free_shared_identifier(p);
                    c = *yyp;
                    *yyp = '\0';
                    yyerrorf("Undefined function: %.50s", wordstart);
                    *yyp = c;
                    yylval.closure.number = CLOSURE_EFUN_OFFS;
                    return L_CLOSURE;
                }

                /* An attempt to override a nomask simul-efun causes
                 * a privilege violation. If the master decides to allow
                 * this attempt, the efun-override will still be deactivated
                 * (iow: a nomask simul-efun overrules an efun override).
                 */
                if (efun_override
                 && p->u.global.sim_efun >= 0
                 && simul_efunp[p->u.global.sim_efun].flags & TYPE_MOD_NO_MASK
                 && p->u.global.efun >= 0
                 && master_ob
                 && (!EVALUATION_TOO_LONG())
                   )
                {
                    svalue_t *res;

                    push_volatile_string("nomask simul_efun");
                    push_volatile_string(current_file);
                    push_shared_string(p->name);
                    res = apply_master(STR_PRIVILEGE, 3);
                    if (!res || res->type != T_NUMBER || res->u.number < 0)
                    {
                        yyerrorf(
                          "Privilege violation: nomask simul_efun %s",
                          p->name
                        );
                        efun_override = MY_FALSE;
                    }
                    else if (!res->u.number)
                    {
                        efun_override = MY_FALSE;
                    }
                }
                else if (EVALUATION_TOO_LONG())
                {
                    yyerrorf("Can't call master::%s for "
                             "'nomask simul_efun %s': eval cost too big"
                            , STR_PRIVILEGE, p->name);
                    efun_override = MY_FALSE;
                }

                /* The code will be L_CLOSURE, now determine the right
                 * closure number to put into yylval.closure.number.
                 * The number is usually the index in the appropriate
                 * table, plus an offset indicating the type of the closure.
                 *
                 * The switch() serves just as a simple try... environment.
                 */
                switch(0) { default:
                    if (!efun_override)
                    {

                        /* lfun? */
                        if (p->u.global.function >= 0)
                        {
                            int i;

                            i = p->u.global.function;
                            yylval.closure.number = i;
                            if (i >= CLOSURE_IDENTIFIER_OFFS)
                                yyerrorf(
                                  "Too high function index of %s for #'",
                                  p->name
                                );
                            break;
                        }

                        /* simul-efun? */
                        if (p->u.global.sim_efun >= 0) {
                            yylval.closure.number =
                              p->u.global.sim_efun + CLOSURE_SIMUL_EFUN_OFFS;
                            break;
                        }
                    }

                    /* efun? */
                    if (p->u.global.efun >= 0)
                    {
                        yylval.closure.number =
                          p->u.global.efun + CLOSURE_EFUN_OFFS;
                        if (yylval.closure.number >
                            LAST_INSTRUCTION_CODE + CLOSURE_EFUN_OFFS)
                        {
                            yylval.closure.number =
                              efun_aliases[
                                yylval.closure.number - CLOSURE_EFUN_OFFS
                                  - LAST_INSTRUCTION_CODE - 1
                              ] + CLOSURE_EFUN_OFFS;
                        }
                        break;
                    }

                    /* object variable? */
                    if (p->u.global.variable >= 0)
                    {
                        if (p->u.global.variable & VIRTUAL_VAR_TAG) {
                            /* Handling this would require an extra coding of
                             * this closure type, and special treatment in
                             * replace_program_lambda_adjust() .
                             */
                            yyerrorf("closure of virtual variable");
                            yylval.closure.number = CLOSURE_IDENTIFIER_OFFS;
                            break;
                        }
                        yylval.closure.number =
                          p->u.global.variable + num_virtual_variables +
                          CLOSURE_IDENTIFIER_OFFS;
                        break;
                    }

                    /* None of these all */
                    c = *yyp;
                    *yyp = 0;
                    yyerrorf("Undefined function: %.50s", wordstart);
                    *yyp = c;
                    yylval.closure.number = CLOSURE_EFUN_OFFS;

                    break;
                }
                return L_CLOSURE;

            } /* if (#') */

            else if (*(yyp-2) == '\n' && !nexpands)
            {
                /* --- <newline>#: Preprocessor statement --- */

                char *sp = NULL; /* Begin of second word */
                Bool quote; /* In "" string? */
                size_t wlen;  /* Length of the preproc keyword */
                char last;
                  /* Character last read, used to implement \-sequences */

                /* Copy the first/only line of the preprocessor statement
                 * from the input buffer into yytext[] while stripping
                 * comments.
                 */

                /* Skip initial blanks */
                outp = yyp;
                yyp = yytext;
                do {
                    c = mygetc();
                } while (lexwhite(c));

                wlen = 0;
                for (quote = MY_FALSE, last = '\0';;)
                {

                    /* Skip comments */
                    while (!quote && c == '/')
                    {
                        char c2;

                        if ( (c2 = mygetc()) == '*')
                        {
                            skip_comment();
                            c = mygetc();
                        }
                        else if (c2 == '/')
                        {
                            outp = skip_pp_comment(outp);
                            current_line--;
                            c = '\n';
                        }
                        else
                        {
                            --outp;
                            break;
                        }
                    }

                    /* If the last character was '\', take this one as
                     * as it is, else interpret this character.
                     */
                    if (last == '\\')
                        last = '\0';
                    else if (c == '"')
                        quote = !quote;
                    else
                        last = c;

                    /* Remember end of the first word in the line */
                    if (!sp && !isalunum(c))
                    {
                        sp = yyp;
                        wlen = yyp - yytext;
                    }

                    if (c == '\n')
                    {
                        break;
                    }
                    SAVEC;
                    c = mygetc();
                }

                /* Terminate the line copied to yytext[] */
                *yyp = '\0';

                /* Remember the end of the first word.
                 * Let sp point to the next word then.
                 */
                if (sp)
                {
                    while(lexwhite(*sp))
                    {
                        sp++;
                    }
                }
                else
                {
                    /* No end found in the copy loop - the next 'word'
                     * will be the terminating '\0'.
                     */
                    sp = yyp;
                    wlen = yyp - yytext;
                }

                /* Evaluate the preprocessor statement */
                if (strncmp("include", yytext, wlen) == 0)
                {
                    /* Calling myfilbuf() before handle_include() is a waste
                     * of time and memory. However, since the include
                     * attempt might fail, we have to call it afterwards
                     * to make sure that the lex can continue.
                     */
                    handle_include(sp);
                    myfilbuf();
                }
                else
                {
                   /* Make sure there is enough data in the buffer. */
                   myfilbuf();

                if (strncmp("define", yytext, wlen) == 0)
                {
                    if (*sp == '\0')
                        yyerror("Missing definition in #define");
                    else
                        handle_define(sp, quote);
                }
                else if (strncmp("if", yytext, wlen) == 0)
                {
                    int cond;
                    svalue_t sv;

                    myungetc('\n');
                    add_input(sp);
                    cond = cond_get_exp(0, &sv);
                    free_svalue(&sv);
                    if (mygetc() != '\n')
                    {
                        yyerror("Condition too complex in #if");
                        while (mygetc() != '\n') NOOP;
                    }
                    else
                        handle_cond(cond);
                }
                else if (strncmp("ifdef", yytext, wlen) == 0)
                {
                    deltrail(sp);
                    handle_cond(lookup_define(sp) != 0);
                }
                else if (strncmp("ifndef", yytext, wlen) == 0)
                {
                    deltrail(sp);
                    handle_cond(lookup_define(sp) == 0);
                }
                else if (strncmp("else", yytext, wlen) == 0)
                {
                    if (*sp != '\0')
                    {
                        if (pragma_pedantic)
                            yyerror("Unrecognized #else (trailing characters)");
                        else
                            yywarn("Unrecognized #else (trailing characters)");
                    }

                    if (iftop && iftop->state == EXPECT_ELSE)
                    {
                        lpc_ifstate_t *p = iftop;

                        iftop = p->next;
                        mempool_free(lexpool, p);
                        skip_to("endif", NULL);
                    }
                    else
                    {
                        yyerror("Unexpected #else");
                    }
                }
                else if (strncmp("elif", yytext, wlen) == 0)
                {
                    if (iftop && iftop->state == EXPECT_ELSE)
                    {
                        lpc_ifstate_t *p = iftop;

                        iftop = p->next;
                        mempool_free(lexpool, p);
                        skip_to("endif", NULL);
                    }
                    else
                    {
                        yyerror("Unexpected #elif");
                    }
                }
                else if (strncmp("endif", yytext, wlen) == 0)
                {
                    if (*sp != '\0')
                    {
                        if (pragma_pedantic)
                            yyerror("Unrecognized #endif (trailing characters)");
                        else
                            yywarn("Unrecognized #endif (trailing characters)");
                    }

                    if (iftop
                     && (   iftop->state == EXPECT_ENDIF
                         || iftop->state == EXPECT_ELSE))
                    {
                        lpc_ifstate_t *p = iftop;

                        iftop = p->next;
                        mempool_free(lexpool, p);
                    }
                    else
                    {
                        yyerror("Unexpected #endif");
                    }
                }
                else if (strncmp("undef", yytext, wlen) == 0)
                {
                    ident_t *p, **q;
                    int h;

                    deltrail(sp);

                    /* Lookup identifier <sp> in the ident_table and
                     * remove it there if it is a #define'd identifier.
                     * If it is a permanent define, park the ident
                     * structure in the undefined_permanent_defines list.
                     */
                    h = identhash(sp);
                    for (q = &ident_table[h]; NULL != ( p= *q); q=&p->next)
                    {
                        if (strcmp(sp, p->name))
                            continue;

                        if (p->type != I_TYPE_DEFINE) /* failure */
                            break;

                        if (!p->u.define.permanent)
                        {
#if defined(LEXDEBUG)
                            fprintf(stderr, "%s #undef define '%s' %d '%s'\n"
                                   , time_stamp(), p->name, p->u.define.nargs
                                   , p->u.define.exps.str);
                            fflush(stderr);
#endif
                            if (p->inferior)
                            {
                                p->inferior->next = p->next;
                                *q = p->inferior;
                            }
                            else
                            {
                                *q = p->next;
                            }
                            xfree(p->u.define.exps.str);
                            free_string(p->name);
                            p->name = NULL;
                                /* mark for later freeing by all_defines */
                            /* success */
                            break;
                       }
                       else
                       {
                            if (p->inferior)
                            {
                                p->inferior->next = p->next;
                                *q = p->inferior;
                            }
                            else
                            {
                                *q = p->next;
                            }
                            p->next = undefined_permanent_defines;
                            undefined_permanent_defines = p;
                            /* success */
                            break;
                        }
                    }
                }
                else if (strncmp("echo", yytext, wlen) == 0)
                {
                    fprintf(stderr, "%s %s\n", time_stamp(), sp);
                }
                else if (strncmp("pragma", yytext, wlen) == 0)
                {
                    handle_pragma(sp);
                }
                else if (strncmp("line", yytext, wlen) == 0)
                {
                    char * end;
                    long new_line;

                    deltrail(sp);
                    new_line = strtol(sp, &end, 0);
                    if (end == sp || *end != '\0')
                        yyerror("Unrecognised #line directive");
                    if (new_line < current_line)
                        store_line_number_backward(current_line - new_line);
                    current_line = new_line - 1;
                }
                else
                {
                    yyerror("Unrecognised # directive");
                }} /* if() { else if () {} } */

                store_line_number_info();
                nexpands = 0;
                current_line++;
                total_lines++;
                yyp = outp;
                if (lex_fatal)
                {
                    return -1;
                }
                break;
            }

            else
                goto badlex;


        /* --- ': Character constant or lambda symbol --- */

        case '\'':
            c = *yyp++;

            if (c == '\\')
            {
                /* Parse an escape sequence */

                if ('\n' != *yyp && CHAR_EOF != *yyp)
                {
                    char *cp;
                    char lc; /* Since c is 'register' */

                    cp = parse_escaped_char(yyp, &lc);
                    if (!cp)
                        yyerror("Illegal character constant");
                    yyp = cp;
                    c = lc;
                }

                /* Test if it's terminated by a quote (this also
                 * catches the \<nl> and \<eof> case).
                 */
                if (*yyp++ != '\'')
                {
                    yyp--;
                    yyerror("Illegal character constant");
                }

                /* Continue after the if() as if it's a normal constant */

            }
            else if (*yyp++ != '\''
                  || (   c == '\''
                      && (*yyp == '(' || isalunum(*yyp) || *yyp == '\'')) )
            {
                /* Parse the symbol or quoted aggregate.
                 *
                 * The test rejects all sequences of the form
                 *   'x'
                 * and
                 *   '''x, with x indicating that the ' character itself
                 *         is meant as the desired constant.
                 *
                 * It accepts all forms of quoted symbols, with one or
                 * more leading ' characters.
                 */

                char *wordstart;
                int quotes = 1;

                /* Count the total number of ' characters, set wordstart
                 * on the first non-quote.
                 */
                yyp -= 2;
                while (*yyp == '\'')
                {
                    quotes++;
                    yyp++;
                }
                wordstart = yyp;

                /* If the first non-quote is not an alnum, it must
                 * be a quoted aggregrate or an error.
                 */
                if (!isalpha((unsigned char)*yyp) && *yyp != '_')
                {
                    if (*yyp == '(' && yyp[1] == '{')
                    {
                        outp = yyp + 2;
                        yylval.number = quotes;
                        return L_QUOTED_AGGREGATE;
                    }
                    yyerror("Illegal character constant");
                    outp = yyp;
                    return L_NUMBER;
                }

                /* Find the end of the symbol and make it a shared string. */
                while (isalunum(*++yyp)) NOOP;
                c = *yyp;
                *yyp = 0;
                yylval.symbol.name = make_shared_string(wordstart);
                *yyp = c;
                yylval.symbol.quotes = quotes;
                outp = yyp;
                return L_SYMBOL;
            }

            /* It's a normal (or escaped) character constant. */
            yylval.number = c;
            outp = yyp;
            return L_NUMBER;


        /* --- ": String Literal --- */

        case '"':
        {
            char *p = yyp;

            /* Construct the string in yytext[], terminated with a \0.
             * ANSI style string concatenation is done by a recursive
             * call to yylex() after this literal is parsed completely.
             * This way a mixture of macros and literals is easily
             * handled.
             */
            yyp = yytext;
            for(;;)
            {
                c = *p++;

                /* No unescaped newlines allowed */
                if (c == '\n')
                {
                    outp = p-1;
                    /* myfilbuf(); not needed */
                    lexerror("Newline in string");
                    return string("");
                }
                SAVEC;

                /* Unescaped ": end of string */
                if (c == '"') {
                    *--yyp = '\0';
                    break;
                }

                /* Handle an escape sequence */
                if (c == '\\')
                {
                    yyp--; /* Undo the SAVEC */

                    switch(c = *p++)
                    {
                    case '\r':
                        /* \<cr><lf> defaults to \<lf>, but
                         * \<cr> puts <cr> into the text.
                         */
                        if (*p++ != '\n')
                        {
                            p--;
                            *yyp++ = c;
                            break;
                        }
                        /* FALLTHROUGH*/

                    case '\n':
                        /* \<lf> and \<lf><cr> are ignored */
                        store_line_number_info();
                        current_line++;
                        total_lines++;
                        if (*p == CHAR_EOF )
                        {
                            outp = p;
                            lexerror("End of file (or 0x01 character) in string");
                            return string("");
                        }
                        if (!*p)
                        {
                            outp = p;
                            p = _myfilbuf();
                        }
                        if (*p++ != '\r')
                            p--;
                        break;

                    default:
                      {
                          char *cp, lc;

                          cp = parse_escaped_char(p-1, &lc);
                          if (!cp)
                              yyerror("Illegal escaped character in string.");
                          p = cp;
                          *yyp++ = lc;
                          break;
                      }
                    }
                }
            } /* for() */

            outp = p;
            return string(yytext);
        }


        /* --- Numbers --- */

        case '0':case '1':case '2':case '3':case '4':
        case '5':case '6':case '7':case '8':case '9':
        {
            char *numstart = yyp-1;
            unsigned long l;

            /* Scan ahead to see if this is a float number */
            while (lexdigit(c = *yyp++)) NOOP ;

            /* If it's a float (and not a range), simply use strtod()
             * to convert the float and to update the text pointer.
             */
            if ('.' == c && '.' != *yyp)
            {
                char * numend;  /* Because yyp is 'register' */
                errno = 0; /* Because strtod() doesn't clear it on success */
                yylval.float_number = strtod(numstart, &numend);
                if (errno == ERANGE)
                {
                    yywarn("Floating point number out of range.");
                }
                else if (errno == EINVAL)
                {
                    yyerror("Floating point number can't be represented.");
                }
                outp = numend;
                return L_FLOAT;
            }

            /* Nope, normal number */
            yyp = parse_number(numstart, &l);

            outp = yyp;
            return number((long)l);
        }


        /* --- Identifier --- */

        case 'A':case 'B':case 'C':case 'D':case 'E':case 'F':case 'G':
        case 'H':case 'I':case 'J':case 'K':case 'L':case 'M':case 'N':
        case 'O':case 'P':case 'Q':case 'R':case 'S':case 'T':case 'U':
        case 'V':case 'W':case 'X':case 'Y':case 'Z':case 'a':case 'b':
        case 'c':case 'd':case 'e':case 'f':case 'g':case 'h':case 'i':
        case 'j':case 'k':case 'l':case 'm':case 'n':case 'o':case 'p':
        case 'q':case 'r':case 's':case 't':case 'u':case 'v':case 'w':
        case 'x':case 'y':case 'z':case '_':case '$':
        case 0xC0:case 0xC1:case 0xC2:case 0xC3:
        case 0xC4:case 0xC5:case 0xC6:case 0xC7:
        case 0xC8:case 0xC9:case 0xCA:case 0xCB:
        case 0xCC:case 0xCD:case 0xCE:case 0xCF:
        case 0xD0:case 0xD1:case 0xD2:case 0xD3:
        case 0xD4:case 0xD5:case 0xD6:case 0xD7:
        case 0xD8:case 0xD9:case 0xDA:case 0xDB:
        case 0xDC:case 0xDD:case 0xDE:case 0xDF:
        case 0xE0:case 0xE1:case 0xE2:case 0xE3:
        case 0xE4:case 0xE5:case 0xE6:case 0xE7:
        case 0xE8:case 0xE9:case 0xEA:case 0xEB:
        case 0xEC:case 0xED:case 0xEE:case 0xEF:
        case 0xF0:case 0xF1:case 0xF2:case 0xF3:
        case 0xF4:case 0xF5:case 0xF6:case 0xF7:
        case 0xF8:case 0xF9:case 0xFA:case 0xFB:
        case 0xFC:case 0xFD:case 0xFE:case 0xFF:
        {
            ident_t *p;
            char *wordstart = yyp-1;

            /* Find the end of the identifier and mark it with a '\0' */
            do
                c = *yyp++;
            while (isalunum(c));
            c = *--yyp; /* the assignment is good for the data flow analysis :-} */
            *yyp = '\0';

            /* Lookup/enter the identifier in the ident_table, then restore
             * the original text
             */
            p = make_shared_identifier(wordstart, I_TYPE_UNKNOWN, 0);
            *yyp = c;
            if (!p)
            {
                lexerror("Out of memory");
                return 0;
            }

            /* printf("DEBUG: ident '%s' type is %p->%d\n", p->name, p, p->type); */

            /* Handle the identifier according to its type */

            switch(p->type)
            {
            case I_TYPE_DEFINE:

                outp = yyp;
                _expand_define(&p->u.define, p);
                if (lex_fatal)
                {
                    return -1;
                }
                yyp=outp;
                continue;

            case I_TYPE_RESWORD:
                outp = yyp;
                return p->u.code;

            case I_TYPE_LOCAL:
                yylval.number = p->u.local.num;
                outp = yyp;
                return L_LOCAL;

            default:
                /* _UNKNOWN identifiers get their type assigned by the
                 * parser.
                 */
                yylval.ident = p;
                outp = yyp;
                return L_IDENTIFIER;
            }
        }


        /* --- Everything else --- */

        default:
            goto badlex;
        } /* switch (c) */

    } /* for() */

badlex:

    /* We come here after an unexpected character */

    if (lex_fatal)
        return -1;

    {
        char buff[100];
        sprintf(buff, "Illegal character (hex %02x) '%c'", c, c);
        yyerror(buff);
        outp = yyp;
        return ' ';
    }

#undef TRY

} /* yylex1() */

/*-------------------------------------------------------------------------*/
int
yylex (void)

/* The lex function called by the parser. The actual lexing is done
 * in yylex1(), this function just does any necessary pre- and post-
 * processing.
 * <depth> is the current nesting depth for local scopes, needed for
 * correct lookup of local identifiers.
 */

{
    int r;

#ifdef LEXDEBUG
    yytext[0] = '\0';
#endif
    r = yylex1();
#ifdef LEXDEBUG
    fprintf(stderr, "%s lex=%d(%s) ", time_stamp(), r, yytext);
#endif
    return r;
}

/*-------------------------------------------------------------------------*/
void
start_new_file (int fd)

/* Start the compilation/lexing of the lpc file opened on file <fd>.
 * This must not be called for included files.
 * The global <current_file> contains the name of the file to be compiled.
 */

{
    object_file = current_file;

    free_defines();

    set_input_source(fd, NULL);

    if (!defbuf_len)
    {
        defbuf = xalloc(DEFBUF_1STLEN);
        defbuf_len = DEFBUF_1STLEN;
    }

    *(outp = linebufend = (linebufstart = defbuf + DEFMAX) + MAXLINE) = '\0';

    current_line = 1; /* already used in _myfilbuf() */
    _myfilbuf();

    lex_fatal = MY_FALSE;

    pragma_strict_types = PRAGMA_WEAK_TYPES;
    instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
    pragma_use_local_scopes = MY_TRUE;
    pragma_save_types = MY_FALSE;
    pragma_verbose_errors = MY_FALSE;
    pragma_no_clone = MY_FALSE;
    pragma_no_inherit = MY_FALSE;
    pragma_no_shadow = MY_FALSE;
    pragma_pedantic = MY_FALSE;
    pragma_warn_deprecated = MY_FALSE;
    pragma_combine_strings = MY_TRUE;

    nexpands = 0;

    next_inline_fun = 0;
    insert_inline_fun_now = MY_FALSE;

    add_auto_include(object_file, NULL, MY_FALSE);
} /* start_new_file() */

/*-------------------------------------------------------------------------*/
void
end_new_file (void)

/* Clean up after a compilation terminated (successfully or not).
 */

{
    while (inctop)
    {
        struct incstate *p;
        p = inctop;
        close_input_source();
        xfree(current_file);
        current_file = p->file;
        yyin = p->yyin;
        inctop = p->next;
    }

    iftop = NULL;

    mempool_reset(lexpool);
      /* Deallocates all incstates and ifstates at once */

    if (defbuf_len > DEFBUF_1STLEN)
    {
        xfree(defbuf);
        defbuf = NULL;
        defbuf_len = 0;
    }

    if (last_lex_string)
    {
        free_string(last_lex_string);
        last_lex_string = NULL;
    }

    while (first_inline_fun)
    {
        struct inline_fun * fun = first_inline_fun;

        first_inline_fun = first_inline_fun->next;
        strbuf_free(&(fun->buf));
        xfree(fun);
    }

} /* end_new_file() */

/*-------------------------------------------------------------------------*/
void
lex_close (char *msg)

/* End the current lexing properly (ie. by calling end_new_file())
 * and throw the error message <msg>. If <msg> is NULL, a message
 * giving the current include depth.
 *
 * This function is used from two places: from within lang.c (at them
 * moment only for 'Out of memory') obviously, but also from the efun
 * write_file() if it is called from within a compile, e.g. to write
 * the error log.
 */

{
    if (!msg)
    {
        /* Count the include depth and make a nice message */

        int i;
        struct incstate *p;
        static char buf[] =
            "File descriptors exhausted, include nesting: 12345678";

        for (i = 0, p = inctop; p; p = p->next)
            i++;

        /* skip back terminating \0 and 8 digits */
        sprintf(buf + sizeof buf - 9, "%d", i);
        msg = buf;
    }

    end_new_file();
    outp = ("##")+1; /* TODO: Not really nice */

    lexerror(msg);
} /* lex_close() */

/*-------------------------------------------------------------------------*/
char *
get_f_name (int n)

/* Return the name of instruction <n>, it if has one.
 * The result is a pointer to a static buffer.
 */

{
    if (instrs[n].name)
        return instrs[n].name;
    else
    {
        static char buf[30];
        sprintf(buf, "<OTHER %d>", n);
        return buf;
    }
} /* get_f_name() */

/*-------------------------------------------------------------------------*/
static char
cmygetc (void)

/* Get the next character from the input buffer (using mygetc()) which
 * is not part of a comment.
 */

{
    char c;

    for(;;)
    {
        c = mygetc();
        if (c == '/') {
            if (gobble('*'))
                skip_comment();
            else if (gobble('/'))
            {
                outp = skip_pp_comment(outp);
                current_line--;
                return '\n';
            }
            else
                return c;
        }
        else
            return c;
    }
} /* cmygetc() */

/*-------------------------------------------------------------------------*/
static Bool
refill (Bool quote)

/* Read the next line from the input buffer into yytext[], skipping
 * comments, reading the final \n as space.
 * <quote> is true if at the time of call the text is supposed
 * to be within a string literal.
 * Result is the new value for <quote>: true if the next character to
 *   read is part of a string literal.
 */
{
    char *p;
    int c;
    char last = '\0';

    p = yytext;
    do
    {
        c = mygetc();

        if (c == '/' && !quote)
        {
            last = '\0';
            if (gobble('*'))
            {
                skip_comment();
                continue;
            }
            else if (gobble('/'))
            {
                outp = skip_pp_comment(outp);
                current_line--;
                c = '\n';
            }
        }
        else if (last == '\\')
        {
            /* Take the current character as it is */
            last = '\0';
        }
        else if (c == '"')
            quote = !quote;
        else
            last = (char)c;

        if (p < yytext+MAXLINE-5)
            *p++ = (char)c;
        else
        {
            lexerror("Line too long");
            break;
        }
    } while (c != '\n' && c != CHAR_EOF);

    /* Refill the input buffer */
    myfilbuf();

    /* Replace the trailing \n by a space */
    if (p[-1] == '\n')
        p[-1] = ' ';
    *p = '\0';

    nexpands = 0;
    current_line++;
    store_line_number_info();

    return quote;
}

/*-------------------------------------------------------------------------*/
static void
handle_define (char *yyt, Bool quote)

/* This function is called from yylex1() to handle '#define' statements.
 * The text of the line with the statement is in yytext[], <yyt> points
 * to the first word after '#define'. <quote> is true if at the end
 * of the line a string literal was still open.
 */

{
  /* Get the identfier (or punctuation) pointed to by p and copy it
   * as null-terminated string to q, but at max up to address m.
   */
#define GETALPHA(p, q, m) \
    while(isalunum(*p)) {\
        *q = *p++;\
        if (q < (m))\
            q++;\
        else {\
            lexerror("Name too long");\
            return;\
        }\
    }\
    *q++ = 0

  /* Skip all whitespace from the current position of char*-variable 'p'
   * on.
   */
#define SKIPWHITE while(lexwhite(*p)) p++


    char namebuf[NSIZE];      /* temp buffer for read identifiers */
    char args[NARGS][NSIZE];  /* parsed argument names of function macros */
#if defined(CYGWIN) && __GNUC__ >= 2
    char *mtext;
      /* replacement text, with arguments replaced by the MARKS characters.
       * Under Cygwin and high optimization, the compiler produces faulty
       * code if the mtext[MLEN] definition is used.
       */
#else
    char mtext[MLEN];
      /* replacement text, with arguments replaced by the MARKS characters
       */
#endif
    char *p;                  /* current text pointer */
    char *q;                  /* destination for parsed text */

#if defined(CYGWIN) && __GNUC__ >= 3 && __GNUC_MINOR__ >= 2
    mtext = alloca(MLEN);
    if (!mtext)
    {
        lexerror("Out of stack memory");
        return;
    }
#endif /* CYGWIN */

    p = yyt;
    strcat(p, " "); /* Make sure GETALPHA terminates */

    /* Get the defined name */
    q = namebuf;
    GETALPHA(p, q, namebuf+NSIZE-1);

    if (*p == '(')
    {
        /* --- Function Macro --- */

        short arg;         /* Number of macro arguments */
        Bool inid;         /* true: parsing an identifier */
        char *ids = NULL;  /* Start of current identifier */

        p++;        /* skip '(' and following whitespace */
        SKIPWHITE;

        /* Parse the arguments (if any) */

        if (*p == ')')
        {
            /* no arguments */
            arg = 0;
        }
        else
        {
            /* Parse up to NARGS-1 arguments */

            for (arg = 0; arg < NARGS; )
            {
                /* Get the argname directly into args[][] */
                q = args[arg];
                GETALPHA(p, q, &args[arg][NSIZE-1]);
                arg++;

                SKIPWHITE;

                /* ')' -> no further argument */

                if (*p == ')')
                    break;

                /* else a ',' is expected as separator */
                if (*p++ != ',') {
                    yyerror("Missing ',' in #define parameter list");
                    return;
                }
                SKIPWHITE;
            }
            if (arg == NARGS)
            {
                lexerrorf("Too many macro arguments");
                return;
            }
        }

        p++;  /* skip ')' */

        /* Parse the replacement text into mtext[], performing
         * macro argument marking as necessary.
         */

        for (inid = MY_FALSE, q = mtext; *p && *p != CHAR_EOF; )
        {
            /* Identifiers are parsed until complete, with the first
             * character pointed to by <ids>.
             */

            if (isalunum(*p))
            {
                /* Identifier. If inid is false, it is a new one.
                 */

                if (!inid)
                {
                    inid = MY_TRUE;
                    ids = p;
                }
            }
            else
            {
                /* Not an identifier, or, if inid is true, the end
                 * of one.
                 */

                if (inid)
                {
                    int idlen = p - ids;
                    size_t l;
                    int n;

                    /* Check if the identifier matches one of the
                     * function arguments. If yes, replace it in mtext[]
                     * by the MARKS sequence.
                     */
                    for (n = 0; n < arg; n++)
                    {
                        l = strlen(args[n]);
                        if (l == idlen && strncmp(args[n], ids, l) == 0)
                        {
                            q -= idlen;
                            *q++ = (char)MARKS;
                            *q++ = (char)(n+MARKS+1);
                            break;
                        }
                    }
                    inid = MY_FALSE;
                }
            }

            /* Whatever the character is, for now store it in mtext[].
             * Literal '@' are escaped.
             */
            *q = *p;
            if (*p++ == MARKS)
                *++q = MARKS;
            if (q < mtext+MLEN-2)
                q++;
            else
            {
                lexerror("Macro text too long");
                return;
            }

            /* If we are at line's end and it is escaped with '\',
             * get the next line and continue.
             */
            if (!*p)
            {
                if (p[-2] == '\\')
                {
                    q -= 2;
                    quote = refill(quote);
                    p = yytext;
                }
                else if (p[-2] == '\r' && p[-3] == '\\' )
                {
                    q -= 3;
                    quote = refill(quote);
                    p = yytext;
                }
            }
        }

        /* If the defined was ended by EOF instead of lineend,
         * we have to pass on the EOF to the caller.
         */
        if (*p == CHAR_EOF)
        {
            myungetc(*p);
        }

        /* Terminate the text and add the macro */
        *--q = '\0';
        add_define(namebuf, arg, mtext);
    }
    else
    {
        /* --- Normal Macro --- */

        /* Parse the replacement text into mtext[].
         */

        for (q = mtext; *p && *p != CHAR_EOF; )
        {
            *q = *p++;
            if (q < mtext+MLEN-2)
                q++;
            else
            {
                lexerror("Macro text too long");
                return;
            }

            /* If we are at line's end and it is escaped with '\',
             * get the next line and continue.
             */
            if (!*p)
            {
                if (p[-2] == '\\')
                {
                    q -= 2;
                    quote = refill(quote);
                    p = yytext;
                }
                else if (p[-2] == '\r' && p[-3] == '\\' )
                {
                    q -= 3;
                    quote = refill(quote);
                    p = yytext;
                }
            }
        }

        /* If the defined was ended by EOF instead of lineend,
         * we have to pass on the EOF to the caller.
         */
        if (*p == CHAR_EOF)
        {
            myungetc(*p);
        }

        /* Terminate the text and add the macro */
        *--q = '\0';
        add_define(namebuf, -1, mtext);
    }

#undef GETALPHA
#undef SKIPWHITE

} /* handle_define() */

/*-------------------------------------------------------------------------*/
static void
add_define (char *name, short nargs, char *exps)

/* Add a new macro definition for macro <name> with <nargs> arguments
 * and the replacement text <exps>. The positions where the arguments
 * are to be put into <exps> have to be marked with the MARKS character
 * as described elsewhere.
 *
 * The new macro is stored in the ident_table[] and also put into
 * the list of all_defines.
 *
 * If the macro <name> is already defined, an error is generated.
 */

{
    ident_t *p;

    /* Lookup/create a new identifier entry */
    p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
    if (!p)
    {
        lexerror("Out of memory");
        return;
    }

    /* If such a macro already exists with different meaning,
     * generate an error. If the meaning doesn't change, generate
     * a warning.
     */
    if (p->type != I_TYPE_UNKNOWN)
    {
        char buf[200+NSIZE];

        if (current_line <= 0)
            sprintf(buf, "(in auto_include text) Redefinition of #define %s", name);
        else
            sprintf(buf, "Redefinition of #define %s", name);

        if (nargs != p->u.define.nargs
         || p->u.define.special
         || strcmp(exps,p->u.define.exps.str) != 0)
        {
            yyerror(buf);
            return;
        }
        else
        {
            yywarn(buf);
        }
    }
    else
    {
        /* New macro: initialise the ident.u.define and
         * add it to the list of defines.
         */

        p->type = I_TYPE_DEFINE;
        p->u.define.nargs = nargs;
        p->u.define.permanent = MY_FALSE;
        p->u.define.special = MY_FALSE;
        if ( !(p->u.define.exps.str = xalloc(strlen(exps)+1)) )
        {
            free_shared_identifier(p);
            lexerror("Out of memory");
            return;
        }
        strcpy(p->u.define.exps.str, exps);

        p->next_all = all_defines;
        all_defines = p;
#if defined(LEXDEBUG)
        fprintf(stderr, "%s define '%s' %d '%s'\n"
               , time_stamp(), name, nargs, exps);
#endif
    }
} /* add_define() */

/*-------------------------------------------------------------------------*/
static void
add_permanent_define (char *name, short nargs, void *exps, Bool special)

/* Add a new permanent macro definition for macro <name>
 * with <nargs> arguments and the replacement text <exps>.
 * The positions where the arguments are to be put into <exps> have to be
 * marked with the MARKS character as described elsewhere.
 *
 * If <special> is true, <exps> is not a text pointer, but instead
 * a pointer to a function returning a text.
 *
 * The new macro is stored in the ident_table[] and also put into
 * the list of permanent_defines.
 *
 * If the macro <name> is already defined, an error is generated.
 *
 * TODO: Instead of <exps>,<special>, it should be <exps>,<fun>
 * TODO:: with proper types.
 */

{
    ident_t *p;

    /* Lookup/create a new identifier entry */
    p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
    if (!p)
    {
        error("Out of memory\n");
    }

    /* If such a macro already exists with different meaning,
     * generate an error.
     */
    if (p->type != I_TYPE_UNKNOWN)
    {
        if (nargs != p->u.define.nargs
         || p->u.define.special
         || strcmp(exps,p->u.define.exps.str) != 0)
        {
            error("Redefinition of #define %s\n", name);
        }
        return;
    }

    /* New macro: initialise the ident.u.define and
     * add it to the list of permanent defines.
     */

    p->type = I_TYPE_DEFINE;
    p->u.define.nargs = nargs;
    p->u.define.permanent = MY_TRUE;
    p->u.define.special = (short)special;
    if (!special)
        p->u.define.exps.str = (char *)exps;
    else
        p->u.define.exps.fun = (defn_fun)exps;
    p->next_all = permanent_defines;
    permanent_defines = p;
} /* add_permanent_define() */

/*-------------------------------------------------------------------------*/
void
free_defines (void)

/* Free all non-permanent defines, and undo any undefine of a permanent
 * define.
 *
 * Also called from the garbage collector and simul_efun.c
 */

{
    ident_t *p, *q;

    /* Free all non-permanent defines */

    for (p = all_defines; p; p = q)
    {
        q = p->next_all;
        if (p->name)
        {
            if (!p->u.define.special)
                xfree(p->u.define.exps.str);
            free_shared_identifier(p);
        }
        else
        {
            /* has been undef'd. */
            xfree(p);
        }
    }
    all_defines = NULL;


    /* Reactivate undefined permanent defines */

    for (p = undefined_permanent_defines; p; p = q)
    {
        ident_t *curr, **prev;

        q = p->next;
        p->next = NULL;
        prev = &ident_table[p->hash];
        while ( NULL != (curr = *prev) )
        {
            if (curr->name == p->name) /* found it */
            {
                p->next = curr->next;
                break;
            }
            prev = &curr->next;
        } /* not found, create new one */
        p->inferior = curr;
        *prev = p;
    }
    undefined_permanent_defines = NULL;
    nexpands = 0;
} /* free_defines() */

/*-------------------------------------------------------------------------*/
static ident_t *
lookup_define (char *s)

/* Lookup the name <s> in the identtable and return a pointer to its
 * ident structure if it is a define. Return NULL else.
 */

{
    ident_t *curr, *prev;
    int h;

    h = identhash(s);

    curr = ident_table[h];
    prev = 0;
    while (curr)
    {
        if (!strcmp(curr->name, s)) /* found it */
        {
            if (prev) /* not at head of list */
            {
                prev->next = curr->next;
                curr->next = ident_table[h];
                ident_table[h] = curr;
            }
            if (curr->type == I_TYPE_DEFINE)
                return curr;
            return NULL;
        }
        prev = curr;
        curr = curr->next;
    } /* not found */

    return NULL;
} /* lookup_define() */


/*-------------------------------------------------------------------------*/
static Bool
expand_define (void)

/* Check if yytext[] holds a macro and expand it if it is.
 * Return true if it was expanded, false if not.
 */

{
    ident_t *p;

    p = lookup_define(yytext);
    if (!p) {
        return MY_FALSE;
    }
    return _expand_define(&p->u.define, p);
}

/*-------------------------------------------------------------------------*/
static Bool
_expand_define (struct defn *p, ident_t * macro)

/* Expand the macro <p> and add_input() the expanded text.
 * For function macros, the function expects the next non-white character
 * in the input buffer to be the opening '(' of the argument list.
 * <macro> is the struct ident_s entry and is needed just for error
 * messages.
 *
 * Return true if the expansion was successfull, false if not.
 */

{
  /* Skip the whitespace in the input buffer until the next non-blank
   * and store that one in variable <c>.
   */
#define SKIPW \
    for(;;) {\
        do {\
            c = cmygetc();\
        } while(lexwhite(c));\
        if (c == '\n') {\
            myfilbuf();\
            store_line_number_info();\
            current_line++;\
            total_lines++;\
        } else break;\
    }

    static char *expbuf = NULL;
      /* The arguments of a function macro, separated by '\0' characters.
       */
    static char *buf = NULL;
      /* Construction buffer for the expanded macro text.
       */

      /* Both buffers are allocated on the first call to the
       * function and reused thereafter. Putting them on the
       * stack would make _expand_define() reentrant, but
       * very slow on systems without proper alloca().
       * Right now the only possibility for a recursive call
       * is an error during the expansing, with error handling requesting
       * another expansion. In this case, reentrancy is not an issue
       * because after returning from the error, the function itself
       * returns immediately.
       *
       * But should the need ever arise, the old fragments may be
       * changed to implement a stack of buffers. Using the stack-mempool
       * allocator, this could even be efficient.
       */

#if 0
    static int mutex = 0;
      /* TODO: The mutex may be used to implement a stack of buffers if needed.
       */
#endif

    char *args[NARGS];
      /* Pointers into expbuf[] to the beginning of the actual
       * macro arguments.
       */
    char *q;  /* Pointer into expbuf[] when parsing the args */
    char *e;  /* Pointer to replacement text */
    char *b;  /* Pointer into buf[] when expanding */
    char *r;  /* Next character to read from input buffer */

#if 0
    /* TODO: This was a test for recursive calls. If a stack of buffers is
     * TODO:: needed, this code fragments allow an easy implementation,
     * TODO:: especially because the DEMUTEX macros are already where
     * TODO:: they have to be.
     */
    if (mutex++)
    {
        lexerror("Recursive call to _expand_define()");
        mutex--;
        return 0;
    }
#define DEMUTEX mutex--
#else
#define DEMUTEX NOOP
#endif

    /* Allocate the buffers if not done already */
    if (!expbuf)
        expbuf = pxalloc(DEFMAX);
    if (!buf)
        buf = pxalloc(DEFMAX);
    if (!expbuf || !buf) {
        lexerror("Stack overflow");
        DEMUTEX;
        return 0;
    }

    /* No more than EXPANDMAX expansions per line */
    if (nexpands++ > EXPANDMAX)
    {
        lexerror("Too many macro expansions");
        DEMUTEX;
        return MY_FALSE;
    }

    if (p->nargs == -1)
    {
        /* --- Normal Macro --- */

        if (!p->special)
        {
            add_input(p->exps.str);
        }
        else
        {
            e = (*p->exps.fun)(NULL);
            if (!e) {
                lexerror("Out of memory");
                DEMUTEX;
                return 0;
            }
            add_input(e);
            xfree(e);
        }

        /* That's it. Jump to the function's end now. */
    }
    else
    {
        /* --- Function Macro --- */

        int c;
        int brakcnt = 0; /* Number of pending open '[' */
        int parcnt = 0;  /* Number of pending open '(' */
        Bool dquote = MY_FALSE; /* true: in "" */
        Bool squote = MY_FALSE; /* true: in '' */
        int n;           /* Number of parsed macro arguments */

        /* Look for the argument list */
        SKIPW;
        if (c != '(') {
            yyerrorf("Macro '%s': Missing '(' in call", macro->name);
            DEMUTEX;
            return MY_FALSE;
        }

        /* Parse the macro arguments and store them in args[].
         * This is a bit complex as we have to care for character
         * constants, string literals, parentheses, symbols and
         * comments.
         */

        SKIPW;
        if (c == ')')
            n = 0;  /* No args */
        else
        {
            /* Setup */
            r = outp;
            *--r = (char)c;
            q = expbuf;
            args[0] = q;

            for (n = 0;;)
            {
                if (q >= expbuf + DEFMAX - 5)
                {
                    lexerrorf("Macro '%s': argument overflow", macro->name);
                    DEMUTEX;
                    return MY_FALSE;
                }

                switch(c = *r++)
                {
                  case '"' :
                    /* Begin of string literal, or '"' constant */
                    if (!squote)
                        dquote = !dquote;
                    *q++ = (char)c;
                    continue;

                  case '#':
                    /* Outside of strings it must be a #'symbol.
                     */
                    *q++ = (char)c;
                    if (!squote && !dquote && *r == '\'')
                    {
                        r++;
                        *q++ = '\'';
                        if (isalunum(c = *r))
                        {
                            do {
                                *q++ = (char)c;
                                ++r;
                            } while (isalunum(c = *r));
                        }
                        else
                        {
                            char *end;

                            if (symbol_operator(r, &end) < 0)
                            {
                                yyerror("Missing function name after #'");
                            }
                            strncpy(q, r, (size_t)(end - r));
                            q += end - r;
                            r = end;
                        }
                    }
                    continue;

                  case '\'':
                    /* Begin of character constant or quoted symbol.
                     */
                    if ( !dquote
                     && (!isalunum(*r) || r[1] == '\'')
                     && (*r != '(' || r[1] != '{') )
                    {
                        squote = !squote;
                    }
                    *q++ = (char)c;
                    continue;

                  case '[' :
                    /* Begin of array/mapping index.
                     */
                    if (!squote && !dquote)
                        brakcnt++;
                    *q++ = (char)c;
                    continue;

                  case ']' :
                    /* End of array/mapping index.
                     */
                    if (!squote && !dquote && brakcnt > 0)
                    {
                        brakcnt--;
                    }
                    *q++ = (char)c;
                    continue;

                  case '(' :
                    /* Begin of nested expression.
                     */
                    if (!squote && !dquote)
                        parcnt++;
                    *q++ = (char)c;
                    continue;

                  case ')' :
                    /* End of nested expression.
                     */
                    if (!squote && !dquote)
                    {
                        parcnt--;
                        if (parcnt < 0)
                        {
                            /* We found the end of the argument list */
                            *q++ = '\0';
                            n++;
                            break;
                        }
                    }
                    *q++ = (char)c;
                    continue;

                  case '\\':
                    /* In strings, escaped sequence.
                     */
                    *q++ = (char)c;
                    if (squote || dquote)
                    {
                        c = *r++;
                        if (c == '\r')
                            c = *r++;
                        if (c == '\n')  /* nope! This wracks consistency! */
                        {
                            store_line_number_info();
                            current_line++;
                            total_lines++;
                            if (!*r)
                            {
                                outp = r;
                                r = _myfilbuf();
                            }
                            q--;        /* alas, long strings should work. */
                            continue;
                        }
                        if (c == CHAR_EOF) /* can't quote THAT */
                        {
                            r--;
                            continue;
                        }
                        *q++ = (char)c;
                    }
                    continue;

                  case '\n':
                    /* Next line.
                     */
                    store_line_number_info();
                    current_line++;
                    total_lines++;
                    *q++ = ' ';
                    if (!*r) {
                        outp = r;
                        r = _myfilbuf();
                    }
                    if (squote || dquote) {
                        lexerror("Newline in string");
                        DEMUTEX;
                        return MY_FALSE;
                    }
                    continue;

                  case ',':
                    /* Argument separation
                     */
                    if (!parcnt && !dquote && !squote && !brakcnt)
                    {
                        *q++ = '\0';
                        args[++n] = q;
                        if (n == NARGS - 1)
                        {
                            lexerror("Maximum macro argument count exceeded");
                            DEMUTEX;
                            return MY_FALSE;
                        }
                        continue;
                    }
                    *q++ = (char)c;
                    continue;

                  case CHAR_EOF:
                        lexerror("Unexpected end of file (or a spurious 0x01 character)");
                        DEMUTEX;
                        return MY_FALSE;

                  case '/':
                    /* Probable comment
                     */
                    if (!squote && !dquote)
                    {
                        if ( (c = *r++) == '*')
                        {
                            outp = r;
                            skip_comment();
                            r = outp;
                        }
                        else if ( c == '/')
                        {
                            r = skip_pp_comment(r);
                        }
                        else
                        {
                            --r;
                            *q++ = '/';
                        }
                        continue;
                    }

                  default:
                    *q++ = (char)c;
                    continue;
                } /* end switch */

                /* The only way to come here is in the case ')' when the
                 * end of the argument list is detected. Hence, we can
                 * break the for().
                 */
                break;
            } /* for(n = 0..NARGS) */
            outp = r;
        } /* if (normal or function macro) */

        /* Proper number of arguments? */
        if (n != p->nargs)
        {
            yyerrorf("Macro '%s': Wrong number of arguments", macro->name);
            DEMUTEX;
            return MY_FALSE;
        }

        /* (Don't) handle dynamic function macros */
        if (p->special)
        {
            (void)(*p->exps.fun)(args);
            DEMUTEX;
            return MY_TRUE;
        }

        /* Construct the expanded macro text in buf[] by simple
         * copy and replace.
         */

        b = buf;
        e = p->exps.str;
        while (*e)
        {
            if (*e == MARKS)
            {
                if (*++e == MARKS)
                    *b++ = *e++;
                else
                {
                    for (q = args[*e++ - MARKS - 1]; *q; )
                    {
                        *b++ = *q++;
                        if (b >= buf+DEFMAX)
                        {
                            lexerror("Macro expansion overflow");
                            DEMUTEX;
                            return MY_FALSE;
                        }
                    }
                }
            }
            else
            {
                *b++ = *e++;
                if (b >= buf+DEFMAX)
                {
                    lexerror("Macro expansion overflow");
                    DEMUTEX;
                    return MY_FALSE;
                }
            }
        }

        /* Terminate the expanded text and add it to the input */
        *b++ = '\0';
        add_input(buf);
    }

    /* That's it. */

    DEMUTEX;
    return MY_TRUE;

#undef SKIPW
}

/*-------------------------------------------------------------------------*/
static int
exgetc (void)

/* Get the first character of the next element of a condition
 * and return it, leaving the input pointing to the rest of it.
 * Comments are skipped, identifiers not defined as macros are
 * replaced with ' 0 ', the predicate 'defined(<name>)' is
 * replaced with ' 0 ' or ' 1 ' depending on the result.
 */

{
#define SKPW         do c = (unsigned char)mygetc(); while(lexwhite(c)); myungetc((char)c)
  /* Skip the whitespace in the input buffer until the first non-blank.
   * End with the input pointing to this non-blank.
   */

    register unsigned char c;
    register char *yyp;

    c = (unsigned char)mygetc();
    for (;;)
    {
        if ( isalpha(c) || c=='_' )
        {
            /* It's an identifier, maybe a macro name, maybe it's
             * an 'defined()' predicate.
             */

            /* Get the full identifier in yytext[] */
            yyp = yytext;
            do {
                SAVEC;
                c=(unsigned char)mygetc();
            } while ( isalunum(c) );
            myungetc((char)c);

            *yyp='\0';
            if (strcmp(yytext, "defined") == 0)
            {
                /* handle the 'defined' predicate */
                do c = (unsigned char)mygetc(); while(lexwhite(c));
                if (c != '(')
                {
                    yyerror("Missing ( in defined");
                    continue;
                }
                do c = (unsigned char)mygetc(); while(lexwhite(c));
                yyp=yytext;
                while ( isalunum(c) )
                {
                    SAVEC;
                    c=(unsigned char)mygetc();
                }
                *yyp='\0';
                while(lexwhite(c)) c = (unsigned char)mygetc();
                if (c != ')') {
                    yyerror("Missing ) in defined");
                    continue;
                }
                SKPW;
                if (lookup_define(yytext))
                    add_input(" 1 ");
                else
                    add_input(" 0 ");
            }
            else
            {
                /* Simple identifier */
                if (!expand_define())
                    add_input(" 0 ");
            }
            c = (unsigned char)mygetc();
        }
        else if (c == '\\' && (*outp == '\n' || *outp == '\r'))
        {
            /* Escaped new line: read the next line, strip
             * all comments, and then add the result again
             * for reparsing.
             */

            Bool quote;

            outp++;
            if (outp[-1] == '\r' && *outp == '\n')
                outp++;
            yyp = yytext;
            for(quote = MY_FALSE;;)
            {
                c = (unsigned char)mygetc();
                if (c == '"')
                    quote = !quote;
                while(!quote && c == '/') { /* handle comments cpp-like */
                    char c2;

                    if ( (c2 = mygetc()) == '*') {
                        skip_comment();
                        c=(unsigned char)mygetc();
                    } else if (c2 == '/') {
                        outp = skip_pp_comment(outp);
                        current_line--;
                        c = '\n';
                    } else {
                        --outp;
                        break;
                    }
                }
                SAVEC;
                if (c == '\n') {
                    break;
                }
            }
            *yyp = '\0';
            current_line++;
            total_lines++;
            add_input(yytext);
            nexpands = 0;
            c = (unsigned char)mygetc();
        }
        else
        {
            break;
        }
    }

    return c;

#undef SKPW
} /* exgetc() */

/*-------------------------------------------------------------------------*/
static int
cond_get_exp (int priority, svalue_t *svp)

/* Evaluate the expression in the input buffer at a priority of at least
 * <priority> and store the result in <svp> (which is assumed to be
 * invalid at the time of call).
 * Return the result if it is numeric, or a truthvalue for string
 * expressions.
 *
 * The function assumes to be called at the proper beginning of
 * an expression, i.e. if it encounters an operator even before a value,
 * it must be unary.
 */

{
    int c;
    int value = 0;
    int value2, x;
    svalue_t sv2;

    svp->type = T_INVALID;
    do c = exgetc(); while ( lexwhite(c) );

    /* Evaluate the first value */

    if (c == '(')
    {
        /* It's a parenthesized subexpression */

        value = cond_get_exp(0, svp);

        do c = exgetc(); while ( lexwhite(c) );
        if ( c != ')' )
        {
            yyerror("parentheses not paired in #if");
            if (c == '\n')
                myungetc('\n');
        }
    }
    else if ( ispunct(c) )
    {
        /* It is a string or an unary operator */

        if (c == '"')
        {
            /* Get the string */

            char *p, *q;

            q = p = outp;
            for (;;)
            {
                c = *p++;
                if (c == '"')
                {
                    break;
                }
                if (c == '\n')
                {
                    yyerror("unexpected end of string in #if");
                    put_malloced_string(svp, string_copy(""));
                    return 0;
                }
                if (c == '\\')
                {
                    c = *p++;
                    if (c == '\n')
                    {
                        current_line++;
                        *--p = '"';
                        break;
                    }
                }
                *q++ = (char)c;
            }
            *q = '\0';
            put_malloced_string(svp, string_copy(outp));
            outp = p;
        }
        else
        {
            /* Is it really an operator? */
            x = optab1(c);
            if (!x)
            {
                yyerror("illegal character in #if");
                return 0;
            }

            /* Get the value for this unary operator */
            value = cond_get_exp(12, svp);

            /* Evaluate the operator */
            switch ( optab2[x-1] )
            {
              case BNOT  : value = ~value; break;
              case LNOT  : value = !value; break;
              case UMINUS: value = -value; break;
              case UPLUS : value =  value; break;
              default :
                yyerror("illegal unary operator in #if");
                free_svalue(svp);
                svp->type = T_NUMBER;
                return 0;
            }

            if (svp->type != T_NUMBER)
            {
                yyerror("illegal type to unary operator in #if");
                free_svalue(svp);
                svp->type = T_NUMBER;
                return 0;
            }
            svp->u.number = value;
        }
    }
    else
    {
        /* It must be a number */

        int base;

        if ( !lexdigit(c) )
        {
            if (c == '\n')
            {
                yyerror("missing expression in #if");
                myungetc('\n');
            }
            else
                yyerror("illegal character in #if");
            return 0;
        }

        value = 0;

        /* Determine the base of the number */
        if (c != '0')
            base=10;
        else
        {
            c = mygetc();
            if (c == 'x' || c == 'X')
            {
                base = 16;
                c = mygetc();
            }
            else
                base = 8;
        }

        /* Now parse the number */
        for(;;)
        {
            if ( isdigit(c) )      x = -'0';
            else if ( isupper(c) ) x = -'A'+10;
            else if ( islower(c) ) x = -'a'+10;
            else break;
            x += c;
            if (x > base)
                break;
            value = value * base + x;
            c = mygetc();
        }
        myungetc((char)c);
        put_number(svp, value);
    }


    /* Now evaluate the following <binop> <expr> pairs (if any) */

    for (;;)
    {
        do c=exgetc(); while ( lexwhite(c) );

        /* An operator or string must come next */
        if ( !ispunct(c) )
            break;

        /* If it's a string, make it a string addition */
        if (c == '"')
        {
            myungetc('"');
            c = '+';
        }

        /* Can it be an operator at all? */
        x = optab1(c);
        if (!x)
            break;

        /* See if the optab[] defines an operator for these characters
         */
        value2 = mygetc();
        for (;;x+=3)
        {
            if (!optab2[x])
            {
                myungetc((char)value2);
                if (!optab2[x+1])
                {
                    yyerror("illegal operator use in #if");
                    return 0;
                }
                break;
            }
            if (value2 == optab2[x])
                break;
        }

        /* If the priority of the operator is too low, we are done
         * with this (sub)expression.
         */
        if (priority >= optab2[x+2])
        {
            if (optab2[x])
                myungetc((char)value2);
            break;
        }

        /* Get the second operand */
        value2 = cond_get_exp(optab2[x+2], &sv2);

        /* Evaluate the operands:
         *   Full set of operations for numbers.
         *   Addition and lexicographic comparisons for strings.
         */
        if (svp->type == T_NUMBER && sv2.type == T_NUMBER)
        {
            switch (optab2[x+1])
            {
              case MULT   : value *= value2;                break;
              case DIV    : if (!value2) lexerror("Division by zero");
                            else value /= value2;         break;
              case MOD    : if (!value2) lexerror("Division by zero");
                            else value %= value2;         break;
              case BPLUS  : value += value2;                break;
              case BMINUS : value -= value2;                break;
              case LSHIFT : if ((uint)value2 > MAX_SHIFT) value = 0;
                            else value <<= value2; break;
              case RSHIFT : value >>= (uint)value2 > MAX_SHIFT ? MAX_SHIFT : value2;
                            break;
              case LESS   : value = value <  value2;        break;
              case LEQ    : value = value <= value2;        break;
              case GREAT  : value = value >  value2;        break;
              case GEQ    : value = value >= value2;        break;
              case EQ     : value = value == value2;        break;
              case NEQ    : value = value != value2;        break;
              case BAND   : value &= value2;                break;
              case XOR    : value ^= value2;                break;
              case BOR    : value |= value2;                break;
              case LAND   : value = value && value2;        break;
              case LOR    : value = value || value2;        break;
              case QMARK  :
                  do c=exgetc(); while( lexwhite(c) );
                  if (c != ':')
                  {
                      yyerror("'?' without ':' in #if");
                      myungetc((char)c);
                      return 0;
                  }
                  if (value)
                  {
                      *svp = sv2;
                      cond_get_exp(1, &sv2);
                      free_svalue(&sv2);
                      value = value2;
                  }
                  else
                      value = cond_get_exp(1, svp);
                  break;
            } /* switch() */
        }
        else if (svp->type == T_STRING && sv2.type == T_STRING)
        {
            x = optab2[x+1];
            if (x == BPLUS)
            {
                char *str;

                str = xalloc(strlen(svp->u.string) + strlen(sv2.u.string) + 1);
                strcpy(str, svp->u.string);
                strcat(str, sv2.u.string);
                free_string_svalue(svp);
                free_string_svalue(&sv2);
                svp->u.string = str;
            }
            else
            {
                value = strcmp(svp->u.string, sv2.u.string);
                free_string_svalue(svp);
                svp->type = T_NUMBER;
                free_string_svalue(&sv2);
                switch (x)
                {
                  case LESS   : value = value <  0; break;
                  case LEQ    : value = value <= 0; break;
                  case GREAT  : value = value >  0; break;
                  case GEQ    : value = value >= 0; break;
                  case EQ     : value = value == 0; break;
                  case NEQ    : value = value != 0; break;
                  default:
                    yyerror("illegal operator use in #if");
                    return 0;
                }
                put_number(svp, value);
            }
        }
        else
        {
            yyerror("operands in #if won't match");
            free_svalue(svp);
            svp->type = T_NUMBER;
            free_svalue(&sv2);
            return 0;
        }
    }
    myungetc((char)c);
    return value;
} /* cond_get_expr() */

/*-------------------------------------------------------------------------*/
void
set_inc_list (vector_t *v)

/* EFUN: set_driver_hook(H_INCLUDE_DIRS, ({ list }) )
 *
 * Set the list of pathnames to search for <>-include files to the
 * names in <v>.
 *
 * The function takes ownership of v->item[], but replaces all string
 * values by its own copies. Since the original v is held in
 * the driver_hook[] array, this is safe to do.
 */

{
    size_t i;
    char *p;
    svalue_t *svp;
    mp_int len, max;

    /* Count and test the passed pathnames */

    svp = v->item;
    for (i = 0, max = 0; i < VEC_SIZE(v); i++, svp++)
    {
        if (svp->type != T_STRING)
        {
            error("H_INCLUDE_DIRS argument has a non-string array element\n");
        }

        /* Set p to the beginning of the pathname, skipping leading
         * '/' and './'.
         */
        p = svp->u.string;
        for(;;) {
            if (*p == '/')
                p++;
            else if (*p == '.' && p[1] == '/')
                p += 2;
            else
                break;
        }

        /* Is the path legal? */
        if (!legal_path(p))
        {
            error("H_INCLUDE_DIRS path contains '..'\n");
        }
        if (*p == '.' && !p[1])
            error("H_INCLUDE_DIRS path is a single prefix dot\n");

        len = (mp_int)strlen(p);
        if (max < len)
            max = len;
        if (len >= 2 && p[len -1] == '.' && p[len - 2] == '/')
            error("H_INCLUDE_DIRS path ends in single prefix dot\n");

        /* Get and store our own copy of the pathname */
        p = string_copy(p);
        if (!p)
            error("Out of memory\n");

        free_svalue(svp);
        svp->type = T_STRING;
        svp->x.string_type = STRING_MALLOC;
        svp->u.string = p;
    }

    inc_list = v->item;
    inc_list_size = VEC_SIZE(v);
    inc_list_maxlen = max;
} /* set_inc_list() */

/*-------------------------------------------------------------------------*/
static char *
get_current_file (char ** args UNUSED)

/* Dynamic macro __FILE__: return the name of the current file.
 * In compat mode, don't return a leading slash.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *buf;

    buf = xalloc(strlen(current_file)+4);
    if (!buf)
        return NULL;
    if (compat_mode)
        sprintf(buf, "\"%s\"", current_file);
    else
        sprintf(buf, "\"/%s\"", current_file);
    return buf;
} /* get_current_file() */

/*-------------------------------------------------------------------------*/
static char *
get_current_dir (char ** args UNUSED)

/* Dynamic macro __DIR__: return the directory of the current file.
 * In compat mode, don't return a leading slash.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *buf;
    int len;

    buf = current_file + strlen(current_file);
    while (*(--buf) != '/' && buf >= current_file) NOOP;
    len = (buf - current_file) + 1;
    buf = xalloc(len + 4);
    if (!buf)
        return NULL;
    if (compat_mode)
        sprintf(buf, "\"%.*s\"", len, current_file);
    else
        sprintf(buf, "\"/%.*s\"", len, current_file);
    return buf;
} /* get_current_dir() */

/*-------------------------------------------------------------------------*/
static char *
get_sub_path (char ** args)

/* Dynamic macro __PATH__(n): return the directory of the current file,
 * where n is the number of directories to pop off from the right.
 * In compat mode, don't return a leading slash.
 */

{
    char *buf;
    int len, rm;

    rm = 0;
    sscanf(*args, "%d", &rm);
    if (rm < 0)
        rm = 0;
    buf = current_file + strlen(current_file);
    while (rm >= 0 && buf >= current_file)
        if (*(--buf) == '/')
            rm--;
    len = (buf - current_file) + 1;
    buf = alloca(len + 4);
    if (compat_mode)
        sprintf(buf, "\"%.*s\"", len, current_file);
    else
        sprintf(buf, "\"/%.*s\"", len, current_file);
    add_input(buf);
    return NULL;
} /* get_sub_path() */

/*-------------------------------------------------------------------------*/
static char *
get_current_line (char ** args UNUSED)

/* Dynamic macro __LINE__: return the number of the current line.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *buf;

    buf = xalloc(12);
    if (!buf)
        return NULL;
    sprintf(buf, "%d", current_line);
    return buf;
} /* get_current_line() */

/*-------------------------------------------------------------------------*/
static char *
get_version(char ** args UNUSED)

/* Dynamic macro __VERSION__: return the driver version.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *buf;
    size_t len;
    short bIsRelease;

    bIsRelease = IS_RELEASE();
    if (bIsRelease)
        len = strlen(GAME_VERSION LOCAL_LEVEL);
    else
        len = strlen(LONG_VERSION LOCAL_LEVEL);
    buf = xalloc(3 + len);
    if (!buf) return 0;
    buf[0] = '"';
    if (bIsRelease)
        strcpy(buf+1, GAME_VERSION LOCAL_LEVEL);
    else
        strcpy(buf+1, LONG_VERSION LOCAL_LEVEL);
    buf[len+1] = '"';
    buf[len+2] = '\0';
    return buf;
} /* get_version() */

/*-------------------------------------------------------------------------*/
static char *
get_hostname (char ** args UNUSED)

/* Dynamic macro __HOSTNAME__: return the hostname.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *tmp, *buf;

    tmp = query_host_name();
    buf = xalloc(strlen(tmp)+3);
    if (!buf) return 0;
    sprintf(buf, "\"%s\"", tmp);
    return buf;
} /* get_hostname() */

/*-------------------------------------------------------------------------*/
static char *
get_domainname (char ** args UNUSED)

/* Dynamic macro __DOMAINNAME__: return the domainname.
 */

{
#ifdef __MWERKS__
#    pragma unused(args)
#endif
    char *buf;

    buf = xalloc(strlen(domain_name)+3);
    if (!buf)
        return 0;
    sprintf(buf, "\"%s\"", domain_name);
    return buf;
} /* get_domainname() */

/*-------------------------------------------------------------------------*/
static char *
efun_defined (char **args)

/* Dynamic macro __EFUN_DEFINE__(name): test if the efun is defined
 * and add ' 0 ' or ' 1 ' depending on the result.
 */

{
    ident_t *p;

    p = make_shared_identifier(args[0], I_TYPE_GLOBAL, 0);
    if (!p)
    {
        lexerror("Out of memory");
        return NULL;
    }

    while (p->type > I_TYPE_GLOBAL)
    {
        if ( !(p = p->inferior) )
            break;
    }

    add_input(
      (p && p->type == I_TYPE_GLOBAL && p->u.global.efun >= 0) ?
        " 1 " : " 0 "
    );

    if (p && p->type == I_TYPE_UNKNOWN)
        free_shared_identifier(p);

    return NULL;
} /* efun_defined() */

/*-------------------------------------------------------------------------*/
void
remove_unknown_identifier (void)

/* Remove all identifiers from the ident_table[] which are of
 * type I_TYPE_UNKNOWN.
 */

{
    int i;
    ident_t *id, *next;

    for (i = ITABLE_SIZE; --i >= 0; )
    {
        id = ident_table[i];
        for ( ; id; id = next)
        {
            next = id->next;
            if (id->type == I_TYPE_UNKNOWN)
                free_shared_identifier(id);
        }
    }
} /* remove_unknown_identifier() */

/*-------------------------------------------------------------------------*/
size_t
show_lexer_status (strbuf_t * sbuf, Bool verbose UNUSED)

/* Return the amount of memory used by the lexer.
 */

{
#if defined(__MWERKS__)
#    pragma unused(verbose)
#endif
    size_t sum;
    ident_t *p;
    int i;

    sum = 0;

    /* Count the space used by identifiers and defines */
    for (i = ITABLE_SIZE; --i >= 0; )
    {
        p = ident_table[i];
        for ( ; p; p = p->next) {
            sum += sizeof(*p);
            if (p->name && p->type == I_TYPE_DEFINE && !p->u.define.special)
                sum += strlen(p->u.define.exps.str)+1;
        }
    }

    sum += mempool_size(lexpool);
    sum += defbuf_len;
    sum += 2 * DEFMAX; /* for the buffers in _expand_define() */

    if (sbuf)
        strbuf_addf(sbuf, "Lexer structures\t\t\t %9lu\n", sum);
    return sum;
} /* show_lexer_status() */

/*-------------------------------------------------------------------------*/
#ifdef GC_SUPPORT

static INLINE void
count_ident_refs (ident_t *id)

/* GC support: count all references held by one identifier (ignoring
 * inferiors).
 */

{
    count_ref_from_string(id->name);
    note_malloced_block_ref(id);
} /* count_ident_refs() */

/*-------------------------------------------------------------------------*/
void
count_lex_refs (void)

/* GC support: count all references held by the lexer.
 */

{
    int i;
    ident_t *id;

    /* Identifier */
    for (i = ITABLE_SIZE; --i >= 0; )
    {
        id = ident_table[i];
        for ( ; id; id = id->next)
        {
            ident_t *id2;
            count_ident_refs(id);
            for (id2 = id->inferior; id2 != NULL; id2 = id2->next)
            {
                count_ident_refs(id);
            }
        }
    }

    for (id = permanent_defines; id; id = id->next_all)
    {
        if (!id->u.define.special)
            note_malloced_block_ref(id->u.define.exps.str);
    }

    if (defbuf_len)
        note_malloced_block_ref(defbuf);

    if (lexpool)
        mempool_note_refs(lexpool);
}
#endif /* GC_SUPPORT */

/*-------------------------------------------------------------------------*/
char *
lex_error_context (void)

/* Create the current lexing context in a static buffer and return its
 * pointer.
 */

{
    static char buf[21];
    char *end;
    mp_int len;

    if (!pragma_verbose_errors)
        return "";

    strcpy(buf, ((signed char)yychar == -1 || yychar == CHAR_EOF)
                ? (len = 6, " near ")
                : (len = 8, " before "));

    if (!yychar || !*outp)
    {
        strcpy(buf+len, "end of line");
    }
    else if ((signed char)*outp == -1 || *outp == CHAR_EOF)
    {
        strcpy(buf+len, "end of file");
    }
    else
    {
        ssize_t left;

        left = linebufend - outp;
        if (left > sizeof(buf) - 3 - len)
            left = sizeof(buf) - 3 - len;
        if (left < 1)
            buf[0] = '\0';
        else
        {
            buf[len] = '\'';
            strncpy(buf + len + 1, outp, left);
            buf[len + left + 1] = '\'';
            buf[len + left + 2] = '\0';
            if ( NULL != (end = strchr(buf, '\n')) )
            {
                *end = '\'';
                *(end+1) = '\0';
                if (buf[len+1] == '\'')
                    strcpy(buf+len, "end of line");
            }
            if ( NULL != (end = strchr(buf, -1)) )
            {
                *end = '\'';
                *(end+1) = '\0';
                if (buf[len+1] == '\'')
                    strcpy(buf+len, "end of file");
            }
        }
    }
    return buf;
} /* lex_error_context() */

/*-------------------------------------------------------------------------*/
svalue_t *
f_expand_define (svalue_t *sp)

/* EFUN expand_define()
 *
 *   string expand_define (string name)
 *   string expand_define (string name, string arg, ...)
 *
 * Expands the macro <name> with the argument(s) <arg>... (default is
 * one empty string "").
 * Result is the expanded macro, or 0 if there is no macro with
 * that name.
 *
 * This efun is applicable only while an object is compiled,
 * therefore its usage is restricted to a few functions like the
 * H_INCLUDE_DIRS driver hook, or the masters runtime_error()
 * function.
 */

{
    char *arg, *res, *end;
    ident_t *d;

    /* Get the arguments from the stack */
    if (sp[-1].type != T_STRING)
        bad_xefun_arg(1, sp);

    arg = sp->u.string;
    if (sp->type != T_STRING) {
        if (sp->type != T_NUMBER || sp->u.number)
            bad_xefun_arg(2, sp);
        arg = "";
    }

    res = NULL;

    /* If we are compiling, lookup the given name and store
     * the expansion in res.
     */
    if (current_file && outp > defbuf && outp <= &defbuf[defbuf_len])
    {
        myungetc('\n');
        end = outp;
        add_input(arg);
        d = lookup_define(sp[-1].u.string);
        if (d && _expand_define(&d->u.define, d) )
        {
            *end = '\0';
            res = string_copy(outp);
            *end = '\n';  /* Restore the newline character */
        }
        outp = &end[1];
    }
    free_svalue(sp);
    free_svalue(--sp);

    /* Return the result */
    if (!res)
    {
        put_number(sp, 0);
    }
    else
    {
        sp->type = T_STRING;
        sp->x.string_type = STRING_MALLOC;
        sp->u.string = res;
    }

    return sp;
}

/***************************************************************************/