%{
/*---------------------------------------------------------------------------
 * make_func: Generation of the parser description and other tables
 *
 *---------------------------------------------------------------------------
 * make_func is an essential part of build process, as it creates the
 * actual LPC compiler description from a list of code and efun specs.
 *
 * Reason is a pecularity of the LPC compiler and interpreter implementation:
 * about all tokens recognized by the parser as terminal symbols translate
 * into one instruction of the bytemachine. To save work, the interpreter
 * directly uses the token definitions created by byacc in lang.h, subtracting
 * an offset to create the actual bytecode (the compiler tokens start at
 * value 256 to account for literal source characters).
 *
 * Since also almost every efun translates into its own bytemachine
 * instruction code, it became necessary to synchronize the assignment
 * of bytecode values to compiler tokens and efuns. This was accomplished
 * by collecting all information about internal machine codes and efuns
 * in one file, 'func_spec', and generating all depending tables and
 * files from it. The generated bytecode space is such that all non-efun
 * codes occupy the lower values, followed by the codes for the efuns.
 *
 * A further complication is that every bytecode can occupy only one
 * byte, but there are more than 256 codes and functions. This is solved
 * by the use of multi-byte instructions, where the first byte is
 * one of a set of prefix bytes, followed by the instructions code
 * byte within the range for this prefix. The code ranges are:
 *    normal instructions:   0..255 (0x000..0x0ff)
 *          xcodes+xefuns: 256..383 (0x100..0x17f)
 *          tcodes+tefuns: 384..511 (0x180..0x1ff)
 *          vcodes+vefuns: 512..639 (0x200..0x27f)
 *
 * When make_func is run, it first reads the file 'config.h' to determine
 * which defines are used in the compilation of the driver. For this
 * make_func implements a simple C preprocessor, capable of numeric
 * expressions and simple macro expansions (no function macros), which
 * also allows the use of C-like block comments. With the knowledge of
 * the defines, make_func then reads the file 'func_spec'
 * with the information about the codes and efuns.
 *
 * From this information, make_func generates these files:
 *   efun_defs.c
 *     This file contains the table of all instructions, instrs[].
 *     The table defines for every machine instruction if it is an
 *     internal code or efun, what arguments of what type it takes, etc.
 *     The file also contains the tables for the driver-specific ctype
 *     implementation.
 *     It is included into the lexer lex.c and compiled there.
 *     Note that 'efun_defs.c' is not created directly, instead all
 *     this data is just printed on stdout.
 *
 *  instrs.h
 *     This file defines the bytecodes representing all the efuns
 *     and non-efun instructions which are not compiler tokens.
 *
 *  lang.y
 *     This is the LPC compiler, which is created by reading and
 *     modifying the template prolang.y . During this process, these
 *     keywords are recognized and replaced:
 *       %efuns: is replaced by statements declaring all the compiler
 *               tokens.
 *       %line:  generates a #line statement to synchronize the C compiler.
 *       %typemap: generates a lookup table using types as indices
 *                 (see handle_map()).
 *       %hookmap: generates a lookup table using driverhooks as indices.
 *     In addition, the keywords %if, %elif, %else and %endif can be
 *     used in a preprocessor fashion to control which parts of prolang.y
 *     end up in lang.y and which don't.
 *
 *
 * func_spec is divided into several sections, each introduced with its
 * own %-keyword. The required order and meaning of the sections is this:
 *
 *     %tokens
 *         Define all codes (tokens) which are produced by the lexer
 *         and needed by the compiler, but are not machine instructions.
 *
 *     %codes
 *         These are the magic codes which are also compiler tokens.
 *         The first codes must be the special codes 'illegal', 'dummy',
 *         'escape', 'tefun' and 'vefun. The interpreter requires these
 *         to have fixed values in order to apply simple bit-manipulation.
 *         TODO: Bad interpreter. No cookie.
 *
 *     %efuns
 *         The efuns which are represented by one bytecode.
 *
 *     %xcodes
 *         Internal machine codes used by the compiler to generate code.
 *         These codes are multi-byte codes, using 'escape' as prefix.
 *
 *     %xefuns
 *         The efuns which are represented by 'escape' prefix codes.
 *
 *     %tcodes
 *         Internal machines codes, represented by 'tefun' prefix codes.
 *
 *     %tefuns
 *         The tabled efuns which are represented by 'tefun' prefix codes,
 *         resp. 'vefun' prefix codes if the efun takes an arbitrary
 *         number of arguments.
 *         The special thing about these functions is that their 'instruction
 *         code' is in fact just an index into (v)efun_table[] generated
 *         in efun_defs.c which holds the address of the actual function.
 *         This is slower than the normal efuns, where the code is
 *         part of the interpreter-switch(), but avoids the bytecode
 *         limitation. TODO: This explanation belongs into interpret.c
 *
 * The entries in the sections are separated by whitespace.
 *
 * A token or code entry follows this syntax:
 *
 *    [ "name" ] id
 *
 *        <id> is the name used in the compiler source, the generated token
 *        will be called F_<ID>. If <name> is specified, it will be used
 *        in tracedumps instead of the plain <id>.
 *
 * An efun is defined this way:
 *
 *    ret-type name [ alias ] ([argtype-1, ... , argtype-n]);
 *
 *        This is the efun <name>, with the compiler source name F_<NAME>,
 *        which returns a value of type <ret-type> and takes n >= 0
 *        arguments of type <argtype-x>. If <alias> is given, it must
 *        be the source name (F_FOO) of another efun this one is an
 *        alias for.
 *
 *        The types are given in the usual LPC syntax, with the additional
 *        type of 'unknown' for return types.
 *
 *        Argument types can be the combination of several types in
 *        the form 'type|type|...', e.g. 'string|object'. If one of the
 *        types is 'void', the argument is optional (but then only optional
 *        arguments may follow).
 *
 *        The last argument can take a default value, which is then specified
 *        as 'default: F_FOO' with F_FOO being the source name of an efun
 *        yielding the desired value. Example:
 *            ..(object default: F_THIS_OBJECT)
 *
 *        Alternatively, the last argument can be given as '...' if the
 *        efun can handle arbitrarily many arguments.
 *---------------------------------------------------------------------------
 */

#define MAKE_FUNC
#include "driver.h"

#include "my-alloca.h"
#include <stdlib.h>
#include <stdio.h>
#include <ctype.h>
#include <fcntl.h>

#include "exec.h"
#include "hash.h"

/* driver.h defines its own memory management functions,
 * which we don't need.
 */
#undef malloc
#undef realloc
#undef free

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

/* Filenames used by make_func */

#define FUNC_SPEC    "func_spec"
  /* The input file with the description of all machine instructions
   * and efuns.
   */

#define CONFIG       "config.h"
  /* The configuration file.
   */

#define PRO_LANG     "prolang.y"
  /* The LPC parser template.
   */

#define THE_LANG     "lang.y"
  /* The LPC parser to generate.
   */

#define THE_INSTRS   "instrs.h"
  /* The instruction and ctype table declarations to generate.
   */

#define EFUN_DEFS    "efun_defs.c"
  /* The instruction and ctype table definitions to generate.
   */

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

#define MAKE_FUNC_MAXLINE    4096
  /* Maximum length of an input line and other buffers.
   */

#define MAX_FUNC      2048
#define MAX_TOKENS    2048
  /* Maximum number of functions and tokens we care to handle.
   */

#define MAX_ARGTYPES  500
  /* Size of the arg_types[] array.
   */

#define MF_TYPE_MOD_POINTER   0x10000
#define MF_TYPE_MOD_REFERENCE 0x20000
  /* Type modifier for array and reference types.
   * These values are bitflags which are |'ed onto the type values
   * produced by the parser (INT, STRING, etc).
   */

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

#if defined(AMIGA)
#    define isascii(c) ((c) >= 0 && (c) <= 255)
#endif

#undef isalunum
#define isalunum(c) (isascii((unsigned char)c) && (isalnum((unsigned char)c) || (c) == '_' ))

#define lexwhite(c) (isascii((unsigned char)c) && isspace((unsigned char)c) && (c) != '\n')

#undef lexdigit
#define lexdigit(c) (isascii((unsigned char)c) && isdigit((unsigned char)c))
  /* Our own char classification predicates.
   */

#define NELEMS(arr)    (sizeof arr / sizeof arr[0])
  /* Handy macro to statically determine the number of elements in
   * an array.
   */

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

/* Parsed functions and instructions are put into different classes.
 * These are the class type definitions and associated predicate macros.
 */

#define C_TOKEN   0  /* Mere lexer tokens */
#define C_CODE    1  /* Internal machine instructions */
#define C_EFUN    2  /* Efuns with own instruction codes */
#define C_XCODE   3  /* Dito for the 'escape' prefix */
#define C_XEFUN   4
#define C_TCODE   5  /* Dito for the 'tefun' prefix */
#define C_TEFUN   6
#define C_VCODE   7  /* Dito for the 'vefun' prefix */
#define C_VEFUN   8
#define C_ALIAS   9  /* Aliased efuns */
#define C_TOTAL  10  /* Number of different classes */

#define C_IS_CODE(x) \
 ((x) == C_CODE || (x) == C_XCODE || (x) == C_TCODE || (x) == C_VCODE)
#define C_IS_EFUN(x) \
 ((x) == C_EFUN || (x) == C_XEFUN || (x) == C_TEFUN || (x) == C_VEFUN)

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

static int num_buff = 0;
  /* Total number of instructions encountered so far.
   */

static int num_instr[C_TOTAL] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
  /* Number of instructions encountered, counted separately for
   * every type.
   */

static char *token_f_names[MAX_TOKENS];
  /* 'F_'-names of the lexer-only tokens in the order encountered
   * in FUNC_SPEC.
   */

static char *f_names[MAX_FUNC];
static char *key[MAX_FUNC];
static char *buf[MAX_FUNC];
static int   code_class[MAX_FUNC];
  /* These four arrays together describe all codes and efuns
   * encountered in FUNC_SPEC:
   *
   *   f_names[x]:    'F-'-name of code/efun x
   *   key[x]:        internal name of code/efun x
   *   buf[x]:        instrs[] entry for code/efun x
   *   code_class[x]: code class of code/efun x
   *
   * The arrays are built in the order found in func_spec and later
   * sorted by code_class and key.
   * TODO: make this a struct.
   */

static int arg_types[MAX_ARGTYPES];
  /* All distinct function argument signatures encountered so far.
   * One signature is simply a list of all argument types, identified
   * by the starting index of the first argument's type.
   * The description of one argument's type is itself a list of the
   * typecode, terminated by 0.
   * Different signatures may overlap, e.g. a (T_STRING) signature
   * could be embedded in a (T_POINTER, T_INT|T_STRING) signature.
   *
   * The content of this array is later written as efun_arg_types[]
   * into EFUN_DEFS and used by the instrs[].arg_index entries.
   */

static int last_current_type;
  /* Index of the first unused entry in arg_types[].
   */

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

/* Variables used when parsing the lines of FUNC_SPEC */

static int min_arg = -1;
  /* Minimum number of arguments for this function if there
   * are optional arguments, or -1 if all arguments are needed.
   */

static Bool limit_max = MY_FALSE;
  /* True when the last argument for a function is the '...'
   */

static int current_code_class;
  /* The current code class (C_TOKEN, C_EFUN, ...) a parsed identifier
   * shall be assigned to.
   */

static int curr_arg_types[MAX_LOCAL];
  /* The function argument signature of the current function.
   * The signature is a list of all argument types, which themselves
   * are lists of typecodes, each argument's list terminated by 0.
   */

static int curr_arg_type_size;
  /* Index of the first unused entry in curr_arg_types[].
   */

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

/* Forward declarations */

static void yyerror(char *);
static int yylex(void);
int yyparse(void);
int ungetc(int c, FILE *f);
static char *type_str(int);
static char *etype(int);
static char *etype1(int);
static char *ctype(int);
#ifndef toupper
int toupper(int);
#endif
static int fatal(char *str);
static int cond_get_exp(int);

/*-------------------------------------------------------------------------*/
static char *
mystrdup (char *str)

/* Copy <str> into a freshly allocated memory block and return that one.
 *
 * This function is needed on Ultrix 4.2 which doesn't seem to know strdup().
 */

{
    char *copy = malloc(strlen(str)+1);
    if (!copy)
        fatal("strdup failed\n");
    strcpy(copy, str);
    return copy;
}

/*-------------------------------------------------------------------------*/
static int
fatal (char *str)

/* Print <str> on stderr, flush stdout and exit the program with
 * exitcode 1.
 */

{
    fprintf(stderr, "%s", str);
    fflush(stdout);
    exit(1);
    /* NOTREACHED */
    return 0;
}

/*-------------------------------------------------------------------------*/
static char *
make_f_name (char *str)

/* Take <str> and return a string 'F_<STR>' in its own memory block.
 */

{
    char f_name[500];
    size_t i, len;

    if (strlen(str) + 1 + 2 > sizeof f_name)
        fatal("A local buffer was too small!(1)\n");
    sprintf(f_name, "F_%s", str);
    len = strlen(f_name);
    for (i = 0; i < len; i++)
    {
        if (islower(f_name[i]))
            f_name[i] = (char)toupper(f_name[i]);
    }
    return mystrdup(f_name);
}

#if defined(__MWERKS__) && !defined(WARN_ALL)
#    pragma warn_possunwant off
#    pragma warn_implicitconv off
#endif
%}

/*=========================================================================*/

/*                           P A R S E R                                   */

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

%union {
    int number;
    char *string;
}

%token NAME ID

%token VOID INT STRING OBJECT MAPPING FLOAT CLOSURE SYMBOL QUOTED_ARRAY
%token MIXED UNKNOWN

%token DEFAULT

%token TOKENS CODES EFUNS XCODES XEFUNS TCODES TEFUNS END

%type <number> VOID MIXED UNKNOWN
%type <number> INT STRING OBJECT MAPPING FLOAT CLOSURE SYMBOL QUOTED_ARRAY
%type <number> basic arg_type
  /* Value is the basic type value
   */

%type <number> opt_star opt_ref
  /* Value is the appropriate bitflag or 0.
   */

%type <number> type
  /* Value is the complete type, incl. *-  and &-modifier bitflags
   */

%type <number> arg_list typel typel2
  /* Value is the number of arguments (so far)
   */

%type <string> ID optional_ID optional_default NAME optional_name
  /* Value is the parsed identifier or NULL (resp. "" for optional_ID).
   */

%%

all: tokens END codes END efuns END xcodes END xefuns END tcodes END tefuns;

tokens:   TOKENS
        | tokens token;

codes:    CODES
        | codes code;

xcodes:   XCODES
        | xcodes code;

tcodes:   TCODES
        | tcodes code;

efuns:    EFUNS  funcs;

xefuns:   XEFUNS funcs;

tefuns:   TEFUNS funcs;

/* --- Tokens --- */

token:    ID
    {
        if (num_instr[C_TOKEN] >= MAX_TOKENS)
            yyerror("Too many tokens!\n");
        token_f_names[num_instr[C_TOKEN]++] = make_f_name($1);
    }

/* --- Codes --- */

optional_name: /* empty */ { $$ = NULL; }
               | NAME;

code:     optional_name ID
    {
        char *f_name, buff[500];

        if (num_buff >= MAX_FUNC)
            yyerror("Too many codes and efuns in total!\n");
        if (!$1)
            $1 = mystrdup($2);
        f_name = make_f_name($2);
        code_class[num_buff] = current_code_class;
        num_instr[current_code_class]++;
        sprintf(buff, "{ 0, 0, { 0, 0 }, -1, 0, 0, \"%s\" },\n", $1);
        if (strlen(buff) > sizeof buff)
            fatal("Local buffer overflow!\n");
        f_names[num_buff] = f_name;
        key[num_buff] = mystrdup($2);
        buf[num_buff] = mystrdup(buff);
        num_buff++;
        free($1);
    }

/* --- Efuns --- */

funcs:   /* empty */
       | funcs func ;

optional_ID:   ID
             | /* empty */ { $$ = ""; } ;

optional_default:   DEFAULT ':' ID { $$ = $3; }
                  | /* empty */    { $$ = "0"; } ;

func: type ID optional_ID '(' arg_list optional_default ')' ';'
    {
        char buff[500];
        char *f_name;
        int i;

        if (num_buff >= MAX_FUNC)
            yyerror("Too many codes and efuns in total!\n");

        if (min_arg == -1)
            min_arg = $5;

        /* Make the correct f_name and determine the code class
         */
        if ($3[0] == '\0')
        {
            f_name = make_f_name($2);
            num_instr[
              (int)(code_class[num_buff] =
                limit_max && current_code_class == C_TEFUN ?
                  C_VEFUN : current_code_class)
            ]++;
        }
        else
        {
            f_name = mystrdup($3);
            code_class[num_buff] = C_ALIAS;
            num_instr[C_ALIAS]++;
        }

        /* Search the function's signature in arg_types[] */

        for (i = 0; i < last_current_type; i++)
        {
            int j;
            for (j = 0; j+i < last_current_type && j < curr_arg_type_size; j++)
            {
                if (curr_arg_types[j] != arg_types[i+j])
                    break;
            }
            if (j == curr_arg_type_size)
                break;
        }

        if (i == last_current_type)
        {
            /* It's a new signature, put it into arg_types[] */
            int j;
            for (j = 0; j < curr_arg_type_size; j++)
            {
                arg_types[last_current_type++] = curr_arg_types[j];
                if (last_current_type == NELEMS(arg_types))
                    yyerror("Array 'arg_types' is too small");
            }
        }

        /* Store the data */

        sprintf(buff, "{ %d, %d, { %s, %s }, %s, %s, %d, \"%s\" },\n"
                    , limit_max ? -1 : $5, min_arg
                    , etype(0), etype(1)
                    , $6, ctype($1), i, $2
               );

        if (strlen(buff) > sizeof buff)
             fatal("Local buffer overwritten !\n");

        f_names[num_buff] = f_name;
        key[num_buff] = mystrdup($2);
        buf[num_buff] = mystrdup(buff);
        num_buff++;

        /* Reset for next function */

        min_arg = -1;
        limit_max = MY_FALSE;
        curr_arg_type_size = 0;
    } ;

/* --- Types and Argument lists --- */

type: basic opt_star opt_ref { $$ = $1 | $2 | $3; };

basic: VOID | INT | STRING | MAPPING | FLOAT | MIXED | OBJECT | CLOSURE |
        UNKNOWN | SYMBOL | QUOTED_ARRAY ;

opt_star : '*' { $$ = MF_TYPE_MOD_POINTER; }
        |      { $$ = 0;                   } ;

opt_ref : '&' { $$ = MF_TYPE_MOD_REFERENCE; }
        |     { $$ = 0;                     } ;

arg_list: /* empty */             { $$ = 0; }
        | typel2                  { $$ = 1; if ($1) min_arg = 0; }
        | arg_list ',' typel2     { $$ = $1 + 1; if ($3) min_arg = $$ - 1; } ;

typel2: typel
    {
        $$ = $1;
        curr_arg_types[curr_arg_type_size++] = 0;
        if (curr_arg_type_size == NELEMS(curr_arg_types))
            yyerror("Too many arguments");
    } ;

arg_type: type
    {
        if ($1 != VOID)
        {
            curr_arg_types[curr_arg_type_size++] = $1;
            if (curr_arg_type_size == NELEMS(curr_arg_types))
                yyerror("Too many arguments");
        }
        $$ = $1;
    } ;

typel: arg_type              { $$ = ($1 == VOID && min_arg == -1); }
     | typel '|' arg_type    { $$ = (min_arg == -1 && ($1 || $3 == VOID));}
     | '.' '.' '.'           { $$ = min_arg == -1 ; limit_max = 1; } ;

%%

#ifdef __MWERKS__
#    pragma warn_possunwant reset
#    pragma warn_implicitconv reset
#endif

/*=========================================================================*/

/*                            L E X E R                                    */

/* The Lexer is used to parse CONFIG and FUNC_SPEC, and to create
 * THE_LANG from PRO_LANG.
 */

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

/* The recognized type names */

struct type {
    char *name;  /* name of the type */
    int   num;   /* the type's parser code */
};

static struct type types[]
  = { { "void",         VOID }
    , { "int",          INT }
    , { "string",       STRING }
    , { "object",       OBJECT }
    , { "mapping",      MAPPING }
    , { "float",        FLOAT }
    , { "closure",      CLOSURE }
    , { "symbol",       SYMBOL }
    , { "quoted_array", QUOTED_ARRAY }
    , { "mixed",        MIXED }
    , { "unknown",      UNKNOWN }
    };

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

/* Defined macros.
 *
 * The macros are kept in the usual hashtable.
 */

#define MAKE_FUNC_DEFHASH 101
#define defhash(str) (whashstr((str), 12) % MAKE_FUNC_DEFHASH)

struct defn {
    char *name;         /* Macro name */
    char *exps;         /* Expanded macro text */
    int  num_arg;       /* Number of arguments or -1 for plain macros */
    struct defn *next;  /* Next entry in the hash chain */
};

static struct defn *deftab[MAKE_FUNC_DEFHASH];

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

/* The stack to handle pending #ifs.
 */

static struct ifstate {
    struct ifstate *next;
    int state;
} *iftop = NULL;

/* Values of ifstate.state: */

#define EXPECT_ELSE   1
#define EXPECT_ENDIF  2

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

static FILE *fpr;
static FILE *fpw;
  /* Input and output file.
   */

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

static char *current_file;
  /* Name of the current file.
   */

static int last_line;
  /* Last line outside an %if-block.
   */

static char *outp;
  /* Next unprocessed character in the input buffer
   */

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

/* The definitions and tables for the preprocessor expression evaluator.
 * For a detailed explanation look into lex.c - it uses slightly
 * different tables, but the basic structure is the same.
 */


#define BNOT   1
#define LNOT   2
#define UMINUS 3
#define UPLUS  4

#define MULT   1
#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

static char _optab[]=
{0,4,0,0,0,26,56,0,0,0,18,14,0,10,0,22,0,0,0,0,0,0,0,0,0,0,0,0,30,50,40,74,
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,70,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,63,0,1};
static char optab2[]=
{BNOT,0,0,LNOT,'=',NEQ,7,0,0,UMINUS,0,BMINUS,10,UPLUS,0,BPLUS,10,
0,0,MULT,11,0,0,DIV,11,0,0,MOD,11,
0,'<',LSHIFT,9,'=',LEQ,8,0,LESS,8,0,'>',RSHIFT,9,'=',GEQ,8,0,GREAT,8,
0,'=',EQ,7,0,0,0,'&',LAND,3,0,BAND,6,0,'|',LOR,2,0,BOR,4,
0,0,XOR,5,0,0,QMARK,1};
#define optab1 (_optab-' ')

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

/* Return the next character from the input buffer.
 */

{
    return *outp++;
}

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

/* Unput character <c> so that the next mygetc() returns it.
 */

{
    *--outp = c;
}

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

/* Insert text <p> at the current point in the input stream so that
 * the next mygetc()s will read it.
 */

{
    size_t l;

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

/*-------------------------------------------------------------------------*/
static void
add_define (char * name, int num_arg, char *exps)

/* Add the definition for the macro <name> with <num_arg> arguments
 * and replacement text <exps> to the table of macros.
 */

{
    int i;
    struct defn *ndef;

    i = defhash(name);
    ndef = malloc(sizeof(struct defn));
    if (!ndef)
    {
        abort();
    }
    ndef->next    = deftab[i];
    ndef->exps    = mystrdup(exps);
    ndef->num_arg = num_arg;
    ndef->name    = mystrdup(name);
    deftab[i]     = ndef;
}

/*-------------------------------------------------------------------------*/
static struct defn *
lookup_define (char *s)

/* Lookup the macro <s> and return a pointer to its defn structure.
 * Return NULL if the macro is not defined.
 */

{
    struct defn *curr, *prev;
    int h;

    h = defhash(s);

    curr = deftab[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 = deftab[h];
                deftab[h] = curr;
            }
            return curr;
        }
        prev = curr;
        curr = curr->next;
    }

    /* not found */
    return NULL;
}

/*-------------------------------------------------------------------------*/
static int
expand_define (char *s)

/* Try to expand macro <s>.
 * If it is not defined, just return 0.
 * If it is a plain macro, add it to the input stream and return 1.
 * If it is a function macro, just return -1.
 */

{
    struct defn *p;

    p = lookup_define(s);
    if (!p)
        return 0;
    if (p->num_arg < 0)
    {
        add_input(p->exps);
    }
    else
    {
        return -1;
    }
    return 1;
}

/*-------------------------------------------------------------------------*/
static char *
nextword (char *str)

/* Find the next word in the input stream starting with <str> and
 * return a pointer to its first character. The end of the word
 * is marked with a '\0'.
 */

{
    char *cp;

    while (!lexwhite(*str)) str++;
    while ( lexwhite(*str)) str++;
    for (cp = str; isalunum(*cp); ) cp++;
    *cp = '\0';
    return str;
}

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

/* Skip the file fpr linewise until one of the following control statements
 * is encountered:
 *   <mark>token:  returns true
 *   <mark>atoken: returns false (only if <atoken> is not NULL).
 *
 * An end of file aborts the program.
 * Nested <mark>if...<mark>endif blocks are skipped altogether.
 */

{
    char  b[20]; /* The word after <mark> */
    char *p;
    int   c;     /* Current character */
    int   nest;  /* <mark>if nesting depth */
    FILE *fp = fpr;

    for (nest = 0;;)
    {
        current_line++;
        c = fgetc(fp);

        if (c == mark)
        {
            /* Get the statement word into b[] */

            do {
                c = fgetc(fp);
            } while(lexwhite(c));

            for (p = b; c != '\n' && c != EOF; )
            {
                if (p < b+sizeof b-1)
                    *p++ = (char)c;
                c = fgetc(fp);
            }
            *p++ = '\0';
            for(p = b; *p && !lexwhite(*p); p++) NOOP;
            *p = '\0';

            if (strcmp(b, "if") == 0
             || strcmp(b, "ifdef") == 0
             || strcmp(b, "ifndef") == 0)
            {
                nest++;
            }
            else if (nest > 0)
            {
                if (strcmp(b, "endif") == 0)
                    nest--;
            }
            else
            {
                if (strcmp(b, token) == 0)
                    return MY_TRUE;
                else if (atoken && strcmp(b, atoken) == 0)
                    return MY_FALSE;
            }
        }
        else
        {
            /* Skip the line altogether */

            while (c != '\n' && c != EOF)
            {
                c = fgetc(fp);
            }
            if (c == EOF)
            {
                fprintf(stderr, "Unexpected end of file while skipping");
                abort();
            }
        }
    } /* for() */

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

/*-------------------------------------------------------------------------*/
static void
compensate_lines (void)

/* To compensate for skipped blocks, print as many \n to fpw as
 * the difference between last_line and current_line determines.
 * last_line is current_line+1 at the end.
 */
{
    for (; last_line <= current_line; last_line++)
        fputc('\n', fpw);
}

/*-------------------------------------------------------------------------*/
static void
handle_cond (char mark, int 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.
 * If <mark> is '%', the number of skipped lines is compensated.
 */

{
    struct ifstate *p;

    if (c || skip_to(mark, "else", "endif"))
    {
        p = (struct ifstate *)malloc(sizeof(struct ifstate));
        p->next = iftop;
        iftop = p;
        p->state = c ? EXPECT_ELSE : EXPECT_ENDIF;
    }
    if (mark == '%')
        compensate_lines();
}

/*-------------------------------------------------------------------------*/
static void
handle_if (char mark, char *str)

/* Evaluate the <mark>if condition <str>
 */

{
    int cond;

    add_input(str);
    cond = cond_get_exp(0);
    if (mygetc() != '\n')
    {
        yyerror("Condition too complex in #/%if");
        fflush(stdout);
        if (mark == '%')
            exit(1);
        while(mygetc() != '\n') NOOP;
    }
    else
        handle_cond(mark, cond);
}

/*-------------------------------------------------------------------------*/
static void
handle_else (char mark)

/* Handle an <mark>else statement.
 */

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

        iftop = p->next;
        free((char *)p);
        skip_to(mark, "endif", (char *)0);
    }
    else
    {
        fprintf(stderr, "Unexpected #/%%else line %d\n", current_line);
        abort();
    }
}

/*-------------------------------------------------------------------------*/
static void
handle_endif (void)

/* Handle an <mark>else statement.
 */

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

        iftop = p->next;
        free((char *)p);
    }
    else
    {
        fprintf(stderr, "Unexpected #/%%endif line %d\n", current_line);
        abort();
    }
}

/*-------------------------------------------------------------------------*/
static int
name_to_type (char *name)

/* Return the proper TYPE_ value for the type <name> which must
 * start with 'TYPE_'.
 * Return -1 if the name was not recognized.
 */

{
    while (isspace((unsigned char)*name))
        name++;
    if ( strncmp(name, "TYPE_", 5) )
        return -1;
    name += 5;
    if ( !strcmp(name, "ANY") )
        return TYPE_ANY;
    if ( !strcmp(name, "NUMBER") )
        return TYPE_NUMBER;
    if ( !strcmp(name, "FLOAT") )
        return TYPE_FLOAT;
    if ( !strcmp(name, "OBJECT") )
        return TYPE_OBJECT;
    if ( !strcmp(name, "MAPPING") )
        return TYPE_MAPPING;
    if ( !strcmp(name, "CLOSURE") )
        return TYPE_CLOSURE;
    return -1;
}

/*-------------------------------------------------------------------------*/
static int
name_to_hook(char *name)

/* Return the proper H_ value for the driverhook <name> which must
 * start with 'H_'
 * Return -1 if the name was not recognized.
 */

{
    while (isspace((unsigned char)*name))
        name++;
    if ( strncmp(name, "H_", 2) )
        return -1;
    name += 2;
    if ( !strcmp(name, "MOVE_OBJECT0") )
        return H_MOVE_OBJECT0;
    if ( !strcmp(name, "MOVE_OBJECT1") )
        return H_MOVE_OBJECT1;
    if ( !strcmp(name, "LOAD_UIDS") )
        return H_LOAD_UIDS;
    if ( !strcmp(name, "CLONE_UIDS") )
        return H_CLONE_UIDS;
    if ( !strcmp(name, "CREATE_SUPER") )
        return H_CREATE_SUPER;
    if ( !strcmp(name, "CREATE_OB") )
        return H_CREATE_OB;
    if ( !strcmp(name, "CREATE_CLONE") )
        return H_CREATE_CLONE;
    if ( !strcmp(name, "RESET") )
        return H_RESET;
    if ( !strcmp(name, "CLEAN_UP") )
        return H_CLEAN_UP;
    if ( !strcmp(name, "MODIFY_COMMAND") )
        return H_MODIFY_COMMAND;
    if ( !strcmp(name, "NOTIFY_FAIL") )
        return H_NOTIFY_FAIL;
    if ( !strcmp(name, "NO_IPC_SLOT") )
        return H_NO_IPC_SLOT;
    if ( !strcmp(name, "INCLUDE_DIRS") )
        return H_INCLUDE_DIRS;
    if ( !strcmp(name, "TELNET_NEG") )
        return H_TELNET_NEG;
    if ( !strcmp(name, "NOECHO") )
        return H_NOECHO;
    if ( !strcmp(name, "ERQ_STOP") )
        return H_ERQ_STOP;
    if ( !strcmp(name, "MODIFY_COMMAND_FNAME") )
        return H_MODIFY_COMMAND_FNAME;
    if ( !strcmp(name, "COMMAND") )
        return H_COMMAND;
    return -1;
}

/*-------------------------------------------------------------------------*/
static void
handle_map (char *str, int size, int (* name_to_index)(char *) )

/* Create a lookup table with <size> elements from the input
 * text <str> (and possibly more lines read from fpr if <str>
 * ends in \<newline>).
 *
 * The input text is supposed to be a comma separated list
 * of <index>:<value> pairs: the text "<index>" is parsed
 * and translated into a number by <name_to_index>().
 * <value> is the assigned to the table element indexed
 * by this number.
 *
 * Unassigned table elements default to the text '0' or
 * to the value set with a 'default:<value>' pair.
 *
 * After the list of pairs is read, the text for the table
 * is written as '{ <value>, ... , <value> }' to fpw.
 */

{
    char **map;        /* The map */
    char deflt[256];   /* Default table entry text */
    char *del = NULL;  /* Position of the current ':' or ',' */
    char *val;         /* Position of the current <value> */
    int i;
    char *output_del = "";  /* How to separate table entries */

    /* Initialize the map */

    map = (char **)alloca(size * sizeof *map);
    strcpy(deflt, "0");
    for (i = 0; i < size; i++) {
        map[i] = deflt;
    }

    /* Process the input list */

    do {

        /* Set str to the next non-blank character,
         * reading a new line if necessary
         */
        while (isspace((unsigned char)*str))
            str++;
        if (*str == '\\')
        {
            str = alloca(MAKE_FUNC_MAXLINE + 1);
            if (!fgets(str, MAKE_FUNC_MAXLINE, fpr))
                break;
            if (del)
            {
                output_del = "\n";
            }
        }

        /* Find and mark the elements of the next pair */

        del = strchr(str, ':');
        if (!del)
            break;
        *del = '\0';
        val = del+1;
        del = strchr(val, ',');

        if (!del)
        {
            del = strchr(val, '\n');
            if (del)
            {
                *del = '\0';
                del = NULL;
            }
        }
        else
        {
            *del = '\0';
        }

        /* Evaluate the current pair */
        if ( !strcmp(str, "default") )
        {
            strncpy(deflt, val, sizeof(deflt));
            deflt[sizeof deflt - 1] = '\0';
        }
        else
        {
            i = (*name_to_index)(str);
            if (i < 0)
            {
                fprintf(stderr, "Can't translate '%s' into an index.\n", str);
                exit(-1);
            }
            map[i] = val;
        }
        str = del+1;
    } while (del);

    /* Write the generated map */

    fprintf(fpw, "{");
    fprintf(fpw, output_del);
    for (i = 0; i < size; i++)
    {
        fprintf(fpw, "%s,", map[i]);
        fprintf(fpw, output_del);
    }
    fprintf(fpw, "};\n");
} /* handle_map() */

/*-------------------------------------------------------------------------*/
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.
 */

{
    char c;

    c = mygetc();
    while (isalpha(c) || c == '_' )
    {
        char word[512], *p;
        int space_left;

        p = word;
        space_left = sizeof(word);
        do {
            *p++ = c;
            c = mygetc();
        } while (isalunum(c) && --space_left);
        if (!space_left)
             fatal("Too long word.\n");
        myungetc(c);
        *p = '\0';
        if (strcmp(word, "defined") == 0)
        {
            /* handle the defined "function" in #if */
            do c = mygetc(); while(lexwhite(c));
            if (c != '(')
            {
                yyerror("Missing ( in defined");
                continue;
            }
            do c = mygetc(); while(lexwhite(c));
            p = word;
            space_left = sizeof(word);
            while ( isalunum(c) && --space_left) {
                *p++ = c;
                c = mygetc();
            }
            *p = '\0';
            while(lexwhite(c)) c = mygetc();
            if (c != ')')
            {
                yyerror("Missing ) in defined");
                continue;
            }
            if (lookup_define(word))
                add_input(" 1 ");
            else
                add_input(" 0 ");
        }
        else
        {
            int res;

            res = expand_define(word);
            if (res < 0)
            {
                yyerror("Unimplemented macro expansion");
                return 0;
            }
            if (!res) add_input(" 0 ");
        }
        c = mygetc();
    }
    return c;
}

/*-------------------------------------------------------------------------*/
static int
cond_get_exp (int priority)

/* Evaluate the expression in the input buffer at a priority of at least
 * <priority> and return the result.
 *
 * 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,value2,x;

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

    /* Evaluate the first value */

    if (c == '(')
    {

        /* It's a parenthesized subexpression */

        value = cond_get_exp(0);
        do c = exgetc(); while ( lexwhite(c) );
        if (c != ')' )
        {
            yyerror("bracket not paired in #if");
            if (!c)
                myungetc('\0');
        }
    }
    else if ( ispunct(c) )
    {
        /* It is an unary 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);

        /* 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");
            return 0;
        }
    }
    else
    {
        /* It must be a number */

        int base;

        if ( !lexdigit(c) )
        {
            if (!c)
            {
                yyerror("missing expression in #if");
                myungetc('\0');
            }
            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);
    }

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

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

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

        /* 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 and perform the operation */
        value2 = cond_get_exp(optab2[x+2]);

        switch ( optab2[x+1] )
        {
        case MULT   : value *= value2;          break;
        case DIV    : value /= value2;          break;
        case MOD    : value %= value2;          break;
        case BPLUS  : value += value2;          break;
        case BMINUS : value -= value2;          break;
        case LSHIFT : value <<= value2;         break;
        case RSHIFT : value >>= 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 )
            {
                cond_get_exp(1);
                value = value2;
            }
            else
                value = cond_get_exp(1);
            break;
        } /* switch() */
  } /* for() */

  myungetc((char)c);
  return value;
} /* cond_get_expr() */

/*-------------------------------------------------------------------------*/
static Bool
make_func_isescaped (char c)

/* Return true if <c> is one of the escapable characters (e.g. \r or \"),
 * false if not.
 */

{
    switch(c) {
      case '\007':
      case '\b'  :
      case '\t'  :
      case '\n'  :
      case '\013':
      case '\014':
      case '\r'  :
        return MY_TRUE;
    }
    if (c == '\\' || c == '\"')
        return MY_TRUE;
    return MY_FALSE;
}

/*-------------------------------------------------------------------------*/
static int
ident (char c)

/* Parse an identifier (first character is <c>) from fpr and classify it.
 * The typenames in types[] return the associated type code, the
 * string "default" returns DEFAULT (both only when currently parsing
 * for EFUN class identifiers).
 * Other identifiers are stored in yylval.string and return ID.
 */

{
    char buff[100];
    size_t len, i;

    for (len = 0; isalunum(c); c = (char)getc(fpr))
    {
        if (len == sizeof buff - 1)
        {
            yyerror("Too long indentifier");
            do c = (char)getc(fpr); while (isalunum(c));
            break;
        }
        buff[len++] = c;
    }
    (void)ungetc(c, fpr);

    buff[len] = '\0';

    if ( C_IS_EFUN(current_code_class) )
    {
        for (i=0; i < NELEMS(types); i++)
        {
            if (strcmp(buff, types[i].name) == 0)
            {
                yylval.number = types[i].num;
                return types[i].num;
            }
        }
        if (strcmp(buff, "default") == 0)
            return DEFAULT;
    }
    yylval.string = mystrdup(buff);
    return ID;
} /* ident() */

/*-------------------------------------------------------------------------*/
static char *
type_str (int n)

/* Create a string representation of type <n> in a static buffer
 * and return it. Unknown types return 'What?'.
 */

{
    int type = n & 0xffff;
    size_t i;

    for (i = 0; i < NELEMS(types); i++)
    {
        if (types[i].num == type)
        {
            if (n & MF_TYPE_MOD_REFERENCE)
            {
                static char buff[100];
                char *str;

                str = type_str(n & ~MF_TYPE_MOD_REFERENCE);
                if (strlen(str) + 3 > sizeof buff)
                    fatal("Local buffer too small in type_str()!\n");
                sprintf(buff, "%s &", str);
                return buff;
            }
            if (n & MF_TYPE_MOD_POINTER)
            {
                static char buff[100];

                if (strlen(types[i].name) + 3 > sizeof buff)
                    fatal("Local buffer too small in type_str()!\n");
                sprintf(buff, "%s *", types[i].name);
                return buff;
            }
            return types[i].name;
        }
    }
    return "What?";
} /* type_str() */

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

/* Skip a block comment on the input stream fpr. It is assumed that
 * the begin marker was already read.
 */

{
    int c;

    for(;;) {
        while((c = getc(fpr)) != '*')
        {
            if (c == EOF)
            {
                yyerror("End of file in a comment");
                return;
            }
            if (c == '\n') {
                current_line++;
            }
        }
        do {
            if ((c = getc(fpr)) == '/')
                return;
            if (c == '\n') {
                current_line++;
            }
        } while(c == '*');
    }
} /* skip_comment() */

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

/* Parse the next lexical element from the input file and return
 * its token value and -1 on end of file.
 */

{
    register int c;

    for(;;)
    {
        size_t match_tmp;
#define MATCH(str) (isspace((unsigned char)line_buffer[match_tmp=strlen(str)]) &&\
                        strncmp(str, line_buffer, match_tmp) == 0)

        char line_buffer[MAKE_FUNC_MAXLINE+1];

        line_buffer[MAKE_FUNC_MAXLINE] = '\0';

        switch(c = getc(fpr))
        {
        case ' ':
        case '\t':
            continue;

        case '#':
        {
            int line;
            char file[2048];  /* TODO: Use the ANSI define */
                /* does any operating system support longer pathnames?
                 */
            fgets(line_buffer, MAKE_FUNC_MAXLINE, fpr);
            if ( sscanf(line_buffer, "%d \"%s\"",&line,file ) == 2 )
            {
                current_line = line+1;
                continue;
            }
            current_line++;
            if MATCH("if") {
                handle_if('#', line_buffer+3);
            } else if MATCH("ifdef") {
                handle_cond('#', lookup_define(nextword(line_buffer)) != 0);
            } else if MATCH("ifndef") {
                handle_cond('#', lookup_define(nextword(line_buffer)) == 0);
                continue;
            } else if MATCH("else") {
                handle_else('#');
            } else if MATCH("endif") {
                handle_endif();
            } else {
                yyerror("unrecognised '#' directive\n");
            }
            continue;
        }

        case '%':
        {
            static int send_end = 0;

            if (send_end)
            {
                send_end = 0;
                ungetc('%', fpr);
                return END;
            }
            send_end = 1;
            fgets(line_buffer, MAKE_FUNC_MAXLINE, fpr);
            current_line++;
            if (MATCH("tokens")) { current_code_class=C_TOKEN; return TOKENS; }
            if (MATCH("codes"))  { current_code_class=C_CODE;  return CODES;  }
            if (MATCH("efuns"))  { current_code_class=C_EFUN;  return EFUNS;  }
            if (MATCH("xcodes")) { current_code_class=C_XCODE; return XCODES; }
            if (MATCH("xefuns")) { current_code_class=C_XEFUN; return XEFUNS; }
            if (MATCH("tcodes")) { current_code_class=C_TCODE; return TCODES; }
            if (MATCH("tefuns")) { current_code_class=C_TEFUN; return TEFUNS; }
            return '%';

#undef MATCH
        }

        case '\"':
        {
            char buff[100];
            int len;

            for (len=0; c = getc(fpr),c != '\"';)
            {
                if (len == sizeof buff - 1)
                {
                    yyerror("Too long name");
                    do
                        c = getc(fpr);
                    while (c != '\"' && c != '\n' && c != EOF);
                    (void)ungetc(c, fpr);
                    break;
                }
                if (c == '\n' || c == EOF)
                {
                    yyerror("unterminated name");
                    (void)ungetc(c, fpr);
                    break;
                }
                buff[len++] = (char)c;
            }
            buff[len] = '\0';
            yylval.string = mystrdup(buff);
            return NAME;
        }

        case '\n':
          current_line++;
          continue;

        case EOF:
            return -1;

        case '/':
            if ( (c=getc(fpr)) == '*') {
                skip_comment();
                continue;
            } else {
                (void)ungetc(c, fpr);
                return '/';
            }
          default:
            if (isalpha(c))
                return ident((char)c);
            return c;
        }
    } /* for() */
} /* yylex1() */

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

/* Parse the next lexical element from the input file and return
 * its token value and -1 on end of file.
 * This just calls yylex1().
 */

{
    int res;

    res = yylex1();
#if 0
    fprintf(stderr,"yylex returns %d '%c'\n",res,res);
#endif
    return res;
}

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

/* Print the error message <str> with information about the current
 * parsing position and exit.
 */

{
    fprintf(stderr, "%s:%d: %s\n", current_file, current_line, str);
    exit(1);
}

/*=========================================================================*/

/*-------------------------------------------------------------------------*/
static char *
etype1 (int n)

/* Express type <n> in the runtime type symbols of interpret.h.
 * Return a pointer to a constant string.
 */

{
    if (n & MF_TYPE_MOD_REFERENCE)
        return "T_LVALUE";
    if (n & MF_TYPE_MOD_POINTER)
        return "T_POINTER";
    switch(n) {
    case INT:
        return "T_NUMBER";
    case OBJECT:
        return "T_OBJECT";
    case STRING:
        return "T_STRING";
    case MAPPING:
        return "T_MAPPING";
    case FLOAT:
        return "T_FLOAT";
    case CLOSURE:
        return "T_CLOSURE";
    case SYMBOL:
        return "T_SYMBOL";
    case QUOTED_ARRAY:
        return "T_QUOTED_ARRAY";
    case MIXED:
        return "0";        /* 0 means any type */
    default:
        yyerror("Illegal type for argument");
    }
    return "What ?";
}

/*-------------------------------------------------------------------------*/
static char *
etype (int n)

/* Express the type(s) of current function argument <n> in the
 * runtime type symbols of interpret.h, multiple types concatenated by '|'.
 * Return a pointer to a static buffer with the text.
 */

{
    int i;
    size_t local_size = 100;
    char *buff = malloc(local_size);

    /* Find the argument <n> in the current signature */

    for (i = 0; i < curr_arg_type_size; i++)
    {
        if (n == 0)
            break;
        if (curr_arg_types[i] == 0)
            n--;
    }
    if (i == curr_arg_type_size || !curr_arg_types[i])
        return "0";

    /* Create the type string */

    buff[0] = '\0';
    for(; curr_arg_types[i] != 0; i++)
    {
        char *p;
        if (curr_arg_types[i] == VOID)
            continue;
        if (buff[0] != '\0')
            strcat(buff, "|");
        p = etype1(curr_arg_types[i]);
        /* The number 2 below is to include the zero-byte and the next
         * '|' (which may not come).
         */
        if (strlen(p) + strlen(buff) + 2 > local_size)
        {
            fprintf(stderr, "Buffer overflow!\n");
            exit(1);
        }
        strcat(buff, etype1(curr_arg_types[i]));
    }

    return buff;
} /* etype() */

/*-------------------------------------------------------------------------*/
static char *
ctype (int n)

/* Express type <n> in the compiler type symbols of exec.h.
 * Return a pointer to a constant string.
 */

{
    static char buff[100];        /* 100 is such a comfortable size :-) */
    char *p;

    buff[0] = '\0';
    if (n & MF_TYPE_MOD_REFERENCE)
        strcat(buff, "TYPE_MOD_REFERENCE|");
    if (n & MF_TYPE_MOD_POINTER)
        strcat(buff, "TYPE_MOD_POINTER|");
    n &= ~(MF_TYPE_MOD_REFERENCE|MF_TYPE_MOD_POINTER);
    switch(n) {
      case VOID:    p = "TYPE_VOID";    break;
      case STRING:  p = "TYPE_STRING";  break;
      case INT:     p = "TYPE_NUMBER";  break;
      case OBJECT:  p = "TYPE_OBJECT";  break;
      case MAPPING: p = "TYPE_MAPPING"; break;
      case FLOAT:   p = "TYPE_FLOAT";   break;
      case CLOSURE: p = "TYPE_CLOSURE"; break;
      case SYMBOL:  p = "TYPE_SYMBOL";  break;
      case MIXED:   p = "TYPE_ANY";     break;
      case UNKNOWN: p = "TYPE_UNKNOWN"; break;
      case QUOTED_ARRAY:
        p = "TYPE_QUOTED_ARRAY"; break;
    default: yyerror("Bad type!"); return 0;
    }
    strcat(buff, p);
    if (strlen(buff) + 1 > sizeof buff)
        fatal("Local buffer overwritten in ctype()");
    return buff;
} /* ctype() */

/*-------------------------------------------------------------------------*/
static int
efuncmp (int i, int j)

/* Compare the function entries <i> and <j>.
 * Return 1 if <i> is greater than <j>, 0 if equal, <j> if lesser.
 *
 * This predicate is used to sort the function/code tables read
 * from FUNC_SPEC>
 */

{
    int result;

    result = code_class[i] - code_class[j];
    if ( result )
        return result;
    if (C_IS_CODE(code_class[i])) return 0;
    return strcmp(key[i], key[j]);
}

/*-------------------------------------------------------------------------*/
int
main (int argc UNUSED, char ** argv UNUSED)

/* The main program.
 */

{
#ifdef __MWERKS__
#    pragma unused(argc, argv)
#endif

    int i, j, k;
    size_t match_tmp;
    char c;
    char line_buffer[MAKE_FUNC_MAXLINE + 1];
    char defbuf[MAKE_FUNC_MAXLINE + 1];
    Bool bPrintedNotice;

    /* Some predefined macros */

#ifdef AMIGA
    add_define("AMIGA",-1,"");
#endif
#ifdef HAVE_GETRUSAGE
    add_define("HAVE_GETRUSAGE",-1,"");
#endif
#ifdef TRACE_CODE
    add_define("TRACE_CODE",-1,"");
#endif

    /* --- Test YACC for default and anonymous rules ---
     *
     * This test uses THE_LANG as temporary file.
     */
    if ((fpw = fopen(THE_LANG, "w")) == 0) {
        perror(THE_LANG);
        exit(1);
    }
    fprintf(fpw, "%s", "\
%union{ int i; char *p; }\n\
%type <p> all\n\
%%\n\
all: { $<p>$ = 0; } 'a'\n\
%%\n\
");
    fclose(fpw);
    sprintf(line_buffer, "%s %s", YACC, THE_LANG);

    fprintf(stderr, "checking default & anonymous rules in %s\n", YACC);
    if (system(line_buffer))
    {
        fprintf(
          stderr,
"...it seems to have trouble with this combination, I'll avoid the latter.\n"
        );
        add_define("YACC_CANNOT_MIX_ANONYMOUS_WITH_DEFAULT", -1, "");
    }
    else
        fprintf(stderr, "...good, it can handle them.\n");


    /* --- Read in CONFIG to see what defines are used by the gamedriver ---
     */

    outp = defbuf + sizeof(defbuf) - 1;
    if ((fpr = fopen(CONFIG, "r")) == 0)
    {
       perror(CONFIG);
       fflush(stdout);
       exit(1);
    }
    current_line = 0;
    current_file = CONFIG;

#define MATCH(str) (isspace((unsigned char)line_buffer[1+(match_tmp=strlen(str))]) &&\
                        strncmp(str, line_buffer+1, match_tmp) == 0)

    while (fgets(line_buffer, MAKE_FUNC_MAXLINE, fpr)) {
        char *name;

        current_line++;
        if ( *line_buffer != '#' )
            continue;
        if MATCH("if") {
            handle_if('#', line_buffer+4);
            continue;
        }
        if MATCH("ifdef") {
            handle_cond('#', lookup_define(nextword(line_buffer)) != 0);
            continue;
        }
        if MATCH("ifndef") {
            handle_cond('#', lookup_define(nextword(line_buffer)) == 0);
            continue;
        }
        if MATCH("else") {
            handle_else('#');
            continue;
        }
        if MATCH("endif") {
            handle_endif();
            continue;
        }
        if MATCH("undef") {
            struct defn *old_def;
            old_def = lookup_define(nextword(line_buffer));
            if (old_def)
                old_def->name[0] = '\0';
            continue;
        }
        if ( !MATCH("define") ) {
            continue;
        }
        /* CONFIG is trusted to be syntactically correct. After all, it was
         * included by the source of this program.
         */
        {
            char *cp, *exps;
            int num_arg;

            cp = line_buffer+8;
            while( isspace((unsigned char)*cp)) cp++;
            name = cp;
            while(isalunum((unsigned char)*cp)) cp++;
            num_arg = *cp == '(' ? 0 : -1;
            if (*cp == '\n') {
                exps = cp;
                *cp = '\0';
            } else {
                *cp++ = '\0';
                while( isspace((unsigned char)*cp)) cp++;
                exps = cp;
                while(*cp != '\n') cp++;
                *cp = '\0';
            }
            add_define(name, num_arg, exps);
        }
    }
    fclose(fpr);


    /* --- Read in FUNC_SPEC ---
     */

    if ((fpr = fopen(FUNC_SPEC, "r")) == NULL)
    {
        perror(FUNC_SPEC);
        exit(1);
    }
    current_line = 1;
    current_file = FUNC_SPEC;
    yyparse();
    fclose(fpr);

    /* Print code usage statistics */

    fprintf(stderr,
"Primary codes: %d Secondary codes: %d\n"
"Tabled codes: %d Tabled varargs codes: %d\n"
           , num_instr[C_CODE]  + num_instr[C_EFUN]
           , num_instr[C_XCODE] + num_instr[C_XEFUN]
           , num_instr[C_TCODE] + num_instr[C_TEFUN]
           , num_instr[C_VCODE] + num_instr[C_VEFUN]
    );

    if ( (num_instr[C_CODE] + num_instr[C_EFUN]) & ~0xff
     ||  (  (num_instr[C_XCODE]+ num_instr[C_XEFUN])
          | (num_instr[C_TCODE]+ num_instr[C_TEFUN])
          | (num_instr[C_VCODE]+ num_instr[C_VEFUN]) ) & ~0x7f)
    {
        fatal("Codes exhausted!");
    }

    /* Now sort the table of functions and codes (eeek, bubblesort!)
     */

    for (i = num_buff; --i >= 0; )
    {
        for (j = 0; j < i; j++)
            if (efuncmp(i,j) < 0)
            {
                char *tmp;
                int tmpi;
                tmp = f_names[i]; f_names[i] = f_names[j]; f_names[j] = tmp;
                tmp = key[i]; key[i] = key[j]; key[j] = tmp;
                tmp = buf[i]; buf[i] = buf[j]; buf[j] = tmp;
                tmpi = code_class[i];
                code_class[i] = code_class[j]; code_class[j] = tmpi;
            }
    }


    /* --- Create EFUN_DEFS --- */

    if ((fpw = fopen(EFUN_DEFS, "w")) == NULL)
    {
       perror(EFUN_DEFS);
       exit(1);
    }

    fprintf(fpw,
"#ifndef __EFUN_DEFS_C__\n"
"#define __EFUN_DEFS_C__ 1\n"
"\n"
"/* DO NOT EDIT!\n"
" *\n"
" * This file is created automatically by make_func from\n"
" * the specifications in " FUNC_SPEC ".\n"
" * It is meant to be included in lex.c\n"
" */\n"
"\n"
"#include \"exec.h\"  /* struct instr */\n"
"\n"
           );

    fprintf(fpw,
"/*----------------------------------------------------------------------*/\n"
"\n"
"/* The table of all instructions\n"
" */\n"
"\n"
"struct instr instrs[] = {\n"
           );
    fprintf(fpw, "\n  /* --- codes and efuns --- */\n\n");
    j = num_instr[C_CODE] + num_instr[C_EFUN];
    for (i = 0; i < j; i++) {
        fprintf(fpw, "  %s", buf[i]);
    }
    for (i -= 256 ; ++i <= 0; ) {
        fprintf(fpw, "  { 0, 0, { 0, 0 }, -1, 0, 0, 0 }, /* unused */\n");
    }
    fprintf(fpw, "\n  /* --- xcodes and xefuns --- */\n\n");
    i = j;
    j += num_instr[C_XCODE] + num_instr[C_XEFUN];
    for (; i < j; i++) {
        fprintf(fpw, "  %s", buf[i]);
    }
    for (i = 128 - num_instr[C_XCODE] - num_instr[C_XEFUN]; --i >= 0; ) {
        fprintf(fpw, "  { 0, 0, { 0, 0 }, -1, 0, 0, 0 }, /* unused */\n");
    }
    fprintf(fpw, "\n  /* --- tcodes and tefuns --- */\n\n");
    i = j;
    j += num_instr[C_TCODE] + num_instr[C_TEFUN];
    for (; i < j; i++) {
        fprintf(fpw, "  %s", buf[i]);
    }
    for (i = 128 - num_instr[C_TCODE] - num_instr[C_TEFUN]; --i >= 0; ) {
        fprintf(fpw, "  { 0, 0, { 0, 0 }, -1, 0, 0, 0 }, /* unused */\n");
    }
    fprintf(fpw, "\n  /* --- vcodes and vefuns --- */\n\n");
    i = j;
    for (; i < num_buff; i++) {
        fprintf(fpw, "  %s", buf[i]);
    }
    fprintf(fpw, "};\n\n\n");

    fprintf(fpw, "/* Aliased efuns\n */\n\n");
    fprintf(fpw, "short efun_aliases[] = {\n");
    for (i = 0; i < num_buff; i++) {
        if (code_class[i] == C_ALIAS)
            fprintf(fpw, "  %s-F_OFFSET,\n", f_names[i]);
    }
    fprintf(fpw, "};\n\n\n");

    fprintf(fpw,
"/* Table of function argument signatures\n"
" * The internal structure is that of arg_types[] in make_func.\n"
" */\n\n"
          );
    fprintf(fpw, "int efun_arg_types[] = {\n ");
    for (i = 0; i < last_current_type; i++) {
        if (arg_types[i] == 0)
            fprintf(fpw, "0,\n ");
        else
            fprintf(fpw, "%s,", ctype(arg_types[i]));
    }
    fprintf(fpw, "};\n\n\n");

    fprintf(fpw, "/* Prototypes of the tabled efuns\n */\n\n");
    for (j = 1, i = 0; j < C_TCODE; j++)
        i += num_instr[j];
    j = i + num_instr[C_TCODE] + num_instr[C_TEFUN];
    k = i;
    while (k < j)
    {
        fprintf(fpw, "extern struct svalue *f_%s(struct svalue *);\n", key[k++]);
    }
    fprintf(fpw, "\n\n");

    fprintf(fpw, "/* The table of tabled efuns\n */\n\n");
    fprintf(fpw, "struct svalue *(*efun_table[]) (struct svalue *) = {\n");
    while(i < j) {
        fprintf(fpw, "  f_%s,\n", key[i++]);
    }
    fprintf(fpw, "};\n\n\n");

    fprintf(fpw, "/* Prototypes of the tabled vararg efuns\n */\n\n");
    j = i + num_instr[C_VCODE] + num_instr[C_VEFUN];
    k = i;
    while(k < j) {
        fprintf(fpw, "extern struct svalue *f_%s(struct svalue *, int);\n", key[k++]);
    }
    fprintf(fpw, "\n\n");

    fprintf(fpw, "/* The table of tabled vararg efuns\n */\n\n");
    fprintf(fpw, "struct svalue *(*vefun_table[])(struct svalue *, int) = {\n");
    while(i < j) {
        fprintf(fpw, "  f_%s,\n", key[i++]);
    }
    fprintf(fpw, "};\n\n\n");

    /* TODO: create a my-ctype.[ch] and a utility program to create
     * TODO:: these two files once and for all.
     */
    fprintf(fpw,
"/*----------------------------------------------------------------------*/\n"
"\n"
"/* Our own ctype implementation. This way we can be sure that\n"
" *   (a) we won't choke on non-ASCII characters\n"
" *   (b) we are fast\n"
" *   (c) we get the non-standard classifications we need anyway\n"
" */\n"
"\n"
           );

    fprintf(fpw, "#define lexwhite(c) (_my_ctype[(unsigned char)(c)]&%d)\n",_MCTs);
    fprintf(fpw, "#define leXdigit(c) (_my_ctype[(unsigned char)(c)]&%d)\n",_MCTx);

    fprintf(fpw, "\n" "unsigned char _my_ctype[] = {");
    c = '\0';
    do {
        if (!(c & 0xf))
            fprintf(fpw, "\n    ");
        fprintf(fpw, "%d,", !isascii(c) ? 0 :
                ( make_func_isescaped(c)   ? _MCTe : 0 ) |
                ( isdigit (c)                   ? _MCTd : 0 ) |
                ( isspace (c) && c != '\n' ? _MCTs : 0 ) |
                ( isxdigit(c)                   ? _MCTx : 0 ) |
                ( isalnum (c) || c == '_'  ? _MCTa : 0 ) );
        c++;
    } while (c != '\0');
    fprintf(fpw, "\n};\n");


    fprintf(fpw,
"\n"
"/************************************************************************/\n"
"\n"
"#endif /* __EFUN_DEFS_C__ */\n"
           );

    fclose(fpw);


    /* --- Create THE_INSTRS --- */

    if ((fpw = fopen(THE_INSTRS, "w")) == NULL)
    {
       perror(THE_INSTRS);
       exit(1);
    }

    fprintf(fpw,
"#ifndef __INSTRS_H__\n"
"#define __INSTRS_H__ 1\n"
"\n"
"/* DO NOT EDIT!\n"
" *\n"
" * This file is created automatically by make_func from\n"
" * the specifications in " FUNC_SPEC ".\n"
" *\n"
" * It holds the token values for all machine instructions which\n"
" * are not simple lexer tokens and code without direct LPC representation.\n"
" *\n"
" * The values as such are used by the LPC compiler, you get the bytecode\n"
" * values by subtracting F_OFFSET from each.\n"
" */\n"
"\n"
"#include \"exec.h\"  /* struct instr */\n"
"\n"
           );

    fprintf(fpw,
"#define F_OFFSET %s\n"
"  /* First token value which represents a real bytecode.\n"
"   * %s is defined in lang.h\n"
"   */\n\n"
           , f_names[0], f_names[0]
           );
    fprintf(fpw,
"#define LAST_INSTRUCTION_CODE %d\n"
"  /* The highest token value in use.\n"
"   */\n\n"
           , 256+128+128+num_instr[C_VCODE]+num_instr[C_VEFUN] - 1
    );
    fprintf(fpw, "extern struct instr instrs[%d];\n",
        256+128+128+num_instr[C_VCODE]+num_instr[C_VEFUN]+num_instr[C_ALIAS]
    );
    fprintf(fpw, "extern short efun_aliases[%d];\n", num_instr[C_ALIAS]);
    fprintf(fpw,
"  /* Both tables are defined in " EFUN_DEFS " and compiled into lex.c\n"
"   */\n\n"
           );

    fprintf(fpw,"/* --- efuns --- */\n\n");
    for (i = j = num_instr[C_CODE]; i < num_buff; i++)
    {
        if (j == num_instr[C_CODE] + num_instr[C_EFUN])
        {
            j = 256;
            fprintf(fpw,"\n/* --- xefuns and xcodes --- */\n\n");
        }
        if (j == 256 + num_instr[C_XCODE] + num_instr[C_XEFUN])
        {
            j = 256+128;
            fprintf(fpw,"\n/* --- tefuns and tcodes --- */\n\n");
        }
        if (j == 256 + 128 + num_instr[C_TCODE] + num_instr[C_TEFUN])
        {
            j = 256+128+128;
            fprintf(fpw,"\n/* --- vefuns and vcodes --- */\n\n");
        }
        if (code_class[i] != C_ALIAS)
        {
            fprintf(fpw, "#define %-30s (F_OFFSET+%d)\n", make_f_name(key[i]), j);
            j++;
        }
    }

    fprintf(fpw,
"\n"
"/************************************************************************/\n"
"\n"
"#endif /* __INSTRS_H__ */\n"
           );

    fclose(fpw);


    /* --- Create THE_LANG from PRO_LANG --- */

    if ((fpr = fopen(PRO_LANG, "r")) == NULL)
    {
       perror(PRO_LANG);
       exit(1);
    }

    if ((fpw = fopen(THE_LANG, "w")) == NULL)
    {
       perror(THE_LANG);
       exit(1);
    }
    current_line = 0;
    bPrintedNotice = MY_FALSE;
    while (fgets(line_buffer, MAKE_FUNC_MAXLINE, fpr))
    {
        current_line++;
        if (*line_buffer == '%') {
            if MATCH("efuns") {
                for (i = 0; i < num_instr[C_TOKEN]; i++)
                {
                    fprintf(fpw, "%%token %s\n", token_f_names[i]);
                }
                for (i = 0; i < num_instr[C_CODE]; i++)
                {
                    if (code_class[i] != C_ALIAS) {
                        fprintf(fpw , "%%token %s\n", make_f_name(key[i]));
                    }
                }
                continue;
            }
            last_line = current_line;
            if MATCH("if") {
                handle_if('%', line_buffer+4);
                continue;
            }
            if MATCH("ifdef") {
                handle_cond('%', lookup_define(nextword(line_buffer)) != 0);
                continue;
            }
            if MATCH("ifndef") {
                handle_cond('%', lookup_define(nextword(line_buffer)) == 0);
                continue;
            }
            if MATCH("else") {
                handle_else('%');
                compensate_lines();
                continue;
            }
            if MATCH("endif") {
                handle_endif();
                compensate_lines();
                continue;
            }
            if MATCH("line") {
                fprintf(fpw, "#line %d \"%s\"\n", current_line+1, PRO_LANG);
                continue;
            }
            if MATCH("typemap") {
                handle_map(line_buffer+9, TYPEMAP_SIZE, name_to_type);
                continue;
            }
            if MATCH("hookmap") {
                handle_map(line_buffer+9, NUM_CLOSURE_HOOKS, name_to_hook);
                continue;
            }
            if MATCH("//") {
                /* c++ - resembling comment */
                fputs("", fpw);
                continue;
            }
            if (!bPrintedNotice) {
                if MATCH("{") {
                    bPrintedNotice = MY_TRUE;
                    fputs(
"%{\n"
"\n"
"/* DO NOT EDIT!\n"
" *\n"
" * This file is created automatically by make_func from\n"
" * the template " PRO_LANG " according to the specs in " FUNC_SPEC ".\n"
" */\n"
"\n"
                         , fpw);
                    continue;
                }
            }
        }
        fputs(line_buffer, fpw);
    }
    fclose(fpr), fclose(fpw);

    /* --- That's it --- */

    return 0;

#undef MATCH

} /* main() */

#if defined(__MWERKS__) && !defined(WARN_ALL)
#    pragma warn_possunwant off
#    pragma warn_implicitconv off
#endif

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

