psyclpc/src/lex.c

7975 lines
224 KiB
C

/*---------------------------------------------------------------------------
* LPC-Compiler: Preprocessor and Lexical Analysis.
*
*---------------------------------------------------------------------------
* The lexer is initialised by a call to init_lexer(). This function sets
* up the internal tables and also reads the permanent defines from
* the lpc_predefs list the caller set up before the call.
*
* A new compilation is set up by a call to start_new_file(), passing
* the filedescriptor of the file to compile as argument. Control is
* then passed to the parser in prolang, which calls yylex() here to
* get the next token. After the compilation is finished, end_new_file()
* performs the cleanup.
*
* The lexer also holds the table of instructions (instrs[]) and the
* driver's own ctype tables. Both are included from the file efun_defs.c
* which is generated by the program make_func during the building
* process.
*
* For an explanation of the datastructures look at the places of
* definition of the structures - it's too much to put here, too.
*---------------------------------------------------------------------------
*/
#include "driver.h"
#include "typedefs.h"
#include "my-alloca.h"
#include <stdio.h>
#include <fcntl.h>
#include <ctype.h>
#include <stdarg.h>
#include <stddef.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "lex.h"
#include "array.h"
#include "backend.h"
#include "closure.h"
#include "comm.h"
#include "exec.h"
#include "filestat.h"
#include "gcollect.h"
#include "hash.h"
#include "instrs.h"
#include "interpret.h"
#include "lang.h"
#include "main.h"
#include "mempools.h"
#include "mstrings.h"
#include "object.h"
#include "patchlevel.h"
#include "prolang.h"
#include "simulate.h"
#include "simul_efun.h"
#include "stdstrings.h"
#include "strfuns.h"
#include "svalue.h"
#include "wiz_list.h" /* wizlist_name[] */
#include "xalloc.h"
#include "i-eval_cost.h"
#include "../mudlib/sys/driver_hook.h"
/* TODO: Implement the # and ## operators. With this, #define X(a) (a + "a")
* TODO:: can be made sane (X(b) -> 'b + "a"' instead of 'b + "b"').
* TODO: New predefs' __BASENAME__, __FUNCTION__.
* TODO: #define macro(a,b,...) -> ... is assigned to __VA_ARGS__ (see oncoming
* TODO:: C standard).
* TODO: Does Standard-C allow recursive macro expansion? If not, we
* TODO:: should disallow it, too.
*/
/* We can't use the EOF character directly, as in its (char) representation
* clashes with ISO-8859 character 0xFF. Instead we use ascii SOH (0x01),
* which in turn is not allowed as input character.
*/
#define CHAR_EOF ((char)0x01)
/*-------------------------------------------------------------------------*/
#define MLEN 4096
/* Maximum length of a macro text (definition)
*/
#define NSIZE 256
/* Maximum length of a macro (argument) name.
*/
#define NARGS 25
/* Max number of macro arguments
*/
#define EXPANDMAX 25000
/* Maximum number of expansions per line.
*/
#define MAXLINE 2048
/* Maximum length of an input line.
*/
#define MAX_ANSI_CONCAT 4096
/* Maximum length of an ANSI-style string literal concatenation.
*/
#define INC_OPEN_BUFSIZE 1024
/* Maximum length of an include filename.
*/
#ifndef DEFMAX
# define DEFMAX 12000
#endif
/* Maximum length of an expanded macro.
*/
#define MAX_TOTAL_BUF 400000
/* Maximum length of macro expansion buffer
*/
#define DEFBUF_1STLEN (DEFMAX+MAXLINE+1)
/* Initial length of macro expansion buffer, enough
* to allow DEFMAX + an input line + '\0'
*/
/*-------------------------------------------------------------------------*/
source_loc_t current_loc;
/* The current compilation location.
*/
int total_lines;
/* Total number of lines compiled so far (used to compute the average
* compiled lines/s)
*/
static const char *object_file;
/* Name of the file for which the lexer was originally called.
*/
Bool pragma_use_local_scopes;
/* True: treat all local scopes as one.
*/
Bool pragma_warn_missing_return;
/* True: generate a runtime warning if a value-returning function
* does end with an explicit return statement.
*/
Bool pragma_check_overloads;
/* TRUE if function redefinitions have to match the originals in their
* types. This pragma is meant mainly to ease the adaption of old
* mudlibs.
*/
Bool pragma_strict_types;
/* Type enforcing mode: PRAGMA_WEAK_TYPES, PRAGMA_STRONG_TYPES
* and PRAGMA_STRICT_TYPES.
*/
Bool pragma_save_types;
/* True: save argument types after compilation.
*/
Bool pragma_combine_strings;
/* True: perform '+'-addition of constant strings at compile time.
*/
Bool pragma_verbose_errors;
/* True: give info on the context of an error.
*/
Bool pragma_no_clone;
/* True: prevent the object from being clone.
*/
Bool pragma_no_inherit;
/* True: prevent the program from being inherited.
*/
Bool pragma_no_shadow;
/* True: prevent the program from being shadowed.
*/
Bool pragma_pedantic;
/* True: treat a number of sloppy language constructs as errors.
*/
Bool pragma_warn_deprecated;
/* True: warn if deprecated efuns are used.
*/
Bool pragma_range_check;
/* True: warn (at runtime) if array ranges are invalid.
*/
Bool pragma_share_variables;
/* TRUE: Share the blueprint's variables with its clones.
*/
Bool pragma_warn_empty_casts;
/* True: warn if a type is casted to itself.
*/
string_t *last_lex_string;
/* When lexing string literals, this is the (shared) string lexed
* so far. It is used to pass string values to lang.c and may be
* freed there.
*/
struct lpc_predef_s *lpc_predefs = NULL;
/* List of macros predefined by other parts of the driver, especially from
* main.c for the '-D' commandline option.
*/
static source_file_t * src_file_list = NULL;
/* List of source_file structures during a compile.
*/
static Mempool lexpool = NULL;
/* Fifopool to hold the allocations for the include and lpc_ifstate_t stacks.
*/
/*-------------------------------------------------------------------------*/
/* The lexer can take data from either a file or a string buffer.
* The handling is unified using the struct source_s structure.
* TODO: Use this source similar to auto-include to expand macros in the
* TODO:: the compile. This would make it easier to find errors caused
* TODO:: by macro replacements.
*/
typedef struct source_s
{
int fd; /* Filedescriptor or -1 */
string_t * str; /* The source string (referenced), or NULL */
size_t current; /* Current position in .str */
} source_t;
static source_t yyin;
/* Current input source.
*/
/*-------------------------------------------------------------------------*/
/* The lexer uses a combined file-input/macro-expansion buffer
* called defbuf[] of length <defbuf_len>. Within this buffer, the last
* MAXLINE bytes are reserved as (initial) file-input buffer, its beginning
* and end marked with the pointers linebufstart and linebufend. In this
* space, pointer outp points to the next character to process.
*
* The file-input buffer may contain several textlines, all terminated
* with a '\n'. After the last (complete) textline, a '\0' is set as
* sentinel. Usually this will overwrite the first character of the
* incomplete line right at the end of the input buffer, therefore this
* character is stored in the variable saved_char.
*
* When all lines in the buffer have been processed (ie. outp points to
* the '\0' sentinel), the remaining fragment of the yet incomplete line
* is copied _before_ linebufstart (and outp set accordingly), then
* the next MAXLINE bytes are read into the buffer starting at
* linebufstart.
*
* If there are less than MAXLINE bytes left to read, the end of the file
* is marked in the buffer with the CHAR_EOF character (a \0 sentinel is not
* necessary as compilation and thus lexing will end with the CHAR_EOF
* character).
*
* When including files, a new area of MAXLINE bytes is reserved in defbuf,
* which ends exactly at the current outp. The position of the current
* area is recorded with the current position of linebufstart relative to
* the end of defbuf. Obviously this can be repeated until the max size
* of defbuf (MAX_TOTAL_BUF) is reached.
*
* Macro expansions are done such that the replacement text for a macro
* copied right before outp (which at that time points at the character
* after the macro use), then outp is set back to point at the beginning
* of the added text, lexing the just expanded text next.
*
#ifndef USE_NEW_INLINES
* Functionals (inline functions) are somewhat similar to macros. When a
* definition '(: ... :)' is encountered, a copy of text between the
* delimiters is stored verbatim in the list of inline functions, starting at
* first_inline_fun. To the compiler the lexer returns L_INLINE_FUN with the
* synthetic identifier of the function. Whenever such functions are pending
* and the compiler is at a safe place to accept a function definition
* (signalled in insert_inline_fun_now), the text of the pending functions is
* inserted into the input stream like a macro.
#endif
*/
static char *defbuf = NULL;
/* The combined input/expansion buffer.
*/
static unsigned long defbuf_len = 0;
/* Current length of defbuf.
*/
static char *outp;
/* Pointer to the next character in defbuf[] to be processed.
*/
static char *linebufstart;
/* Begin of the input line buffer within defbuf[].
*/
static char *linebufend;
/* End of the input line buffer within defbuf[].
*/
static char saved_char;
/* The first character of the incomplete line after the last complete
* one in the input buffer. Saved here because in the buffer itself
* it is overwritten with '\0'.
*/
/*-------------------------------------------------------------------------*/
static Bool lex_fatal;
/* True: lexer encountered fatal error.
*/
static svalue_t *inc_list;
/* An array of pathnames to search for <>-include files.
* This is a pointer to the vector.item[] held in the driver_hook[]
* array.
*/
static size_t inc_list_size;
/* The number of names in <inc_list>.
*/
static mp_int inc_list_maxlen;
/* The lenght of the longest name in <inc_list>.
*/
static int nexpands;
/* Number of macro expansions on this line so far.
*/
static char yytext[MAXLINE];
/* Temporary buffer used to collect data.
*/
/*-------------------------------------------------------------------------*/
static ident_t *ident_table[ITABLE_SIZE];
/* The lexer stores all encountered identifiers in a hashtable of struct
* idents. The table follows the usual structure: the index (hash value)
* is computed from the name of the identifier, the indexed table element
* the points to the head of a chain of different identifier values with
* identical hash. The most recently used identifier is always moved to
* the head of the chain.
*
* The table is used to store all identifiers and their value: starting
* from efun names and reserved words (like 'while') over preprocessor
* macros to 'normal' lfun and variable names. The identifiers are
* distinguished by the .type field in the ident structure. Should one
* identifier used with several different types at the same time, one entry
* is generated for each type, and they are all linked together by their
* .inferior pointers into a list ordered by falling type value. The entry
* with the highest type value is the one put into the hashtable's chain.
*/
#if ITABLE_SIZE == 256
# define identhash(s) chashstr((s), 12)
#else
# define identhash(s) (whashstr((s), 12) % ITABLE_SIZE)
#endif
/* Hash an identifier name (c-string) into a table index.
*/
/* In addition to this, the lexer keeps two lists for all efuns and
* preprocessor defines: all_efuns and all_defines. These are linked
* together with the .next_all field in the ident structure.
*/
ident_t *all_efuns = NULL;
/* The list of efuns. */
static ident_t *all_defines = NULL;
/* The list of all non-permanent macro defines.
* Entries with a NULL .name are undefined macros.
*/
static ident_t *permanent_defines = NULL;
/* The list of all permanent macro defines. */
static ident_t *undefined_permanent_defines = NULL;
/* 'Parking list' for permanent defines which have been #undef'ined.
* After the compilation is complete, they will be put back into
* the ident_table.
*/
#ifndef USE_NEW_INLINES
/*-------------------------------------------------------------------------*/
struct inline_fun * first_inline_fun = NULL;
/* Linked list of the saved function text for inline functions.
*/
Bool insert_inline_fun_now = MY_FALSE;
/* This is TRUE when we are at a suitable point to insert the
* saved inline functions. Usually this is at the end of a function,
* or after a global variable definition.
*/
unsigned int next_inline_fun = 0;
/* The running count of inline functions, used to 'name' the next
* function to generate.
*/
#endif /* USE_NEW_INLINES */
/*-------------------------------------------------------------------------*/
/* The stack to handle nested #if...#else...#endif constructs.
*/
typedef struct lpc_ifstate_s
{
struct lpc_ifstate_s *next;
int state; /* which token to expect */
} lpc_ifstate_t;
/* lpc_ifstate_t.state values: */
#define EXPECT_ELSE 1
#define EXPECT_ENDIF 2
static lpc_ifstate_t *iftop = NULL;
/*-------------------------------------------------------------------------*/
/* The stack to save important state information when handling
* nested includes.
*/
static struct incstate
{
struct incstate * next;
source_t yyin; /* The current input source */
source_loc_t loc; /* Current source location */
ptrdiff_t linebufoffset; /* Position of linebufstart */
mp_uint inc_offset; /* Handle returned by store_include_info() */
char saved_char;
} *inctop = NULL;
/*-------------------------------------------------------------------------*/
/* Translation table of reserved words into the lexcodes assigned by yacc
* in lang.h.
*/
struct s_reswords
{
char *name; /* The reserved word */
int code; /* The assigned code */
};
static struct s_reswords reswords[]
= { { "break", L_BREAK }
, { "case", L_CASE }
, { "catch", L_CATCH }
, { "closure", L_CLOSURE_DECL }
, { "continue", L_CONTINUE }
, { "default", L_DEFAULT }
, { "do", L_DO }
, { "else", L_ELSE }
, { "float", L_FLOAT_DECL }
, { "for", L_FOR }
, { "foreach", L_FOREACH }
#ifdef USE_NEW_INLINES
, { "function", L_FUNC }
#endif
, { "if", L_IF }
#ifdef L_IN
, { "in", L_IN }
#endif
, { "inherit", L_INHERIT }
, { "int", L_INT }
, { "mapping", L_MAPPING }
, { "mixed", L_MIXED }
, { "nomask", L_NO_MASK }
, { "nosave", L_NOSAVE }
, { "object", L_OBJECT }
#ifdef USE_PARSE_COMMAND
, { "parse_command", L_PARSE_COMMAND }
#endif
, { "private", L_PRIVATE }
, { "protected", L_PROTECTED }
, { "public", L_PUBLIC }
, { "return", L_RETURN }
, { "sscanf", L_SSCANF }
, { "static", L_STATIC }
, { "status", L_STATUS }
#ifdef USE_STRUCTS
, { "struct", L_STRUCT }
#endif
, { "string", L_STRING_DECL }
, { "switch", L_SWITCH }
, { "symbol", L_SYMBOL_DECL }
, { "varargs", L_VARARGS }
, { "virtual", L_VIRTUAL }
, { "void", L_VOID }
, { "while", L_WHILE }
};
/*-------------------------------------------------------------------------*/
/* The definitions and tables for the preprocessor expression evaluator.
*/
#define BNOT 1 /* Unary operator opcodes*/
#define LNOT 2
#define UMINUS 3
#define UPLUS 4
#define MULT 1 /* Binary operator opcodes */
#define DIV 2
#define MOD 3
#define BPLUS 4
#define BMINUS 5
#define LSHIFT 6
#define RSHIFT 7
#define LESS 8
#define LEQ 9
#define GREAT 10
#define GEQ 11
#define EQ 12
#define NEQ 13
#define BAND 14
#define XOR 15
#define BOR 16
#define LAND 17
#define LOR 18
#define QMARK 19
/* lookup table for initial operator characters.
* The table covers the characters [' '..'~'].
* 0 for no operator, else index into optab2.
*/
static char _optab[]
= {0,6,0,0,0,46,50,0,0,0,2,18,0,14,0,10,0,0,0,0,0,0,0,0,0,0,0,0,22,42,32,68,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,64,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,57,0,1
};
/* Lookup table for the complete operator data in a serial format.
*
* optab2[index-1] : operation code for unary operator, 0 for none.
* optab2[index+0 .. +3 .. +6 ...] :
* two character binary operators: second character, operation code, prio
* one character binary operator & end: 0, operation code, prio
* end: 0, 0
*
* Note that some entries overlap.
*/
static char optab2[]
= { BNOT, 0 /* 1: ~ */
, 0, MULT, 11 /* 2: * */
, LNOT, '=', NEQ, 7 /* 6: !, != */
, 0, 0, DIV, 11 /* 10: / */
, UMINUS, 0, BMINUS, 10 /* 14: -x, x-y */
, UPLUS, 0, BPLUS, 10 /* 18: +x, x+y */
, 0, '<', LSHIFT, 9, '=', LEQ, 8, 0, LESS, 8
/* 22: <<, <=, < */
, 0, '>', RSHIFT, 9, '=', GEQ, 8, 0, GREAT, 8
/* 32: >>, >=, > */
, 0, '=', EQ, 7 /* 42: == */
, 0, 0, MOD, 11 /* 46: % */
, 0, '&', LAND, 3, 0, BAND, 6 /* 50: &&, & */
, 0, '|', LOR, 2, 0, BOR, 4 /* 57: ||, | */
, 0, 0, XOR, 5 /* 64: ^ */
, 0, 0, QMARK, 1 /* 68: ? */
};
#define optab1(c) (_optab[(c)-' '])
/* Use optab1 to index _optab with raw characters.
*/
/*-------------------------------------------------------------------------*/
/* A handy macro to statically determine the number of
* elements in an array.
*/
#define NELEM(a) (sizeof (a) / sizeof (a)[0])
/* Save the character in variable 'c' in the yytext buffer, if
* there is enough space left.
*/
#define SAVEC \
if (yyp < yytext+MAXLINE-5)\
*yyp++ = (char)c;\
else {\
lexerror("Line too long");\
break;\
}
/* The magic character used for function macros to mark the places
* in the replacement text where the macro arguments are to be
* inserted.
* The marking sequence for argument n is { '@', '@'+n+1 }, and
* the character '@' itself is stored as { '@', '@' }.
*/
#define MARKS '@'
/*-------------------------------------------------------------------------*/
/* Forward declarations */
static INLINE int number(long);
static INLINE int string(char *, size_t);
static void handle_define(char *, Bool);
static void add_define(char *, short, char *, source_loc_t);
static void add_permanent_define(char *, short, void *, Bool);
static Bool expand_define(void);
static Bool _expand_define(struct defn*, ident_t*);
static INLINE void myungetc(char);
static int cond_get_exp(int, svalue_t *);
static int exgetc(void);
static char *get_current_file(char **);
static char *get_current_line(char **);
static char *get_version(char **);
static char *get_hostname(char **);
static char *get_domainname(char **);
static char *get_current_dir(char **);
static char *get_sub_path(char **);
static char *efun_defined(char **);
static void lexerrorf VARPROT((char *, ...), printf, 1, 2);
static void lexerror(char *);
static ident_t *lookup_define(char *);
/*-------------------------------------------------------------------------*/
#include "efun_defs.c"
/* struct instr instrs[] = { ... };
*
* Information about all instructions and efuns, generated by make_func.
* Also included are the table for our own ctype functions.
*
* The numbers of arguments are used by the compiler.
* If min == max, then no information has to be coded about the
* actual number of arguments. Otherwise, the actual number of arguments
* will be stored in the byte after the instruction.
* A maximum value of -1 means unlimited maximum value.
*
* If an argument has type 0 (T_INVALID) specified, then no checks will
* be done at run time.
*
* The argument types are checked by the compiler if type checking is enabled,
* and always at runtime.
*/
/*-------------------------------------------------------------------------*/
void
init_lexer(void)
/* Initialize the various lexer tables, including the predefined macros
* from the commandline given in lpc_predefs.
* The lpc_predefs list is deallocated by this call.
*/
{
size_t i, n;
char mtext[MLEN];
/* Allocate enough memory for 20 nested includes/ifs */
lexpool = new_lifopool(size_lifopool( sizeof(lpc_ifstate_t)
+sizeof(struct incstate)));
if (!lexpool)
fatal("Out of memory.\n");
current_loc.file = NULL;
current_loc.line = 0;
/* Clear the table of identifiers */
for (i = 0; i < ITABLE_SIZE; i++)
ident_table[i] = NULL;
/* For every efun, create a global entry in ident_table[] */
for (n = 0; n < NELEM(instrs); n++)
{
ident_t *p;
#if defined(AMIGA) && defined(_DCC) && defined(DICE30)
if (n >= NELEM(instrs)-1)
continue;
#endif
if (instrs[n].Default == -1)
continue;
/* In !compat mode, skip certain efuns */
if (!compat_mode
&& ( !strcmp(instrs[n].name, "creator")
#ifdef USE_DEPRECATED
|| n == F_TRANSFER
#endif /* USE_DEPRECATED */
)
)
continue;
p = make_shared_identifier(instrs[n].name, I_TYPE_GLOBAL, 0);
if (!p)
fatal("Out of memory\n");
if (p->type != I_TYPE_UNKNOWN)
{
fatal("Duplicate efun '%s'.\n", instrs[n].name);
/* NOTREACHED */
continue;
}
init_global_identifier(p, /* bVariable: */ MY_FALSE);
p->u.global.efun = (short)n;
p->next_all = all_efuns;
all_efuns = p;
}
/* For every reserved word, create a global entry in ident_table[] */
for (i = 0; i < NELEM(reswords); i++)
{
ident_t *p;
#if defined(AMIGA) && defined(_DCC) && defined(DICE30)
if (i >= NELEM(reswords)-1)
continue;
#endif
p = make_shared_identifier(reswords[i].name, I_TYPE_RESWORD, 0);
if (!p)
fatal("Out of memory\n");
p->type = I_TYPE_RESWORD;
p->u.code = reswords[i].code;
}
/* Add the standard permanent macro definitions */
/* TODO: Make the strings tabled */
add_permanent_define("LPC3", -1, string_copy(""), MY_FALSE);
add_permanent_define("__" PROGNAME "__", -1, string_copy(""), MY_FALSE);
add_permanent_define("__LDMUD__", -1, string_copy(""), MY_FALSE);
if (compat_mode)
{
add_permanent_define("COMPAT_FLAG", -1, string_copy(""), MY_FALSE);
add_permanent_define("__COMPAT_MODE__", -1, string_copy(""), MY_FALSE);
}
add_permanent_define("__EUIDS__", -1, string_copy(""), MY_FALSE);
if (allow_filename_spaces)
add_permanent_define("__FILENAME_SPACES__", -1, string_copy(""), MY_FALSE);
if (strict_euids)
add_permanent_define("__STRICT_EUIDS__", -1, string_copy(""), MY_FALSE);
if (compat_mode)
{
mtext[0] = '"';
strcpy(mtext+1, master_name);
strcat(mtext+1, "\"");
}
else
{
mtext[0] = '"';
mtext[1] = '/';
strcpy(mtext+2, master_name);
strcat(mtext+2, "\"");
}
add_permanent_define("__MASTER_OBJECT__", -1, string_copy(mtext), MY_FALSE);
add_permanent_define("__FILE__", -1, (void *)get_current_file, MY_TRUE);
add_permanent_define("__DIR__", -1, (void *)get_current_dir, MY_TRUE);
add_permanent_define("__PATH__", 1, (void *)get_sub_path, MY_TRUE);
add_permanent_define("__LINE__", -1, (void *)get_current_line, MY_TRUE);
add_permanent_define("__VERSION__", -1, (void *)get_version, MY_TRUE);
add_permanent_define("__VERSION_MAJOR__", -1, string_copy(VERSION_MAJOR), MY_FALSE);
add_permanent_define("__VERSION_MINOR__", -1, string_copy(VERSION_MINOR), MY_FALSE);
add_permanent_define("__VERSION_MICRO__", -1, string_copy(VERSION_MICRO), MY_FALSE);
add_permanent_define("__VERSION_PATCH__", -1, string_copy("0"), MY_FALSE);
add_permanent_define("__HOST_NAME__", -1, (void *)get_hostname, MY_TRUE);
add_permanent_define("__DOMAIN_NAME__", -1, (void *)get_domainname, MY_TRUE);
add_permanent_define("__HOST_IP_NUMBER__", -1
, (void*)get_host_ip_number, MY_TRUE);
sprintf(mtext, "%d", MAX_USER_TRACE);
add_permanent_define("__MAX_RECURSION__", -1, string_copy(mtext), MY_FALSE);
add_permanent_define("__EFUN_DEFINED__", 1, (void *)efun_defined, MY_TRUE);
#ifdef ERQ_DEMON
sprintf(mtext, "%d", ERQ_MAX_SEND);
add_permanent_define("__ERQ_MAX_SEND__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%d", ERQ_MAX_REPLY);
add_permanent_define("__ERQ_MAX_REPLY__", -1, string_copy(mtext), MY_FALSE);
#endif
sprintf(mtext, "%"PRIdMPINT, max_malloced);
add_permanent_define("__MAX_MALLOC__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%"PRId32, def_eval_cost);
add_permanent_define("__MAX_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", (long)CATCH_RESERVED_COST);
add_permanent_define("__CATCH_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", (long)MASTER_RESERVED_COST);
add_permanent_define("__MASTER_EVAL_COST__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", time_to_reset);
add_permanent_define("__RESET_TIME__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", time_to_cleanup);
add_permanent_define("__CLEANUP_TIME__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", alarm_time);
add_permanent_define("__ALARM_TIME__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%ld", heart_beat_interval);
add_permanent_define("__HEART_BEAT_INTERVAL__", -1, string_copy(mtext), MY_FALSE);
if (synch_heart_beats)
add_permanent_define("__SYNCHRONOUS_HEART_BEAT__", -1, string_copy("1"), MY_FALSE);
#ifdef EVAL_COST_TRACE
add_permanent_define("__EVAL_COST_TRACE__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef MSDOS_FS
add_permanent_define("__MSDOS_FS__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef HAS_IDN
add_permanent_define("__IDNA__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_IPV6
add_permanent_define("__IPV6__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_MCCP
add_permanent_define("__MCCP__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_MYSQL
add_permanent_define("__MYSQL__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_PGSQL
add_permanent_define("__PGSQL__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_SQLITE
add_permanent_define("__SQLITE__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_IKSEMEL
add_permanent_define("__XML_DOM__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_EXPAT
add_permanent_define("__EXPAT__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_SRV
/* in fact SRV should always be the default,
* so we only handle the no-srv case
add_permanent_define("__SRV__", -1, string_copy("1"), MY_FALSE);
*/
#else
add_permanent_define("__NO_SRV__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_ALISTS
add_permanent_define("__ALISTS__", -1, string_copy("1"), MY_FALSE);
#endif
add_permanent_define("__PCRE__", -1, string_copy("1"), MY_FALSE);
add_permanent_define("__LPC_NOSAVE__", -1, string_copy("1"), MY_FALSE);
#ifdef USE_DEPRECATED
add_permanent_define("__DEPRECATED__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_STRUCTS
add_permanent_define("__LPC_STRUCTS__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_NEW_INLINES
add_permanent_define("__LPC_INLINE_CLOSURES__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_ARRAY_CALLS
add_permanent_define("__LPC_ARRAY_CALLS__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_PTHREADS
add_permanent_define("__PTHREADS__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef USE_TLS
add_permanent_define("__TLS__", -1, string_copy("1"), MY_FALSE);
#ifdef HAS_GNUTLS
add_permanent_define("__GNUTLS__", -1, string_copy("1"), MY_FALSE);
#endif
#ifdef HAS_OPENSSL
add_permanent_define("__OPENSSL__", -1, string_copy("1"), MY_FALSE);
#endif
#endif
if (wizlist_name[0] != '\0')
{
if (compat_mode)
{
mtext[0] = '"';
strcpy(mtext+1, wizlist_name);
strcat(mtext+1, "\"");
}
else
{
mtext[0] = '"';
mtext[1] = '/';
strcpy(mtext+2, wizlist_name);
strcat(mtext+2, "\"");
}
add_permanent_define("__WIZLIST__", -1, string_copy(mtext), MY_FALSE);
}
sprintf(mtext, "(%"PRIdPINT")", PINT_MAX);
add_permanent_define("__INT_MAX__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "(%"PRIdPINT")", PINT_MIN);
add_permanent_define("__INT_MIN__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "(%g)", DBL_MAX);
add_permanent_define("__FLOAT_MAX__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "(%g)", DBL_MIN);
add_permanent_define("__FLOAT_MIN__", -1, string_copy(mtext), MY_FALSE);
sprintf(mtext, "%"PRIdMPINT, get_current_time());
add_permanent_define("__BOOT_TIME__", -1, string_copy(mtext), MY_FALSE);
/* Add the permanent macro definitions given on the commandline */
while (NULL != lpc_predefs)
{
char namebuf[NSIZE];
struct lpc_predef_s *tmpf;
tmpf = lpc_predefs;
lpc_predefs = lpc_predefs->next;
*mtext = '\0';
sscanf(tmpf->flag, "%[^=]=%[ -~=]", namebuf, mtext);
if ( strlen(namebuf) >= NSIZE )
fatal("-D%s: macroname too long (>%d)\n", tmpf->flag, NSIZE);
if ( strlen(mtext) >= MLEN )
fatal("-D%s: macrotext too long (>%d)\n", tmpf->flag, MLEN);
add_permanent_define(namebuf, -1, string_copy(mtext), MY_FALSE);
xfree(tmpf->flag);
xfree(tmpf);
}
} /* init_lexer() */
/*-------------------------------------------------------------------------*/
int
symbol_operator (const char *symbol, const char **endp)
/* Analyse the text starting at <symbol> (which points to the first character
* after the assumed "#'") if it describes a closure symbol. If yes, return
* the operator code and set *<endp> to the first character after the
* recognized operator.
* If no operator can be recognized, return -1 and set *<endp> to <symbol>.
*
* The function is called from ed.c and from symbol_efun().
*
* Recognized are the following operators:
*
* #'+= -> F_ADD_EQ
* #'++ -> F_POST_INC
* #'+ -> F_ADD
* #'-= -> F_SUB_EQ
* #'-- -> F_POST_DEC
* #'- -> F_SUBTRACT
* #'*= -> F_MULT_EQ
* #'* -> F_MULTIPLY
* #'/= -> F_DIV_EQ
* #'/ -> F_DIVIDE
* #'%= -> F_MOD_EQ
* #'% -> F_MOD
* #', -> F_POP_VALUE
* #'^= -> F_XOR_EQ
* #'^ -> F_XOR
* #'|| -> F_LOR
* #'||= -> F_LOR_EQ
* #'|= -> F_OR_EQ
* #'| -> F_OR
* #'&& -> F_LAND
* #'&&= -> F_LAND_EQ
* #'&= -> F_AND_EQ
* #'& -> F_AND
* #'~ -> F_COMPL
* #'<= -> F_LE
* #'<<= -> F_LSH_EQ
* #'<< -> F_LSH
* #'< -> F_LT
* #'>= -> F_GE
* #'>>= -> F_RSH_EQ
* #'>>>= -> F_RSHL_EQ
* #'>>> -> F_RSHL
* #'>> -> F_RSH
* #'> -> F_GT
* #'== -> F_EQ
* #'= -> F_ASSIGN
* #'!= -> F_NE
* #'! -> F_NOT
* #'?! -> F_BRANCH_WHEN_NON_ZERO
* #'? -> F_BRANCH_WHEN_ZERO
* #'[..] -> F_RANGE
* #'[..<] -> F_NR_RANGE
* #'[<..] -> F_RN_RANGE
* #'[<..<] -> F_RR_RANGE
* #'[..>] -> F_NA_RANGE
* #'[>..] -> F_AN_RANGE
* #'[<..>] -> F_RA_RANGE
* #'[>..<] -> F_AR_RANGE
* #'[>..>] -> F_AA_RANGE
* #'[.. -> F_NX_RANGE
* #'[<.. -> F_RX_RANGE
* #'[>.. -> F_AX_RANGE
* #'[,] -> F_MAP_INDEX
* #'[ -> F_INDEX
* #'[< -> F_RINDEX
* #'[> -> F_AINDEX
* #'({ -> F_AGGREGATE
* #'([ -> F_M_CAGGREGATE
#ifdef USE_STRUCTS
* #'-> -> F_S_INDEX
* #'(< -> F_S_AGGREGATE
#endif
*
* Note that all operators must have a instrs[].Default value of '0'.
* If necessary, update the lex::init_lexer()::binary_operators[] to
* include the operator values.
*/
{
char c;
int ret;
switch(*symbol)
{
case '+':
c = symbol[1];
if (c == '=')
{
symbol++;
ret = F_ADD_EQ;
break;
}
else if (c == '+')
{
symbol++;
ret = F_POST_INC;
break;
}
ret = F_ADD;
break;
case '-':
c = symbol[1];
if (c == '=')
{
symbol++;
ret = F_SUB_EQ;
break;
}
else if (c == '-')
{
symbol++;
ret = F_POST_DEC;
break;
}
#ifdef USE_STRUCTS
else if (c == '>')
{
symbol++;
ret = F_S_INDEX;
break;
}
#endif /* USE_STRUCTS */
ret = F_SUBTRACT;
break;
case '*':
if (symbol[1] == '=')
{
symbol++;
ret = F_MULT_EQ;
break;
}
ret = F_MULTIPLY;
break;
case '/':
if (symbol[1] == '=')
{
symbol++;
ret = F_DIV_EQ;
break;
}
ret = F_DIVIDE;
break;
case '%':
if (symbol[1] == '=')
{
symbol++;
ret = F_MOD_EQ;
break;
}
ret = F_MOD;
break;
case ',':
ret = F_POP_VALUE;
break;
case '^':
if (symbol[1] == '=')
{
symbol++;
ret = F_XOR_EQ;
break;
}
ret = F_XOR;
break;
case '|':
c = *++symbol;
if (c == '|')
{
if (symbol[1] == '=')
{
symbol++;
ret = F_LOR_EQ;
}
else
ret = F_LOR;
break;
}
else if (c == '=')
{
ret = F_OR_EQ;
break;
}
symbol--;
ret = F_OR;
break;
case '&':
c = *++symbol;
if (c == '&')
{
if (symbol[1] == '=')
{
symbol++;
ret = F_LAND_EQ;
}
else
ret = F_LAND;
break;
}
else if (c == '=')
{
ret = F_AND_EQ;
break;
}
symbol--;
ret = F_AND;
break;
case '~':
ret = F_COMPL;
break;
case '<':
c = *++symbol;
if (c == '=')
{
ret = F_LE;
break;
}
else if (c == '<')
{
if (symbol[1] == '=')
{
symbol++;
ret = F_LSH_EQ;
break;
}
ret = F_LSH;
break;
}
symbol--;
ret = F_LT;
break;
case '>':
c = *++symbol;
if (c == '=')
{
ret = F_GE;
break;
}
else if (c == '>')
{
if (symbol[1] == '=')
{
symbol++;
ret = F_RSH_EQ;
break;
}
if (symbol[1] == '>')
{
symbol++;
if (symbol[1] == '=')
{
symbol++;
ret = F_RSHL_EQ;
break;
}
ret = F_RSHL;
break;
}
ret = F_RSH;
break;
}
symbol--;
ret = F_GT;
break;
case '=':
if (symbol[1] == '=')
{
symbol++;
ret = F_EQ;
break;
}
ret = F_ASSIGN;
break;
case '!':
if (symbol[1] == '=')
{
symbol++;
ret = F_NE;
break;
}
ret = F_NOT;
break;
case '?':
if (symbol[1] == '!')
{
symbol++;
ret = F_BRANCH_WHEN_NON_ZERO;
break;
}
ret = F_BRANCH_WHEN_ZERO;
break;
case '[':
c = *++symbol;
if (c == '<')
{
if (symbol[1] == '.' && symbol[2] == '.')
{
c = *(symbol+=3);
if (c == ']')
{
ret = F_RN_RANGE;
break;
}
else if (c == '>' && symbol[1] == ']')
{
symbol++;
ret = F_RA_RANGE;
break;
}
else if (c == '<' && symbol[1] == ']')
{
symbol++;
ret = F_RR_RANGE;
break;
}
symbol--;
ret = F_RX_RANGE;
break;
}
ret = F_RINDEX;
break;
}
else if (c == '>')
{
if (symbol[1] == '.' && symbol[2] == '.')
{
c = *(symbol+=3);
if (c == ']')
{
ret = F_AN_RANGE;
break;
}
else if (c == '>' && symbol[1] == ']')
{
symbol++;
ret = F_AA_RANGE;
break;
}
else if (c == '<' && symbol[1] == ']')
{
symbol++;
ret = F_AR_RANGE;
break;
}
symbol--;
ret = F_AX_RANGE;
break;
}
ret = F_AINDEX;
break;
}
else if (c == '.' && symbol[1] == '.')
{
c = *(symbol+=2);
if (c == ']') {
ret = F_RANGE;
break;
} else if (c == '>' && symbol[1] == ']') {
symbol++;
ret = F_NA_RANGE;
break;
} else if (c == '<' && symbol[1] == ']') {
symbol++;
ret = F_NR_RANGE;
break;
}
symbol--;
ret = F_NX_RANGE;
break;
}
else if (c == ',' && symbol[1] == ']')
{
symbol++;
ret = F_MAP_INDEX;
break;
}
symbol--;
ret = F_INDEX;
break;
case '(':
c = *++symbol;
if (c == '{')
{
ret = F_AGGREGATE;
break;
}
else if (c == '[')
{
ret = F_M_CAGGREGATE;
break;
}
#ifdef USE_STRUCTS
else if (c == '<')
{
ret = F_S_AGGREGATE;
break;
}
#endif /* USE_STRUCTS */
symbol--;
/* FALL THROUGH */
default:
ret = -1;
symbol--;
break;
}
/* Symbol is not an operator */
*endp = symbol+1;
return ret;
} /* symbol_operator() */
/*-------------------------------------------------------------------------*/
static INLINE int
symbol_resword (ident_t *p)
/* This function implements the resword lookup for closures.
*
* If ident <p> is a reserved word with a closure representation, return
* the corresponding instruction code:
*
* #'if -> F_BRANCH_WHEN_ZERO
* #'do -> F_BBRANCH_WHEN_NON_ZERO
* #'while -> F_BBRANCH_WHEN_ZERO
* #'foreach -> F_FOREACH
* #'continue -> F_BRANCH
* #'default -> F_CSTRING0
* #'switch -> F_SWITCH
* #'break -> F_BREAK
* #'return -> F_RETURN
* #'sscanf -> F_SSCANF
* #'catch -> F_CATCH
*
* If ident <p> is not a reserved word, or a word without closure
* representation, return 0.
*/
{
int code = 0;
if (p->type != I_TYPE_RESWORD)
return 0;
switch(p->u.code)
{
default:
/* Unimplemented reserved word */
code = 0;
break;
case L_IF:
code = F_BRANCH_WHEN_ZERO;
break;
case L_DO:
code = F_BBRANCH_WHEN_NON_ZERO;
break;
case L_WHILE:
/* the politically correct code was already taken, see above. */
code = F_BBRANCH_WHEN_ZERO;
break;
case L_FOREACH:
code = F_FOREACH;
break;
case L_CONTINUE:
code = F_BRANCH;
break;
case L_DEFAULT:
code = F_CSTRING0;
break;
case L_SWITCH:
code = F_SWITCH;
break;
case L_BREAK:
code = F_BREAK;
break;
case L_RETURN:
code = F_RETURN;
break;
case L_SSCANF:
code = F_SSCANF;
break;
#ifdef USE_PARSE_COMMAND
case L_PARSE_COMMAND:
code = F_PARSE_COMMAND;
break;
#endif
case L_CATCH:
code = F_CATCH;
break;
}
return code;
} /* symbol_resword() */
/*-------------------------------------------------------------------------*/
void
symbol_efun_str (const char * str, size_t len, svalue_t *sp, Bool is_efun)
/* This function implements the efun/operator/sefun part of efun
* symbol_function().
*
* It is also called by parse_command to lookup the (simul)efuns find_living()
* and find_player() at runtime, and by restore_svalue().
*
* The function takes the string <str> of length <len> and looks up the named
* efun, sefun or operator. If the efun/operator is found, the value <sp> is
* turned into the proper closure value, otherwise it is set to the numeric
* value 0. If <is_efun> is TRUE, <str> is resolved as an efun even if it
* doesn't contain the 'efun::' prefix.
*
* inter_sp must be set properly before the call.
*
* Accepted symbols are:
*
* #'<operator>: see lex::symbol_operator()
*
* #'if -> F_BRANCH_WHEN_ZERO +CLOSURE_OPERATOR
* #'do -> F_BBRANCH_WHEN_NON_ZERO +CLOSURE_OPERATOR
* #'while -> F_BBRANCH_WHEN_ZERO +CLOSURE_OPERATOR
* #'foreach -> F_FOREACH +CLOSURE_OPERATOR
* #'continue -> F_BRANCH +CLOSURE_OPERATOR
* #'default -> F_CSTRING0 +CLOSURE_OPERATOR
* #'switch -> F_SWITCH +CLOSURE_OPERATOR
* #'break -> F_BREAK +CLOSURE_OPERATOR
* #'return -> F_RETURN +CLOSURE_OPERATOR
* #'sscanf -> F_SSCANF +CLOSURE_OPERATOR
* #'catch -> F_CATCH +CLOSURE_OPERATOR
*
* #'<efun> -> F_<efun> +CLOSURE_EFUN
* #'<sefun> -> <function-index> +CLOSURE_SIMUL_EFUN
*/
{
Bool efun_override = is_efun;
/* If the first character is alphanumeric, the string names a function,
* otherwise an operator.
*/
if (isalunum(*str))
{
/* It is a function or keyword.
*/
ident_t *p;
char *cstr;
/* Take care of an leading efun override */
if ( len >= 6 && !strncmp(str, "efun::", 6) )
{
str += 6;
len -= 6;
efun_override = MY_TRUE;
}
/* Convert the string_t into a C string for local purposes */
cstr = alloca(len+1);
if (!cstr)
{
outofmem(len, "identifier");
}
memcpy(cstr, str, len);
cstr[len] = '\0';
/* Lookup the identifier in the string in the global table
* of identifers.
*/
if ( !(p = make_shared_identifier(cstr, I_TYPE_GLOBAL, 0)) )
{
outofmem(len, "identifier");
}
/* Loop through the possible multiple definitions.
*/
while (p->type > I_TYPE_GLOBAL)
{
/* Is it a reserved word? */
if (p->type == I_TYPE_RESWORD)
{
int code = symbol_resword(p);
if (!code)
{
/* Unimplemented reserved word */
if ( NULL != (p = p->inferior) )
continue;
goto undefined_function;
}
/* Got the reserved word: return the closure value */
sp->type = T_CLOSURE;
sp->x.closure_type = (short)(code + CLOSURE_OPERATOR);
sp->u.ob = ref_object(current_object, "symbol_efun");
return;
}
if ( !(p = p->inferior) )
break; /* Found a valid definition */
}
/* It is a real identifier */
if (!p || p->type < I_TYPE_GLOBAL
|| (( efun_override || p->u.global.sim_efun < 0 )
&& p->u.global.efun < 0)
)
{
/* But it's a (new) local identifier or a non-existing function */
if (p && p->type == I_TYPE_UNKNOWN)
free_shared_identifier(p);
undefined_function:
put_number(sp, 0);
return;
}
/* Attempting to override a 'nomask' simul efun?
* Check it with a privilege violation.
*/
if (efun_override && p->u.global.sim_efun >= 0
&& simul_efunp[p->u.global.sim_efun].flags & TYPE_MOD_NO_MASK)
{
svalue_t *res;
push_ref_string(inter_sp, STR_NOMASK_SIMUL_EFUN);
push_ref_valid_object(inter_sp, current_object, "nomask simul_efun");
push_ref_string(inter_sp, p->name);
res = apply_master(STR_PRIVILEGE, 3);
if (!res || res->type != T_NUMBER || res->u.number < 0)
{
/* Override attempt is fatal */
errorf(
"Privilege violation: nomask simul_efun %s\n",
get_txt(p->name)
);
}
else if (!res->u.number)
{
/* Override attempt not fatal, but rejected nevertheless */
efun_override = MY_FALSE;
}
}
/* Symbol is ok - create the closure value */
sp->type = T_CLOSURE;
if (!efun_override && p->u.global.sim_efun >= 0)
{
/* Handle non-overridden simul efuns */
sp->x.closure_type = (short)(p->u.global.sim_efun + CLOSURE_SIMUL_EFUN);
sp->u.ob = ref_object(current_object, "symbol_efun");
}
else
{
/* Handle efuns (possibly aliased).
* We know that p->u.global.efun >= 0 here.
*/
sp->x.closure_type = (short)(p->u.global.efun + CLOSURE_EFUN);
if (sp->x.closure_type > LAST_INSTRUCTION_CODE + CLOSURE_EFUN)
sp->x.closure_type = (short)(CLOSURE_EFUN +
efun_aliases[
sp->x.closure_type - CLOSURE_EFUN - LAST_INSTRUCTION_CODE - 1]);
sp->u.ob = ref_object(current_object, "symbol_efun");
}
}
else
{
int i;
const char *end;
i = symbol_operator(str, &end);
/* If there was a valid operator with trailing junk, *end, but i >= 0.
* On the other hand, if we passed the empty string, i < 0, but !*end.
* Thus, we have to test for (*end || i < 0) .
*/
if (*end || i < 0)
{
put_number(sp, 0);
return;
}
sp->type = T_CLOSURE;
if (instrs[i].Default == -1) {
sp->x.closure_type = (short)(i + CLOSURE_OPERATOR);
} else {
sp->x.closure_type = (short)(i + CLOSURE_EFUN);
}
sp->u.ob = ref_object(current_object, "symbol_efun");
}
} /* symbol_efun_str() */
/*-------------------------------------------------------------------------*/
void
symbol_efun (string_t *name, svalue_t *sp)
/* This function is a wrapper around symbol_efun_str(), taking a regular
* string <name> as argument.
*/
{
symbol_efun_str(get_txt(name), mstrsize(name), sp, MY_FALSE);
} /* symbol_efun() */
/*-------------------------------------------------------------------------*/
source_file_t *
new_source_file (const char * name, source_loc_t * parent)
/* Create a new source_file structure for file <name>.
*
* If <name> is non-NULL, a new string is allocated and the content of <name>
* is copied. If <name> is NULL, the caller has to set the filename in
* the returned structure.
*
* If <parent> is non-NULL, it denotes the parent file location this source was
* included from.
*
* Result is the new structure, or NULL if out of memory.
*
* Once allocated, the structure can be removed only through the general
* cleanup routined cleanup_source_files().
*/
{
source_file_t * rc;
rc = xalloc(sizeof(*rc));
if (!rc)
return NULL;
if (name)
{
rc->name = string_copy(name);
if (!rc->name)
{
xfree(rc);
return NULL;
}
}
else
rc->name = NULL;
if (parent)
rc->parent = *parent;
else
{
rc->parent.file = NULL;
rc->parent.line = 0;
}
rc->next = src_file_list;
src_file_list = rc;
return rc;
} /* new_source_file() */
/*-------------------------------------------------------------------------*/
static void
cleanup_source_files (void)
/* Deallocate all listed source_file structures.
*/
{
source_file_t * this;
while ((this = src_file_list) != NULL)
{
src_file_list = this->next;
if (this->name)
xfree(this->name);
xfree(this);
}
current_loc.file = NULL;
current_loc.line = 0;
} /* cleanup_source_files() */
/*-------------------------------------------------------------------------*/
void
init_global_identifier (ident_t * ident, Bool bVariable)
/* The (newly created or to be reused) identifier <ident> is set up
* to be a global identifier, with all the .global.* fields set to
* a suitable default. The caller has to fill in the information specifying
* what kind of global this is.
*
* <bVariable> is to be TRUE if the caller intends to use the identifier
* for a (local or global) variable or lfun; and FALSE if it is for a
* efun/sefun.
*
* The function is rather small, but having it here makes it easier to
* guarantee that all fields are set to a proper default.
*/
{
ident->type = I_TYPE_GLOBAL;
ident->u.global.function = I_GLOBAL_FUNCTION_OTHER;
if (bVariable)
ident->u.global.variable = I_GLOBAL_VARIABLE_OTHER;
else
ident->u.global.variable = I_GLOBAL_VARIABLE_FUN;
ident->u.global.efun = I_GLOBAL_EFUN_OTHER;
ident->u.global.sim_efun = I_GLOBAL_SEFUN_OTHER;
#ifdef USE_STRUCTS
ident->u.global.struct_id = I_GLOBAL_STRUCT_NONE;
#endif
} /* init_global_identifier() */
/*-------------------------------------------------------------------------*/
ident_t *
lookfor_shared_identifier (char *s, int n, int depth, Bool bCreate)
/* Aliases: make_shared_identifier(): bCreate passed as MY_TRUE
* find_shared_identifier(): bCreate passed as MY_FALSE
*
* Find and/or add identifier <s> of type <n> to the ident_table, and
* return a pointer to the found/generated struct ident. Local identifiers
* (<n> == I_TYPE_LOCAL) are additionally distinguished by their definition
* <depth>.
*
* If bCreate is FALSE, the function just checks if the given identfier
* exists in the table. The identifier is considered found, if there
* is an entry in the table for this very name, and with a type equal
* or greater than <n>. If <n> is LOCAL and the found identifier is LOCAL
* as well, the identifier is considered found if <depth> is equal or smaller
* than the depth of the found identifier. The result is the pointer to the
* found identifier, or NULL if not found.
*
* If bCreate is TRUE, the identifier is created if not found. If an
* identifier with the same name but a lower type exists in the table,
* it is shifted down: a new entry for this name created and put into the
* table, the original entry is referenced by the .inferior pointer in the
* new entry. The same happens when a new LOCAL of greater depth is
* added to an existing LOCAL of smaller depth. New generated
* entries have their type set to I_TYPE_UNKNOWN regardless of <n>.
* The result is the pointer to the found/new entry, or NULL when out
* of memory.
*/
{
ident_t *curr, *prev;
int h;
string_t *str;
#if defined(LEXDEBUG)
printf("%s lookfor_shared_identifier called: %s\n", time_stamp(), s);
#endif
h = identhash(s); /* the identifiers hash code */
/* look for the identifier in the table */
curr = ident_table[h];
prev = NULL;
while (curr)
{
#if defined(LEXDEBUG)
printf("%s checking %s.\n", time_stamp(), get_txt(curr->name));
#endif
if (!strcmp(get_txt(curr->name), s)) /* found it */
{
#if defined(LEXDEBUG)
printf("%s -> found.\n", time_stamp());
#endif
/* Move the found entry to the head of the chain */
if (prev) /* not at head of chain */
{
prev->next = curr->next;
curr->next = ident_table[h];
ident_table[h] = curr;
}
/* If the found entry is of inferior type, shift it down */
if (n > curr->type
|| ( I_TYPE_LOCAL == curr->type && I_TYPE_LOCAL == n
&& depth > curr->u.local.depth)
)
{
if (bCreate)
{
ident_t *inferior = curr;
#if defined(LEXDEBUG)
printf("%s shifting down inferior.\n", time_stamp());
#endif
curr = xalloc(sizeof *curr);
if ( NULL != curr )
{
curr->name = ref_mstring(inferior->name);
curr->next = inferior->next;
curr->type = I_TYPE_UNKNOWN;
curr->inferior = inferior;
curr->hash = (short)h;
ident_table[h] = curr;
}
}
else
curr = NULL;
}
/* Return the found (or generated) entry */
return curr;
}
prev = curr;
curr = curr->next;
}
if (bCreate)
{
/* Identifier is not in table, so create a new entry */
str = new_tabled(s);
if (!str)
return NULL;
curr = xalloc(sizeof *curr);
if (!curr)
{
free_mstring(str);
return NULL;
}
curr->name = str;
curr->next = ident_table[h];
curr->type = I_TYPE_UNKNOWN;
curr->inferior = NULL;
curr->hash = (short)h;
ident_table[h] = curr;
}
/* else curr is NULL */
return curr;
} /* lookfor_shared_identifier() */
/*-------------------------------------------------------------------------*/
ident_t *
make_global_identifier (char *s, int n)
/* Create an identifier <s> on level I_TYPE_GLOBAL, after searching for it
* using type <n>.
*
* The difference to make_shared_identifier() is that if an identifier for
* this name already exists and is of higher level than I_TYPE_GLOBAL (e.g.
* somebody created a #define for this name), the function will insert
* an appropriate I_TYPE_GLOBAL entry into the inferior list.
*
* Result is the pointer to the identifier, or NULL when out of memory
* (yyerror() is called in that situation, too).
*/
{
ident_t *ip, *q;
ip = make_shared_identifier(s, n, 0);
if (!ip)
{
yyerrorf("Out of memory: identifer '%s'", s);
return NULL;
}
if (ip->type > I_TYPE_GLOBAL)
{
/* Somebody created a #define with this name.
* Back-insert an ident-table entry.
*/
do {
q = ip;
ip = ip->inferior;
} while (ip && ip->type > I_TYPE_GLOBAL);
if (!ip)
{
ip = xalloc(sizeof(ident_t));
if (!ip) {
yyerrorf("Out of memory: identifier (%zu bytes)",
sizeof(ident_t));
return NULL;
}
ip->name = ref_mstring(q->name);
ip->type = I_TYPE_UNKNOWN;
ip->inferior = NULL;
ip->hash = q->hash;
q->inferior = ip;
}
}
return ip;
} /* make_global_identifier() */
/*-------------------------------------------------------------------------*/
static INLINE void
free_identifier (ident_t *p)
/* Deallocate the identifier <p> which must not be in any list or table
* anymore.
* It is a fatal error if it can't be found.
*/
{
free_mstring(p->name);
xfree(p);
} /* free_identifier() */
/*-------------------------------------------------------------------------*/
static INLINE void
unlink_shared_identifier (ident_t *p)
/* Unlink the identifier <p> (which may be an inferior entry ) from the
* identifier table.
* It is a fatal error if it can't be found.
*/
{
ident_t *curr, **q;
int h;
string_t *s;
h = p->hash;
q = &ident_table[h];
curr = *q;
s = p->name;
#if defined(LEXDEBUG)
printf("%s unlinking '%s'\n", time_stamp(), get_txt(s));
fflush(stdout);
#endif
/* Look for the hashed entry with the same name */
while (curr)
{
if (curr->name == s
#ifdef DEBUG
|| mstreq(curr->name, s)
#endif
) /* found matching name */
{
ident_t *first = curr;
/* Search the list of inferiors for entry <p> */
while (curr)
{
if (curr == p) /* this is the right one */
{
/* Remove the entry from the inferior list */
if (first == curr)
{
if (curr->inferior)
{
curr->inferior->next = curr->next;
*q = curr->inferior;
return; /* success */
}
*q = curr->next;
return;
}
*q = curr->inferior;
return; /* success */
}
q = &curr->inferior;
curr = *q;
}
fatal("free_shared_identifier: entry '%s' not found!\n"
, get_txt(p->name));
/* NOTREACHED */
}
q = &curr->next;
curr = *q;
} /* not found */
fatal("free_shared_identifier: name '%s' not found!\n", get_txt(p->name));
/* NOTREACHED */
} /* unlink_shared_identifier() */
/*-------------------------------------------------------------------------*/
void
free_shared_identifier (ident_t *p)
/* Remove the identifier <p> (which may be an inferior entry ) from the
* identifier table.
* It is a fatal error if it can't be found.
*/
{
#if defined(LEXDEBUG)
printf("%s freeing '%s'\n", time_stamp(), get_txt(p->name));
fflush(stdout);
#endif
unlink_shared_identifier(p);
free_identifier(p);
} /* free_shared_identifier() */
/*-------------------------------------------------------------------------*/
static void
realloc_defbuf (void)
/* Increase the size of defbuf[] (unless it would exceed MAX_TOTAL_BUF).
* The old content of defbuf[] is copied to the end of the new buffer.
* outp is corrected to the new position, other pointers into defbuf
* become invalid.
*/
{
char * old_defbuf = defbuf;
size_t old_defbuf_len = defbuf_len;
char * old_outp = outp;
ptrdiff_t outp_off;
if (MAX_TOTAL_BUF <= defbuf_len)
return;
outp_off = &defbuf[defbuf_len] - outp;
/* Double the current size of defbuf, but top off at MAX_TOTAL_BUF. */
if (defbuf_len > (MAX_TOTAL_BUF >> 1) )
{
defbuf_len = MAX_TOTAL_BUF;
} else {
defbuf_len <<= 1;
}
if (comp_flag)
fprintf(stderr, "%s (reallocating defbuf from %zu (%td left) to %lu) "
, time_stamp(), old_defbuf_len, (ptrdiff_t)(old_outp-defbuf)
, defbuf_len);
defbuf = xalloc(defbuf_len);
memcpy(defbuf+defbuf_len-old_defbuf_len, old_defbuf, old_defbuf_len);
xfree(old_defbuf);
outp = &defbuf[defbuf_len] - outp_off;
} /* realloc_defbuf() */
/*-------------------------------------------------------------------------*/
static void
set_input_source (int fd, string_t * str)
/* Set the current input source to <fd>/<str>.
* If <str> is given, it will be referenced.
*/
{
yyin.fd = fd;
yyin.str = str ? ref_mstring(str) : NULL;
yyin.current = 0;
} /* set_input_source() */
/*-------------------------------------------------------------------------*/
static void
close_input_source (void)
/* Close the current input source: a file is closed, a string is deallocated
*/
{
if (yyin.fd != -1) close(yyin.fd); yyin.fd = -1;
if (yyin.str != NULL) free_mstring(yyin.str); yyin.str = NULL;
yyin.current = 0;
} /* close_input_source() */
/*-------------------------------------------------------------------------*/
static /* NO inline */ char *
_myfilbuf (void)
/* Read the next MAXLINE bytes from the input source <yyin> and store
* them in the input-buffer. If there were the beginning of an incomplete
* line left in the buffer, they are copied right before linebufstart.
* The end of the last complete line in the buffer is marked with a '\0'
* sentinel, or, if the file is exhausted, the end of data is marked
* with the CHAR_EOF char.
*
* outp is set to point to the new data (which may be the copied remnants
* from the incomplete line) and also returned as result.
*
* The function must not be called unless all lines in the buffer have
* been processed. This macro */
#define myfilbuf() (*outp?0:_myfilbuf())
/* takes care of that.
*/
{
int i;
char *p;
/* Restore the data clobbered by the old sentinel */
*outp = saved_char;
/* Copy any remnants of an incomplete line before the buffer begin
* and reset outp.
*/
if (linebufend < outp)
fatal("(lex.c) linebufend %p < outp %p\n", linebufend, outp);
if (linebufend - outp)
memcpy(outp-MAXLINE, outp, (size_t)(linebufend - outp));
outp -= MAXLINE;
*(outp-1) = '\n'; /* so an ungetc() gives a sensible result */
/* Read the next block of data */
p = linebufstart; /* == linebufend - MAXLINE */
if (yyin.fd != -1)
i = read(yyin.fd, p, MAXLINE);
else
{
i = mstrsize(yyin.str) - yyin.current;
if (i > MAXLINE)
i = MAXLINE;
memcpy(p, get_txt(yyin.str)+yyin.current, i);
yyin.current += i;
}
if (i < MAXLINE)
{
/* End of file or error: put in the final EOF marker */
if (i < 0)
{
i = 0;
}
p += i;
if (p - outp ? p[-1] != '\n' : current_loc.line == 1)
*p++ = '\n';
*p++ = CHAR_EOF;
return outp;
}
/* Buffer filled: mark the last line with the '\0' sentinel */
p += i;
while (*--p != '\n') NOOP; /* find last newline */
if (p < linebufstart)
{
lexerror("line too long");
*(p = linebufend-1) = '\n';
}
p++;
saved_char = *p;
*p = '\0';
return outp;
} /* _myfilbuf() */
/*-------------------------------------------------------------------------*/
static void
add_input (char *p)
/* Copy the text <p> into defbuf[] right before the current position of
* outp and set outp back to point at the beginning of the new text.
*
* Main use is by the macro expansion routines.
*/
{
size_t l = strlen(p);
#if defined(LEXDEBUG)
if (l > 0)
fprintf(stderr, "%s add '%s'\n", time_stamp(), p);
#endif
if ((ptrdiff_t)l > outp - &defbuf[10])
{
lexerror("Macro expansion buffer overflow");
return;
}
outp -= l;
strncpy(outp, p, l);
}
/*-------------------------------------------------------------------------*/
static INLINE char
mygetc (void)
/* Retrieve the next character from the file input buffer.
*/
{
#if 0
fprintf(stderr, "c='%c' %x, ", *outp, *outp);
#endif
#if defined(LEXDEBUG)
putc(*outp, stderr);
fflush(stderr);
#endif
return *outp++;
}
/*-------------------------------------------------------------------------*/
static INLINE void
myungetc (char c)
/* Store character <c> in the file input buffer so the next mygetc()
* can retrieve it.
*/
{
*--outp = c;
}
/*-------------------------------------------------------------------------*/
static INLINE Bool
gobble (char c)
/* Skip the next character in the input buffer if it is <c> and return true.
* If the next character is not <c>, don't advance in the buffer and
* return false.
*/
{
if (c == mygetc())
return MY_TRUE;
--outp;
return MY_FALSE;
}
/*-------------------------------------------------------------------------*/
static void
lexerrorf (char *format, ...)
/* Generate an lexerror() using printf()-style arguments.
*/
{
va_list va;
char buff[5120];
char fixed_fmt[1000];
format = limit_error_format(fixed_fmt, sizeof(fixed_fmt), format);
va_start(va, format);
vsprintf(buff, format, va);
va_end(va);
lexerror(buff);
} /* lexerrorf() */
/*-------------------------------------------------------------------------*/
static void
lexerror (char *s)
/* The lexer encountered fatal error <s>. Print the error via yyerror()
* and set lex_fatal.
*/
{
yyerror(s);
lex_fatal = MY_TRUE;
}
/*-------------------------------------------------------------------------*/
static Bool
skip_to (char *token, char *atoken)
/* Skip the file linewise until one of the following preprocessor statements
* is encountered:
* #<token> : returns true, outp is set to the following line.
* #<atoken>: returns false, outp is set to the following line.
* #elif : returns false, the statement is rewritten to #if and
* outp is set to point to the '#' in the new statement.
* If an end of file occurs, an error is generated and the function returns
* true after setting outp to the character before the CHAR_EOF.
*
* Nested #if ... #endif blocks are skipped altogether.
*
* <atoken> may be the NULL pointer and is ignored in that case.
*/
{
char *p; /* Local copy of outp */
char *q; /* The start of the preprocessor statement */
char c;
char nl = '\n';
int nest; /* Current nesting depth of #if...#endif blocks */
p = outp;
for (nest = 0; ; ) {
current_loc.line++;
total_lines++;
c = *p++;
if (c == '#')
{
/* Parse the preprocessor statement */
/* Set q to the first non-blank character of the keyword */
while(lexwhite(*p++)) NOOP;
q = --p;
/* Mark the end of the preprocessor keyword with \0 */
while (isalunum(*p++)) NOOP;
c = *--p; /* needed for eventual undos */
*p = '\0';
/* Set p to the first character of the next line */
if (c != nl)
{
while (*++p != nl) NOOP;
}
p++;
/* Evaluate the token at <q> */
if (strcmp(q, "if") == 0
|| strcmp(q, "ifdef") == 0
|| strcmp(q, "ifndef") == 0)
{
nest++;
}
else if (nest > 0)
{
if (strcmp(q, "endif") == 0)
nest--;
}
else
{
if (strcmp(q, token) == 0)
{
*(p-1) = nl;
outp = p;
if (!*p)
{
_myfilbuf();
}
return MY_TRUE;
}
else if (atoken)
{
if (strcmp(q, atoken) == 0)
{
*(p-1) = nl;
outp = p;
if (!*p) {
_myfilbuf();
}
return MY_FALSE;
}
else if (strcmp(q, "elif") == 0)
{
/* Morph the 'elif' into '#if' and reparse it */
current_loc.line--;
total_lines--;
q[0] = nl;
q[1] = '#';
q[4] = c; /* undo the '\0' */
outp = q+1;
return MY_FALSE;
}
}
}
}
else /* not a preprocessor statement */
{
if (c == CHAR_EOF)
{
outp = p - 2;
current_loc.line--;
total_lines--;
lexerror("Unexpected end of file while skipping");
return MY_TRUE;
}
/* Skip the rest of the line */
while (c != nl) c = *p++;
}
/* Read new data from the file if necessary */
if (!*p)
{
outp = p;
p = _myfilbuf();
}
} /* for () */
/* NOTREACHED */
} /* skip_to() */
/*-------------------------------------------------------------------------*/
static void
handle_cond (Bool c)
/* Evaluate the boolean condition <c> of a preprocessor #if statement.
* If necessary, skip to the condition branch to read next, and/or
* push a new state onto the ifstate-stack.
*/
{
lpc_ifstate_t *p;
if (c || skip_to("else", "endif")) {
p = mempool_alloc(lexpool, sizeof(lpc_ifstate_t));
p->next = iftop;
iftop = p;
p->state = c ? EXPECT_ELSE : EXPECT_ENDIF;
}
} /* handle_cond() */
/*-------------------------------------------------------------------------*/
static Bool
start_new_include (int fd, string_t * str
, char * name, char * name_ext, char delim)
/* The lexer is about to read data from an included source (either file
* <fd> or string <str> which will be referenced) - handle setting up the
* include information. <name> is the name of the file to be read, <name_ext>
* is NULL or a string to add to <name> as " (<name_ext>)", <delim> is the
* delimiter ('"', '>' or ')') of the include filename.
*
* Return TRUE on success, FALSE if something failed.
*/
{
struct incstate *is, *ip;
source_file_t * src_file;
size_t namelen;
int inc_depth;
ptrdiff_t linebufoffset;
/* Prepare defbuf for a (nested) include */
linebufoffset = linebufstart - &defbuf[defbuf_len];
if (outp - defbuf < 3*MAXLINE)
{
realloc_defbuf();
/* linebufstart is invalid now */
if (outp - defbuf < 2*MAXLINE)
{
lexerror("Maximum total buffer size exceeded");
return MY_FALSE;
}
}
/* Copy the current state, but don't put it on the stack
* yet in case we run into an error further down.
*/
is = mempool_alloc(lexpool, sizeof(struct incstate));
if (!is) {
lexerror("Out of memory");
return MY_FALSE;
}
src_file = new_source_file(NULL, &current_loc);
if (!src_file)
{
mempool_free(lexpool, is);
lexerror("Out of memory");
return MY_FALSE;
}
is->yyin = yyin;
is->loc = current_loc;
is->linebufoffset = linebufoffset;
is->saved_char = saved_char;
is->next = inctop;
/* Copy the new filename into src_file */
namelen = strlen(name);
if (name_ext != NULL)
namelen += 3 + strlen(name_ext);
src_file->name = xalloc(namelen+1);
if (!src_file->name)
{
mempool_free(lexpool, is);
lexerror("Out of memory");
return MY_FALSE;
}
strcpy(src_file->name, name);
if (name_ext)
{
strcat(src_file->name, " (");
strcat(src_file->name, name_ext);
strcat(src_file->name, ")");
}
/* Now it is save to put the saved state onto the stack*/
inctop = is;
/* Compute the include depth and store the include information */
for (inc_depth = 0, ip = inctop; ip; ip = ip->next)
inc_depth++;
if (name_ext)
inctop->inc_offset = store_include_info(name_ext, src_file->name, delim, inc_depth);
else
inctop->inc_offset = store_include_info(name, src_file->name, delim, inc_depth);
/* Initialise the rest of the lexer state */
current_loc.file = src_file;
current_loc.line = 0;
linebufend = outp - 1; /* allow trailing zero */
linebufstart = linebufend - MAXLINE;
*(outp = linebufend) = '\0';
set_input_source(fd, str);
_myfilbuf();
return MY_TRUE;
} /* start_new_include() */
/*-------------------------------------------------------------------------*/
static void
add_auto_include (const char * obj_file, const char *cur_file, Bool sys_include)
/* A new file <cur_file> was opened while compiling object <object_file>.
* Add the auto-include information if available.
*
* If <cur_file> is NULL, then the <object_file> itself has just been
* opened, otherwise <cur_file> is an included file. In the latter case,
* flag <sys_include> purveys if it was a <>-type include.
*
* The global <current_loc.line> must be valid and will be modified.
*/
{
string_t * auto_include_string = NULL;
if (driver_hook[H_AUTO_INCLUDE].type == T_STRING
&& cur_file == NULL
)
{
auto_include_string = driver_hook[H_AUTO_INCLUDE].u.str;
}
else if (driver_hook[H_AUTO_INCLUDE].type == T_CLOSURE)
{
svalue_t *svp;
/* Setup and call the closure */
push_c_string(inter_sp, obj_file);
if (cur_file != NULL)
{
push_c_string(inter_sp, (char *)cur_file);
push_number(inter_sp, sys_include ? 1 : 0);
}
else
{
push_number(inter_sp, 0);
push_number(inter_sp, 0);
}
svp = secure_apply_lambda(driver_hook+H_AUTO_INCLUDE, 3);
if (svp && svp->type == T_STRING)
{
auto_include_string = svp->u.str;
}
}
if (auto_include_string != NULL)
{
/* The auto include string is handled like a normal include */
if (cur_file != NULL) /* Otherwise we already are at line 1 */
current_loc.line++; /* Make sure to restore to line 1 */
(void)start_new_include(-1, auto_include_string
, current_loc.file->name, "auto include", ')');
if (cur_file == NULL) /* Otherwise #include will increment it */
current_loc.line++; /* Make sure to start at line 1 */
}
} /* add_auto_include() */
/*-------------------------------------------------------------------------*/
static void
merge (char *name, mp_int namelen, char *deststart)
/* Take the given include file <name> of length <namelen>, make it
* a proper absolute pathname and store it into the buffer <deststart>.
* This buffer must be at least INC_OPEN_BUFSIZE bytes big.
* On a failure, return the empty string in *deststart.
*
* If <name> is a relative pathname, it is interpreted to the location
* of <currentfile>. './' and '../' sequences in the name are properly
* resolved (includes from above the mudlib are caught).
*/
{
char *from; /* Next character in <name> to process */
char *dest; /* Destination pointer into <deststart> */
from = name;
/* If <name> is an absolute pathname, skip any leading '/'.
* Else extract the pathpart from <currentfile>, put
* it into the destination buffer and set dest to point after it.
*/
if (*from == '/')
{
/* absolute path */
dest = deststart;
do from++; while (*from == '/');
}
else
{
/* relative path */
char *cp, *dp;
dest = (dp = deststart) - 1;
for (cp = current_loc.file->name; *cp; *dp++ = *cp++)
{
if (*cp == '/')
dest = dp;
}
dest++;
}
/* Make sure the bufferlimits are not overrun. */
if ((dest - deststart) + namelen >= INC_OPEN_BUFSIZE)
{
*deststart = '\0';
return;
}
/* Append the <name> to the buffer starting at <dest>,
* collapsing './' and '../' sequences while doing it.
*/
for (;;)
{
/* <from> now points to the character after the last '/'.
*/
if (*from == '.')
{
if (from[1] == '.' && from[2] == '/')
{
/* '../': remove the pathpart copied last */
if (dest == deststart)
{
/* including from above mudlib is NOT allowed */
*deststart = '\0';
return;
}
for (--dest;;)
{
if (*--dest == '/')
{
dest++;
break;
}
if (dest == deststart)
break;
}
from += 3;
continue;
} else if (from[1] == '/')
{
/* just skip these two characters */
from += 2;
continue;
}
}
/* Copy all characters up to and including the next '/'
* from <name> into the destination buffer.
* Return when at the end of the name.
*/
{
char c;
do {
c = *from++;
*dest++ = c;
if (!c)
return;
} while (c != '/');
while (*from == '/')
from++;
}
} /* for (;;) */
/* NOTREACHED */
} /* merge() */
/*-------------------------------------------------------------------------*/
static int
open_include_file (char *buf, char *name, mp_int namelen, char delim)
/* Open the include file <name> (length <namelen>) and return the file
* descriptor. On failure, generate an error message and return -1.
*
* <buf> is a buffer of size INC_OPEN_BUFSIZE and may be used to
* generate the real filename - <name> is just the name given in the
* #include statement.
*
* <delim> is '"' for #include ""-type includes, and '>' else.
* Relative "-includes are searched relative to the current file.
* <-includes are searched in the path(s) defined by the H_INCLUDE_DIRS
* driver hook.
*/
{
int fd;
int i;
struct stat aStat;
/* First, try to call master->include_file().
* Since simulate::load_object() makes sure that the master has been
* loaded, this test can only fail when the master is compiled.
*/
if (master_ob && !(master_ob->flags & O_DESTRUCTED)
&& (!EVALUATION_TOO_LONG())
)
{
svalue_t *res;
push_c_string(inter_sp, name);
if (!compat_mode)
{
char * filename;
filename = alloca(strlen(current_loc.file->name)+2);
*filename = '/';
strcpy(filename+1, current_loc.file->name);
push_c_string(inter_sp, filename);
}
else
push_c_string(inter_sp, current_loc.file->name);
push_number(inter_sp, (delim == '"') ? 0 : 1);
res = apply_master(STR_INCLUDE_FILE, 3);
if (res && !(res->type == T_NUMBER && !res->u.number))
{
/* We got a result - either a new name or a "reject it"
* value.
*/
char * cp;
if (res->type != T_STRING)
{
yyerrorf("Illegal to include file '%s'.", name);
return -1;
}
if (mstrsize(res->u.str) >= INC_OPEN_BUFSIZE)
{
yyerrorf("Include name '%s' too long.", get_txt(res->u.str));
return -1;
}
for (cp = get_txt(res->u.str); *cp == '/'; cp++) NOOP;
if (!legal_path(cp))
{
yyerrorf("Illegal path '%s'.", get_txt(res->u.str));
return -1;
}
strcpy(buf, cp);
if (!stat(buf, &aStat)
&& S_ISREG(aStat.st_mode)
&& (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
{
FCOUNT_INCL(buf);
return fd;
}
if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
if (errno == ENFILE) lexerror("File table overflow");
#endif
/* If we come here, we fail: file not found */
return -1;
}
}
else if (EVALUATION_TOO_LONG())
{
yyerrorf("Can't call master::%s for '%s': eval cost too big"
, get_txt(STR_INCLUDE_FILE), name);
}
/* The master apply didn't succeed, try the manual handling */
if (delim == '"') /* It's a "-include */
{
/* Merge the <name> with the current filename. */
merge(name, namelen, buf);
/* Test the file and open it */
if (!stat(buf, &aStat)
&& S_ISREG(aStat.st_mode)
&& (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0)
{
FCOUNT_INCL(buf);
return fd;
}
if (errno == EMFILE)
lexerror("File descriptors exhausted");
#ifdef ENFILE
if (errno == ENFILE)
lexerror("File table overflow");
#endif
/* Include not found - fall back onto <> search pattern */
}
/* Handle a '<'-include. */
if (driver_hook[H_INCLUDE_DIRS].type == T_POINTER)
{
char * cp;
/* H_INCLUDE_DIRS is a vector of include directories.
*/
if (namelen + inc_list_maxlen >= INC_OPEN_BUFSIZE)
{
yyerror("Include name too long.");
return -1;
}
for (cp = name; *cp == '/'; cp++) NOOP;
/* The filename must not specifiy parent directories */
if (!check_no_parentdirs(cp))
return -1;
/* Search all include dirs specified.
*/
for (i = 0; (size_t)i < inc_list_size; i++)
{
char * iname;
sprintf(buf, "%s%s", get_txt(inc_list[i].u.str), name);
for (iname = buf; *iname == '/'; iname++) NOOP;
if (!stat(iname, &aStat)
&& S_ISREG(aStat.st_mode)
&& (fd = ixopen(iname, O_RDONLY|O_BINARY)) >= 0 )
{
FCOUNT_INCL(iname);
return fd;
}
if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
if (errno == ENFILE) lexerror("File table overflow");
#endif
}
/* If we come here, the include file was not found */
}
else if (driver_hook[H_INCLUDE_DIRS].type == T_CLOSURE)
{
/* H_INCLUDE_DIRS is a function generating the full
* include file name.
*/
svalue_t *svp;
/* Setup and call the closure */
push_c_string(inter_sp, name);
push_c_string(inter_sp, current_loc.file->name);
if (driver_hook[H_INCLUDE_DIRS].x.closure_type == CLOSURE_LAMBDA)
{
free_object(driver_hook[H_INCLUDE_DIRS].u.lambda->ob, "open_include_file");
driver_hook[H_INCLUDE_DIRS].u.lambda->ob = ref_object(current_object, "open_include_file");
}
svp = secure_apply_lambda(&driver_hook[H_INCLUDE_DIRS], 2);
/* The result must be legal relative pathname */
if (svp && svp->type == T_STRING
&& mstrsize(svp->u.str) < INC_OPEN_BUFSIZE)
{
char * cp;
for (cp = get_txt(svp->u.str); *cp == '/'; cp++) NOOP;
strcpy(buf, cp);
if (legal_path(buf))
{
if (!stat(buf, &aStat)
&& S_ISREG(aStat.st_mode)
&& (fd = ixopen(buf, O_RDONLY|O_BINARY)) >= 0 )
{
FCOUNT_INCL(buf);
return fd;
}
if (errno == EMFILE) lexerror("File descriptors exhausted");
#if ENFILE
if (errno == ENFILE) lexerror("File table overflow");
#endif
}
}
/* If we come here, the include file was not found */
}
/* File not found */
return -1;
} /* open_include_file() */
/*-------------------------------------------------------------------------*/
#ifdef USE_NEW_INLINES
void *
get_include_handle (void)
/* Helper function for inline closures: return the current inctop
* setting so that the compiler can check if a closures spans files.
*/
{
return (void*)inctop;
} /* get_include_handle() */
#endif /* USE_NEW_INLINES */
/*-------------------------------------------------------------------------*/
static INLINE void
handle_include (char *name)
/* Handle an #include statement, <name> points to the first non-blank
* character after the '#include'.
* If the include succeeds, a new incstate is created and pushed
* onto the include stack. Else an error message is generated.
*/
{
char *p;
int fd; /* fd of new include file */
char delim; /* Filename end-delimiter ('"' or '>'). */
char *old_outp; /* Save the original outp */
Bool in_buffer = MY_FALSE; /* True if macro was expanded */
char buf[INC_OPEN_BUFSIZE];
#if 0
if (nbuf) {
lexerror("Internal preprocessor error");
return;
}
#endif
old_outp = outp;
/* If <name> doesn't start with '"' or '<', assume that it
* is a macro. Attempt to expand these macros until <name>
* starts with a proper delimiter.
*/
while (*name != '"' && *name != '<')
{
char c;
ident_t *d;
/* Locate the end of the macro and look it up */
for (p = name; isalunum(*p); p++) NOOP;
c = *p;
*p = '\0';
d = lookup_define(name);
*p = c;
/* Prepare to expand the macro */
if (in_buffer)
{
outp = p;
}
else
{
myungetc('\n');
add_input(p);
in_buffer = MY_TRUE;
}
/* Expand the macro */
if (!d || !_expand_define(&d->u.define, d) ) {
yyerror("Missing leading \" or < in #include");
return;
}
/* Set name to the first non-blank of the expansion */
name = outp;
while (lexwhite(*name))
name++;
}
/* Store the delimiter and set p to the closing delimiter */
delim = (char)((*name++ == '"') ? '"' : '>');
for(p = name; *p && *p != delim; p++) NOOP;
if (!*p) {
yyerror("Missing trailing \" or > in #include");
outp = old_outp;
return;
}
*p = '\0';
/* For "-includes, look for following macros or "<path>"
* fragments on the same line and append these to the <name>.
* The new name is created in the yytext[] buffer (if at all).
*/
if (delim == '"')
{
char *q;
q = p + 1;
for (;;)
{
/* Find the first non-blank character after p */
while(lexwhite(*q))
q++;
if (!*q || *q == '\n')
break;
/* First, try to expand a macros */
while (*q != delim)
{
char *r, c;
ident_t *d;
/* Set r to the first blank after the macro name */
for (r = q; isalunum(*r); r++) NOOP;
/* Lookup the macro */
c = *r;
*r = '\0';
d = lookup_define(q);
*r = c;
/* Prepare to expand the macro */
if (in_buffer)
{
outp = r;
if (name != yytext)
{
if ( (p - name) >= MAXLINE - 1)
{
yyerror("Include name too long.");
outp = old_outp;
return;
}
*p = '\0';
strcpy(yytext, name);
p += yytext - name;
name = yytext;
}
}
else
{
myungetc('\n');
add_input(r);
in_buffer = MY_TRUE;
}
/* Expand the macro */
if (!d || !_expand_define(&d->u.define, d) ) {
yyerror("Missing leading \" in #include");
outp = old_outp;
return;
}
q = outp;
/* Skip the blanks until the next macro/filename */
while (lexwhite(*q))
q++;
}
/* Second, try to parse a string literal */
while (*++q && *q != delim)
{
if ( (p - name) >= MAXLINE - 1)
{
yyerror("Include name too long.");
outp = old_outp;
return;
}
*p++ = *q;
}
if (!*q++) {
yyerror("Missing trailing \" in #include");
outp = old_outp;
return;
}
} /* for (;;) */
} /* if (delim == '"') */
/* p now points to the character after the parsed filename */
outp = old_outp; /* restore outp */
*p = '\0'; /* mark the end of the filename */
/* Open the include file, put the current lexer state onto
* the incstack, and set up for the new file.
*/
if ((fd = open_include_file(buf, name, p - name, delim)) >= 0)
{
if (!start_new_include(fd, NULL, buf, NULL, delim))
return;
add_auto_include(object_file, current_loc.file->name, delim != '"');
}
else
{
yyerrorf("Cannot #include '%s'", name);
}
} /* handle_include() */
/*-------------------------------------------------------------------------*/
static void
skip_comment (void)
/* Skip a block comment (/ * ... * /). The function is entered with outp
* pointing to the first character after the comment introducer, and left
* with outp pointing to the first character after the comment end delimiter.
*/
{
register char c, *p;
p = outp;
for(;;)
{
/* Skip everything until the next '*' */
while((c = *p++) != '*')
{
if (c == '\n') {
store_line_number_info();
nexpands = 0;
if ((c = *p) == CHAR_EOF) {
outp = p - 1;
lexerror("End of file (or 0x01 character) in a comment");
return;
}
current_loc.line++;
if (!c)
{
outp = p;
p = _myfilbuf();
}
}
} /* while (c == '*') */
/* Skip all '*' until we find '/' or something else */
do
{
if ((c = *p++) == '/')
{
outp = p;
return;
}
if (c == '\n') {
store_line_number_info();
nexpands = 0;
if ((c = *p) == CHAR_EOF)
{
outp = p - 1;
lexerror("End of file (or 0x01 character) in a comment");
return;
}
current_loc.line++;
if (!c)
{
outp = p;
p = _myfilbuf();
}
c = '\0'; /* Make sure to terminate the '*' loop */
}
} while(c == '*');
} /* for() */
/* NOTREACHED */
} /* skip_comment() */
/*-------------------------------------------------------------------------*/
static char *
skip_pp_comment (char *p)
/* Skip a '//' line comment. <p> points to the first character after
* the comment introducer, the function returns a pointer to the first
* character after the terminating newline. If the comment is ended
* prematurely by the end of file, the returned pointer will point at the
* EOF character.
* Note that a '\<newline>' lineend does not terminate the comment.
*/
{
char c;
for (;;)
{
c = *p++;
if (CHAR_EOF == c)
{
return p-1;
}
if (c == '\n')
{
store_line_number_info();
current_loc.line++;
if (p[-2] == '\\')
{
if (!*p)
{
outp = p;
p = _myfilbuf();
}
continue;
}
nexpands = 0;
if (!*p)
{
outp = p;
p = _myfilbuf();
}
return p;
}
}
/* NOTREACHED */
} /* skip_pp_comment() */
/*-------------------------------------------------------------------------*/
static void
deltrail (char *sp)
/* Look for the first blank character in the text starting at <sp> and
* set it to '\0'. The function is used to isolate the next word
* in '#' statements.
*/
{
char *p;
p = sp;
if (!*p)
{
lexerror("Illegal # command");
}
else
{
while(*p && !isspace((unsigned char)*p))
p++;
*p = '\0';
}
} /* deltrail() */
/*-------------------------------------------------------------------------*/
static void
handle_pragma (char *str)
/* Handle the pragma <str>. Unknown pragmas are ignored.
* One pragma string can contain multiple actual pragmas, separated
* with comma (and additional spaces).
*/
{
char * base, * next;
#if defined(LEXDEBUG)
printf("%s handle pragma:'%s'\n", time_stamp(), str);
#endif
/* Loop over the pragma(s).
* If valid, base points to the first character of the pragma name,
* or to spaces before it.
*/
for ( base = str, next = NULL
; base != NULL && *base != '\0' && *base != '\r'
; base = next
)
{
size_t namelen;
Bool validPragma;
/* Skip spaces */
base = base + strspn(base, " \t\r");
if ('\0' == *base || '\r' == *base)
break;
/* Find next delimiter, if any, and determine the
* length of the pragma name.
*/
next = strpbrk(base, " \t,\r");
if (NULL == next)
namelen = strlen(base);
else
namelen = next - base;
/* Evaluate the found pragma name */
validPragma = MY_FALSE;
if (namelen == 0)
{
if (master_ob)
{
yywarnf("Empty #pragma");
}
else
{
debug_message("Warning: Empty #pragma"
": file %s, line %d\n"
, current_loc.file->name, current_loc.line);
}
validPragma = MY_TRUE; /* Since we already issued a warning */
}
else if (strncmp(base, "strict_types", namelen) == 0)
{
pragma_strict_types = PRAGMA_STRICT_TYPES;
instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_UNKNOWN;
instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_UNKNOWN;
validPragma = MY_TRUE;
}
else if (strncmp(base, "strong_types", namelen) == 0)
{
pragma_strict_types = PRAGMA_STRONG_TYPES;
instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
validPragma = MY_TRUE;
}
else if (strncmp(base, "weak_types", namelen) == 0)
{
pragma_strict_types = PRAGMA_WEAK_TYPES;
instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
validPragma = MY_TRUE;
}
else if (strncmp(base, "save_types", namelen) == 0)
{
pragma_save_types = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "combine_strings", namelen) == 0)
{
pragma_combine_strings = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_combine_strings", namelen) == 0)
{
pragma_combine_strings = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "verbose_errors", namelen) == 0)
{
pragma_verbose_errors = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_clone", namelen) == 0)
{
pragma_no_clone = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_inherit", namelen) == 0)
{
pragma_no_inherit = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_shadow", namelen) == 0)
{
pragma_no_shadow = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "pedantic", namelen) == 0)
{
pragma_pedantic = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "sloppy", namelen) == 0)
{
pragma_pedantic = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_local_scopes", namelen) == 0)
{
pragma_use_local_scopes = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "local_scopes", namelen) == 0)
{
pragma_use_local_scopes = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "warn_missing_return", namelen) == 0)
{
pragma_warn_missing_return = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_warn_missing_return", namelen) == 0)
{
pragma_warn_missing_return = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "warn_function_inconsistent", namelen) == 0)
{
pragma_check_overloads = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_warn_function_inconsistent", namelen) == 0)
{
pragma_check_overloads = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "warn_deprecated", namelen) == 0)
{
pragma_warn_deprecated = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_warn_deprecated", namelen) == 0)
{
pragma_warn_deprecated = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "range_check", namelen) == 0)
{
pragma_range_check = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_range_check", namelen) == 0)
{
pragma_range_check = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "warn_empty_casts", namelen) == 0)
{
pragma_warn_empty_casts = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "no_warn_empty_casts", namelen) == 0)
{
pragma_warn_empty_casts = MY_FALSE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "share_variables", namelen) == 0)
{
if (variables_defined)
{
yywarnf("Can't use #pragma share_variables after defining "
"variables");
}
else
pragma_share_variables = MY_TRUE;
validPragma = MY_TRUE;
}
else if (strncmp(base, "init_variables", namelen) == 0)
{
if (variables_defined)
{
yywarnf("Can't use #pragma init_variables after defining "
"variables");
}
else
pragma_share_variables = MY_FALSE;
validPragma = MY_TRUE;
}
#if defined( DEBUG ) && defined ( TRACE_CODE )
else if (strncmp(base, "set_code_window", namelen) == 0)
{
set_code_window();
validPragma = MY_TRUE;
}
else if (strncmp(base, "show_code_window", namelen) == 0)
{
show_code_window();
validPragma = MY_TRUE;
}
#endif
/* Advance next to the next scanning position so that the
* for loop increment works.
*/
if (NULL != next)
{
/* Skip spaces */
next = next + strspn(next, " \t\r");
if (',' == *next)
{
/* Skip the one allowed comma.
* We allow the comma to be followed by lineend
*/
next++;
}
else if ('\0' != *next && '\r' != *next)
{
if (master_ob)
{
yywarnf("Missing comma between #pragma options");
}
else
{
debug_message("Warning: Missing comma between #pragma options"
": file %s, line %d\n"
, current_loc.file->name, current_loc.line);
}
}
if ('\0' == *next || '\r' == *next)
{
/* End of string */
next = NULL;
}
/* If next now points to something else but space or a pragma
* name, the next loop iteration will complain about an illegal
* pragma.
*/
}
/* Finally check if the pragma was valid */
if (!validPragma)
{
if (master_ob)
{
/* Calling yywarnf() without a master can cause the game
* to shut down, because yywarnf() eventually tries to call
* a master lfun.
*/
yywarnf("Unknown #pragma '%.*s'", (int)namelen, base);
}
else
{
debug_message("Warning: Unknown #pragma '%.*s': file %s, line %d\n"
, (int)namelen, base, current_loc.file->name, current_loc.line);
}
}
} /* for (base) */
} /* handle_pragma() */
/*-------------------------------------------------------------------------*/
static INLINE int
number (long i)
/* Return a number to yacc: set yylval.number to <i> and return L_NUMBER.
*/
{
#ifdef LEXDEBUG
printf("%s returning number %d.\n", time_stamp(), i);
#endif
yylval.number = i;
return L_NUMBER;
} /* number() */
/*-------------------------------------------------------------------------*/
static INLINE char *
parse_numeric_escape (char * cp, unsigned char * p_char)
/* Parse a character constant in one of the following formats:
* <decimal> (max 3 digits)
* 0o<octal> (max 3 digits)
* 0x<sedecimal> (max 2 digits)
* x<sedecimal> (max 2 digits)
* 0b<binary> (max 8 digits)
*
* with <cp> pointing to the first character. The function parses
* until the first illegal character, but at max the given number of
* digits.
*
* The parsed number is stored in *<p_num>, the function returns the pointer
* to the first character after the number.
* If no valid character constant could be found, NULL is returned.
*/
{
char c;
int num_digits = 3;
unsigned long l;
unsigned long base = 10;
c = *cp++;
if ('0' == c)
{
/* '0' introduces decimal, octal, binary and sedecimal numbers, or it
* can be a float.
*
* Sedecimals are handled in a following if-clause to allow the
* two possible prefixes.
*/
c = *cp++;
switch (c)
{
case 'X': case 'x':
/* Sedecimal number are handled below - here just fall
* through.
*/
NOOP;
break;
case 'b': case 'B':
{
c = *cp++;
num_digits = 8;
base = 2;
break;
}
case 'o': case 'O':
c = *cp++;
base = 8;
num_digits = 3;
break;
default:
c = '0';
cp--;
break;
} /* switch(c) */
} /* if ('0' == c) */
if ( c == 'X' || c == 'x' )
{
if (!leXdigit(*cp))
{
yywarn("Character constant used with no valid digits");
return NULL;
}
/* strtol() gets the sign bit wrong,
* strtoul() isn't portable enough.
* TODO: strtoul should be portable enough today... Re-check if we
* TODO::require C99.
*/
num_digits = 2;
l = 0;
while(leXdigit(c = *cp++) && num_digits-- > 0)
{
if (c > '9')
c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
l <<= 4;
l += c - '0';
}
}
else
{
/* Parse a normal number from here */
l = c - '0';
/* l is unsigned. So any c smaller than '0' will be wrapped into
* positive values and be larger then base as well. Therefore an
* additional comparison of l < 0 is not explicitly needed here. */
if (l > base)
{
yywarn("Character constant used with no valid digits");
return NULL;
}
while (lexdigit(c = *cp++) && c < (char)('0'+base) && --num_digits > 0)
l = l * base + (c - '0');
}
if (l >= 256)
yywarn("Character constant out of range (> 255)");
*p_char = l & 0xff;
return cp-1;
} /* parse_numeric_escape() */
/*-------------------------------------------------------------------------*/
static INLINE char *
parse_number (char * cp, unsigned long * p_num, Bool * p_overflow)
/* Parse a positive integer number in one of the following formats:
* <decimal>
* 0o<octal>
* 0x<sedecimal>
* x<sedecimal>
* 0b<binary>
*
* with <cp> pointing to the first character.
*
* The parsed number is stored in *<p_num>, the function returns the pointer
* to the first character after the number. If the parsed number exceeded
* the numerical limits, *<p_overflow> is set to TRUE, otherwise to FALSE.
*
* The function is also available to the other parts of the driver.
*/
{
char c;
unsigned long l;
unsigned long base = 10;
unsigned long max_shiftable = ULONG_MAX / base;
*p_overflow = MY_FALSE;
c = *cp++;
if ('0' == c)
{
/* '0' introduces decimal, octal, binary and sedecimal numbers, or it
* can be a float.
*
* Sedecimals are handled in a following if-clause to allow the
* two possible prefixes.
*/
c = *cp++;
switch (c)
{
case 'X': case 'x':
/* Sedecimal number are handled below - here just fall
* through.
*/
NOOP;
break;
case 'b': case 'B':
{
l = 0;
max_shiftable = ULONG_MAX / 2;
--cp;
while('0' == (c = *++cp) || '1' == c)
{
*p_overflow = *p_overflow || (l > max_shiftable);
l <<= 1;
l += c - '0';
}
*p_num = *p_overflow ? LONG_MAX : l;
return cp;
}
case 'o': case 'O':
c = '0';
base = 8;
max_shiftable = ULONG_MAX / base;
break;
default:
/* If some non-digit follows, it's just the number 0.
*/
if (!lexdigit(c))
{
*p_num = 0;
return cp-1;
}
break;
} /* switch(c) */
} /* if ('0' == c) */
if ( c == 'X' || c == 'x' )
{
/* strtol() gets the sign bit wrong,
* strtoul() isn't portable enough.
*/
max_shiftable = ULONG_MAX / 16;
l = 0;
--cp;
while(leXdigit(c = *++cp))
{
*p_overflow = *p_overflow || (l > max_shiftable);
if (c > '9')
c = (char)((c & 0xf) + ( '9' + 1 - ('a' & 0xf) ));
l <<= 4;
l += c - '0';
}
*p_num = *p_overflow ? LONG_MAX : l;
return cp;
}
/* Parse a normal number from here */
max_shiftable = ULONG_MAX / base;
l = c - '0';
while (lexdigit(c = *cp++) && c < (char)('0'+base))
{
*p_overflow = *p_overflow || (l > max_shiftable);
l = l * base + (c - '0');
}
*p_num = *p_overflow ? LONG_MAX : l;
return cp-1;
} /* parse_number() */
/*-------------------------------------------------------------------------*/
char *
lex_parse_number (char * cp, unsigned long * p_num, Bool * p_overflow)
/* Parse a positive integer number in one of the following formats:
* <decimal>
* 0o<octal>
* 0x<sedecimal>
* 0b<binary>
*
* with <cp> pointing to the first character.
*
* The parsed number is stored in *<p_num>, the function returns the pointer
* to the first character after the number. If the parsed number exceeded
* the numerical limits, *<p_overflow> is set to TRUE, otherwise to FALSE.
*
* If the string is not a number, p_num will be unchanged, and cp will
* be returned.
*/
{
char c = *cp;
*p_overflow = MY_FALSE;
if (isdigit(c))
{
cp = parse_number(cp, p_num, p_overflow);
}
return cp;
} /* lex_parse_number() */
/*-------------------------------------------------------------------------*/
static INLINE char *
parse_escaped_char (char * cp, char * p_char)
/* Parse the sequence for an escaped character:
*
* \a : Bell (0x07)
* \b : Backspace (0x08)
* \e : Escape (0x1b)
* \f : Formfeed (0x0c)
* \n : Newline (0x0a)
* \r : Carriage-Return (0x0d)
* \t : Tab (0x09)
* \<decimal>, \0o<octal>, \x<sedecimal>, \0x<sedecimal>, \0b<binary>:
* the character with the given code.
* \<other printable character> : the printable character
*
* with <cp> pointing to the character after the '\'.
*
* The parsed character is stored in *<p_char>, the function returns the
* pointer to the first character after the sequence.
*
* If the sequence is not one of the recognized sequences, NULL is returned.
*/
{
char c;
switch (c = *cp++)
{
case '\n':
case CHAR_EOF:
return NULL; break;
case 'a': c = '\007'; break;
case 'b': c = '\b'; break;
case 'e': c = '\033'; break;
case 'f': c = '\014'; break;
case 'n': c = '\n'; break;
case 'r': c = '\r'; break;
case 't': c = '\t'; break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
case 'x': case 'X':
{
char * cp2;
/* If no valid escaped character is found, treat the sequence
* as a normal escaped character.
*/
cp2 = parse_numeric_escape(cp-1, (unsigned char *)&c);
if (cp2 != NULL)
cp = cp2;
}
} /* switch() */
*p_char = c;
return cp;
} /* parse_escaped_char() */
/*-------------------------------------------------------------------------*/
static void
add_lex_string (char *str, size_t slen)
/* Add <str> with length <slen> to the global <last_lex_string> in order
* to implement Standard-C style string concatenation.
*/
{
size_t len1;
string_t *new;
len1 = mstrsize(last_lex_string);
if (len1+slen > MAX_ANSI_CONCAT)
{
/* Without this test, compilation would still terminate eventually,
* thus it would still be 'correct', but it could take several hours.
*/
lexerror("Too long ansi style string concatenation");
/* leave the old string, ignore the new addition */
return;
}
new = mstr_add_txt(last_lex_string, str, slen);
if (!new)
{
lexerrorf("Out of memory for string concatenation (%zu bytes)",
len1+slen);
}
free_mstring(last_lex_string);
last_lex_string = make_tabled(new);
} /* add_lex_string() */
/*-------------------------------------------------------------------------*/
static INLINE int
string (char *str, size_t slen)
/* Return a string to yacc: set last_lex_string to <str> of length <slen>
* and return L_STRING.
* If there is a string in last_lex_string already, <str> is appended
* and yylex() is called recursively to allow ANSI string concatenation.
*/
{
if (last_lex_string)
{
add_lex_string(str, slen);
return yylex();
}
else
{
last_lex_string = new_n_tabled(str, slen);
if (!last_lex_string)
{
lexerrorf("Out of memory for string literal (%zu bytes)",
slen);
}
}
return L_STRING;
} /* string() */
/*-------------------------------------------------------------------------*/
static INLINE int
closure (char *in_yyp)
/* The lexer has found a closure token (#'...), with <in_yyp> pointing
* to the quote. Parse the token into yylval and return the proper
* token code.
*/
{
register char * yyp = in_yyp;
register char c;
ident_t *p;
char *wordstart = ++yyp;
char *super_name = NULL;
Bool efun_override; /* True if 'efun::' is specified. */
/* Set yyp to the last character of the functionname
* after the #'.
*/
do
c = *yyp++;
while (isalunum(c));
c = *--yyp;
/* the assignment is good for the data flow analysis :-} */
/* Just one character? It must be an operator */
if (yyp == wordstart && *yyp != ':')
{
int i;
if ((i = symbol_operator(yyp, (const char **)&outp)) < 0)
yyerror("Missing function name after #'");
yylval.closure.number = i + CLOSURE_EFUN_OFFS;
yylval.closure.inhIndex = 0;
return L_CLOSURE;
}
/* Test for an inherited function name specification.
* If found, set super_name to the inherit name, and
* reset wordstart/yyp to point to the name after the '::'.
*/
if (':' == *yyp && ':' == *(yyp+1))
{
super_name = wordstart;
wordstart = yyp += 2;
do
c = *yyp++;
while (isalunum(c));
c = *--yyp;
}
/* Test for the 'efun::' override.
*/
efun_override = MY_FALSE;
if (super_name != NULL && !strncmp(super_name, "efun::", 6))
{
efun_override = MY_TRUE;
super_name = NULL;
}
outp = yyp;
/* Lookup the name parsed from the text */
if (super_name != NULL)
{
short ix;
unsigned short inhIndex;
*yyp = '\0'; /* c holds the char at this place */
*(wordstart-2) = '\0';
ix = find_inherited_function(super_name, wordstart, &inhIndex);
inhIndex++;
if (ix < 0)
{
yyerrorf("Undefined function: %.50s::%.50s"
, super_name, wordstart);
ix = CLOSURE_EFUN_OFFS;
}
*yyp = c;
*(wordstart-2) = ':';
yylval.closure.number = ix;
yylval.closure.inhIndex = inhIndex;
return L_CLOSURE;
}
*yyp = '\0'; /* c holds the char at this place */
p = make_shared_identifier(wordstart, I_TYPE_GLOBAL, 0);
*yyp = c;
if (!p) {
lexerror("Out of memory");
return 0;
}
/* #' can be used only on identifiers with global visibility
* or better. Look along the .inferior chain for such an
* identifier. If the identifier happens to be a reserved
* word, the better for us.
*/
while (p->type > I_TYPE_GLOBAL)
{
if (p->type == I_TYPE_RESWORD)
{
int code = symbol_resword(p);
if (!code)
{
/* There aren't efuns with reswords as names, and
* it is impossible to define local / global vars
* or functions with such a name.
* Thus, !p->inferior .
*/
yyerrorf(
"No closure associated with reserved word '%s'",
get_txt(p->name)
);
}
yylval.closure.number = code + CLOSURE_EFUN_OFFS;
yylval.closure.inhIndex = 0;
return L_CLOSURE;
}
if ( !(p = p->inferior) )
break;
} /* while (p->type > I_TYPE_GLOBAL */
/* Did we find a suitable identifier? */
if (!p || p->type < I_TYPE_GLOBAL)
{
if (p && p->type == I_TYPE_UNKNOWN)
free_shared_identifier(p);
c = *yyp;
*yyp = '\0';
yyerrorf("Undefined function: %.50s", wordstart);
*yyp = c;
yylval.closure.number = CLOSURE_EFUN_OFFS;
yylval.closure.inhIndex = 0;
return L_CLOSURE;
}
/* An attempt to override a nomask simul-efun causes
* a privilege violation. If the master decides to allow
* this attempt, the efun-override will still be deactivated
* (iow: a nomask simul-efun overrules an efun override).
*/
if (efun_override
&& p->u.global.sim_efun >= 0
&& simul_efunp[p->u.global.sim_efun].flags & TYPE_MOD_NO_MASK
&& p->u.global.efun >= 0
&& master_ob
&& (!EVALUATION_TOO_LONG())
)
{
svalue_t *res;
push_ref_string(inter_sp, STR_NOMASK_SIMUL_EFUN);
push_c_string(inter_sp, current_loc.file->name);
push_ref_string(inter_sp, p->name);
res = apply_master(STR_PRIVILEGE, 3);
if (!res || res->type != T_NUMBER || res->u.number < 0)
{
yyerrorf(
"Privilege violation: nomask simul_efun %s",
get_txt(p->name)
);
efun_override = MY_FALSE;
}
else if (!res->u.number)
{
efun_override = MY_FALSE;
}
}
else if (EVALUATION_TOO_LONG())
{
yyerrorf("Can't call master::%s for "
"'nomask simul_efun %s': eval cost too big"
, get_txt(STR_PRIVILEGE), get_txt(p->name));
efun_override = MY_FALSE;
}
/* The code will be L_CLOSURE, now determine the right
* closure number to put into yylval.closure.number.
* The number is usually the index in the appropriate
* table, plus an offset indicating the type of the closure.
*
* The switch() serves just as a simple try... environment.
*/
yylval.closure.inhIndex = 0;
switch(0) { default:
if (!efun_override)
{
/* lfun? */
if (p->u.global.function >= 0)
{
int i;
i = p->u.global.function;
yylval.closure.number = i;
if (i >= CLOSURE_IDENTIFIER_OFFS)
yyerrorf(
"Too high function index of %s for #'",
get_txt(p->name)
);
break;
}
/* simul-efun? */
if (p->u.global.sim_efun >= 0) {
yylval.closure.number =
p->u.global.sim_efun + CLOSURE_SIMUL_EFUN_OFFS;
break;
}
}
/* efun? */
if (p->u.global.efun >= 0)
{
yylval.closure.number =
p->u.global.efun + CLOSURE_EFUN_OFFS;
if (yylval.closure.number >
LAST_INSTRUCTION_CODE + CLOSURE_EFUN_OFFS)
{
yylval.closure.number =
efun_aliases[
yylval.closure.number - CLOSURE_EFUN_OFFS
- LAST_INSTRUCTION_CODE - 1
] + CLOSURE_EFUN_OFFS;
}
break;
}
/* object variable? */
if (p->u.global.variable >= 0)
{
if (p->u.global.variable & VIRTUAL_VAR_TAG) {
/* Handling this would require an extra coding of
* this closure type, and special treatment in
* replace_program_lambda_adjust() .
*/
yyerrorf("closure of virtual variable");
yylval.closure.number = CLOSURE_IDENTIFIER_OFFS;
break;
}
yylval.closure.number =
p->u.global.variable + num_virtual_variables +
CLOSURE_IDENTIFIER_OFFS;
break;
}
/* None of these all */
c = *yyp;
*yyp = 0;
yyerrorf("Undefined function: %.50s", wordstart);
*yyp = c;
yylval.closure.number = CLOSURE_EFUN_OFFS;
break;
}
return L_CLOSURE;
} /* closure() */
/*-------------------------------------------------------------------------*/
static char *
handle_preprocessor_statement (char * in_yyp)
/* The lexer has found a preprocessor statement (<newline>#), an <in_yyp>
* is pointing to the character after the '#'. Parse the statement and return
* the new character pointer.
*/
{
register char * yyp = in_yyp;
register char c;
char *sp = NULL; /* Begin of second word */
Bool quote; /* In "" string? */
size_t wlen; /* Length of the preproc keyword */
char last;
/* Character last read, used to implement \-sequences */
/* Copy the first/only line of the preprocessor statement
* from the input buffer into yytext[] while stripping
* comments.
*/
/* Skip initial blanks */
outp = yyp;
yyp = yytext;
do {
c = mygetc();
} while (lexwhite(c));
wlen = 0;
for (quote = MY_FALSE, last = '\0';;)
{
/* Skip comments */
while (!quote && c == '/')
{
char c2;
if ( (c2 = mygetc()) == '*')
{
skip_comment();
c = mygetc();
}
else if (c2 == '/')
{
outp = skip_pp_comment(outp);
current_loc.line--;
c = '\n';
}
else
{
--outp;
break;
}
}
/* If the last character was '\', take this one as
* as it is, else interpret this character.
*/
if (last == '\\')
last = '\0';
else if (c == '"')
quote = !quote;
else
last = c;
/* Remember end of the first word in the line */
if (!sp && !isalunum(c))
{
sp = yyp;
wlen = yyp - yytext;
}
if (c == '\n')
{
break;
}
SAVEC;
c = mygetc();
}
/* Terminate the line copied to yytext[] */
*yyp = '\0';
/* Remember the end of the first word.
* Let sp point to the next word then.
*/
if (sp)
{
while(lexwhite(*sp))
{
sp++;
}
}
else
{
/* No end found in the copy loop - the next 'word'
* will be the terminating '\0'.
*/
sp = yyp;
wlen = yyp - yytext;
}
/* Evaluate the preprocessor statement */
if (strncmp("include", yytext, wlen) == 0)
{
/* Calling myfilbuf() before handle_include() is a waste
* of time and memory. However, since the include
* attempt might fail, we have to call it afterwards
* to make sure that the lex can continue.
*/
handle_include(sp);
myfilbuf();
}
else
{
/* Make sure there is enough data in the buffer. */
myfilbuf();
if (strncmp("define", yytext, wlen) == 0)
{
if (*sp == '\0')
yyerror("Missing definition in #define");
else
handle_define(sp, quote);
}
else if (strncmp("if", yytext, wlen) == 0)
{
int cond;
svalue_t sv;
myungetc('\n');
add_input(sp);
cond = cond_get_exp(0, &sv);
free_svalue(&sv);
if (mygetc() != '\n')
{
yyerror("Condition too complex in #if");
while (mygetc() != '\n') NOOP;
}
else
handle_cond(cond);
}
else if (strncmp("ifdef", yytext, wlen) == 0)
{
deltrail(sp);
handle_cond(lookup_define(sp) != 0);
}
else if (strncmp("ifndef", yytext, wlen) == 0)
{
deltrail(sp);
handle_cond(lookup_define(sp) == 0);
}
else if (strncmp("else", yytext, wlen) == 0)
{
if (*sp != '\0')
{
if (pragma_pedantic)
yyerror("Unrecognized #else (trailing characters)");
else
yywarn("Unrecognized #else (trailing characters)");
}
if (iftop && iftop->state == EXPECT_ELSE)
{
lpc_ifstate_t *p = iftop;
iftop = p->next;
mempool_free(lexpool, p);
skip_to("endif", NULL);
}
else
{
yyerror("Unexpected #else");
}
}
else if (strncmp("elif", yytext, wlen) == 0)
{
if (iftop && iftop->state == EXPECT_ELSE)
{
lpc_ifstate_t *p = iftop;
iftop = p->next;
mempool_free(lexpool, p);
skip_to("endif", NULL);
}
else
{
yyerror("Unexpected #elif");
}
}
else if (strncmp("endif", yytext, wlen) == 0)
{
if (*sp != '\0')
{
if (pragma_pedantic)
yyerror("Unrecognized #endif (trailing characters)");
else
yywarn("Unrecognized #endif (trailing characters)");
}
if (iftop
&& ( iftop->state == EXPECT_ENDIF
|| iftop->state == EXPECT_ELSE))
{
lpc_ifstate_t *p = iftop;
iftop = p->next;
mempool_free(lexpool, p);
}
else
{
yyerror("Unexpected #endif");
}
}
else if (strncmp("undef", yytext, wlen) == 0)
{
ident_t *p, **q;
int h;
deltrail(sp);
/* Lookup identifier <sp> in the ident_table and
* remove it there if it is a #define'd identifier.
* If it is a permanent define, park the ident
* structure in the undefined_permanent_defines list.
*/
h = identhash(sp);
for (q = &ident_table[h]; NULL != ( p= *q); q=&p->next)
{
if (strcmp(sp, get_txt(p->name)))
continue;
if (p->type != I_TYPE_DEFINE) /* failure */
break;
if (!p->u.define.permanent)
{
#if defined(LEXDEBUG)
fprintf(stderr, "%s #undef define '%s' %d '%s'\n"
, time_stamp(), get_txt(p->name)
, p->u.define.nargs
, p->u.define.exps.str);
fflush(stderr);
#endif
if (p->inferior)
{
p->inferior->next = p->next;
*q = p->inferior;
}
else
{
*q = p->next;
}
xfree(p->u.define.exps.str);
free_mstring(p->name);
p->name = NULL;
/* mark for later freeing by all_defines */
/* success */
break;
}
else
{
if (p->inferior)
{
p->inferior->next = p->next;
*q = p->inferior;
}
else
{
*q = p->next;
}
p->next = undefined_permanent_defines;
undefined_permanent_defines = p;
/* success */
break;
}
}
}
else if (strncmp("echo", yytext, wlen) == 0)
{
#ifdef USE_LDMUD_COMPATIBILITY
fprintf(stderr, "%s %s\n", time_stamp(), sp);
#else
/*
* More useful to see where these messages come from
* instead of time stamp. --lynX
*/
if (object_file)
debug_message("<%s> %s\n", object_file, sp);
#endif
}
else if (strncmp("pragma", yytext, wlen) == 0)
{
handle_pragma(sp);
}
else if (strncmp("line", yytext, wlen) == 0)
{
char * end;
long new_line;
deltrail(sp);
new_line = strtol(sp, &end, 0);
if (end == sp || *end != '\0')
yyerror("Unrecognised #line directive");
if (new_line < current_loc.line)
store_line_number_backward(current_loc.line - new_line);
current_loc.line = new_line - 1;
}
else
{
yyerror("Unrecognised # directive");
}} /* if() { else if () {} } */
store_line_number_info();
nexpands = 0;
current_loc.line++;
total_lines++;
return outp;
} /* handle_preprocessor_statement() */
/*-------------------------------------------------------------------------*/
static INLINE int
yylex1 (void)
/* Lex the next lexical element starting from outp and return its code.
* For single characters, this is the character code itself. Multi-character
* elements return the associated code define in lang.h.
* Illegal characters are returned as spaces.
* If the lexer runs into a fatal error or the end of file, -1 is returned.
*
* <depth> is the current nesting depth for local scopes, needed for
* correct lookup of local identifiers.
*
* Some elements return additional information:
* L_ASSIGN: yylval.number is the type of assignment operation
* e.g. F_ADD_EQ for '+='.
* '=' itself is returned as F_ASSIGN.
* L_NUMBER: yylval.number is the parsed whole number or char constant.
* L_FLOAT: yylval.float_number is the parsed float number.
* L_STRING: last_lex_string is the (tabled) parsed string literal.
* L_CLOSURE: yylval.closure.number/.inhIndex identifies the closure. See
* the source for which value means what (it's a bit longish).
* L_QUOTED_AGGREGATE: yylval.number is the number of quotes
* L_SYMBOL: yylval.symbol.name is the (shared) name of the symbol,
* yylval.symbol.quotes the number of quotes.
*/
{
register char *yyp;
register char c;
#define TRY(c, t) if (*yyp == (c)) {yyp++; outp = yyp; return t;}
#ifndef USE_NEW_INLINES
/* If we are at a point suitable for inline function insertion,
* do it.
* Note: It is not strictly necessary to insert all of them
* at once, since the compiler will set insert_inline_fun_now
* again as soon as it is finished with this one.
*/
if (insert_inline_fun_now)
{
struct inline_fun * fun;
char buf[80];
sprintf(buf, "#line %d\n", current_loc.line);
insert_inline_fun_now = MY_FALSE;
while (first_inline_fun)
{
fun = first_inline_fun->next;
if (first_inline_fun->buf.length)
{
strbuf_add(&(first_inline_fun->buf), buf);
add_input(first_inline_fun->buf.buf);
strbuf_free(&(first_inline_fun->buf));
}
xfree(first_inline_fun);
first_inline_fun = fun;
}
}
#endif /* USE_NEW_INLINES */
yyp = outp;
for(;;) {
switch((unsigned char)(c = *yyp++))
{
/* --- End Of File --- */
case CHAR_EOF:
if (inctop)
{
/* It's the end of an included file: return the previous
* file
*/
struct incstate *p;
Bool was_string_source = (yyin.fd == -1);
p = inctop;
/* End the lexing of the included file */
close_input_source();
nexpands = 0;
store_include_end(p->inc_offset, p->loc.line);
/* Restore the previous state */
current_loc = p->loc;
if (!was_string_source)
current_loc.line++;
yyin = p->yyin;
saved_char = p->saved_char;
inctop = p->next;
*linebufend = '\n';
yyp = linebufend + 1;
linebufstart = &defbuf[defbuf_len] + p->linebufoffset;
linebufend = linebufstart + MAXLINE;
mempool_free(lexpool, p);
if (!*yyp)
{
outp = yyp;
yyp = _myfilbuf();
}
break;
}
/* Here it's the end of the main file */
if (iftop)
{
/* Oops, pending #if!
* Note the error and clean up the if-stack.
*/
lpc_ifstate_t *p = iftop;
yyerror(p->state == EXPECT_ENDIF ? "Missing #endif" : "Missing #else");
while(iftop)
{
p = iftop;
iftop = p->next;
mempool_free(lexpool, p);
}
}
/* Return the EOF condition */
outp = yyp-1;
return -1;
/* --- Newline --- */
case '\n':
{
store_line_number_info();
nexpands = 0;
current_loc.line++;
total_lines++;
if (!*yyp)
{
outp = yyp;
yyp = _myfilbuf();
}
}
break;
/* --- Other line markers --- */
case 0x1a: /* Used by some MSDOS editors as EOF */
case '\r':
*(yyp-1) = *(yyp-2);
break;
/* --- White space --- */
case ' ':
case '\t':
case '\f':
case '\v':
break;
/* --- Multi-Char Operators --- */
case '+':
switch(c = *yyp++)
{
case '+': outp = yyp;
return L_INC;
case '=': yylval.number = F_ADD_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return '+';
case '-':
switch(c = *yyp++)
{
case '>': outp = yyp;
return L_ARROW;
case '-': outp = yyp;
return L_DEC;
case '=': yylval.number = F_SUB_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return '-';
case '&':
switch(c = *yyp++)
{
case '&':
switch(c = *yyp++)
{
case '=': yylval.number = F_LAND_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return L_LAND;
case '=': yylval.number = F_AND_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return '&';
case '|':
switch(c = *yyp++)
{
case '|':
switch(c = *yyp++)
{
case '=': yylval.number = F_LOR_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return L_LOR;
case '=': yylval.number = F_OR_EQ;
outp = yyp;
return L_ASSIGN;
default: yyp--;
}
outp = yyp;
return '|';
case '^':
if (*yyp == '=')
{
yyp++;
yylval.number = F_XOR_EQ;
outp = yyp;
return L_ASSIGN;
}
outp = yyp;
return '^';
case '<':
c = *yyp++;;
if (c == '<')
{
if (*yyp == '=')
{
yyp++;
yylval.number = F_LSH_EQ;
outp = yyp;
return L_ASSIGN;
}
outp = yyp;
return L_LSH;
}
if (c == '=') {
outp=yyp;
return L_LE;
}
yyp--;
outp = yyp;
return '<';
case '>':
c = *yyp++;
if (c == '>')
{
if (*yyp == '=')
{
yyp++;
yylval.number = F_RSH_EQ;
outp = yyp;
return L_ASSIGN;
}
if (*yyp == '>')
{
yyp++;
if (*yyp == '=')
{
yyp++;
yylval.number = F_RSHL_EQ;
outp = yyp;
return L_ASSIGN;
}
outp = yyp;
return L_RSHL;
}
outp = yyp;
return L_RSH;
}
if (c == '=')
{
outp = yyp;
return L_GE;
}
yyp--;
outp = yyp;
return '>';
case '*':
if (*yyp == '=')
{
yyp++;
yylval.number = F_MULT_EQ;
outp = yyp;
return L_ASSIGN;
}
outp = yyp;
return '*';
case '%':
if (*yyp == '=') {
yyp++;
yylval.number = F_MOD_EQ;
outp = yyp;
return L_ASSIGN;
}
outp = yyp;
return '%';
case '/':
c = *yyp++;
if (c == '*')
{
outp = yyp;
skip_comment();
yyp = outp;
if (lex_fatal)
{
return -1;
}
break;
}
if (c == '/')
{
yyp = skip_pp_comment(yyp);
break;
}
if (c == '=')
{
yylval.number = F_DIV_EQ;
outp = yyp;
return L_ASSIGN;
}
yyp--;
outp = yyp;
return '/';
case '=':
TRY('=', L_EQ);
yylval.number = F_ASSIGN;
outp = yyp;
return L_ASSIGN;
case '!':
TRY('=', L_NE);
outp = yyp;
return L_NOT;
case '.':
if (yyp[0] == '.' && yyp[1] == '.')
{
yyp += 2;
outp = yyp;
return L_ELLIPSIS;
}
TRY('.',L_RANGE);
goto badlex;
case ':':
TRY(':', L_COLON_COLON);
#ifdef USE_NEW_INLINES
TRY(')', L_END_INLINE);
#endif /* USE_NEW_INLINES */
outp = yyp;
return ':';
/* --- Inline Function --- */
case '(':
#ifndef USE_NEW_INLINES
/* Check for '(:' but ignore '(::' which can occur e.g.
* in 'if (::remove())'. However, accept '(:::' e.g. from
* '(:::remove()', and '(::)'.
*/
if (*yyp == ':'
&& (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')'))
{
struct inline_fun * fun;
strbuf_t * textbuf;
size_t pos_return; /* position of the 'return' */
char name[256+MAXPATHLEN+1];
int level; /* Nesting level of embedded (: :) */
int blevel; /* Nesting level of embedded { } */
int first_line; /* For error messages */
char *start;
first_line = current_loc.line;
/* Allocate new function list element */
if (!first_inline_fun)
{
/* Create the list */
first_inline_fun = xalloc(sizeof *first_inline_fun);
if (!first_inline_fun)
yyerror("Out of memory.");
fun = first_inline_fun;
}
else
{
/* Append the element at the end of the list */
fun = first_inline_fun;
while (fun->next)
fun = fun->next;
fun->next = xalloc(sizeof *fun);
if (!fun->next)
yyerror("Out of memory.");
fun = fun->next;
}
textbuf = &(fun->buf);
strbuf_zero(textbuf);
fun->next = NULL; /* Terminate the list properly */
/* Create the name of the new inline function.
* We have to make sure the name is really unique.
*/
do
{
sprintf(name, "__inline_%s_%d_%04x", current_loc.file->name
, current_loc.line, next_inline_fun++);
/* Convert all non-alnums to '_' */
for (start = name; *start != '\0'; start++)
{
if (!isalnum((unsigned char)(*start)))
*start = '_';
}
} while ( find_shared_identifier(name, 0, 0)
&& next_inline_fun != 0);
if (next_inline_fun == 0)
{
yyerror("Can't generate unique name for inline closure.");
return -1;
}
/* Create the function header in the string buffer.
* For now we insert a 'return' which we might 'space out'
* later.
*/
strbuf_addf(textbuf, "\n#line %d\n", current_loc.line-1);
strbuf_addf(textbuf,
"private nomask varargs mixed %s "
"(mixed $1, mixed $2, mixed $3,"
" mixed $4, mixed $5, mixed $6, mixed $7,"
" mixed $8, mixed $9) {\n"
"return "
, name
);
pos_return = (size_t)textbuf->length-7;
/* Set yyp to the end of (: ... :), and also check
* for the highest parameter used.
*/
yyp++;
level = 1;
blevel = 0;
start = yyp;
while (level)
{
switch (*yyp++)
{
case CHAR_EOF:
current_loc.line = first_line;
yyerror("Unexpected end of file in (: .. :)");
return -1;
case '\0':
lexerror("Lexer failed to refill the line buffer");
return -1;
case '(':
if (yyp[0] == ':'
&& (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')')
)
level++, yyp++;
else if (yyp[0] == '{')
yyp++;
break;
case ':':
if (yyp[0] == ')')
level--, yyp++;
break;
case '#':
if (*yyp == '\'')
yyp++;
break;
case '{':
blevel++;
break;
case '}':
if (yyp[0] != ')')
{
if (!blevel)
{
yyerror("Illegal block nesting");
return -1;
}
blevel--;
}
break;
case '/':
c = *yyp;
if (c == '*')
{
int this_line;
this_line = current_loc.line;
strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
outp = yyp;
skip_comment();
yyp = outp;
if (lex_fatal)
return -1;
start = yyp;
while (this_line++ < current_loc.line)
strbuf_addc(textbuf, '\n');
continue;
}
if (c == '/')
{
int this_line;
this_line = current_loc.line;
strbuf_addn(textbuf, start, (size_t)(yyp-start-1));
yyp = skip_pp_comment(yyp);
start = yyp;
while (this_line++ < current_loc.line)
strbuf_addc(textbuf, '\n');
continue;
}
break;
case '\n':
store_line_number_info();
nexpands = 0;
current_loc.line++;
total_lines++;
if (!*yyp)
{
strbuf_addn(textbuf, start, (size_t)(yyp-start));
outp = yyp;
yyp = _myfilbuf();
start = yyp;
}
break;
case '\"':
case '\'':
{
char delimiter = yyp[-1];
/* If the delimiter is a ', we have to check
* for (possibly escaped) character constants
* and symbols.
*/
if (delimiter == '\'' && *yyp == '\\')
{
/* Parse an escape sequence */
if ('\n' != yyp[1] && CHAR_EOF != yyp[1])
{
char *cp;
char lc; /* Since c is 'register' */
cp = parse_escaped_char(yyp+1, &lc);
if (!cp)
yyerror("Illegal character constant");
yyp = cp;
}
/* Test if it's terminated by a quote (this also
* catches the \<nl> and \<eof> case).
*/
if (*yyp++ != '\'')
{
yyp--;
yyerror("Illegal character constant");
}
}
else if (delimiter == '\''
&& ( ( yyp[1] != '\''
|| ( *yyp == '\''
&& ( yyp[1] == '('
|| isalunum(yyp[1])
|| yyp[1] == '\'')
)
)
)
)
{
/* Skip the symbol or quoted aggregate
*
* The test rejects all sequences of the form
* 'x'
* and
* '''x, with x indicating that the ' character
* itself is meant as the desired constant.
*
* It accepts all forms of quoted symbols, with
* one or more leading ' characters.
*/
/* Skip all leading quotes.
*/
while (*yyp == '\'')
{
yyp++;
}
/* If the first non-quote is not an alnum, it must
* be a quoted aggregrate or an error.
*/
if (!isalpha((unsigned char)*yyp)
&& *yyp != '_'
)
{
if (*yyp == '(' && yyp[1] == '{')
{
yyp += 2;
}
else
{
lexerror("Illegal character constant");
return -1;
}
}
else
{
/* Find the end of the symbol. */
while (isalunum(*++yyp)) NOOP;
}
}
else /* Normal string or character */
while ((c = *yyp++) != delimiter)
{
if (c == CHAR_EOF)
{
/* Just in case... */
current_loc.line = first_line;
lexerror("Unexpected end of file "
"(or 0x01 character) in string.\n");
return -1;
}
else if (c == '\\')
{
if (*yyp++ == '\n')
{
store_line_number_info();
nexpands = 0;
current_loc.line++;
total_lines++;
if (!*yyp)
{
strbuf_addn(textbuf
, start
, (size_t)(yyp-start));
outp = yyp;
yyp = _myfilbuf();
start = yyp;
}
}
}
else if (c == '\n')
{
/* No unescaped newlines in strings */
lexerror("Newline in string");
return -1;
}
} /* while(!delimiter) */
break;
} /* string-case */
} /* switch(yyp[0]) */
} /* while(level) */
/* yyp now points to the character after the ':)'.
* This is where the next call to lex has to continue.
* Also copy the remaining (or the only) part of the
* closure into the text buffer.
*/
strbuf_addn(textbuf, start, (size_t)(yyp-start-2));
outp = yyp;
/* The closure must not be too long (there is a hard limit in
* the strbuf_t datastructure.
*/
if (textbuf->length > MAX_STRBUF_LEN-100)
yyerror("Inline closure too long");
/* Check if the last character before the ':)' is
* a ';' or '}'. For convenience we re-use yyp to
* point into our buffer (we will exit from here
* anyway).
*/
yyp = textbuf->buf + textbuf->length-1;
while (lexwhite(*yyp) || '\n' == *yyp || '\r' == *yyp)
yyp--;
if (*yyp == ';' || *yyp == '}')
{
/* Functional contains statements: remove the 'return'
* added in the beginnin.
*/
int i;
for (i = 0; i < 6; i++)
textbuf->buf[pos_return+i] = ' ';
/* Finish up the function text */
strbuf_add(textbuf, "\n}\n");
}
else
{
/* Finish up the function text */
strbuf_add(textbuf, ";\n}\n");
}
/* Return the ID of the name of the new inline function */
yylval.ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
return L_INLINE_FUN;
}
#else /* USE_NEW_INLINES */
/* Check for '(:' but ignore '(::' which can occur e.g.
* in 'if (::remove())'. However, accept '(:::' e.g. from
* '(:::remove()', and '(::)'.
*/
if (*yyp == ':'
&& (yyp[1] != ':' || yyp[2] == ':' || yyp[2] == ')'))
{
yyp++;
outp = yyp;
return L_BEGIN_INLINE;
}
#endif /* USE_NEW_INLINES */
/* FALL THROUGH */
/* --- Single-char Operators and Punctuation --- */
/* case '(' is a fall through from above */
case ';':
case ')':
case ',':
case '{':
case '}':
case '~':
case '[':
case ']':
case '?':
outp = yyp;
return c;
/* --- #: Preprocessor statement or symbol --- */
case '#':
if (*yyp == '\'')
{
/* --- #': Closure Symbol --- */
return closure(yyp);
} /* if (#') */
else if (*(yyp-2) == '\n' && !nexpands)
{
/* --- <newline>#: Preprocessor statement --- */
yyp = handle_preprocessor_statement(yyp);
if (lex_fatal)
{
return -1;
}
break;
}
else
goto badlex;
/* --- ': Character constant or lambda symbol --- */
case '\'':
c = *yyp++;
if (c == '\\')
{
/* Parse an escape sequence */
if ('\n' != *yyp && CHAR_EOF != *yyp)
{
char *cp;
char lc = 0; /* Since c is 'register' */
cp = parse_escaped_char(yyp, &lc);
if (!cp)
yyerror("Illegal character constant");
yyp = cp;
c = lc;
}
/* Test if it's terminated by a quote (this also
* catches the \<nl> and \<eof> case).
*/
if (*yyp++ != '\'')
{
yyp--;
yyerror("Illegal character constant");
}
/* Continue after the if() as if it's a normal constant */
}
else if (*yyp++ != '\''
|| ( c == '\''
&& (*yyp == '(' || isalunum(*yyp) || *yyp == '\'')) )
{
/* Parse the symbol or quoted aggregate.
*
* The test rejects all sequences of the form
* 'x'
* and
* '''x, with x indicating that the ' character itself
* is meant as the desired constant.
*
* It accepts all forms of quoted symbols, with one or
* more leading ' characters.
*/
char *wordstart;
int quotes = 1;
/* Count the total number of ' characters, set wordstart
* on the first non-quote.
*/
yyp -= 2;
while (*yyp == '\'')
{
quotes++;
yyp++;
}
wordstart = yyp;
/* If the first non-quote is not an alnum, it must
* be a quoted aggregrate or an error.
*/
if (!isalpha((unsigned char)*yyp) && *yyp != '_')
{
if (*yyp == '(' && yyp[1] == '{')
{
outp = yyp + 2;
yylval.number = quotes;
return L_QUOTED_AGGREGATE;
}
yyerror("Illegal character constant");
outp = yyp;
return L_NUMBER;
}
/* Find the end of the symbol and make it a shared string. */
while (isalunum(*++yyp)) NOOP;
c = *yyp;
*yyp = 0;
yylval.symbol.name = new_tabled(wordstart);
*yyp = c;
yylval.symbol.quotes = quotes;
outp = yyp;
return L_SYMBOL;
}
/* It's a normal (or escaped) character constant.
* Make sure that characters with the MSB set appear
* as positive numbers.
*/
yylval.number = (unsigned char)c;
outp = yyp;
return L_NUMBER;
/* --- ": String Literal --- */
case '"':
{
char *p = yyp;
/* Construct the string in yytext[], terminated with a \0.
* ANSI style string concatenation is done by a recursive
* call to yylex() after this literal is parsed completely.
* This way a mixture of macros and literals is easily
* handled.
*/
yyp = yytext;
for(;;)
{
c = *p++;
/* No unescaped newlines allowed */
if (c == '\n')
{
outp = p-1;
/* myfilbuf(); not needed */
lexerror("Newline in string");
return string("", 0);
}
SAVEC;
/* Unescaped ": end of string */
if (c == '"') {
*--yyp = '\0';
break;
}
/* Handle an escape sequence */
if (c == '\\')
{
yyp--; /* Undo the SAVEC */
switch(c = *p++)
{
case '\r':
/* \<cr><lf> defaults to \<lf>, but
* \<cr> puts <cr> into the text.
*/
if (*p++ != '\n')
{
p--;
*yyp++ = c;
break;
}
/* FALLTHROUGH*/
case '\n':
/* \<lf> and \<lf><cr> are ignored */
store_line_number_info();
current_loc.line++;
total_lines++;
if (*p == CHAR_EOF )
{
outp = p;
lexerror("End of file (or 0x01 character) in string");
return string("", 0);
}
if (!*p)
{
outp = p;
p = _myfilbuf();
}
if (*p++ != '\r')
p--;
break;
default:
{
char *cp, lc = 0;
cp = parse_escaped_char(p-1, &lc);
if (!cp)
yyerror("Illegal escaped character in string.");
p = cp;
*yyp++ = lc;
break;
}
}
}
} /* for() */
outp = p;
return string(yytext, yyp-yytext);
}
/* --- Numbers --- */
case '0':case '1':case '2':case '3':case '4':
case '5':case '6':case '7':case '8':case '9':
{
char *numstart = yyp-1;
unsigned long l;
Bool overflow;
/* Scan ahead to see if this is a float number */
while (lexdigit(c = *yyp++)) NOOP ;
/* If it's a float (and not a range), simply use strtod()
* to convert the float and to update the text pointer.
*/
if ('.' == c && '.' != *yyp)
{
char * numend; /* Because yyp is 'register' */
errno = 0; /* Because strtod() doesn't clear it on success */
yylval.float_number = strtod(numstart, &numend);
if (errno == ERANGE)
{
yywarn("Floating point number out of range.");
}
else if (errno == EINVAL)
{
yyerror("Floating point number can't be represented.");
}
outp = numend;
return L_FLOAT;
}
/* Nope, normal number */
yyp = parse_number(numstart, &l, &overflow);
if (overflow)
{
yywarnf("Number exceeds numeric limits");
}
outp = yyp;
return number((long)l);
}
/* --- Identifier --- */
case 'A':case 'B':case 'C':case 'D':case 'E':case 'F':case 'G':
case 'H':case 'I':case 'J':case 'K':case 'L':case 'M':case 'N':
case 'O':case 'P':case 'Q':case 'R':case 'S':case 'T':case 'U':
case 'V':case 'W':case 'X':case 'Y':case 'Z':case 'a':case 'b':
case 'c':case 'd':case 'e':case 'f':case 'g':case 'h':case 'i':
case 'j':case 'k':case 'l':case 'm':case 'n':case 'o':case 'p':
case 'q':case 'r':case 's':case 't':case 'u':case 'v':case 'w':
case 'x':case 'y':case 'z':case '_':case '$':
case 0xC0:case 0xC1:case 0xC2:case 0xC3:
case 0xC4:case 0xC5:case 0xC6:case 0xC7:
case 0xC8:case 0xC9:case 0xCA:case 0xCB:
case 0xCC:case 0xCD:case 0xCE:case 0xCF:
case 0xD0:case 0xD1:case 0xD2:case 0xD3:
case 0xD4:case 0xD5:case 0xD6:case 0xD7:
case 0xD8:case 0xD9:case 0xDA:case 0xDB:
case 0xDC:case 0xDD:case 0xDE:case 0xDF:
case 0xE0:case 0xE1:case 0xE2:case 0xE3:
case 0xE4:case 0xE5:case 0xE6:case 0xE7:
case 0xE8:case 0xE9:case 0xEA:case 0xEB:
case 0xEC:case 0xED:case 0xEE:case 0xEF:
case 0xF0:case 0xF1:case 0xF2:case 0xF3:
case 0xF4:case 0xF5:case 0xF6:case 0xF7:
case 0xF8:case 0xF9:case 0xFA:case 0xFB:
case 0xFC:case 0xFD:case 0xFE:case 0xFF:
{
ident_t *p;
char *wordstart = yyp-1;
/* Find the end of the identifier and mark it with a '\0' */
do
c = *yyp++;
while (isalunum(c));
c = *--yyp; /* the assignment is good for the data flow analysis :-} */
*yyp = '\0';
/* Lookup/enter the identifier in the ident_table, then restore
* the original text
*/
p = make_shared_identifier(wordstart, I_TYPE_UNKNOWN, 0);
*yyp = c;
if (!p)
{
lexerror("Out of memory");
return 0;
}
/* printf("DEBUG: ident '%s' type is %p->%d\n", p->name, p, p->type); */
/* Handle the identifier according to its type */
switch(p->type)
{
case I_TYPE_DEFINE:
outp = yyp;
_expand_define(&p->u.define, p);
if (lex_fatal)
{
return -1;
}
yyp=outp;
continue;
case I_TYPE_RESWORD:
outp = yyp;
return p->u.code;
case I_TYPE_LOCAL:
yylval.ident = p;
outp = yyp;
return L_LOCAL;
default:
/* _UNKNOWN identifiers get their type assigned by the
* parser.
*/
yylval.ident = p;
outp = yyp;
return L_IDENTIFIER;
}
}
/* --- Everything else --- */
default:
goto badlex;
} /* switch (c) */
} /* for() */
badlex:
/* We come here after an unexpected character */
if (lex_fatal)
return -1;
{
char buff[100];
sprintf(buff, "Illegal character (hex %02x) '%c'", c, c);
yyerror(buff);
outp = yyp;
return ' ';
}
#undef TRY
} /* yylex1() */
/*-------------------------------------------------------------------------*/
int
yylex (void)
/* The lex function called by the parser. The actual lexing is done
* in yylex1(), this function just does any necessary pre- and post-
* processing.
* <depth> is the current nesting depth for local scopes, needed for
* correct lookup of local identifiers.
*/
{
int r;
#ifdef LEXDEBUG
yytext[0] = '\0';
#endif
r = yylex1();
#ifdef LEXDEBUG
fprintf(stderr, "%s lex=%d(%s) ", time_stamp(), r, yytext);
#endif
return r;
}
/*-------------------------------------------------------------------------*/
void
start_new_file (int fd, const char * fname)
/* Start the compilation/lexing of the lpc file opened on file <fd> with
* name <fname>.
* This must not be called for included files.
*/
{
object_file = fname;
cleanup_source_files();
free_defines();
current_loc.file = new_source_file(fname, NULL);
current_loc.line = 1; /* already used in first _myfilbuf() */
set_input_source(fd, NULL);
if (!defbuf_len)
{
defbuf = xalloc(DEFBUF_1STLEN);
defbuf_len = DEFBUF_1STLEN;
}
*(outp = linebufend = (linebufstart = defbuf + DEFMAX) + MAXLINE) = '\0';
_myfilbuf();
lex_fatal = MY_FALSE;
pragma_check_overloads = MY_TRUE;
pragma_strict_types = PRAGMA_WEAK_TYPES;
instrs[F_CALL_OTHER].ret_type.typeflags = TYPE_ANY;
instrs[F_CALL_DIRECT].ret_type.typeflags = TYPE_ANY;
pragma_use_local_scopes = MY_TRUE;
pragma_save_types = MY_FALSE;
pragma_verbose_errors = MY_FALSE;
pragma_no_clone = MY_FALSE;
pragma_no_inherit = MY_FALSE;
pragma_no_shadow = MY_FALSE;
pragma_pedantic = MY_FALSE;
pragma_warn_missing_return = MY_TRUE;
pragma_warn_deprecated = MY_FALSE;
pragma_range_check = MY_FALSE;
pragma_warn_empty_casts = MY_TRUE;
pragma_combine_strings = MY_TRUE;
pragma_share_variables = share_variables;
nexpands = 0;
#ifndef USE_NEW_INLINES
next_inline_fun = 0;
insert_inline_fun_now = MY_FALSE;
#endif /* USE_NEW_INLINES */
add_auto_include(object_file, NULL, MY_FALSE);
} /* start_new_file() */
/*-------------------------------------------------------------------------*/
void
end_new_file (void)
/* Clean up after a compilation terminated (successfully or not).
*/
{
while (inctop)
{
struct incstate *p;
p = inctop;
close_input_source();
yyin = p->yyin;
inctop = p->next;
}
iftop = NULL;
cleanup_source_files();
mempool_reset(lexpool);
/* Deallocates all incstates and ifstates at once */
if (defbuf_len > DEFBUF_1STLEN)
{
xfree(defbuf);
defbuf = NULL;
defbuf_len = 0;
}
if (last_lex_string)
{
free_mstring(last_lex_string);
last_lex_string = NULL;
}
#ifndef USE_NEW_INLINES
while (first_inline_fun)
{
struct inline_fun * fun = first_inline_fun;
first_inline_fun = first_inline_fun->next;
strbuf_free(&(fun->buf));
xfree(fun);
}
#endif /* USE_NEW_INLINES */
} /* end_new_file() */
/*-------------------------------------------------------------------------*/
void
lex_close (char *msg)
/* End the current lexing properly (ie. by calling end_new_file())
* and throw the error message <msg>. If <msg> is NULL, a message
* giving the current include depth.
*
* This function is used from two places: from within lang.c (at them
* moment only for 'Out of memory') obviously, but also from the efun
* write_file() if it is called from within a compile, e.g. to write
* the error log.
*/
{
if (!msg)
{
/* Count the include depth and make a nice message */
int i;
struct incstate *p;
static char buf[] =
"File descriptors exhausted, include nesting: 12345678";
for (i = 0, p = inctop; p; p = p->next)
i++;
/* skip back terminating \0 and 8 digits */
sprintf(buf + sizeof buf - 9, "%d", i);
msg = buf;
}
end_new_file();
outp = ("##")+1; /* TODO: Not really nice */
lexerror(msg);
} /* lex_close() */
/*-------------------------------------------------------------------------*/
char *
get_f_name (int n)
/* Return the name of instruction <n>, it if has one.
* The result is a pointer to a static buffer.
*/
{
if (instrs[n].name)
return instrs[n].name;
else
{
static char buf[30];
sprintf(buf, "<OTHER %d>", n);
return buf;
}
} /* get_f_name() */
/*-------------------------------------------------------------------------*/
static char
cmygetc (void)
/* Get the next character from the input buffer (using mygetc()) which
* is not part of a comment.
*/
{
char c;
for(;;)
{
c = mygetc();
if (c == '/') {
if (gobble('*'))
skip_comment();
else if (gobble('/'))
{
outp = skip_pp_comment(outp);
current_loc.line--;
return '\n';
}
else
return c;
}
else
return c;
}
} /* cmygetc() */
/*-------------------------------------------------------------------------*/
static Bool
refill (Bool quote)
/* Read the next line from the input buffer into yytext[], skipping
* comments, reading the final \n as space.
* <quote> is true if at the time of call the text is supposed
* to be within a string literal.
* Result is the new value for <quote>: true if the next character to
* read is part of a string literal.
*/
{
char *p;
int c;
char last = '\0';
p = yytext;
do
{
c = mygetc();
if (c == '/' && !quote)
{
last = '\0';
if (gobble('*'))
{
skip_comment();
continue;
}
else if (gobble('/'))
{
outp = skip_pp_comment(outp);
current_loc.line--;
c = '\n';
}
}
else if (last == '\\')
{
/* Take the current character as it is */
last = '\0';
}
else if (c == '"')
quote = !quote;
else
last = (char)c;
if (p < yytext+MAXLINE-5)
*p++ = (char)c;
else
{
lexerror("Line too long");
break;
}
} while (c != '\n' && c != CHAR_EOF);
/* Refill the input buffer */
myfilbuf();
/* Replace the trailing \n by a space */
if (p[-1] == '\n')
p[-1] = ' ';
*p = '\0';
nexpands = 0;
current_loc.line++;
store_line_number_info();
return quote;
} /* refill() */
/*-------------------------------------------------------------------------*/
static void
handle_define (char *yyt, Bool quote)
/* This function is called from yylex1() to handle '#define' statements.
* The text of the line with the statement is in yytext[], <yyt> points
* to the first word after '#define'. <quote> is true if at the end
* of the line a string literal was still open.
*/
{
/* Get the identfier (or punctuation) pointed to by p and copy it
* as null-terminated string to q, but at max up to address m.
*/
#define GETALPHA(p, q, m) \
while(isalunum(*p)) {\
*q = *p++;\
if (q < (m))\
q++;\
else {\
lexerror("Name too long");\
return;\
}\
}\
*q++ = 0
/* Skip all whitespace from the current position of char*-variable 'p'
* on.
*/
#define SKIPWHITE while(lexwhite(*p)) p++
source_loc_t loc; /* Location of the #define */
char namebuf[NSIZE]; /* temp buffer for read identifiers */
char args[NARGS][NSIZE]; /* parsed argument names of function macros */
#if defined(CYGWIN) && __GNUC__ >= 3 && __GNUC_MINOR__ >= 2
# define MTEXT_IS_POINTER
char *mtext;
/* replacement text, with arguments replaced by the MARKS characters.
* Under Cygwin and high optimization, the compiler produces faulty
* code if the mtext[MLEN] definition is used.
*/
#else
char mtext[MLEN];
/* replacement text, with arguments replaced by the MARKS characters
*/
#endif /* CYGWIN and gcc 3.2 or newer */
char *p; /* current text pointer */
char *q; /* destination for parsed text */
loc = current_loc;
#if defined(MTEXT_IS_POINTER)
mtext = alloca(MLEN);
if (!mtext)
{
lexerror("Out of stack memory");
return;
}
#endif /* MTEXT_IS_POINTER */
p = yyt;
strcat(p, " "); /* Make sure GETALPHA terminates */
/* Get the defined name */
q = namebuf;
GETALPHA(p, q, namebuf+NSIZE-1);
if (*p == '(')
{
/* --- Function Macro --- */
short arg; /* Number of macro arguments */
Bool inid; /* true: parsing an identifier */
char *ids = NULL; /* Start of current identifier */
p++; /* skip '(' and following whitespace */
SKIPWHITE;
/* Parse the arguments (if any) */
if (*p == ')')
{
/* no arguments */
arg = 0;
}
else
{
/* Parse up to NARGS-1 arguments */
for (arg = 0; arg < NARGS; )
{
/* Get the argname directly into args[][] */
q = args[arg];
GETALPHA(p, q, &args[arg][NSIZE-1]);
arg++;
SKIPWHITE;
/* ')' -> no further argument */
if (*p == ')')
break;
/* else a ',' is expected as separator */
if (*p++ != ',') {
yyerror("Missing ',' in #define parameter list");
return;
}
SKIPWHITE;
}
if (arg == NARGS)
{
lexerrorf("Too many macro arguments");
return;
}
}
p++; /* skip ')' */
/* Parse the replacement text into mtext[], performing
* macro argument marking as necessary.
*/
for (inid = MY_FALSE, q = mtext; *p && *p != CHAR_EOF; )
{
/* Identifiers are parsed until complete, with the first
* character pointed to by <ids>.
*/
if (isalunum(*p))
{
/* Identifier. If inid is false, it is a new one.
*/
if (!inid)
{
inid = MY_TRUE;
ids = p;
}
}
else
{
/* Not an identifier, or, if inid is true, the end
* of one.
*/
if (inid)
{
int idlen = p - ids;
size_t l;
int n;
/* Check if the identifier matches one of the
* function arguments. If yes, replace it in mtext[]
* by the MARKS sequence.
*/
for (n = 0; n < arg; n++)
{
l = strlen(args[n]);
if (l == (size_t)idlen && strncmp(args[n], ids, l) == 0)
{
q -= idlen;
*q++ = (char)MARKS;
*q++ = (char)(n+MARKS+1);
break;
}
}
inid = MY_FALSE;
}
}
/* Whatever the character is, for now store it in mtext[].
* Literal '@' are escaped.
*/
*q = *p;
if (*p++ == MARKS)
*++q = MARKS;
if (q < mtext+MLEN-2)
q++;
else
{
lexerror("Macro text too long");
return;
}
/* If we are at line's end and it is escaped with '\',
* get the next line and continue.
*/
if (!*p)
{
if (p[-2] == '\\')
{
q -= 2;
quote = refill(quote);
p = yytext;
}
else if (p[-2] == '\r' && p[-3] == '\\' )
{
q -= 3;
quote = refill(quote);
p = yytext;
}
}
}
/* If the defined was ended by EOF instead of lineend,
* we have to pass on the EOF to the caller.
*/
if (*p == CHAR_EOF)
{
myungetc(*p);
}
/* Terminate the text and add the macro */
*--q = '\0';
add_define(namebuf, arg, mtext, loc);
}
else
{
/* --- Normal Macro --- */
/* Parse the replacement text into mtext[].
*/
for (q = mtext; *p && *p != CHAR_EOF; )
{
*q = *p++;
if (q < mtext+MLEN-2)
q++;
else
{
lexerror("Macro text too long");
return;
}
/* If we are at line's end and it is escaped with '\',
* get the next line and continue.
*/
if (!*p)
{
if (p[-2] == '\\')
{
q -= 2;
quote = refill(quote);
p = yytext;
}
else if (p[-2] == '\r' && p[-3] == '\\' )
{
q -= 3;
quote = refill(quote);
p = yytext;
}
}
}
/* If the defined was ended by EOF instead of lineend,
* we have to pass on the EOF to the caller.
*/
if (*p == CHAR_EOF)
{
myungetc(*p);
}
/* Terminate the text and add the macro */
*--q = '\0';
add_define(namebuf, -1, mtext, loc);
}
#undef GETALPHA
#undef SKIPWHITE
} /* handle_define() */
/*-------------------------------------------------------------------------*/
static void
add_define (char *name, short nargs, char *exps, source_loc_t loc)
/* Add a new macro definition for macro <name> with <nargs> arguments
* and the replacement text <exps>. The positions where the arguments
* are to be put into <exps> have to be marked with the MARKS character
* as described elsewhere. The macro is defined at <loc> in the source.
*
* The new macro is stored in the ident_table[] and also put into
* the list of all_defines.
*
* If the macro <name> is already defined, an error is generated.
*/
{
ident_t *p;
/* Lookup/create a new identifier entry */
p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
if (!p)
{
lexerrorf("Out of memory for new macro '%s'", name);
return;
}
/* If such a macro already exists with different meaning,
* generate an error. If the meaning doesn't change, generate
* a warning.
*/
if (p->type != I_TYPE_UNKNOWN)
{
char buf[200+NSIZE+MAXPATHLEN];
if (current_loc.line <= 0)
sprintf(buf, "(in auto include text) #define %s already defined", name);
else
sprintf(buf, "#define %s already defined", name);
if (p->u.define.loc.file != NULL)
{
char * add = &buf[strlen(buf)];
sprintf(add, " (from %s line %d)"
, p->u.define.loc.file->name, p->u.define.loc.line);
}
if (nargs != p->u.define.nargs
|| p->u.define.special
|| strcmp(exps,p->u.define.exps.str) != 0)
{
yyerror(buf);
return;
}
else
{
yywarn(buf);
}
}
else
{
/* New macro: initialise the ident.u.define and
* add it to the list of defines.
*/
p->type = I_TYPE_DEFINE;
p->u.define.nargs = nargs;
p->u.define.permanent = MY_FALSE;
p->u.define.special = MY_FALSE;
if ( !(p->u.define.exps.str = xalloc(strlen(exps)+1)) )
{
free_shared_identifier(p);
lexerrorf("Out of memory for new macro '%s'", name);
return;
}
strcpy(p->u.define.exps.str, exps);
p->u.define.loc = loc;
p->next_all = all_defines;
all_defines = p;
#if defined(LEXDEBUG)
fprintf(stderr, "%s define '%s' %d '%s'\n"
, time_stamp(), name, nargs, exps);
#endif
}
} /* add_define() */
/*-------------------------------------------------------------------------*/
static void
add_permanent_define (char *name, short nargs, void *exps, Bool special)
/* Add a new permanent macro definition for macro <name>
* with <nargs> arguments and the replacement text <exps>.
* The positions where the arguments are to be put into <exps> have to be
* marked with the MARKS character as described elsewhere.
*
* If <special> is true, <exps> is not a text pointer, but instead
* a pointer to a function returning a text.
*
* The new macro is stored in the ident_table[] and also put into
* the list of permanent_defines.
*
* If the macro <name> is already defined, an error is generated.
*
* TODO: Instead of <exps>,<special>, it should be <exps>,<fun>
* TODO:: with proper types.
*/
{
ident_t *p;
/* Lookup/create a new identifier entry */
p = make_shared_identifier(name, I_TYPE_DEFINE, 0);
if (!p)
{
errorf("Out of memory for permanent macro '%s'\n", name);
}
/* If such a macro already exists with different meaning,
* generate an error.
*/
if (p->type != I_TYPE_UNKNOWN)
{
if (nargs != p->u.define.nargs
|| p->u.define.special
|| strcmp(exps,p->u.define.exps.str) != 0)
{
errorf("Permanent #define %s already defined\n", name);
}
return;
}
/* New macro: initialise the ident.u.define and
* add it to the list of permanent defines.
*/
p->type = I_TYPE_DEFINE;
p->u.define.nargs = nargs;
p->u.define.permanent = MY_TRUE;
p->u.define.special = (short)special;
if (!special)
p->u.define.exps.str = (char *)exps;
else
p->u.define.exps.fun = (defn_fun)exps;
p->u.define.loc.file = NULL;
p->u.define.loc.line = 0;
p->next_all = permanent_defines;
permanent_defines = p;
} /* add_permanent_define() */
/*-------------------------------------------------------------------------*/
void
free_defines (void)
/* Free all non-permanent defines, and undo any undefine of a permanent
* define.
*
* Also called from the garbage collector and simul_efun.c
*/
{
ident_t *p, *q;
/* Free all non-permanent defines */
for (p = all_defines; p; p = q)
{
q = p->next_all;
if (p->name)
{
if (!p->u.define.special)
xfree(p->u.define.exps.str);
free_shared_identifier(p);
}
else
{
/* has been undef'd. */
xfree(p);
}
}
all_defines = NULL;
/* Reactivate undefined permanent defines */
for (p = undefined_permanent_defines; p; p = q)
{
ident_t *curr, **prev;
q = p->next;
p->next = NULL;
prev = &ident_table[p->hash];
while ( NULL != (curr = *prev) )
{
if (curr->name == p->name) /* found it */
{
p->next = curr->next;
break;
}
prev = &curr->next;
} /* not found, create new one */
p->inferior = curr;
*prev = p;
}
undefined_permanent_defines = NULL;
nexpands = 0;
} /* free_defines() */
/*-------------------------------------------------------------------------*/
static ident_t *
lookup_define (char *s)
/* Lookup the name <s> in the identtable and return a pointer to its
* ident structure if it is a define. Return NULL else.
*/
{
ident_t *curr, *prev;
int h;
h = identhash(s);
curr = ident_table[h];
prev = 0;
while (curr)
{
if (!strcmp(get_txt(curr->name), s)) /* found it */
{
if (prev) /* not at head of list */
{
prev->next = curr->next;
curr->next = ident_table[h];
ident_table[h] = curr;
}
if (curr->type == I_TYPE_DEFINE)
return curr;
return NULL;
}
prev = curr;
curr = curr->next;
} /* not found */
return NULL;
} /* lookup_define() */
/*-------------------------------------------------------------------------*/
static Bool
expand_define (void)
/* Check if yytext[] holds a macro and expand it if it is.
* Return true if it was expanded, false if not.
*/
{
ident_t *p;
p = lookup_define(yytext);
if (!p) {
return MY_FALSE;
}
return _expand_define(&p->u.define, p);
} /* expand_define() */
/*-------------------------------------------------------------------------*/
static Bool
_expand_define (struct defn *p, ident_t * macro)
/* Expand the macro <p> and add_input() the expanded text.
* For function macros, the function expects the next non-white character
* in the input buffer to be the opening '(' of the argument list.
* <macro> is the struct ident_s entry and is needed just for error
* messages.
*
* Return true if the expansion was successfull, false if not.
*/
{
/* Skip the whitespace in the input buffer until the next non-blank
* and store that one in variable <c>.
*/
#define SKIPW \
for(;;) {\
do {\
c = cmygetc();\
} while(lexwhite(c));\
if (c == '\n') {\
myfilbuf();\
store_line_number_info();\
current_loc.line++;\
total_lines++;\
} else break;\
}
static char *expbuf = NULL;
/* The arguments of a function macro, separated by '\0' characters.
*/
static char *buf = NULL;
/* Construction buffer for the expanded macro text.
*/
/* Both buffers are allocated on the first call to the
* function and reused thereafter. Putting them on the
* stack would make _expand_define() reentrant, but
* very slow on systems without proper alloca().
* Right now the only possibility for a recursive call
* is an error during the expansion, with error handling requesting
* another expansion. In this case, reentrancy is not an issue
* because after returning from the error, the function itself
* returns immediately.
*
* But should the need ever arise, the old fragments may be
* changed to implement a stack of buffers. Using the stack-mempool
* allocator, this could even be efficient.
*/
#if 0
static int mutex = 0;
/* TODO: The mutex may be used to implement a stack of buffers if needed.
*/
#endif
char *args[NARGS];
/* Pointers into expbuf[] to the beginning of the actual
* macro arguments.
*/
char *q; /* Pointer into expbuf[] when parsing the args */
char *e; /* Pointer to replacement text */
char *b; /* Pointer into buf[] when expanding */
char *r; /* Next character to read from input buffer */
#if 0
/* TODO: This was a test for recursive calls. If a stack of buffers is
* TODO:: needed, this code fragments allow an easy implementation,
* TODO:: especially because the DEMUTEX macros are already where
* TODO:: they have to be.
*/
if (mutex++)
{
lexerror("Recursive call to _expand_define()");
mutex--;
return 0;
}
#define DEMUTEX mutex--
#else
#define DEMUTEX NOOP
#endif
/* Allocate the buffers if not done already */
if (!expbuf)
expbuf = pxalloc(DEFMAX);
if (!buf)
buf = pxalloc(DEFMAX);
if (!expbuf || !buf) {
lexerror("Stack overflow");
DEMUTEX;
return 0;
}
/* No more than EXPANDMAX expansions per line */
if (nexpands++ > EXPANDMAX)
{
lexerror("Too many macro expansions");
DEMUTEX;
return MY_FALSE;
}
if (p->nargs == -1)
{
/* --- Normal Macro --- */
if (!p->special)
{
add_input(p->exps.str);
}
else
{
e = (*p->exps.fun)(NULL);
if (!e) {
lexerror("Out of memory");
DEMUTEX;
return 0;
}
add_input(e);
xfree(e);
}
/* That's it. Jump to the function's end now. */
}
else
{
/* --- Function Macro --- */
int c;
int brakcnt = 0; /* Number of pending open '[' */
int parcnt = 0; /* Number of pending open' (' */
Bool dquote = MY_FALSE; /* true: in "" */
Bool squote = MY_FALSE; /* true: in '' */
int n; /* Number of parsed macro arguments */
/* Look for the argument list */
SKIPW;
if (c != '(') {
yyerrorf("Macro '%s': Missing '(' in call", get_txt(macro->name));
DEMUTEX;
return MY_FALSE;
}
/* Parse the macro arguments and store them in args[].
* This is a bit complex as we have to care for character
* constants, string literals, parentheses, symbols and
* comments.
*/
SKIPW;
if (c == ')')
n = 0; /* No args */
else
{
/* Setup */
r = outp;
*--r = (char)c;
q = expbuf;
args[0] = q;
for (n = 0;;)
{
if (q >= expbuf + DEFMAX - 5)
{
lexerrorf("Macro '%s': argument overflow", get_txt(macro->name));
DEMUTEX;
return MY_FALSE;
}
switch(c = *r++)
{
case '"' :
/* Begin of string literal, or '"' constant */
if (!squote)
dquote = !dquote;
*q++ = (char)c;
continue;
case '#':
/* Outside of strings it must be a #'symbol.
*/
*q++ = (char)c;
if (!squote && !dquote && *r == '\'')
{
r++;
*q++ = '\'';
if (isalunum(c = *r))
{
do {
*q++ = (char)c;
++r;
} while (isalunum(c = *r));
}
else
{
const char *end;
if (symbol_operator(r, &end) < 0)
{
yyerror("Missing function name after #'");
}
strncpy(q, r, (size_t)(end - r));
q += end - r;
r = (char *)end;
}
}
continue;
case '\'':
/* Begin of character constant or quoted symbol.
*/
if ( !dquote
&& (!isalunum(*r) || r[1] == '\'')
&& (*r != '(' || r[1] != '{') )
{
squote = !squote;
}
*q++ = (char)c;
continue;
case '[' :
/* Begin of array/mapping index.
*/
if (!squote && !dquote)
brakcnt++;
*q++ = (char)c;
continue;
case ']' :
/* End of array/mapping index.
*/
if (!squote && !dquote && brakcnt > 0)
{
brakcnt--;
}
*q++ = (char)c;
continue;
case '(' :
/* Begin of nested expression.
*/
if (!squote && !dquote)
parcnt++;
*q++ = (char)c;
continue;
case ')' :
/* End of nested expression.
*/
if (!squote && !dquote)
{
parcnt--;
if (parcnt < 0)
{
/* We found the end of the argument list */
*q++ = '\0';
n++;
break;
}
}
*q++ = (char)c;
continue;
case '\\':
/* In strings, escaped sequence.
*/
*q++ = (char)c;
if (squote || dquote)
{
c = *r++;
if (c == '\r')
c = *r++;
if (c == '\n') /* nope! This wracks consistency! */
{
store_line_number_info();
current_loc.line++;
total_lines++;
if (!*r)
{
outp = r;
r = _myfilbuf();
}
q--; /* alas, long strings should work. */
continue;
}
if (c == CHAR_EOF) /* can't quote THAT */
{
r--;
continue;
}
*q++ = (char)c;
}
continue;
case '\n':
/* Next line.
*/
store_line_number_info();
current_loc.line++;
total_lines++;
*q++ = ' ';
if (!*r) {
outp = r;
r = _myfilbuf();
}
if (squote || dquote) {
lexerror("Newline in string");
DEMUTEX;
return MY_FALSE;
}
continue;
case ',':
/* Argument separation
*/
if (!parcnt && !dquote && !squote && !brakcnt)
{
*q++ = '\0';
args[++n] = q;
if (n == NARGS - 1)
{
lexerror("Maximum macro argument count exceeded");
DEMUTEX;
return MY_FALSE;
}
continue;
}
*q++ = (char)c;
continue;
case CHAR_EOF:
lexerror("Unexpected end of file (or a spurious 0x01 character)");
DEMUTEX;
return MY_FALSE;
case '/':
/* Probable comment
*/
if (!squote && !dquote)
{
if ( (c = *r++) == '*')
{
outp = r;
skip_comment();
r = outp;
}
else if ( c == '/')
{
r = skip_pp_comment(r);
}
else
{
--r;
*q++ = '/';
}
continue;
}
default:
*q++ = (char)c;
continue;
} /* end switch */
/* The only way to come here is in the case ')' when the
* end of the argument list is detected. Hence, we can
* break the for().
*/
break;
} /* for(n = 0..NARGS) */
outp = r;
} /* if (normal or function macro) */
/* Proper number of arguments? */
if (n != p->nargs)
{
yyerrorf("Macro '%s': Wrong number of arguments", get_txt(macro->name));
DEMUTEX;
return MY_FALSE;
}
/* (Don't) handle dynamic function macros */
if (p->special)
{
(void)(*p->exps.fun)(args);
DEMUTEX;
return MY_TRUE;
}
/* Construct the expanded macro text in buf[] by simple
* copy and replace.
*/
b = buf;
e = p->exps.str;
while (*e)
{
if (*e == MARKS)
{
if (*++e == MARKS)
*b++ = *e++;
else
{
for (q = args[*e++ - MARKS - 1]; *q; )
{
*b++ = *q++;
if (b >= buf+DEFMAX)
{
lexerror("Macro expansion overflow");
DEMUTEX;
return MY_FALSE;
}
}
}
}
else
{
*b++ = *e++;
if (b >= buf+DEFMAX)
{
lexerror("Macro expansion overflow");
DEMUTEX;
return MY_FALSE;
}
}
}
/* Terminate the expanded text and add it to the input */
*b++ = '\0';
add_input(buf);
}
/* That's it. */
DEMUTEX;
return MY_TRUE;
#undef SKIPW
}
/*-------------------------------------------------------------------------*/
static int
exgetc (void)
/* Get the first character of the next element of a condition
* and return it, leaving the input pointing to the rest of it.
* Comments are skipped, identifiers not defined as macros are
* replaced with ' 0 ', the predicate 'defined(<name>)' is
* replaced with ' 0 ' or ' 1 ' depending on the result.
*/
{
#define SKPW do c = (unsigned char)mygetc(); while(lexwhite(c)); myungetc((char)c)
/* Skip the whitespace in the input buffer until the first non-blank.
* End with the input pointing to this non-blank.
*/
register unsigned char c;
register char *yyp;
c = (unsigned char)mygetc();
for (;;)
{
if ( isalpha(c) || c=='_' )
{
/* It's an identifier, maybe a macro name, maybe it's
* an 'defined()' predicate.
*/
/* Get the full identifier in yytext[] */
yyp = yytext;
do {
SAVEC;
c=(unsigned char)mygetc();
} while ( isalunum(c) );
myungetc((char)c);
*yyp='\0';
if (strcmp(yytext, "defined") == 0)
{
/* handle the 'defined' predicate */
do c = (unsigned char)mygetc(); while(lexwhite(c));
if (c != '(')
{
yyerror("Missing ( in defined");
continue;
}
do c = (unsigned char)mygetc(); while(lexwhite(c));
yyp=yytext;
while ( isalunum(c) )
{
SAVEC;
c=(unsigned char)mygetc();
}
*yyp='\0';
while(lexwhite(c)) c = (unsigned char)mygetc();
if (c != ')') {
yyerror("Missing ) in defined");
continue;
}
SKPW;
if (lookup_define(yytext))
add_input(" 1 ");
else
add_input(" 0 ");
}
else
{
/* Simple identifier */
if (!expand_define())
add_input(" 0 ");
}
c = (unsigned char)mygetc();
}
else if (c == '\\' && (*outp == '\n' || *outp == '\r'))
{
/* Escaped new line: read the next line, strip
* all comments, and then add the result again
* for reparsing.
*/
Bool quote;
outp++;
if (outp[-1] == '\r' && *outp == '\n')
outp++;
yyp = yytext;
for(quote = MY_FALSE;;)
{
c = (unsigned char)mygetc();
if (c == '"')
quote = !quote;
while(!quote && c == '/') { /* handle comments cpp-like */
char c2;
if ( (c2 = mygetc()) == '*') {
skip_comment();
c=(unsigned char)mygetc();
} else if (c2 == '/') {
outp = skip_pp_comment(outp);
current_loc.line--;
c = '\n';
} else {
--outp;
break;
}
}
SAVEC;
if (c == '\n') {
break;
}
}
*yyp = '\0';
current_loc.line++;
total_lines++;
add_input(yytext);
nexpands = 0;
c = (unsigned char)mygetc();
}
else
{
break;
}
}
return c;
#undef SKPW
} /* exgetc() */
/*-------------------------------------------------------------------------*/
static int
cond_get_exp (int priority, svalue_t *svp)
/* Evaluate the expression in the input buffer at a priority of at least
* <priority> and store the result in <svp> (which is assumed to be
* invalid at the time of call).
* Return the result if it is numeric, or a truthvalue for string
* expressions.
*
* The function assumes to be called at the proper beginning of
* an expression, i.e. if it encounters an operator even before a value,
* it must be unary.
*/
{
int c;
int value = 0;
int value2, x;
svalue_t sv2;
svp->type = T_INVALID;
do c = exgetc(); while ( lexwhite(c) );
/* Evaluate the first value */
if (c == '(')
{
/* It's a parenthesized subexpression */
value = cond_get_exp(0, svp);
do c = exgetc(); while ( lexwhite(c) );
if ( c != ')' )
{
yyerror("parentheses not paired in #if");
if (c == '\n')
myungetc('\n');
}
}
else if ( ispunct(c) )
{
/* It is a string or an unary operator */
if (c == '"')
{
/* Get the string */
char *p, *q;
q = p = outp;
for (;;)
{
c = *p++;
if (c == '"')
{
break;
}
if (c == '\n')
{
yyerror("unexpected end of string in #if");
put_ref_string(svp, STR_EMPTY);
return 0;
}
if (c == '\\')
{
c = *p++;
if (c == '\n')
{
current_loc.line++;
*--p = '"';
break;
}
}
*q++ = (char)c;
}
*q = '\0';
put_c_string(svp, outp);
outp = p;
}
else
{
/* Is it really an operator? */
x = optab1(c);
if (!x)
{
yyerror("illegal character in #if");
return 0;
}
/* Get the value for this unary operator */
value = cond_get_exp(12, svp);
/* Evaluate the operator */
switch ( optab2[x-1] )
{
case BNOT : value = ~value; break;
case LNOT : value = !value; break;
case UMINUS: value = -value; break;
case UPLUS : value = value; break;
default :
yyerror("illegal unary operator in #if");
free_svalue(svp);
svp->type = T_NUMBER;
return 0;
}
if (svp->type != T_NUMBER)
{
yyerror("illegal type to unary operator in #if");
free_svalue(svp);
svp->type = T_NUMBER;
return 0;
}
svp->u.number = value;
}
}
else
{
/* It must be a number */
int base;
if ( !lexdigit(c) )
{
if (c == '\n')
{
yyerror("missing expression in #if");
myungetc('\n');
}
else
yyerror("illegal character in #if");
return 0;
}
value = 0;
/* Determine the base of the number */
if (c != '0')
base=10;
else
{
c = mygetc();
if (c == 'x' || c == 'X')
{
base = 16;
c = mygetc();
}
else
base = 8;
}
/* Now parse the number */
for(;;)
{
if ( isdigit(c) ) x = -'0';
else if ( isupper(c) ) x = -'A'+10;
else if ( islower(c) ) x = -'a'+10;
else break;
x += c;
if (x > base)
break;
value = value * base + x;
c = mygetc();
}
myungetc((char)c);
put_number(svp, value);
}
/* Now evaluate the following <binop> <expr> pairs (if any) */
for (;;)
{
do c=exgetc(); while ( lexwhite(c) );
/* An operator or string must come next */
if ( !ispunct(c) )
break;
/* If it's a string, make it a string addition */
if (c == '"')
{
myungetc('"');
c = '+';
}
/* Can it be an operator at all? */
x = optab1(c);
if (!x)
break;
/* See if the optab[] defines an operator for these characters
*/
value2 = mygetc();
for (;;x+=3)
{
if (!optab2[x])
{
myungetc((char)value2);
if (!optab2[x+1])
{
yyerror("illegal operator use in #if");
return 0;
}
break;
}
if (value2 == optab2[x])
break;
}
/* If the priority of the operator is too low, we are done
* with this (sub)expression.
*/
if (priority >= optab2[x+2])
{
if (optab2[x])
myungetc((char)value2);
break;
}
/* Get the second operand */
value2 = cond_get_exp(optab2[x+2], &sv2);
/* Evaluate the operands:
* Full set of operations for numbers.
* Addition and lexicographic comparisons for strings.
*/
if (svp->type == T_NUMBER && sv2.type == T_NUMBER)
{
switch (optab2[x+1])
{
case MULT : value *= value2; break;
case DIV : if (!value2) lexerror("Division by zero");
else value /= value2; break;
case MOD : if (!value2) lexerror("Division by zero");
else value %= value2; break;
case BPLUS : value += value2; break;
case BMINUS : value -= value2; break;
case LSHIFT : if ((uint)value2 > MAX_SHIFT) value = 0;
else value <<= value2; break;
case RSHIFT : value >>= (uint)value2 > MAX_SHIFT ? (int)MAX_SHIFT : value2;
break;
case LESS : value = value < value2; break;
case LEQ : value = value <= value2; break;
case GREAT : value = value > value2; break;
case GEQ : value = value >= value2; break;
case EQ : value = value == value2; break;
case NEQ : value = value != value2; break;
case BAND : value &= value2; break;
case XOR : value ^= value2; break;
case BOR : value |= value2; break;
case LAND : value = value && value2; break;
case LOR : value = value || value2; break;
case QMARK :
do c=exgetc(); while( lexwhite(c) );
if (c != ':')
{
yyerror("'?' without ':' in #if");
myungetc((char)c);
return 0;
}
if (value)
{
*svp = sv2;
cond_get_exp(1, &sv2);
free_svalue(&sv2);
value = value2;
}
else
value = cond_get_exp(1, svp);
break;
} /* switch() */
}
else if (svp->type == T_STRING && sv2.type == T_STRING)
{
x = optab2[x+1];
if (x == BPLUS)
{
svp->u.str = mstr_append(svp->u.str, sv2.u.str);
free_string_svalue(&sv2);
}
else
{
value = mstrcmp(svp->u.str, sv2.u.str);
free_string_svalue(svp);
svp->type = T_NUMBER;
free_string_svalue(&sv2);
switch (x)
{
case LESS : value = value < 0; break;
case LEQ : value = value <= 0; break;
case GREAT : value = value > 0; break;
case GEQ : value = value >= 0; break;
case EQ : value = value == 0; break;
case NEQ : value = value != 0; break;
default:
yyerror("illegal operator use in #if");
return 0;
}
put_number(svp, value);
}
}
else
{
yyerror("operands in #if won't match");
free_svalue(svp);
svp->type = T_NUMBER;
free_svalue(&sv2);
return 0;
}
}
myungetc((char)c);
return value;
} /* cond_get_expr() */
/*-------------------------------------------------------------------------*/
void
set_inc_list (vector_t *v)
/* EFUN: set_driver_hook(H_INCLUDE_DIRS, ({ list }) )
*
* Set the list of pathnames to search for <>-include files to the
* names in <v>.
*
* The function takes ownership of v->item[], but replaces all string
* values by its own copies. Since the original v is held in
* the driver_hook[] array, this is safe to do.
*/
{
size_t i;
char *p;
svalue_t *svp;
mp_int len, max;
/* Count and test the passed pathnames */
svp = v->item;
for (i = 0, max = 0; i < (size_t)VEC_SIZE(v); i++, svp++)
{
string_t *new;
if (svp->type != T_STRING)
{
errorf("H_INCLUDE_DIRS argument has a non-string array element\n");
}
/* Set p to the beginning of the pathname, skipping leading
* '/' and './'.
*/
p = get_txt(svp->u.str);
for(;;) {
if (*p == '/')
p++;
else if (*p == '.' && p[1] == '/')
p += 2;
else
break;
}
/* Is the path legal? */
if (!legal_path(p))
{
errorf("H_INCLUDE_DIRS path contains '..'\n");
}
if (*p == '.' && !p[1])
errorf("H_INCLUDE_DIRS path is a single prefix dot\n");
len = (mp_int)strlen(p);
if (max < len)
max = len;
if (len >= 2 && p[len -1] == '.' && p[len - 2] == '/')
errorf("H_INCLUDE_DIRS path ends in single prefix dot\n");
/* Get and store our own copy of the pathname */
new = unshare_mstring(svp->u.str);
if (!new)
errorf("Out of memory\n");
put_string(svp, new); /* dup() already freed it */
}
inc_list = v->item;
inc_list_size = VEC_SIZE(v);
inc_list_maxlen = max;
} /* set_inc_list() */
/*-------------------------------------------------------------------------*/
static char *
get_current_file (char ** args UNUSED)
/* Dynamic macro __FILE__: return the name of the current file.
* In compat mode, don't return a leading slash.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *buf;
buf = xalloc(strlen(current_loc.file->name)+4);
if (!buf)
return NULL;
if (compat_mode)
sprintf(buf, "\"%s\"", current_loc.file->name);
else
sprintf(buf, "\"/%s\"", current_loc.file->name);
return buf;
} /* get_current_file() */
/*-------------------------------------------------------------------------*/
static char *
get_current_dir (char ** args UNUSED)
/* Dynamic macro __DIR__: return the directory of the current file.
* In compat mode, don't return a leading slash.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *buf;
int len;
buf = current_loc.file->name + strlen(current_loc.file->name);
while (*(--buf) != '/' && buf >= current_loc.file->name) NOOP;
len = (buf - current_loc.file->name) + 1;
buf = xalloc(len + 4);
if (!buf)
return NULL;
if (compat_mode)
sprintf(buf, "\"%.*s\"", len, current_loc.file->name);
else
sprintf(buf, "\"/%.*s\"", len, current_loc.file->name);
return buf;
} /* get_current_dir() */
/*-------------------------------------------------------------------------*/
static char *
get_sub_path (char ** args)
/* Dynamic macro __PATH__(n): return the directory of the current file,
* where n is the number of directories to pop off from the right.
* In compat mode, don't return a leading slash.
*/
{
char *buf;
int len, rm;
rm = 0;
sscanf(*args, "%d", &rm);
if (rm < 0)
rm = 0;
buf = current_loc.file->name + strlen(current_loc.file->name);
while (rm >= 0 && buf >= current_loc.file->name)
if (*(--buf) == '/')
rm--;
len = (buf - current_loc.file->name) + 1;
buf = alloca(len + 4);
if (compat_mode)
sprintf(buf, "\"%.*s\"", len, current_loc.file->name);
else
sprintf(buf, "\"/%.*s\"", len, current_loc.file->name);
add_input(buf);
return NULL;
} /* get_sub_path() */
/*-------------------------------------------------------------------------*/
static char *
get_current_line (char ** args UNUSED)
/* Dynamic macro __LINE__: return the number of the current line.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *buf;
buf = xalloc(12);
if (!buf)
return NULL;
sprintf(buf, "%d", current_loc.line);
return buf;
} /* get_current_line() */
/*-------------------------------------------------------------------------*/
static char *
get_version(char ** args UNUSED)
/* Dynamic macro __VERSION__: return the driver version.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *buf;
size_t len;
len = strlen(DRIVER_VERSION LOCAL_LEVEL);
buf = xalloc(3 + len);
if (!buf) return 0;
buf[0] = '"';
strcpy(buf+1, DRIVER_VERSION LOCAL_LEVEL);
buf[len+1] = '"';
buf[len+2] = '\0';
return buf;
} /* get_version() */
/*-------------------------------------------------------------------------*/
static char *
get_hostname (char ** args UNUSED)
/* Dynamic macro __HOSTNAME__: return the hostname.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *tmp, *buf;
tmp = query_host_name();
buf = xalloc(strlen(tmp)+3);
if (!buf) return 0;
sprintf(buf, "\"%s\"", tmp);
return buf;
} /* get_hostname() */
/*-------------------------------------------------------------------------*/
static char *
get_domainname (char ** args UNUSED)
/* Dynamic macro __DOMAINNAME__: return the domainname.
*/
{
#ifdef __MWERKS__
# pragma unused(args)
#endif
char *buf;
buf = xalloc(strlen(domain_name)+3);
if (!buf)
return 0;
sprintf(buf, "\"%s\"", domain_name);
return buf;
} /* get_domainname() */
/*-------------------------------------------------------------------------*/
static char *
efun_defined (char **args)
/* Dynamic macro __EFUN_DEFINE__(name): test if the efun is defined
* and add ' 0 ' or ' 1 ' depending on the result.
*/
{
ident_t *p;
p = make_shared_identifier(args[0], I_TYPE_GLOBAL, 0);
if (!p)
{
lexerror("Out of memory");
return NULL;
}
while (p->type > I_TYPE_GLOBAL)
{
if ( !(p = p->inferior) )
break;
}
add_input(
(p && p->type == I_TYPE_GLOBAL && p->u.global.efun >= 0) ?
" 1 " : " 0 "
);
if (p && p->type == I_TYPE_UNKNOWN)
free_shared_identifier(p);
return NULL;
} /* efun_defined() */
/*-------------------------------------------------------------------------*/
void
remove_unknown_identifier (void)
/* Remove all identifiers from the ident_table[] which are of
* type I_TYPE_UNKNOWN.
*/
{
int i;
ident_t *id, *next;
for (i = ITABLE_SIZE; --i >= 0; )
{
id = ident_table[i];
for ( ; id; id = next)
{
next = id->next;
if (id->type == I_TYPE_UNKNOWN)
free_shared_identifier(id);
}
}
} /* remove_unknown_identifier() */
/*-------------------------------------------------------------------------*/
size_t
show_lexer_status (strbuf_t * sbuf, Bool verbose UNUSED)
/* Return the amount of memory used by the lexer.
*/
{
#if defined(__MWERKS__)
# pragma unused(verbose)
#endif
size_t sum;
ident_t *p;
int i;
sum = 0;
/* Count the space used by identifiers and defines */
for (i = ITABLE_SIZE; --i >= 0; )
{
p = ident_table[i];
for ( ; p; p = p->next) {
sum += sizeof(*p);
if (p->name && p->type == I_TYPE_DEFINE && !p->u.define.special)
sum += strlen(p->u.define.exps.str)+1;
}
}
sum += mempool_size(lexpool);
sum += defbuf_len;
sum += 2 * DEFMAX; /* for the buffers in _expand_define() */
if (sbuf)
strbuf_addf(sbuf, "Lexer structures\t\t\t %9zu\n", sum);
return sum;
} /* show_lexer_status() */
/*-------------------------------------------------------------------------*/
#ifdef GC_SUPPORT
static INLINE void
count_ident_refs (ident_t *id)
/* GC support: count all references held by one identifier (ignoring
* inferiors).
*/
{
count_ref_from_string(id->name);
note_malloced_block_ref(id);
} /* count_ident_refs() */
/*-------------------------------------------------------------------------*/
void
count_lex_refs (void)
/* GC support: count all references held by the lexer.
*/
{
int i;
ident_t *id;
/* Identifier */
for (i = ITABLE_SIZE; --i >= 0; )
{
id = ident_table[i];
for ( ; id; id = id->next)
{
ident_t *id2;
count_ident_refs(id);
for (id2 = id->inferior; id2 != NULL; id2 = id2->next)
{
count_ident_refs(id2);
}
}
}
for (id = permanent_defines; id; id = id->next_all)
{
if (!id->u.define.special)
note_malloced_block_ref(id->u.define.exps.str);
}
if (defbuf_len)
note_malloced_block_ref(defbuf);
if (lexpool)
mempool_note_refs(lexpool);
}
#endif /* GC_SUPPORT */
/*-------------------------------------------------------------------------*/
char *
lex_error_context (void)
/* Create the current lexing context in a static buffer and return its
* pointer.
*/
{
static char buf[21];
char *end;
mp_int len;
if (!pragma_verbose_errors)
return "";
strcpy(buf, ((signed char)yychar == -1 || yychar == CHAR_EOF)
? (len = 6, " near ")
: (len = 8, " before "));
if (!yychar || !*outp)
{
strcpy(buf+len, "end of line");
}
else if ((signed char)*outp == -1 || *outp == CHAR_EOF)
{
strcpy(buf+len, "end of file");
}
else
{
ssize_t left;
left = linebufend - outp;
if (left > (ssize_t)sizeof(buf) - 3 - len)
left = sizeof(buf) - 3 - len;
if (left < 1)
buf[0] = '\0';
else
{
buf[len] = '\'';
strncpy(buf + len + 1, outp, left);
buf[len + left + 1] = '\'';
buf[len + left + 2] = '\0';
if ( NULL != (end = strchr(buf, '\n')) )
{
*end = '\'';
*(end+1) = '\0';
if (buf[len+1] == '\'')
strcpy(buf+len, "end of line");
}
if ( NULL != (end = strchr(buf, -1)) )
{
*end = '\'';
*(end+1) = '\0';
if (buf[len+1] == '\'')
strcpy(buf+len, "end of file");
}
}
}
return buf;
} /* lex_error_context() */
/*-------------------------------------------------------------------------*/
svalue_t *
f_expand_define (svalue_t *sp)
/* EFUN expand_define()
*
* string expand_define (string name)
* string expand_define (string name, string arg, ...)
*
* Expands the macro <name> with the argument(s) <arg>... (default is
* one empty string "").
* Result is the expanded macro, or 0 if there is no macro with
* that name.
*
* This efun is applicable only while an object is compiled,
* therefore its usage is restricted to a few functions like the
* H_INCLUDE_DIRS driver hook, or the masters runtime_error()
* function.
* TODO: Right now, only one arg is evaluated.
*/
{
char *arg, *end;
string_t *res;
ident_t *d;
/* Get the arguments from the stack */
if (sp->type == T_STRING)
{
arg = get_txt(sp->u.str);
/* TODO: Concatenate all strings on the stack */
}
else /* it's the number 0 */
arg = "";
res = NULL;
/* If we are compiling, lookup the given name and store
* the expansion in res.
*/
if (current_loc.file && current_loc.file->name
&& outp > defbuf && outp <= &defbuf[defbuf_len])
{
myungetc('\n');
end = outp;
add_input(arg);
d = lookup_define(get_txt(sp[-1].u.str));
if (d && _expand_define(&d->u.define, d) )
{
*end = '\0';
res = new_mstring(outp);
*end = '\n'; /* Restore the newline character */
}
outp = &end[1];
}
free_svalue(sp);
free_svalue(--sp);
/* Return the result */
if (!res)
{
put_number(sp, 0);
}
else
{
put_string(sp, res);
}
return sp;
} /* f_expand_define() */
/***************************************************************************/