sima/autoconf/
sima/hosts/i386/
sima/mudlib/
sima/mudlib/kernel/
sima/mudlib/obj/
sima/mudlib/sys/
sima/synhash/mips/
/* Copyright 1991 - 1997 J"orn Rennecke */

#include <stdio.h>
#include <fcntl.h>
#include <ctype.h>
#include <sys/types.h>
#include <unistd.h>
#include <sys/stat.h>
#include <sys/mman.h>
#ifdef linux
#include <linux/mman.h>
#define MAP_ANON MAP_ANONYMOUS
#ifndef MAP_FILE
#define MAP_FILE 0
#endif
#endif
#include <errno.h>

#include "common.h"
#include "alloc.h"
#include "object.h"
#include "interpret.h"

#ifdef OS2
#include <io.h>
#endif

#include "lang.h"
#include "string.h"
#include "config.h"
#include "exec.h"
#include "lex.h"
#include "instrs.h"
#include "patchlevel.h"

#define FILE_END	"\0"
#define IS_OCTAL(c)	((c) & ~7 == '0')

#define CURRENT_FILE inctop->file

/* Line numbers have to be kept for code in #include files, and the code
 * is stored in line-number tagged nodes till all files have been read;
 * therefore, line numbers have to be unique in each compilation.
 * Thus, we simply count up current_line, remembering where each file starts.
 */
int current_line;
int pragma_strong_types;	/* require call_other() values to be casted */
int pragma_save_types;		/* Save argument types after compilation */
int pragma_optimize;
#if LEXDEBUG
int lexdebug;
#endif
svalue all_proto_closures;
static INLINE int number(p_int);
static char *handle_define(char *);
static void add_permanent_define(char *, int, char *, char);
char *add_input(const char *, mp_int, char *);
static char *expand_define(struct ident*, char *);
static char *expand_defarg(char *p);
static void myungetc(char);
static union svalue cond_get_exp(int priority);
static int exgetc();
static char *skip_comment(char *p);
static char *skip_pp_comment(char *p);
static char *skip2nl(char *p);
static char *skip_white_bsnl(char *p);
static char *efun_defined(char *, char **, struct expand_stack *);
static char *add_current_file(), *add_current_line(),
	*add_hostname(), *add_domainname();

extern char *add_host_ip_number();
static union svalue *inc_list;
static svalue inc_hook_value;
static int inc_list_size;
static mp_int inc_list_maxlen;
static char *auto_include_string = (char *)0;
static int basestate_firstline = 0;

#define EXPANDMAX 25000
static int nexpands;

static void lexerror(int n);

#define INC_LIST_MAXLEN 1024

static struct ident *lookup_define(char *s, mp_int len, int hash, int type);

static struct ifstate {
    struct ifstate *next;
    p_int expect_else; /* compatible with svalues from cond_get_exp() */
    int line;
} *iftop = 0;

static struct incstate {
    struct incstate *next, *next_hash;
    int line, lastif_line;
    union svalue file;
    char *outp;
    int pragma_strong_types;
    dev_t dev;
    ino_t inode;
    time_t mtime;
    caddr_t mapstart;
    off_t maplen;
} basestate, *maptab[16];

struct incstate *inctop;

#define EXPSTACK_SIZE 1024

static struct expand_stack expstack[EXPSTACK_SIZE], *expsp;

/*
 * Two entrys in expstack are reserved for defarg expansion, defined()
 * evaluation and #elif processing, so that these operations can be
 * done without expsp overflow check.
 */

static char *outp;

static struct s_reswords reswords[] = {
  { "break",		YYF_BREAK, RESWORD_CLOSURE(F_BREAK) },
  { "case",		YYF_CASE, },
  { "catch",		YYF_CATCH, RESWORD_CLOSURE(F_CATCH) },
  { "closure",		YYF_CLOSURE_DECL, TYPE_CLOSURE, },
  { "const",		YYF_VAR_TYPE_MODIFIER, TYPE__CONST, },
  { "continue",		YYF_CONTINUE, RESWORD_CLOSURE(F_BRANCH) },
  { "default",		YYF_DEFAULT, RESWORD_CLOSURE(F_CSHARED0) },
  { "do",		YYF_DO, RESWORD_CLOSURE(F_BRANCH_ON_NON_ZERO) },
  { "else",		YYF_ELSE, },
  { "float",		YYF_BASIC_TYPE, TYPE_FLOAT, },
  { "for",		YYF_FOR, },
  { "if",		YYF_IF, RESWORD_CLOSURE(F_BRANCH_ON_ZERO) },
  { "inherit",		YYF_INHERIT, },
  { "int",		YYF_BASIC_TYPE, TYPE_NUMBER, },
  { "mapping",		YYF_BASIC_TYPE, TYPE_MAPPING, },
  { "mixed",		YYF_BASIC_TYPE, TYPE_ANY, },
  { "nomask",		YYF_TYPE_MODIFIER, TYPE__NOMASK, },
  { "object",		YYF_BASIC_TYPE, TYPE_OBJECT, },
  { "private",		YYF_TYPE_MODIFIER, TYPE__PRIVATE, },
  { "protected",	YYF_FUN_TYPE_MODIFIER, TYPE__PROTECTED, },
  { "public",		YYF_TYPE_MODIFIER, TYPE__PUBLIC, },
  { "return",		YYF_RETURN, RESWORD_CLOSURE(F_RETURN) },
  { "shared",		YYF_VAR_TYPE_MODIFIER, TYPE__SHARED, },
  { "sscanf",		YYF_SSCANF, RESWORD_CLOSURE(F_SSCANF) },
  { "static",		YYF_TYPE_MODIFIER, TYPE__STATIC, },
  { "status",		YYF_BASIC_TYPE, TYPE_NUMBER, },
  { "string",		YYF_BASIC_TYPE, TYPE_STRING, },
  { "struct",		YYF_STRUCT, },
  { "switch",		YYF_SWITCH, RESWORD_CLOSURE(F_SWITCH) },
  { "symbol",		YYF_BASIC_TYPE, TYPE_SYMBOL, },
  { "varargs",		YYF_VARARGS, TYPE__VARARGS, },
  { "virtual",		YYF_VIRTUAL, TYPE__VIRTUAL},
  { "void",		YYF_VOID, TYPE_VOID },
  { "while",		YYF_WHILE, RESWORD_CLOSURE(F_BRANCH_ON_ZERO) },
};

struct ident *ident_table[ITABLE_SIZE];

#define identhash(s, len) hashstr(s, len, 20)

static void set_inc_list(svalue sv);

#include "efun_defs.c"

struct ident *make_shared_identifier(char *s, mp_int len, uint16 hash, int n)
{
    struct ident *curr, *prev, **q;

    q = &ident_table[hash & (ITABLE_SIZE - 1)];

    curr = *q;
    prev = 0;
    while (curr) {
	if (curr->hash == hash /* make most collisions cheap */ &&
	    curr->namelen == len && !memcmp(curr->name, s, len))
	{
	    /* found it */
	    if (prev) { /* not at head of list */
		prev->next = curr->next;
		curr->next = *q;
		*q = curr;
	    }
	    if (n > curr->type) {
	        struct ident *inferior=curr;

    		if (curr = alloc_gen(sizeof *curr)) {
		    curr->name = inferior->name;
		    curr->namelen = inferior->namelen;
    		    curr->next = inferior->next;
    		    curr->type = I_TYPE_UNKNOWN;
    		    curr->inferior = inferior;
    		    curr->hash = hash;
		    *q = curr;
		}
	    }
	    return curr;
	}
	prev = curr;
	curr = curr->next;
    } /* not found, create new one */
    curr = alloc_gen(sizeof *curr);
    if (!curr)
	return 0;
    curr->name = s;
    curr->namelen = len;
    curr->next = *q;
    curr->type = I_TYPE_UNKNOWN;
    curr->inferior = 0;
    curr->hash = hash;
    *q = curr;
    return curr;
}

struct ident *new_ident(struct ident *id, int type, union ident_u u) {
    if (id->type > type) {
	struct ident *inferior;
	do {
	    inferior = id->inferior;
	    if (!inferior || inferior->type < type) {
		struct ident *new = alloc_gen(sizeof *new);
		if (new) {
		    new->type = type;
		    new->u = u;
		    id->inferior = new;
		    new->inferior = inferior;
		    new->name = inferior->name;
		    new->namelen = inferior->namelen;
		    new->hash = inferior->hash;
		}
		return new;
	    }
	    id = inferior;
	} while (id->type != type);
	return id;
    } else {
	/* id->type < type */
        struct ident *new;

	if (new = alloc_gen(sizeof *new)) {
	    new->type = type;
	    new->u = u;
	    new->name = id->name;
	    new->namelen = id->namelen;
    	    new->next = id->next;
    	    new->next = id->next;
    	    new->inferior = id;
    	    new->hash = id->hash;
	    ident_table[new->hash & (ITABLE_SIZE - 1)] = new;
	}
	return new;
    }
}

void free_shared_identifier(struct ident *p) {
    struct ident *first, **q;
    uint16 hash;

    hash = p->hash;

    q = &ident_table[hash & (ITABLE_SIZE - 1)];
    first = *q;
    for(;;) {
	if (first->hash == hash) {
	    struct ident *curr = first;

	    do {
		if (curr == p) { /* this is the right one */
		    if (first == curr) {
			if (curr->inferior) {
			    curr->inferior->next = curr->next;
			    *q = curr->inferior;
			    free_gen((char *)curr);
			    return; /* success */
			} else {
			    *q = curr->next;
			    free_gen((char *)curr);
			    return; /* success */
			}
		    } else {
			*q = curr->inferior;
			free_gen((char *)curr);
			return; /* success */
		    }
		}
		q = &curr->inferior;
		curr = *q;
	    } while(curr);
	}
	q = &first->next;
	first = *q;
    } /* not found */
}

static void lexerror(int n) {
    yyerrorn(n);
    outp = FILE_END;
}

static p_int skip2nume(char *token) {
    char *p;
    char c;
    char nl = '\n';
    int nest;

    p = outp;
    for (nest = 0;;) {
	do {
	    c = *p++;
      check_newline:
	} while (c > nl);
	if (c != nl) {
	    if (!c) {
		yyerrorn(CE_EOF_SKIP);
		outp = FILE_END;
		return 1;
	    }
	    continue;
	}
	current_line++;
	c = *p++;
	if (c == '#') {
	    do c = *p++; while(lexwhite(c));
	    if (c == 'i') {
		if (*p != 'f')
		    continue;
		if ( !isalunum(*++p) ||
		     ( !memcmp(p, "def", 3) ?
		       !isalunum(*(p+=3)) :
		       ( !memcmp(p, "ndef", 4) && !isalunum(*(p+=4)) )
		) )
		{
		    nest++;
		}
		continue;
	    } else if (c == 'e') {
		if (nest > 0) {
		    if (!memcmp(p, "ndif", 4) && !isalunum(*(p+=5)))
			nest--;
		} else {
		    if (!memcmp(p, "ndif", 4) && !isalunum(*(p+=4))) {
			do c = *p++; while (c && c != nl);
			/* *(p-1) == nl */
			outp = p;
			return 0;
		    } else if (token) {
			/* token == "lse" */
			if (!memcmp(p, token, 3) && !isalunum(*(p+=3))) {
			    do c = *p++; while (c && c != nl);
			    /* *(p-1) == nl */
			    outp = p;
			    return 1;
			} else if (!memcmp(p, "lif", 3) && !isalunum(*(p+=3))) {
			    static char iffake[] =
				{ '\n','#','i','f',' ',LC_POP };

			    expsp[1].pop = expsp;
			    expsp[1].ret = p;
			    expsp++;
			    outp = &iffake[1];
			    return 0;
			}
		    }
		}
		continue;
	    }
	}
	goto check_newline;
    }
}

static void handle_cond(p_int c) {
    struct ifstate *p;

    if (!c) {
	if (current_line - inctop->line == inctop->lastif_line) {
	    outp = FILE_END;
	    return;
	}
	if (!skip2nume("lse"))
	    return;
    }
    p = alloc_gen(sizeof(struct ifstate));
    p->next = iftop;
    iftop = p;
    p->expect_else = c;
    p->line = current_line;
}

extern size_t pagesize;
size_t pagemask;

caddr_t lex_map(int fd, struct incstate *is) {
    struct stat sbuf;
    off_t size;
    caddr_t p, q;
    int hash;
    struct incstate *old;

    if (fstat(fd, &sbuf)) switch(errno) {
      default:
	perror("fstat");
	close(fd);
	yyerrorn(CE_MAPFAIL);
	return 0;
    }
    hash = sbuf.st_dev ^ sbuf.st_ino ^ sbuf.st_mtime;
    hash ^= hash >> 16;
    hash ^= hash >> 8;
    hash ^= hash >> 4;
    hash &= NELEM(maptab) - 1;
    for (old = maptab[hash]; old; old = old->next_hash) {
	if (sbuf.st_ino == old->inode && sbuf.st_mtime == old->mtime &&
	    sbuf.st_dev == old->dev)
	{
	    is->mapstart = p = old->mapstart;
	    is->lastif_line = old->lastif_line;
	    is->maplen = 0;
	    goto mapping_done;
	}
    }
    is->next_hash = maptab[hash];
    maptab[hash] = is;
    size = sbuf.st_size;
    if ((size - 1 & pagemask) + 3 > pagemask) {
	p = q = mmap((caddr_t)0, size+3, PROT_READ, MAP_ANON|MAP_PRIVATE, -1, 0);
	if (p != (caddr_t)-1) {
	    p = mmap(p, size, PROT_READ, MAP_FILE|MAP_FIXED|MAP_PRIVATE, fd, 0);
	    if (p == (caddr_t)-1) {
		munmap(q, size+3);
	    }
	}
    } else {
	p = mmap((caddr_t)0, size, PROT_READ, MAP_FILE|MAP_PRIVATE, fd, 0);
    }
    if (p == (caddr_t)-1) switch(errno) {
      default:
	perror("mmap");
	yyerrorn(CE_MAPFAIL);
	return 0;
    }
    is->mapstart = p;
    is->maplen = size+3;
    is->lastif_line = -1;
mapping_done:
    close(fd);
    inctop = is;
    pragma_strong_types = 0;
    instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
    return p;
}

/*
 * handle_include() is only used once, thus it is an obvious candidate for
 * inline. But gcc 2.5.8 only makes a mess of it :-(
 */

static /* INLINE */ char *handle_include(char *yyp) {
    char *after_string;
    int concat; /* 2 for neutral path in double quotes,
		   1 for path starting with "/" or ".."
		  -1 for path in < > */
    char buf[INC_LIST_MAXLEN+1024], *end;
    char *relstart;


    after_string = 0;
    concat = 0;
    for (;;) {
	char c;

	c = *yyp;
	switch(c) {
	  {
	    struct ident *d;
	    char *start;

	  case LC_IDENT:
	    if (expsp == &expstack[0]) {
		yyerrorn(CE_BADCHAR, (p_int)LC_IDENT << 1);
		yyp++;
		continue;
	    }
	    yyp = ALIGN(yyp + 1 + 2*sizeof(char *), char *);
	    d = lookup_define( ((char **)yyp)[-2], ((p_int *)yyp)[-1],
		  ((short *)yyp)[0], I_TYPE_DEFINE);
	    yyp += sizeof(short);
	    goto try_expand_define;
	  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 '_':
	    {
		struct idhash_ret idhr;

		start = yyp;
		idhr = idhash(yyp);
		yyp = idhr.p;
		d = lookup_define(start, yyp - start, idhr.hash, I_TYPE_DEFINE);
	    }
	  try_expand_define:
	    if (!d) {
		if (concat >= 0) {
		    yyerrorn(concat ? CE_INC_CONT : CE_INC_START);
		    return yyp;
		}
		if (end + (yyp - start) >= &buf[sizeof(buf)-1]) {
		    yyerrorn(CE_INC_NLEN);
		    return yyp;
		}
		memcpy(end+1, start, yyp - start);
		end += yyp - start;
		continue;
	    } else {
		yyp = expand_define(d, yyp);
		continue;
	    }
	  }
	  case ' ': case '\f': case '\r': case '\t': case '\v':
	    yyp++;
	    continue;
	  case '/':
	    c = *++yyp;
	    if (c == '*') {
		yyp = skip_comment(yyp+1);
		continue;
	    } else if (c == '/') {
		yyp = skip_pp_comment(yyp+1)-1;
		continue;
	    } else if (concat < 0) {
		if (*end == '.') {
		    if (end[-1] == '.' && end[-2] == '/') {
			end -= 2;
			yyerrorn(CE_ILLPATH,
			  make_string(&buf[INC_LIST_MAXLEN],
			    (end + 1) - &buf[INC_LIST_MAXLEN]));
			continue;
		    }
		    if (*--end == '/')
			continue;
		    end++;
		}
		goto store_lg_char;
	    }
	    goto badchar;
	  case '\\':
	    yyp = skip_white_bsnl(yyp);
	    if (*yyp != '\\')
		continue;
	    /* fall through */
	  default:
	    yyp++;
	    if (concat < 0) {
	  store_lg_char:
		if (end == &buf[sizeof(buf)-2]) {
		    yyerrorn(CE_INC_NLEN);
		    return yyp;
		}
		*++end = c;
		continue;
	    }
	    yyp--;
	  badchar:
	    if (concat)
		yyerrorn(CE_INC_CONT);
	    yyp = skip2nl(yyp);
	    /* fall through */
	  {
	    int fd;

	  case '\n': case LC_EOF:
	    if (!concat) {
		yyerrorn(CE_INC_START);
		return yyp;
	    }
	    *++end = '\0';
	    /* try the '\"' relative match */
	    fd = open(&buf[INC_LIST_MAXLEN]+1, O_RDONLY|O_BINARY);
	    if (fd >= 0) {
		relstart = &buf[INC_LIST_MAXLEN];
		/* active variables: relstart, end, fd */
		goto open_success;
	    }
	    /*
	     * semantics must not depend on temporary shortage of system
	     * resources. i.e. don't try standard include directories if the
	     * error was EMFILE, ENFILE or ENOMEM
	     */
	    switch(errno) {
	      default:
		if (concat != 2) {
	      case EMFILE:
#ifdef ENFILE
#if ENFILE != EMFILE
	      case ENFILE:
#endif
#endif
	      case ENOMEM:
		    relstart = &buf[INC_LIST_MAXLEN];
		    /* active variables: relstart, end */
		    goto open_failure;
		}
	    }
	    goto stdinc_at_nl;
	  case '>':
	    {
		int i;
		union svalue sv;
		struct incstate *is;

		yyp = skip_white_bsnl(yyp + 1);
		if (*yyp != '\n' && *yyp != LC_EOF) {
		    yyp = skip2nl(yyp);
		}
		*++end = '\0';
	  stdinc_at_nl:
		/* path starts at relstart */
		sv = driver_hook[H_INCLUDE_DIRS];
		if (SV_GEN_TYPE(sv) == T_ARRAY) {
		    if (sv.p != inc_hook_value.p) {
			set_inc_list(sv);
		    }
		    /*
		     * Search all include dirs specified.
		     */
		    for (i=0; i < inc_list_size; i++) {
			char *str;
			mp_uint len;
	    
			sv = inc_list[i];
			str = sv_string(sv, &len);
			memcpy((relstart -= len), str, len);
			fd = open(relstart, O_RDONLY|O_BINARY);
			if (fd >= 0) {
	  open_success:
			    sv = make_string(relstart, end - relstart);
			    if (!sv.p) {
				yyerrorn(CE_NOMEM);
				return FILE_END;
			    }
			    break;
			}
	  open_failure:
			if (errno == EMFILE) {
			    yyerrorn(CE_MFILE, SV_NULL);
			    return FILE_END;
			}
#ifdef ENFILE
			else if (errno == ENFILE) {
			    yyerrorn(CE_NFILE, SV_NULL);
			    return FILE_END;
			}
#endif
			else {
			    /*
			     * In case of out of memory error, we'll pass the
			     * number 0 to the error hook.
			     */
			    yyerrorn(CE_INC_NF,
			      make_string(relstart, end - relstart));
			    return yyp;
			}
		    }
		} else if (SV_TYPE(sv) == T_CLOSURE) {
		    char *cstr_start;
		    mp_int cstr_len;
		    struct counted_string cstr;

		    *++inter_sp = make_string(relstart, end - relstart);
		    push_svalue(CURRENT_FILE);
		    push_svalue(basestate.file);
		    sv = call_hook(
			driver_hook[H_INCLUDE_DIRS], inter_fp->object, 3);
		    if (SV_IS_NUMBER(sv) || !SV_IS_STRING(sv) ||
			(cstr = sv_string2(sv), cstr_start = cstr.start,
			 cstr_len = cstr.len, cstr_len >= sizeof(buf)))
		    {
			yyerrorn(CE_HOOKFAIL_INC, sv);
			return yyp;
		    }
		    if (!legal_path(cstr.start, cstr_len)) {
			yyerrorn(CE_ILLPATH, sv);
			return yyp;
		    }
		    memcpy(buf, cstr_start, cstr_len);
		    buf[cstr_len] = '\0';
		    fd = open(buf, O_RDONLY|O_BINARY);
		    if (fd < 0) {
			/*
			 * Providing the filename for E[NM]FILE is not
			 * particularily useful, but it is less code than
			 * explicit freeing.
			 */
			if (errno == EMFILE) {
			    yyerrorn(CE_MFILE, sv);
			    return FILE_END;
			}
#ifdef ENFILE
			if (errno == ENFILE) {
			    yyerrorn(CE_NFILE, sv);
			    return FILE_END;
			}
#endif
			yyerrorn(CE_INC_NF, sv);
			return yyp;
		    }
		}
		/* filename in sv */
		store_include_info(sv);
		is = alloc_gen(sizeof(struct incstate));
		if (!is) {
		    yyerrorn(CE_NOMEM);
		    return FILE_END;
		}
		is->line = current_line;
		/* actual linenumber is current_line - inctop->line + 1 */
		is->file = sv;
		is->outp = yyp;
		is->next = inctop;
		is->pragma_strong_types = pragma_strong_types;
		if ( !(yyp = lex_map(fd, is)) ) {
		    free_gen(is);
		    return FILE_END;
		}
		return yyp;
	    }
	  }
	  case LC_POP:
	    yyp = expsp->ret;
	    expsp = expsp->pop;
	    continue;
	  case LC_DEFARG:
	    yyp = expand_defarg(yyp+1);
	    continue;
	  case LC_STRING:
	    if (expsp == &expstack[0]) {
		yyp++;
		continue;
	    }
	    yyp = ALIGN(yyp + 1 + 2*sizeof(char *), char *);
	    after_string = yyp;
	    yyp = ((char **)yyp)[-2];
	    yyp--;
	    /* fall through */
	  case '\"':
	  {
	    yyp++;
	    if (concat) {
		if (concat < 0) {
		    yyerrorn(CE_INC_MIX);
		    return after_string ? after_string : yyp;
		}
	    } else {
		/* get first char to determine if it's an absolute path */
		c = *yyp;
		while (c == '\\' && (yyp[1] == '\n' || yyp[1] == '\r')) {
		    current_line++;
		    yyp += 2;
		    if (yyp[-1] ^ yyp[0] == '\n' ^ '\r')
			yyp++;
		    c = *yyp;
		}
		if (c == '\"') {
		    /*
		     * No char in this string, ignore it.
		     * This code will accept #include "" <path> ,
		     * which can be considered a mostly harmless bug.
		     */
		    yyp++;
		    continue;
		}
		if (c == '/') {
		    concat = 1;
		    yyp++;
		    end = &buf[INC_LIST_MAXLEN];
		} else {
		    char *str;
		    mp_uint len;

		    concat = 2;
		    str = sv_string(CURRENT_FILE, &len);
		    end = &str[len];
		    yyp -= 3;
		    do {
			concat = 1;
			yyp += 3;
			while (*--end != '/');
		    } while (end != str && !memcmp(yyp, "../", 3));
		    memcpy(&buf[INC_LIST_MAXLEN], str, end - str);
		    end += &buf[INC_LIST_MAXLEN] - str;
		    relstart = end;
		}
		*end = '/';
	    }
	    c = *yyp++;
	    for (;;) {
		if (c > '/') { /* ASCII optimization */
		    do {
	      store_char:
			if (end == &buf[sizeof(buf)-2]) {
			    yyerrorn(CE_INC_NLEN);
			    return yyp;
			}
			*++end = c;
			c = *yyp++;
		    } while (c > '/');
		}
		if (c == '/') {
		    if (*end == '.') {
			if (end[-1] == '.' && end[-2] == '/') {
			    concat = 1;
			    end -= 2;
			    if (end != &buf[INC_LIST_MAXLEN])
				while (*--end != '/');
			    continue;
			}
			if (*--end == '/')
			    continue;
			end++;
		    }
		} else if (c == '\"') {
		    break;
		} else if (c == '\n') {
		    yyerrorn(CE_NL_INC);
		    return yyp - 1;
		} else if (c == LC_EOF) {
		    yyerrorn(CE_EOF_INC);
		    return yyp - 1;
		}
		goto store_char;
	    };
	    if (after_string) {
		yyp = after_string;
		after_string = 0;
	    }
	    /* Try to find extra strings to be concatenated in ANSI style */
	    continue;
	  }
	  case '<':
	    yyp++;
	    end = &buf[INC_LIST_MAXLEN+1];
	    *end = '/';
	    relstart = end;
	    concat = -1;
	    continue;
	}
	break;
    }
}

static char *skip_comment(register char *p)
{
    register char c;

    for(;;) {
	c = *p++;
	if (c == '*') for (;;) {
	    c = *p++;
	    if (c == '*') continue;
	    if (c == '/') {
		return p;
	    }
	}
	if (c <= LC_MAX) {
	    switch(c) {
	      case LC_NL:
		nexpands=0;
		current_line++;
		break;
	      case LC_EOF:
		yyerrorn(CE_EOF_COMMENT);
		return p - 1;
	      case LC_POP:
		p = expsp->ret;
		expsp = expsp->pop;
		break;
	      case LC_DEFARG:
		p = expand_defarg(p);
		break;
	      case LC_IDENT:
		p = ALIGN(p + 2*sizeof(char *), char *);
		p += 2;
		break;
	      case LC_STRING:
		p = ALIGN(p + 2*sizeof(char *), char *);
		break;
	    }
	}
    }
}

static char *skip_pp_comment(p)
    char *p;
{
    char c;

    while (expsp->pop != expsp) {
	p = expsp->ret;
	expsp = expsp->pop;
    }
    for (;;) {
	c = *p;
	if (!c) {
	    yyerrorn(CE_EOF_COMMENT);
	    return p;
	}
	p++;
	if (c == '\n') {
	    nexpands=0;
	    current_line++;
	    return p;
	}
    }
}

/* skip white space in a #directive */
static char *skip_numdir_white(char *p) {
    char c;

    c = *p;
    for(;;) {
	if (lexwhite(c)) {
	    c = *++p;
	    continue;
	}
	if (c == '/') {
	    c = p[1];
	    if (c == '*') {
		p = skip_comment(p+2);
		c = *p;
		continue;
	    } else if(c == '/') {
		for (c = *(p += 2); c != '\n'; c = *++p);
		return p;
	    }
	}
	break;
    }
    return p;
}

/* Skip white space and backslash/newline */

static char *skip_white_bsnl(char *p) {
    char c;

    c = *p;
    for(;;) {
	if (lexwhite(c)) {
	    c = *++p;
	    continue;
	}
	if (c == '/') {
	    c = p[1];
	    if (c == '*') {
		p = skip_comment(p+2);
		c = *p;
		continue;
	    } else if(c == '/') {
		return skip2nl(p+2);
	    }
	}
	if (c == '\\') {
	    c = p[1];
	    if (p[1] == '\n') {
		current_line++;
		c = *(p += 2);
		continue;
	    }
	    if (p[1] == '\r' && p[2] == '\n') {
		current_line++;
		c = *(p += 3);
		continue;
	    }
	}
	if (c <= LC_MAX_SPECIAL) {
	    if (c == LC_POP) {
		p = expsp->ret;
		expsp = expsp->pop;
		c = *p;
		continue;
	    } else if (c == LC_DEFARG) {
		p = expand_defarg(p+1);
		c = *p;
		continue;
	    }
	}
	break;
    };
    return p;
}

static char *skip2nl(char *start) {
    unsigned char c, *p;

    p = (unsigned char *)start;

    while (expsp->pop != expsp) {
	p = expsp->ret;
	expsp = expsp->pop;
    }

    c = *p;
    for (;;) {
	if (c == LC_EOF || c == '\n')
	    return p;
	c = *++p;
    }
}

static char *handle_pragma(str)
    char *str;
{
    if (LEXDEBUG && lexdebug)
	printf("handle pragma:'%s'\n",str);
    str = skip_numdir_white(str);
    if (!memcmp(str, "strict_types", 12) && !isalunum(str[12])) {
	pragma_strong_types = 2;
	instrs[F_CALL_OTHER].ret_type = TYPE_UNKNOWN;
	str += 12;
    } else if (!memcmp(str, "save_types", 10) && !isalunum(str[10])) {
	pragma_save_types = 1;
	str += 10;
    } else if (!memcmp(str, "strong_types", 12) && !isalunum(str[12])) {
	pragma_strong_types = 1;
	instrs[F_CALL_OTHER].ret_type = TYPE_ANY;
	str += 12;
    } else if (!memcmp(str, "optimize", 8) && !isalunum(str[8])) {
	pragma_optimize = 1;
	str += 14;
#if defined( DEBUG ) && defined ( TRACE_CODE )
    } else if (!memcmp(str, "set_code_window", 15) && !isalunum(str[15])) {
	extern void set_code_window();

	set_code_window();
	str += 15;
    } else if (!memcmp(str, "show_code_window", 16) && !isalunum(str[16])) {
	extern void show_code_window();

	show_code_window();
	str += 16;
#endif
    }
    str = skip_numdir_white(str);
    if (*str != '\n') {
	if (*str) {
	    yyerrorn(CE_UK_PRAGMA);
	    do ; while(*++str != '\n');
	    str++;
	}
    } else {
	str++;
    }
    return str;
}
static struct ident *all_defines = 0, *permanent_defines = 0,
	*undefined_permanent_defines = 0;

static INLINE int number(p_int i)
{
    if (LEXDEBUG && lexdebug)
	printf("returning number %ld.\n", (long)i);
    yylval.constant.i = i << 1;
    return YYF_CONSTANT;
}

int yylex();

char *count_string(char *yyp, struct counted_string *cstrp) {
    char c;
    mp_int len = -1;

    cstrp->start = yyp;
    for (;;) {
	len++;
      dont_count:
	c = *yyp++;
	if (c <= LC_MAX) {
	    if (c == '\n' || !c) {
		cstrp->start--;
		cstrp->len = 0;
		yyerrorn(c ? CE_NL_STRING : CE_EOF_STRING);
		return yyp - 1;
	    }
	}
	if (c == '\\') {
	    c = *yyp++;
	    if (!escchars[(unsigned char)c]) {
		if (c == '\n' || c == '\r') {
		    yyp++;
		    if (c ^ *yyp == '\n' ^ '\r')
			yyp++;
		    goto dont_count;
		} else if (!c) {
		    cstrp->start--;
		    cstrp->len = 0;
		    yyerrorn(CE_EOF_STRING);
		    return yyp - 1;
		} else {
		    if (IS_OCTAL(*yyp)) {
			yyp++;
			if (IS_OCTAL(*yyp))
			    yyp++;
		    }
		    continue;
		}
	    }
	}
	if (c == '\"')
	    break;
    }
    cstrp->len = len;
    return yyp;
}

static void free_mappings() {
    int i;
    struct incstate **pp;

    i = NELEM(maptab);
    pp = maptab;
    do {
	struct incstate *p, *next;

	for (p = *pp, *pp++ = 0; p; p = next) {
	    next = p->next_hash;
	    munmap(p->mapstart, p->maplen);
	    if (p != &basestate)
		free_gen(p);
	}
    } while(--i);
}

int yylex() {
  register char *yyp;
  register char c;

  yyp = outp;
  for(;;) {
    switch(c = *yyp++) {
      case 0:
      {
	if (inctop->next) {
	    static char call_other_return_types[] =
		{ TYPE_ANY, TYPE_ANY, TYPE_UNKNOWN };
	    struct incstate *p;

	    p = inctop;
	    FREE_ALLOCED_SVALUE(p->file);
	    nexpands=0;
	    pragma_strong_types = p->pragma_strong_types;
	    instrs[F_CALL_OTHER].ret_type = 
		call_other_return_types[pragma_strong_types];
	    inctop = p->next;
	    yyp = p->outp;
	    if (!p->maplen)
		free_gen(p);
	    store_include_end();
	    break;
	}
	if (iftop) {
	    struct ifstate *p = iftop;
	    yyerrorn(p->expect_else ? CE_NO_NUMELSE : CE_NO_NUMENDIF,
		p->line - inctop->line + 1);
	    while(iftop) {
		p = iftop;
		iftop = p->next;
		free_gen(p);
	    }
	}
	outp = yyp-1;
	return 0;
      }
      case '\n':
	nexpands=0;
	current_line++;
      case '\r':
	/* if there are '\r's present, they usually come as '\r' '\n',
	 * which is OK with #directives. Alas, sometimes they come reversed.
	 * We don't want to reorder them because this would require to
	 * map the files read-write, and we would get page faults too.
	 */
	if (*yyp == '#') {
	    yyp++;
	    if (*yyp == '\'')
		goto closure_literal;
	    if (yyp-1 != inctop->mapstart && yyp[-2] == '\n')
		goto num_directive;
	    goto badchar;
	}
      case 0x1a: /* Used by some MSDOS editors as EOF */
      case ' ': case '\t': case '\f': case '\v':
	break;
      case '+':
	switch(c=*yyp++) {
	  case '+':
	    outp=yyp;
	    yylval.number = ULV_INC;
	    return YYF_ADDQ;
	  case '=':
	    yylval.number = ULV_ADD;
	    outp=yyp;
	    return YYF_ASSIGN;
	  default:
	    yyp--;
	}
	outp = yyp;
	yylval.number = F_ADD;
	return '+';
    case '-':
    	switch(c=*yyp++) {
    	  case '>':
	    outp=yyp;
    	    return YYF_ARROW;
    	  case '-':
	    outp=yyp;
	    yylval.number = ULV_DEC;
	    return YYF_ADDQ;
	case '=':
	    yylval.number = ULV_SUB;
	    outp=yyp;
	    return YYF_ASSIGN;
	  default:
	    yyp--;
	}
	outp = yyp;
	yylval.number = F_SUB;
	return '-';
      case '&':
    	switch(c=*yyp++) {
    	  case '&':
	    outp=yyp;
	    yylval.number = F_LAND;
    	    return YYF_LAND;
	  case '=':
	    yylval.number = ULV_AND;
	    outp=yyp;
	    return YYF_ASSIGN;
	  default:
	    yyp--;
	}
	outp = yyp;
	yylval.number = F_AND;
	return '&';
      case '|':
    	switch(c=*yyp++) {
    	  case '|':
	    outp=yyp;
	    yylval.number = F_LOR;
    	    return YYF_LOR;
	  case '=':
	    yylval.number = ULV_OR;
	    outp=yyp;
	    return YYF_ASSIGN;
	  default:  yyp--;
	}
	outp = yyp;
	yylval.number = F_OR;
	return '|';
      case '^':
	if (*yyp == '=') {
	    yyp++;
	    yylval.number = ULV_XOR;
	    outp=yyp;
	    return YYF_ASSIGN;
	}
	outp = yyp;
	yylval.number = F_XOR;
	return '^';
      case '<':
	c = *yyp++;;
	if (c == '<') {
	    if (*yyp == '=') {
	        yyp++;
	        yylval.number = ULV_LSH;
	        outp=yyp;
	        return YYF_ASSIGN;
	    }
	    outp=yyp;
	    yylval.number = F_LSH;
	    return YYF_SHIFT;
	}
	if (c == '=') {
	    outp=yyp;
	    yylval.number = F_LE;
	    return YYF_COMPARE;
	}
	yyp--;
	outp=yyp;
	yylval.number = F_LT;
	return '<';
      case '>':
	c = *yyp++;
	if (c == '>') {
	    if (*yyp == '=') {
	        yyp++;
	        yylval.number = ULV_RSH;
	        outp=yyp;
	        return YYF_ASSIGN;
	    }
	    outp=yyp;
	    yylval.number = F_RSH;
	    return YYF_SHIFT;
	}
	if (c == '=') {
	    outp=yyp;
	    yylval.number = F_GE;
	    return YYF_COMPARE;
	}
	yyp--;
	outp=yyp;
	yylval.number = F_GT;
	return YYF_COMPARE;
    case '*':
	if (*yyp == '=') {
	    yyp++;
	    yylval.number = ULV_MUL;
	    outp=yyp;
	    return YYF_ASSIGN;
	}
	outp=yyp;
	yylval.number = F_MULTIPLY;
	return '*';
    case '%':
	if (*yyp == '=') {
	    yyp++;
	    yylval.number = ULV_MOD;
	    outp=yyp;
	    return YYF_ASSIGN;
	}
	outp=yyp;
	yylval.number = F_MOD;
	return YYF_DIV;
    case '/':
	c = *yyp++;
	if (c == '*') {
	    yyp = skip_comment(yyp);
	    break;
	}
	if (c == '/') {
	    yyp = skip_pp_comment(yyp);
	    break;
	}
	if (c == '=') {
	    yylval.number = ULV_DIV;
	    outp=yyp;
	    return YYF_ASSIGN;
	}
	yyp--;
	outp=yyp;
	yylval.number = F_DIVIDE;
	return YYF_DIV;
      case '=':
	if (*yyp == '=') {
	    yyp++;
	    outp = yyp;
	    yylval.number = F_EQ;
	    return YYF_EQUALITY;
	}
	/* '=' is special because it is not only used for assignments, but
	 * also for initializations. Nontheless we store a value compatible
	 * to YYF_ASSIGN in yylval so that the parser can easily join
	 * the alternatives.
	 * note that is still has to check for possible call by reference,
	 * which necessiates ULV_HAIRY_ASSIGN
	 */
	yylval.number = ULV_ASSIGN;
	outp=yyp;
	return '=';
      case '~':
	yylval.number = F_COMPLEMENT;
	outp=yyp;
	return c;
      case ':':
	if (*yyp == c) {
	    yyp++;
	    outp = yyp;
	    return YYF_SCOPE;
	}
	outp=yyp;
	return c;
      case '?':
	if (*yyp == '-' && yyp[1] == '>') {
	    /* New operator: test if an auto variable is defined in an object */
	    outp = yyp + 2;
	    return YYF_QARROW;
	}
      case ',': case ';':
      case '(': case ')':
      case '{': case '}':
      case '[': case ']':
	outp=yyp;
	return c;
      case '!':
	if (*yyp == '=') {
	    yyp++;
	    outp = yyp;
	    yylval.number = F_NE;
	    return YYF_EQUALITY;
	}
	outp=yyp;
	yylval.number = F_NOT;
	return '!';
      case '.':
	if (*yyp == '.') {
	    yyp++;
	    outp = yyp;
	    return YYF_RANGE;
	}
	goto badchar;
      case '#':
	if (*yyp == '\'') {
	    struct ident *p;
	    struct idhash_ret idhr;
	    int efun_override;

      closure_literal:
	    if (!isalunum(*++yyp)) {
		extern int symbol_operator(char *, char **);
		int i;

		if ((i = symbol_operator(yyp, &outp)) < 0)
		    yyerrorn(CE_CL_NONAME);
		yylval.closure.number = i + CLOSURE_EFUN_OFFS;
		return F_CLOSURE;
	    }
	    idhr = idhash(yyp);
	    efun_override = 0;
	    if (idhr.p - yyp == 4 && !strncmp(yyp, "efun::", 6) ) {
		efun_override = 1;
		yyp = idhr.p + 2;
		idhr = idhash(yyp);
	    }
	    outp = idhr.p;
	    p = make_shared_identifier(
		yyp, idhr.p - yyp, idhr.hash, I_TYPE_GLOBAL);
	    if (!p) {
		lexerror(CE_NOMEM);
		return 0;
	    }
	    while (p->type > I_TYPE_GLOBAL) {
		if (p->type == I_TYPE_RESWORD) {
		    int code;

		    switch(code = p->u.terminal.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 .
			 */
			yyerrorn(CE_NOCLOSURE_OP, code << 1);
			code = CLOSURE_EFUN_OFFS;
			break;
		      }
		      case YYF_IF:
			code = F_BRANCH_ON_ZERO + CLOSURE_EFUN_OFFS;
			break;
		      case YYF_DO:
			code = F_BBRANCH_ON_NON_ZERO + CLOSURE_EFUN_OFFS;
			break;
		      case YYF_WHILE:
			/* the politically correct code   /
			/  was already taken, see above. */
			code = F_BBRANCH_ON_ZERO + CLOSURE_EFUN_OFFS;
			break;
		      case YYF_CONTINUE:
			code = F_BRANCH + CLOSURE_EFUN_OFFS;
			break;
		      case YYF_DEFAULT:
			code = F_CSHARED0 + CLOSURE_EFUN_OFFS;
			/* as bogus as we can possibly get :-) */
			break;
		      case YYF_BREAK:
		      case YYF_RETURN:
		      case YYF_SSCANF:
		      case YYF_CATCH:
		      case YYF_SWITCH:
			code += CLOSURE_EFUN_OFFS + F_BREAK - YYF_BREAK;
			break;
		    }
		    yylval.closure.number = code;
		    return YYF_CLOSURE;
		}
		if ( !(p = p->inferior) )
		    break;
	    }
	    if (!p || p->type < I_TYPE_GLOBAL) {
		if (p && p->type == I_TYPE_UNKNOWN)
		    free_shared_identifier(p);
		yyerrorn(CE_CL_FUN_UNDEF, make_string(yyp, idhr.p - yyp));
		yylval.closure.number = CLOSURE_EFUN_OFFS;
		return YYF_CLOSURE;
	    }
	    if (efun_override && p->u.global.sim_efun >= 0 &&
		simul_efun_table[p->u.global.sim_efun].nomask &&
		p->u.global.efun >= 0 &&
		master_ob.i)
	    {
		union svalue res;

		/* This privilege violation is special:
		 * Files loaded by the master must not get all privileges,
		 * thus the usual test for current_object == master_ob
		 * is not applicable.
		 */
		PUSH_NUMBER(PV_NOMASK_SIMUL_EFUN << 1);
		push_svalue(CURRENT_FILE);
		push_svalue(basestate.file);
		PUSH_REFERENCED_SVALUE(make_string(p->name, p->namelen));
		/* We couldn't reload the master right now, but we
		 * could might be able to reactivate a destructed one.
		 */
		assert_master_ob_loaded();
		res = call_hook(
		    driver_hook[H_PRIVILEGE_VIOLATION], master_ob, 4);
		if (!SV_IS_NUMBER(res) || res.i < 0)
		{
		    yyerrorn(CE_NOMASK_SIM, p->name);
		    efun_override = 0;
		} else if (!res.i) {
		    efun_override = 0;
		}
	    }
	    switch(0) { default:
		if (!efun_override) {
		    if (p->u.global.function >= 0) {
			svalue sv;

			sv = ALLOC_TTS(T_CLOSURE, 2, CLOSURE_PROTO_LFUN,
				sizeof(struct lfun_closure));
			if (sv.p) {
			    yylval.constant = sv;
			    SV_CLOSURE(sv).lfun.index = p->u.global.function;
			    SV_CLOSURE(sv).lfun.ob = all_proto_closures;
			    all_proto_closures = sv;
			}
			break;
		    }
		    if (p->u.global.sim_efun >= 0) {
			yylval.closure.number =
			  p->u.global.sim_efun + CLOSURE_SIMUL_EFUN_OFFS;
			break;
		    }
		}
		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;
		}
		if (p->u.global.variable >= 0) {
#if 0
		    extern int num_virtual_variables;

		    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() .
			 */
			yyerrorn(CE_CL_VIRT_VAR);
			yylval.closure.number = CLOSURE_IDENTIFIER_OFFS;
			break;
		    }
		    yylval.closure.number =
		      p->u.global.variable + num_virtual_variables +
		      CLOSURE_IDENTIFIER_OFFS;
		    break;
#endif
		}
		yyerrorn(CE_CL_FUN_UNDEF, make_string(yyp, idhr.p - yyp));
		yylval.closure.number = CLOSURE_EFUN_OFFS;
		break;
	    }
	    return YYF_CONSTANT;
	} else if ((yyp - 1 == inctop->mapstart || *(yyp-2) == '\n')) {
      num_directive:
	    do {
		c = *yyp++;
	    } while (lexwhite(c));
	    switch(c) {
	      case 'd':
		if (!memcmp(yyp, "efine", 5) && lexwhite(yyp[5])) {
		    yyp = handle_define(yyp+6);
		} else {
		    goto unrecognized_directive;
		}
		break;
	      case 'e':
		if (!memcmp(yyp, "ndif", 4) && isspace(yyp[4])) {
		    yyp = skip_numdir_white(yyp+4);
		    if (iftop) {
			struct ifstate *p = iftop;

			if (p->expect_else &&
			    yyp[1] == '\n' && yyp[2] == LC_EOF)
			{
			    inctop->lastif_line = p->line - inctop->line;
			}
			iftop = p->next;
			free_gen(p);
		    } else {
			yyerrorn(CE_NUMENDIF);
		    }
		} else if (yyp[0] == 'l' &&
			   ((yyp[1] == 's' && yyp[2] == 'e') ||
			    (yyp[1] == 'i' && yyp[2] == 'f')  ) &&
			   isspace(yyp[3]))
		{
		    /* #else of #elif */

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

			iftop = p->next;
			free_gen(p);
			outp = yyp + 3;
			skip2nume((char *)0);
			yyp = outp;
		    } else {
			yyerrorn(CE_NUMELSE);
		    }
		} else if (!memcmp(yyp, "cho", 3) && isspace(yyp[3])) {
		    yyp += 3;
		    do {
			c = *yyp++;
			if (c == '/') {
			    yyp = skip_numdir_white(yyp-1);
			    c = *yyp++;
			}
			fputc(c, stderr);
		    } while (c != '\n');
		} else {
		    goto unrecognized_directive;
		}
		break;
	      case 'i':
		if (!memcmp(yyp, "nclude", 6) && lexwhite(yyp[6])) {
		    yyp = handle_include(yyp+7);
		    break;
		} else if (*yyp == 'f') {
		    yyp++;
		    if (lexwhite(*yyp)) {
			union svalue cond;

			outp = yyp;
			cond = cond_get_exp(0);
			FREE_SVALUE(cond);
			outp = skip_white_bsnl(outp);
			if (*outp != '\n' && *outp != LC_EOF) {
			    if (cond.p != CONST_INVALID.p)
				yyerrorn(CE_NUMIF_GARBAGE);
			    outp = skip2nl(outp);
			    cond = CONST_INVALID;
			} else if (*outp == '\n' && outp[1] == LC_POP) {
			    outp = expsp->ret - 1;
			    expsp = expsp->pop;
			    if (*outp != '\n')
				fatal("Cannot prepare for skip2nume");
			}
			if (cond.p == CONST_INVALID.p)
			    skip2nume((char*)0);
			else
			    handle_cond(cond.i);
			yyp = outp;
			break;
		    } else {
			p_int cond;

			cond = 0;
			if (*yyp == 'n') {
			    yyp += cond = 1;
			}
			if (!memcmp(yyp, "def", 3) && lexwhite(yyp[3])) {
			    yyp = skip_white_bsnl(yyp + 3);
			    if (!isalunum(*yyp)) {
				outp = yyp;
			    } else {
				struct idhash_ret idhr;
    
				idhr = idhash(yyp);
				outp = idhr.p;
				if (lookup_define(yyp, idhr.p - yyp, idhr.hash,
				    I_TYPE_DEFINE))
				{
				    cond--;
				}
			    }
			    handle_cond(cond);
			    yyp = outp;
			    break;
			}
		    }
		}
		goto unrecognized_directive;
	      case 'p':
		if (!memcmp(yyp, "ragma", 5) && lexwhite(yyp[5])) {
		    yyp = handle_pragma(yyp+6);
		} else {
		    goto unrecognized_directive;
		}
		break;
	      case 'u':
		if (!memcmp(yyp, "ndef", 4) && lexwhite(yyp[4])) {
		    struct idhash_ret idhr;
		    struct ident *p, **q;

		    yyp = skip_white_bsnl(yyp + 4);
		    if (!isalunum(*yyp))
			break;
		    idhr = idhash(yyp);
		    p = lookup_define(
			  yyp, idhr.p - yyp, idhr.hash, I_TYPE_DEFINE);
		    yyp = idhr.p;
		    if (!p)
			break;
		    /* lookup_define() moved p to *q */
		    q = &ident_table[idhr.hash & (ITABLE_SIZE-1)];
		    if (!p->u.define.permanent) {
			if (p->inferior) {
			    p->inferior->next = p->next;
			    *q = p->inferior;
			} else {
			    *q = p->next;
			}
			free_gen(p->u.define.exps.str - 1);

			/* mark for later freeing by all_defines */
			p->name = 0;
			/* success */
		    } 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 */
		    }
		} else {
		    goto unrecognized_directive;
		}
		break;
	      default:
		yyp--;
	      unrecognized_directive:
		yyerrorn(CE_UK_DIRECTIVE);
		yyp = skip2nl(yyp);
		if (*yyp == '\n') {
		    current_line++;
		    yyp++;
		}
		break;
	    }
	    break;
	} else
	    goto badchar;
      case '\'':
	c = *yyp++;
	if (c == '\\') {
	    c = escchars[*(unsigned char *)yyp++];
	    if (!c || *yyp++ != '\'') {
		yyp--;
		yyerrorn(CE_ILL_CHARCONST);
	    }
	} else if (*yyp++ != '\'' || c == '\'') {
	    char *wordstart;
	    int quotes = 1;
	    union svalue name, symbol;

	    yyp -= 2;
	    while (*yyp == '\'') {
		quotes++;
		yyp++;
	    }
	    wordstart = yyp;
	    if (!isalpha(*yyp)) {
		if (*yyp == '(' && yyp[1] == '{') {
		    outp = yyp + 2;
		    yylval.number = quotes;
		    return YYF_QUOTED_AGGREGATE;
		}
		if (*yyp == LC_IDENT) {
		    yyp = ALIGN(yyp + 1 + 2*sizeof(char *), char *);
		    outp = yyp + sizeof(short);
		    wordstart = ((char **)yyp)[-2];
		    yyp = wordstart + ((p_int *)yyp)[-1];
		    /* hash in ((short *)yyp[0] */
		    goto return_symbol;
		}
		yyerrorn(CE_ILL_CHARCONST);
		outp = yyp;
		yylval.constant.i = 0;
		return YYF_CONSTANT;
	    }
	    while(isalunum(*++yyp));
	    outp = yyp;
	  return_symbol:
	    symbol = ALLOC(T_QUOTED, 1, sizeof(name));
	    yylval.constant = symbol;
	    if (symbol.p) {
		name = make_global_string(wordstart, yyp - wordstart);
		SV_QUOTES(symbol) = quotes;
		SV_QUOTED(symbol) = name;
	    }
	    return YYF_CONSTANT;
	}
	yylval.constant.i = c << 1;
	outp = yyp;
	return YYF_CONSTANT;
      case '\"':
	outp = count_string(yyp, &yylval.string);
	return YYF_STRING;
      case '0':
	c = *yyp++;
	if ( c == 'X' || c == 'x' ) {
	    p_int l;

	    /* strtol() gets the sign bit wrong,
	       strtoul() isn't portable enough. */
	    l = 0;
	    --yyp;
	    while(leXdigit(c = *++yyp)) {
		if (c > '9')
		    c = (c & 0xf) + ( '9' + 1 - ('a' & 0xf) );
		l <<= 4;
		l += c - '0';
	    }
	    outp=yyp;
	    return number(l);
	}
	yyp--;
	if (!lexdigit(c) && (c != '.' || yyp[1] == '.') ) {
	    outp=yyp;
	    return number(0);
	}
	c = '0';
	/* fall through */
               case '1':case '2':case '3':case '4':
      case '5':case '6':case '7':case '8':case '9':
      {
	char *numstart=yyp;
	p_int l;

	l = c - '0';
	while(lexdigit(c = *yyp++)) l = (((l << 2)+l) << 1) + 
#ifndef NOASCII
		(c & 0xf ); /* can be done in the same step as the type conversion */
#else
		(c - '0');
#endif

	if (c == '.' && *yyp != '.') {
	    union svalue sv;

	    sv = ALLOC_FLOAT;
	    while(lexdigit(*yyp++));
	    c = *--yyp;
	    yylval.constant = sv;
	    if (sv.p) {
		*yyp = 0;
		SV_FLOAT(sv) = atof(numstart-1);
		*yyp = c;
	    }
	    outp=yyp;
	    return YYF_CONSTANT;
	}
	--yyp;
	outp = yyp;
	return number(l);
      }
      case LC_POP:
	yyp = expsp->ret;
	expsp = expsp->pop;
	continue;
      case LC_DEFARG:
	yyp = expand_defarg(yyp+1);
	continue;
      case LC_STRING:
	if (expsp == &expstack[0])
	    goto badchar;
	yyp = ALIGN(yyp + 1 + 2*sizeof(char *), char *);
	yylval.string.start = ((char **)yyp)[-2];
	yylval.string.len = ((p_int *)yyp)[-1];
	outp = yyp;
	return YYF_STRING;
      {
	struct ident *p;

      case LC_IDENT:
	if (expsp == &expstack[0])
	    goto badchar;
	yyp = ALIGN(yyp + 1 + 2*sizeof(char *), char *);
	p = make_shared_identifier( ((char **)yyp)[-2], ((p_int *)yyp)[-1],
		  ((short *)yyp)[0], I_TYPE_UNKNOWN );
	yyp += sizeof(short);
	goto return_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 '_':
	{
	    struct idhash_ret idhr;

	    yyp--;
	    idhr = idhash(yyp);
	    p = make_shared_identifier(yyp, idhr.p - yyp, idhr.hash,
		  I_TYPE_UNKNOWN);
	    yyp = idhr.p;
	}
      return_identifier:
	if (!p) {
	    lexerror(CE_NOMEM);
	    return 0;
	}
	if (LEXDEBUG && lexdebug)
	  printf("returning identifier '%.*s'.\n", (int)p->namelen, p->name);
	switch(p->type) {
	  case I_TYPE_DEFINE:
	    yyp = expand_define(p, yyp);
	    continue;
	  case I_TYPE_RESWORD:
	    outp = yyp;
	    yylval.number = p->u.terminal.value;
	    return p->u.terminal.code;
	  case I_TYPE_PARAM:
	    yylval.number = p->u.param;
	    outp = yyp;
	    return YYF_PARAM;
	  case I_TYPE_LOCAL:
	    yylval.ident = p;
	    outp = yyp;
	    return YYF_LOCAL;
	  default:
	    yylval.ident = p;
	    outp = yyp;
	    return YYF_IDENTIFIER;
	}
      }
    badchar:
      default:
	outp = yyp;
	yyerrorn(CE_BADCHAR, (p_int)c << 1);
	continue;
    }
  }
}

extern YYSTYPE yylval;

void lex_close(p_int msg)
{
    int i = 0;

    while (inctop->next) {
	struct incstate *p;
	p = inctop;
	i++;
	FREE_ALLOCED_SVALUE(p->file);
	inctop = p->next;
	free_gen(p);
    }
    free_mappings();
    while(iftop) {
	struct ifstate *p;

	p = iftop;
	iftop = p->next;
	free_gen(p);
    }
    if (msg)
	yyerrorn(msg, i << 1);
    outp = FILE_END;
}

void lex_open(int fd, svalue name) {
    free_defines();
    current_line = 1;
    outp = lex_map(fd, &basestate);
    if (outp)
	inctop->file = name;
    expsp = &expstack[0];
    if (auto_include_string) {
	expsp[1].ret = outp;
	expsp[1].pop = expsp;
	expsp++;
	outp = auto_include_string;
    }
    basestate.line = basestate_firstline;
    pragma_save_types = 0;
    pragma_optimize = 0;
    nexpands = 0;
}

struct ident *all_efuns = 0;

void initialize_lex()
{
    extern struct ident builtin_identifiers[];

    static short binary_operators[] = {
	F_ADD, F_SUB, 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,
    };
    int i, n;
    char mtext[MBUF_SIZE];
    char *str;

#ifdef DEBUG
    if (!BITNUM_IS_1(ITABLE_SIZE))
	fatal("Select a power of two for ITABLE_SIZE\n");
#endif
    pagemask = pagesize - 1;
    for (i=0; i<ITABLE_SIZE; i++)
	ident_table[i] = 0;
    { struct ident *p = builtin_identifiers; do {
	struct idhash_ret idhr;

	idhr = idhash(p->name);
	p->hash = idhr.hash;
	idhr.hash &= ITABLE_SIZE-1;
	p->next = ident_table[idhr.hash];
	ident_table[idhr.hash] = p;
    } while (p = p->next_all); }
    for (n=0; n < NELEM(instrs); n++) {
	struct idhash_ret idhr;
	struct ident *p;

	if (instrs[n].Default == -1) continue;
	idhr = idhash(instrs[n].name);
	p = make_shared_identifier(
	    instrs[n].name, idhr.p - instrs[n].name, idhr.hash, I_TYPE_GLOBAL);
	if (!p)
	    fatal("Out of memory\n");
	p->type = I_TYPE_GLOBAL;
	p->u.global.efun     =  n;
	p->u.global.sim_efun = -1;
	p->u.global.function = -2;
	p->u.global.variable = -2;
	p->next_all = all_efuns;
	all_efuns = p;
    }
    for (i=0; i < NELEM(reswords); i++) {
	struct idhash_ret idhr;
        struct ident *p;

        idhr = idhash(reswords[i].name);
        p = make_shared_identifier(reswords[i].name,
	    idhr.p - reswords[i].name, idhr.hash, I_TYPE_RESWORD);
	if (!p)
	    fatal("Out of memory\n");
        p->type = I_TYPE_RESWORD;
        p->u.terminal.code  = reswords[i].code;
        p->u.terminal.value = reswords[i].value;
    }
    for (i=0; i < NELEM(binary_operators); i++) {
	n = binary_operators[i];
	instrs[n].min_arg = instrs[n].max_arg = 2;
	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_COMPLEMENT;
	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_permanent_define("__SIMA__", -1, "", 0);
    mtext[0] = '"';
    mtext[1] = '/';
    SV_COUNT_STRING(master_name, str, n);
    memcpy(mtext+2, str, n);
    strcpy(mtext+2+n, "\"");
    add_permanent_define("__MASTER_OBJECT__", -1, mtext, 0);
    sprintf(mtext, "\"%5.5s%s\"", GAME_VERSION, PATCH_LEVEL);
    add_permanent_define("__VERSION__", -1, mtext, 0);
    add_permanent_define("__FILE__", -1, (char *)add_current_file, 1);
    add_permanent_define("__LINE__", -1, (char *)add_current_line, 1);
    add_permanent_define("__HOST_NAME__", -1, (char *)add_hostname, 1);
    add_permanent_define("__DOMAIN_NAME__", -1, (char *)add_domainname, 1);
    sprintf(mtext, "\"%s\"", query_host_ip_number());
    add_permanent_define("__HOST_IP_NUMBER__", -1, mtext, 0);
    sprintf(mtext, "%d", MAX_RECURSION);
    add_permanent_define("__MAX_RECURSION__", -1, mtext, 0);
    add_permanent_define("__EFUN_DEFINED__", 1, (char *)efun_defined, 1);
}

void commandline_define(char *flag) {
    char mtext[MBUF_SIZE];

    *mtext='\0';
    sscanf(flag,"%*[^=]=%[ -~=]",mtext);
    if ( strlen(mtext) >= MBUF_SIZE ) fatal("Macro name overflow\n");
    add_permanent_define(flag, -1, mtext, 0);
}

/*
 * string: "([^"\]|\.)*"
 * parameter: [a-zA-Z_][a-zA-Z_0-9]*
 * stringized parameter: # parameter
 * token pasting: token ## token
 *
 * token pasting makes only sense if one of the tokens is a parameter
 */

#define GETID(r, yyp, type) \
{ \
    struct idhash_ret idhr; \
\
    idhr = idhash(yyp); \
    (r) = make_shared_identifier((yyp), idhr.p - (yyp), idhr.hash, (type)); \
    (yyp) = idhr.p; \
}

#define HIGH_WATERMARK (&mbuf[sizeof(mbuf)-12])

static char *handle_define(char *yyp) {
    int nargs;
    struct ident *r, *p, *last_arg;
    char *cout;
    char mbuf[MBUF_SIZE];
    mp_int clen;
    char *exps;

    if (!isalunum(*yyp)) {
	yyp = skip_white_bsnl(yyp);
	if (!isalunum(*yyp)) {
	    yyerrorn(CE_SYNTAX);
	    return yyp;
	}
    }
    GETID(r, yyp, I_TYPE_DEFINE)
    if (!r) {
	yyerrorn(CE_NOMEM);
	return yyp;
    }
    if (r->type != I_TYPE_UNKNOWN) {
	yyerrorn(CE_MREDEF, make_string(r->name, r->namelen));
	return yyp;
    }
    r->type = I_TYPE_DEFINE;
    nargs = -1;
    last_arg = 0;
    if (*yyp == '(') {
	for(;;) {
	    do yyp++; while(lexwhite(*yyp));
	    if (!isalunum(*yyp)) {
		if (*yyp == ')')
		    break;
		yyp = skip_white_bsnl(yyp);
		if (!isalunum(*yyp)) {
		    if (*yyp == ')')
			break;
		    yyerrorn(CE_SYNTAX);
		    return yyp;
		}
	    }
	    GETID(p, yyp, I_TYPE_DEFARG)
	    if (!p) {
		yyerrorn(CE_NOMEM);
	    } else {
		if (p->type != I_TYPE_UNKNOWN) {
		    yyerrorn(CE_MARG_DUP, make_string(p->name, p->namelen));
		}
		p->type = I_TYPE_DEFARG;
		p->u.defarg = nargs++;
		p->next_all = last_arg;
		last_arg = p;
	    }
	    if (*yyp == ',') continue;
	    if (*yyp == ')') break;
	    yyp = skip_white_bsnl(yyp);
	    if (*yyp == ',') continue;
	    if (*yyp == ')') break;
	    yyerrorn(CE_SYNTAX);
	    return yyp;
	}
	nargs = ~nargs;
    }
    r->u.define.nargs = nargs;
    cout = &mbuf[0];
    for (;;) {
	if (cout >= HIGH_WATERMARK) {
      mtext_overflow:
	    yyerrorn(CE_MTEXT_OVERFL);
	    yyp = skip2nl(yyp);
	    break;
	}
	switch(*yyp) {
	  case '"':
	    *cout = LC_STRING;
	    cout = ALIGN(cout+1 + sizeof(struct counted_string), char *);
	    yyp = count_string(yyp+1, &((struct counted_string *)cout)[-1]);
	    continue;
	  case '\'':
	    do {
		*cout++ = *yyp++;
		if (cout >= HIGH_WATERMARK)
		    goto mtext_overflow;
	    } while (*yyp == '\'');
	    if (*yyp == '\\')
		*cout++ = *yyp++;
	    if (!*yyp || *yyp == '\n') {
		break;
	    }
	    if (yyp[1] == '\'') {
		*cout++ = *yyp++;
		*cout++ = *yyp++;
	    }
	    continue;
	  case '\\':
	    yyp = skip_white_bsnl(yyp);
	    if (*yyp == '\\')
		yyp++;
	    continue;
	  case '\n':
	    break;
	  case ' ': case '\t':case '\f':case '\v':case '\r':
	    yyp++;
	    continue;
	  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 '_':
	  {
	    struct idhash_ret idhr;
	    mp_int len;

	    idhr = idhash(yyp);
	    len = idhr.p - yyp;
	    p = lookup_define(yyp, len, idhr.hash, I_TYPE_DEFARG);
	    if (p) {
		*cout++ = LC_DEFARG;
		*cout++ = p->u.defarg;
	    } else {
		*cout = LC_IDENT;
		cout = ALIGN(cout+1, char *);
		((char **)cout)[0] = yyp;
		((p_int *)cout)[1] = len;
		*(short *)&((char **)cout)[2] = idhr.hash;
		cout += sizeof(char *) * 2 + sizeof(short);
	    }
	    yyp = idhr.p;
	    continue;
	  }
	  case '/':
	    if (yyp[1] == '*' || yyp[1] == '/') {
		yyp = skip_white_bsnl(yyp);
		continue;
	    }
	    /* else fall through */
	  default:
	    *cout++ = *yyp++;
	    continue;
	}
	break; /* loop end */
    }
    *cout++ = LC_POP;
    while ((p = last_arg)) {
	last_arg = p->next_all;
	free_shared_identifier(p);
    }
    r->u.define.permanent = 0;
    r->u.define.special = 0;
    clen = ALIGNI((cout - &mbuf[0]) + 1, char *);
    exps = alloc_gen(clen);
    if (!exps) {
	free_shared_identifier(r);
	yyerrorn(CE_NOMEM);
	return FILE_END;
    }
    *exps++ = ' '; /* won't match '\n' if we have a '#' as first char */
    memcpy(exps, mbuf, clen-1);
    r->u.define.exps.str = exps;
    r->next_all = all_defines;
    all_defines = r;
    return yyp;
}

static void
add_permanent_define(char *name, int nargs, char *exps, char special)
{
    struct ident *p;
    struct idhash_ret idhr;

    idhr = idhash(name);
    p = make_shared_identifier(name, idhr.p - name, idhr.hash, I_TYPE_DEFINE);
    if (!p) {
	error(IE_NOMEM);
    }
    if (p->type != I_TYPE_UNKNOWN) {
	error(IE_MACROREDEF, name);
	return;
    }
    p->type = I_TYPE_DEFINE;
    p->u.define.nargs = nargs;
    p->u.define.permanent = 1;
    p->u.define.special = special;
    if (!special) {
	mp_int len;
	char *new;

	len = strlen(exps);
	new = alloc_gen(ALIGNI(len+1, char *));
	memcpy(new, exps, len);
	new[len] = LC_POP;
	exps = new;
    }
    p->u.define.exps.str = exps;
    p->next_all = permanent_defines;
    permanent_defines = p;
}

void free_defines() {
    struct ident *p, *q;

    for(p = all_defines; p; p = q) {
	q = p->next_all;
	if (p->name) {
	    free_gen(p->u.define.exps.str - 1);
	    free_shared_identifier(p);
	} else { /* has been undef'd. */
	    free_gen((char *)p);
	}
    }
    all_defines = 0;
    for (p = undefined_permanent_defines; p; p = q) {
	struct ident *curr, **prev;

	q = p->next;
	p->next = 0;
	prev = &ident_table[p->hash & (ITABLE_SIZE-1)];
	while (curr = *prev) {
	    if (curr->hash == p->hash && curr->namelen == p->namelen &&
		!memcmp(curr->name, p->name, p->namelen))
	    {
		/* found it */

		p->next = curr->next;
		break;
	    }
	    prev = &curr->next;
	} /* not found, create new one */
	p->inferior = curr;
	*prev = p;
    }
    undefined_permanent_defines = 0;
    nexpands = 0;
}

static struct ident *lookup_define(char *s, mp_int len, int hash, int type) {
    struct ident *curr, *prev;
    int h;

    h = hash & (ITABLE_SIZE - 1);

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

static char *expand_define(struct ident *id, char *yyp) {
    union {
	struct expand_stack *e;
	char *s, **sp;
	p_int *ip; short *shp;
	struct counted_string *cs;
    } tmpsp;
    char **args;

    if (nexpands++ > EXPANDMAX) {
	yyerrorn(CE_MEXP_NUM);
	return FILE_END;
    }
    tmpsp.e = expsp;
    if (id->u.define.nargs >= 0) {
	char **arg_end;
	int i;
	int nest;

	/*
	 * set i as a flag that we are searching the opening bracket,
	 * not the closing bracket yet.
	 */
	i = 1;
	/*
	 * search for '(' . If there are to be no arguments, search for the
	 * closing bracket too.
	 */
	for (;;) {
	    switch (*yyp) {
	      case '\n':
		current_line++;
	      case ' ': case '\t':case '\f':case '\v':case '\r':
		yyp++;
		continue;
	      case LC_POP:
		yyp = expsp->ret;
		expsp = expsp->pop;
		continue;
	      case LC_DEFARG:
		yyp = expand_defarg(yyp+1);
		continue;
	      case '/':
		if (yyp[1] == '*') {
		    yyp = skip_comment(yyp+2);
		    continue;
		} else if (yyp[1] == '/') {
		    yyp = skip_pp_comment(yyp+2);
		    continue;
		}
		goto no_opening_bracket;
	      case ')':
		yyp++;
		if (!i)
		    goto arguments_fetched;
		/* fall through */
	      default:
		/*
		 * including '\\' in the switch would span a much larger
		 * table for ASCII .
		 */
		if (*yyp == '\\') {
		    if (yyp[1] == '\n' || yyp[1] == '\r') {
			yyp += 2;
			current_line++;
			if (yyp[-1] ^ yyp[0] == '\n' ^ '\r')
			    yyp++;
			continue;
		    }
		}
	      no_opening_bracket:
		yyerrorn(CE_MEXP_NOBRAC);
		return yyp;
	      case '(':
		i = -id->u.define.nargs;
		if (!i) {
		    continue;
		}
		break;
	    }
	    break;
	}
	/* We might need space to expand macro arguments */
	args = (void *)&tmpsp.e->arg;
	i = -id->u.define.nargs;
	tmpsp.s = (void *)((char *)args + id->u.define.nargs * sizeof(char *));
	arg_end = tmpsp.sp;
	if (tmpsp.e + 2 >= &expstack[EXPSTACK_SIZE - 1]) {
	    yyerrorn(CE_MEXP_NEST);
	    return FILE_END;
	}
	*tmpsp.s++ = ' '; /* avoid matching '\n' if first char is '#' */
	arg_end[i] = tmpsp.s;
	for (nest = 0;;) {
	    char c;

	    if (tmpsp.e + 2 >= &expstack[EXPSTACK_SIZE - 1]) {
		yyerrorn(CE_MEXP_NEST);
		return FILE_END;
	    }
	    /*
	     * '\\' '\n' is not implemented outside strings because it isn't
	     * really useful (you can use ordinary newlines) and it would
	     * hurt performance, either by enlargung the switch table &
	     * degrading locality, or by necessiating an extra test in the
	     * heavily used default case
	     */
	    switch(c = *yyp++) {
	      case '(':
		nest++;
		*tmpsp.s++ = c;
		continue;
	      case ')':
		if (--nest < 0)
		    break;
		*tmpsp.s++ = c;
		continue;
	      case '\"':
		*tmpsp.s = LC_STRING;
		tmpsp.s = ALIGN(tmpsp.s+1+sizeof(char)*2, char *);
		yyp = count_string(yyp, &tmpsp.cs[-1]);
		continue;
	      case '\'':
		*tmpsp.s++ = c;
		if ((c = *yyp) == '\\') {
		    *tmpsp.s++ = '\\';
		    if (!escchars[*(unsigned char *)yyp]) {
			if (IS_OCTAL(*yyp)) {
			    *tmpsp.s++ = *yyp++;
			    if (IS_OCTAL(*yyp)) {
				*tmpsp.s++ = *yyp++;
				if (IS_OCTAL(*yyp))
				    *tmpsp.s++ = *yyp++;
			    }
			} else continue;
		    }
		    *tmpsp.s++ = *yyp++;
		    if (*yyp == '\'') {
			yyp++;
			*tmpsp.s++ = '\'';
		    }
		} else {
		    if ((((int)c - LC_MAX) >> 8) + yyp[1] == '\'') {
			tmpsp.s[0] = yyp[0];
			tmpsp.s[1] = yyp[1];
			yyp += 2;
			tmpsp.s += 2;
		    }
		}
		continue;
	      case '\n':
		current_line++;
	      case '\r':
		continue;
	      case '#':
		*tmpsp.s++ = c;
		if (*yyp == '\'') {
		    yyp++;
		    *tmpsp.s++ = '\'';
		    if (isalunum(c = *yyp)) {
			yyp++;
			*tmpsp.s++ = c;
			/*
			 * transferring the rest here would need overflow
			 * checks, thus we simply let the main loop do the
			 * rest.
			 */
			continue;
		    } else {
			extern int symbol_operator(char *, char **);

			char *end;

			if (symbol_operator(yyp, &end) < 0)
			    continue;
			/* longest item is #'[<..<] */
			strncpy(tmpsp.s, yyp, end - yyp);
			tmpsp.s += end - yyp;
			yyp = end;
		    }
		}
		continue;
	      case '/':
		if (*yyp == '*') {
		    yyp = skip_comment(yyp + 1);
		    continue;
		} else if (*yyp == '/') {
		    yyp = skip_pp_comment(yyp + 1);
		    continue;
		}
		*tmpsp.s++ = '/';
		continue;
	      case ',':
		if (!nest) {
		    if (++i) {
			*tmpsp.s++ = LC_POP;
			arg_end[i] = tmpsp.s;
			continue;
		    }
		}
		/* fall through */
	      default:
		*tmpsp.s++ = c;
		continue;
	      case LC_IDENT:
		*tmpsp.s = c;
		tmpsp.s = ALIGN(tmpsp.s+1+sizeof(char)*2, char *);
		yyp = ALIGN(yyp+sizeof(struct counted_string), char *);
		tmpsp.sp[-2] = ((char **)yyp)[-2];
		tmpsp.ip[-1] = ((p_int *)yyp)[-1];
		continue;
	      case LC_STRING:
		*tmpsp.s = c;
		tmpsp.s =
		  ALIGN(tmpsp.s+1+sizeof(struct counted_string), char *);
		yyp = ALIGN(yyp, char *);
		tmpsp.sp[-2] = ((char **)yyp)[-2];
		tmpsp.ip[-1] = ((p_int *)yyp)[-1];
		tmpsp.shp[0] = ((short *)yyp)[ 0];
		tmpsp.s += sizeof(short);
		yyp += sizeof(short);
		continue;
	      case LC_POP:
		yyp = expsp->ret;
		expsp = expsp->pop;
		continue;
	      case LC_DEFARG:
		yyp = expand_defarg(yyp);
		continue;
	    }
	}

	tmpsp.e = ALIGN(tmpsp.s, char *);
    }
  arguments_fetched:
    if (tmpsp.e + 1 >= &expstack[EXPSTACK_SIZE - 1]) {
	yyerrorn(CE_MEXP_NEST);
	return FILE_END;
    }
    if (id->u.define.special) {
	return (*id->u.define.exps.fun)(yyp, args, tmpsp.e);
    }
    tmpsp.e[1].pop = expsp;
    tmpsp.e[1].ret = yyp;
    tmpsp.e[1].arg = args;
    expsp = tmpsp.e + 1;
    return id->u.define.exps.str;
}

static char *expand_defarg(char *p) {
    int n;

    /*
     * expand_define() already makes sure that there is space for
     * one argument expansion in expstack.
     */
    n = *(unsigned char *)p++;
    expsp[1].pop = expsp;
    expsp[1].ret = p;
    if (expsp == &expstack[0]) {
	yyerrorn(CE_BADCHAR, (p_int)LC_DEFARG << 1);
        return p;
    }
    p = expsp->arg[n];
    expsp++;
    return p;
}

char mygetc() {
    char c;

    for (;;) {
	c = *outp++;
	switch(c) {
	  case LC_POP:
	    outp = expsp->ret;
	    expsp = expsp->pop;
	    break;
	  case LC_DEFARG:
	    outp = expand_defarg(outp);
	    break;
	  default:
	    return c;
	}
    }
}

void myungetc(char c) {
    if ( ((p_int)(outp-1) & -sizeof(char *)) == (p_int)&expsp->arg ) {
	/* We have been called before, and have some space left in expsp->arg */
	*--outp = c;
	return;
    }
    if (c == '\"') {
	/*
	 * We must not separate the '\"' from the rest of the string, because
	 * this implementation tolerates LC_POP inside strings.
	 * The caller must not unget a '\"' unless it is freshly read.
	 */
	--outp;
	return;
    }
    /*
     * store the character like a macro argument expansion.
     * (ab)use the space in expsp->arg to place the character itself
     * and LC_POP in it.
     */
    expsp[1].ret = outp;
    expsp[1].pop = expsp;
    expsp++;
    outp = (char *)(&expsp->arg+1) - 2;
    outp[0] = c;
    outp[1] = LC_POP;
}

#define unget1c(c) (outp--)

/*
 * once you got the starting character of a string, you shouldn't use exgetc,
 * because it filters out comments without respecting strings
 */
static int exgetc() {
    register char c;

    for (;;) {
	char *start;
	mp_int len;
	struct idhash_ret idhr;

	c=mygetc();
	if (isalpha(c) || c=='_') {
	    start = outp - 1;
	    idhr = idhash(start);
	    len = idhr.p - start;
	  check_defined:
	    if (len == 7 && !memcmp(start, "defined", 7)) {
		idhr.p = skip_white_bsnl(idhr.p);
		if (*idhr.p != '(') {
		    yyerrorn(CE_DEFD_NOBRAC);
		    outp = idhr.p;
		    c = mygetc();
		    continue;
		}
		idhr.p = skip_white_bsnl(idhr.p+1);
		c = *idhr.p;
		if (isalpha(c) || c == '_') {
		    start = idhr.p;
		    idhr = idhash(idhr.p);
		    len = idhr.p - start;
		} else if (c == LC_IDENT && expsp != &expstack[0]) {
		    idhr.p =
		      ALIGN(idhr.p + 1 + sizeof(struct counted_string), char *);
		    start = ((char **)idhr.p)[-2];
		    len   = ((p_int *)idhr.p)[-1];
		    idhr.hash = ((short*)idhr.p)[0];
		    idhr.p += sizeof(short);
		} else {
		    len = 0;
		}
		idhr.p = skip_white_bsnl(idhr.p);
		if (*idhr.p != ')') {
		    yyerrorn(CE_DEFD_ENDBRAC);
		    outp = idhr.p;
		    c = mygetc();
		    continue;
		}
		idhr.p++;
		c = lookup_define(start, len, idhr.hash, I_TYPE_DEFINE) ?
				'1' : '0';
	  unget_cond:
		/* do the analogue to myungetc(' '),myungetc('c'); */
		expsp[1].ret = idhr.p;
		expsp[1].pop = expsp;
		expsp++;
		idhr.p = (char *)(&expsp->arg+1) - 3;
		idhr.p[0] = c;
		idhr.p[1] = ' ';
		idhr.p[2] = LC_POP;
		outp = idhr.p;

		return ' ';
	    } else {
		struct ident *p;

		p = lookup_define(start, len, idhr.hash, I_TYPE_DEFINE);
		if (!p) {
		    c = '0';
		    goto unget_cond;
		} else {
		    outp = expand_define(p, idhr.p);
		}
	    }
	} else if (c == LC_IDENT && expsp != &expstack[0]) {
	    idhr.p = ALIGN(outp + 1 + sizeof(struct counted_string), char *);
	    start = ((char **)idhr.p)[-2];
	    len   = ((p_int *)idhr.p)[-1];
	    idhr.hash = ((short*)idhr.p)[0];
	    idhr.p += sizeof(short);
	    goto check_defined;
	} else if (c == '\\' && (*outp == '\n' || *outp == '\r') ||
		   c == '/'  && (*outp == '*'  || *outp == '/' )   )
	{
	    outp = skip_white_bsnl(outp-1);
	    return ' ';
	} else {
	    break;
	}
    }
    return c;
}

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

#define LAND  1
#define LOR   2
#define QMARK 3

/* lookup table for characters >= ' ' and <= '~'.
 * 0 for no operator, else index into optab2.
 */
static const 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};

/* optab2[index-1] : operation code for unary operator, 0 for none.
 * optab[index+0 .. +3 .. +6 ...] :
 * two character binary operators: second character, operation code, priority
 * one character binary operator & end: 0,           operation code, priority
 * end: 0, 0
 */
static const unsigned char optab2[]=
{
    BNOT,0,0, F_MULTIPLY,11,
    LNOT,'=',F_NE,7,0,0, F_DIVIDE,11,
    UMINUS,0,F_SUB,10,
    UPLUS,0,F_ADD,10,
    0,'<',F_LSH,9,'=',F_LE,8,0,F_LT,8,
    0,'>',F_RSH,9,'=',F_GE,8,0,F_GT,8,
    0,'=',F_EQ,7,0,0, F_MOD,11,
    0,'&',LAND,3,0,F_AND,6,0,'|',LOR,2,0,F_OR,4,
    0,0,F_XOR,5,0,0,QMARK,1
};
#define optab1 (_optab-' ')

static union svalue cond_get_exp(int priority) {
    int c, x;
    union svalue sv1, sv2;

    do c=exgetc(); while ( lexwhite(c) );
    if ( c=='(' ) {

	sv1 = cond_get_exp(0);
	if (sv1.p == CONST_INVALID.p)
	    return CONST_INVALID;
	do c=exgetc(); while ( lexwhite(c) );
	if ( c!=')' ) {
	    yyerrorn(CE_NUMIF_BNPAIRD);
	    if (c == '\n') unget1c('\n');
	}
    } else if ( ispunct(c) ) {
	if (c == '"') {
	    struct counted_string cstr;

	    outp = count_string(outp, &cstr);
	    sv1 = concat_strings(cstr.start, cstr.len, 0);
	} else {
	    x=optab1[c];
	    if (!x) {
		yyerrorn(CE_NUMIF_BADCHAR);
		return CONST_INVALID;
	    }
	    sv1 = cond_get_exp(12);
	    x = optab2[x-1];
	    if (x == LNOT) {
		sv1.i = !sv1.i << 1;
	    } else {
		if (!SV_IS_NUMBER(sv1)) {
		    if (sv1.p != CONST_INVALID.p) {
			yyerrorn(CE_NUMIF_IT_UOP);
			FREE_ALLOCED_SVALUE(sv1);
		    }
		    return CONST_INVALID;
		}
		switch (x) {
		  case BNOT  : sv1.i ^= ~1; break;
		  case UMINUS: sv1.i = -sv1.i; break;
		  case UPLUS : sv1.i =  sv1.i; break;
		  default :
		    yyerrorn(CE_NUMIF_ILL_UOP);
		    return CONST_INVALID;
		}
	    }
	}
    } else {
	if ( !lexdigit(c) ) {
	    if (c == LC_STRING) {
		struct counted_string *csp;

		csp = ALIGN(outp+sizeof(*csp), char *);
		outp = (char *)csp;
		sv1 = concat_strings(csp->start, csp->len, 0);
	    } else if (c == '\n' || c == LC_EOF) {
		yyerrorn(CE_NL_NUMIF);
		unget1c(c);
	    } else yyerrorn(CE_NUMIF_BADCHAR);
	    return CONST_INVALID;
	} else {
	    p_int value;
	    int base;

	    value=0;
	    if ( c!='0' ) {
		base=10;
	    } else {
		c=mygetc();
		if ( c=='x' || c=='X' ) {
		    base=16;
		    c=mygetc();
		} else base=8;
	    }
	    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(c);
	    sv1.i = value << 1;
	}
    }
    for (;;) {
	int value;

	do c=exgetc(); while ( lexwhite(c) );
	if ( !ispunct(c) ) break;
	if (c == '"') {
	    unget1c('"');
	    c = '+';
	}
	x=optab1[c];
	if (!x) break;
	value = mygetc();
	for(;;x+=3) {
	    if ( !optab2[x] ) {
		unget1c(value);
		if ( !optab2[x+1] ) {
		    yyerrorn(CE_NUMIF_ILL_OPU);
		    FREE_SVALUE(sv1);
		    return CONST_INVALID;
		}
		break;
	    }
	    if (value == optab2[x]) break;
	}
	if (priority >= optab2[x+2]) {
	    if (optab2[x]) myungetc(value);
	    break;
	}
	sv2 = cond_get_exp(optab2[x+2]);
	x = optab2[x+1];
	switch(x) {
	  case LAND:
	    if (sv1.i) {
		FREE_SVALUE(sv1);
		sv1 = sv2;
	    } else {
		FREE_SVALUE(sv2);
	    }
	    break;
	  case LOR:
	    if (!sv1.i)
		sv1 = sv2;
	    else
		FREE_SVALUE(sv2);
	    break;
	  case QMARK:
	    FREE_SVALUE(sv1);
	    do c=exgetc(); while( lexwhite(c) );
	    if (c != ':') {
		yyerrorn(CE_NUMIF_QMARK);
		myungetc(c);
		FREE_SVALUE(sv2);
		return CONST_INVALID;
	    }
	    if (sv1.i) {
		sv1 = cond_get_exp(1);
		FREE_SVALUE(sv1);
		sv1 = sv2;
	    } else {
		FREE_SVALUE(sv2);
		sv1 = cond_get_exp(1);
	    }
	    break;
	  default:
	  {
	    static struct efun_closure tmp_closure = {
		T_CLOSURE,	/* type */
		1,		/* ref */
		CLOSURE_EFUN,	/* closure_type */
		TO_SVALUE(&nil_object)
	    };

	    tmp_closure.closure_type = CLOSURE_EFUN + x;
	    *++inter_sp = (sv1);
	    *++inter_sp = (sv2);
	    call_lambda(TO_SVALUE(&tmp_closure), 2);
	    sv1 = *inter_sp--;
	    if (inter_errno) {
		inter_errno = 0;
		yyerrorn(CE_NUMIF_ERROR);
		FREE_SVALUE(sv1);
		return CONST_INVALID;
	    }
	  }
	}
    }
    myungetc(c);
    return sv1;
}

static void set_inc_list(svalue hook)
{
    struct array *v;
    int i;
    char *p;
    p_uint len, max;
    union svalue *svp, sv;

    v = &SV_ARRAY(hook);
    svp = v->member;
    for (i = 0, max = 0; i < VEC_SIZE(v); i++, svp++) {
	sv = *svp;
	if (SV_IS_NUMBER(sv) || !SV_IS_STRING(sv)) {
	    error(IE_BADINCPATH, sv);
	}
	p = sv_string(sv, &len);
	for(;;) {
	    if (!len)
		break;
	    if (*p == '/') {
		p++;
		len--;
	    } else if (*p == '.' && len > 1 && p[1] == '/') {
		p += 2;
		len -= 2;
	    } else {
		break;
	    }
	}
	/*
	 * Make sure that no master error compromises the security of the
	 * account.
	 */
	if (!legal_path(p, len)) {
	    error(IE_BADINCPATH, p);
	}
	if (*p == '.' && len == 1) {
	    error(IE_BADINCPATH, p);
	    return;
	}
	if (len >= 2 && p[len -1] == '.' && p[len - 2] == '/') {
	    error(IE_BADINCPATH, p);
	    return;
	}
	sv = make_global_string(p, len);
	if (!sv.p) {
	    error(IE_NOMEM);
	    return;
	}
	if (max < len)
	    max = len;
	FREE_ALLOCED_SVALUE(*svp);
	*svp = sv;
    }
    if (max > INC_LIST_MAXLEN) {
	return;
    }
    inc_hook_value = hook;
    inc_list = v->member;
    inc_list_size = VEC_SIZE(v);
    inc_list_maxlen = max;
}

void clear_auto_include_string()
{
    if (auto_include_string) {
	x_free(auto_include_string-1);
	auto_include_string = 0;
    }
}

union svalue *f_set_auto_include_string(sp)
    union svalue *sp;
{
    char *s;
    mp_uint len;
    union svalue sv;

    sv = *sp;
    if (SV_IS_NUMBER(sv) || !SV_IS_STRING(sv)) {
	bad_efun_arg(1);
	return sp;
    }
    if (_privilege_violation(PV_SET_AUTO_INCLUDE_STRING << 1, *sp, sp) > 0)
    {
	clear_auto_include_string();
	s = sv_string(sp, &len);
	auto_include_string = x_alloc(len+2);
	*auto_include_string++ = '\n';
	memcpy(auto_include_string, s, len);
	s = auto_include_string;
	for (basestate_firstline = 0; *s; ) {
	    if (*s < LC_MAX_SPECIAL)
		*s = ' ';
	    basestate_firstline -= *s++ == '\n';
	}
	*s = LC_POP;
    }
    FREE_ALLOCED_SVALUE(sv);
    return sp - 1;
}

/* mode < 0 : count	mode == 0: count & quote	mode > 0: quote */
char *add_input(const char *str, mp_int mode, char *yyp) {
    mp_int len;
    char *dest;
    struct expand_stack *newsp;

    len = mode;
    if (mode <= 0)
	len = strlen(str);
    dest = (char *)&expsp[1];
    newsp = ALIGN(dest + len + 3, char *);
    if (newsp > &expstack[EXPSTACK_SIZE-1]) {
	yyerrorn(CE_MEXP_NEST);
	return yyp;
    }
    newsp->pop = expsp;
    newsp->ret = yyp;
    expsp = newsp;
    yyp = dest;
    if (mode >= 0)
	*dest++ = '"';
    memcpy(dest, str, mode);
    str += mode;
    if (mode >= 0)
	*dest++ = '"';
    *dest = LC_POP;
    return yyp;
}

static char *add_current_file(char *yyp, char **args) {
    struct counted_string cstr;

    cstr = sv_string2(CURRENT_FILE);
    return add_input(cstr.start, cstr.len, yyp);
}

static char *add_current_line(char *yyp, char **args) {
    char buf[12];

    sprintf(buf, "%d", current_line - inctop->line +  - inctop->line + 1);
    return add_input(buf, -1, yyp);
}

static char *add_hostname(char *yyp, char **args) {
    return add_input(query_host_name(), 0, yyp);
}

static char *add_domainname(char *yyp, char **args) {
    char tmp[257];

    getdomainname(&tmp[1], sizeof(tmp)-1);
    tmp[sizeof(tmp)-1] = '\0';
    return add_input(tmp, 0, yyp);
}

static char *efun_defined(char *yyp, char **args, struct expand_stack *sp) {
    static char fakemain[] = { '~', LC_POP };

    struct expand_stack *oldsp;
    struct ident *p;
    int token;
    char *expand;

    oldsp = sp;
    sp++;
    sp->pop = sp;
    sp->ret = fakemain;
    expsp = sp;
    outp = args[0];
    token = yylex();
    expsp = oldsp;
    expand = " 0 ";
    if (token == YYF_IDENTIFIER) {
	p = yylval.ident;
	if (p->type == I_TYPE_UNKNOWN) {
	    free_shared_identifier(p);
	} else {
	    /* p->type == I_TYPE_GLOBAL */
	    if (p->u.global.efun >= 0)
		expand = " 1 ";
	}
    }
    yyp = add_input(expand, -1, yyp);
    return yyp;
}

void remove_unknown_identifier() {
    int i;
    struct ident *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);
	}
    }
}

#ifdef MALLOC_smalloc
void count_lex_refs() {
    int i;
    struct ident *id;

    /* Identifier */
    for (i = ITABLE_SIZE; --i >= 0; ) {
	id = ident_table[i];
	for ( ; id; id = id->next) {
	    count_ref_from_string(id->name);
	    note_malloced_block_ref((char *)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 (auto_include_string)
	note_malloced_block_ref(auto_include_string-1);
}
#endif /* MALLOC_smalloc */

char *lex_error_context() {
    extern int yychar;

    static char buf[20];
    char *end;
    mp_int len;

    strcpy(buf, yychar == -1 ? (len = 5, "near ") : (len = 7, "before "));
    if (!yychar) {
	end = buf;
    } else {
	strncpy(buf + len, outp, sizeof buf - 1 - len);
	buf[sizeof buf - 1] = '\n';
	end = strchr(buf, '\n');
    }
    for (;;) {
	if (end == buf) {
	    strcpy(buf+len, "end of line");
	    break;
	}
	if (!lexwhite(end[-1])) {
	    *end = '\0';
	    break;
	}
	end--;
    }
    return buf;
}