psyc-mirrors
/
psyclpc
mirror of git://git.psyced.org/git/psyclpc
1
0
Fork 0
Code Issues Releases Wiki Activity
psyclpc/src/prolang.y

16909 lines
517 KiB
Plaintext
Raw Blame History

%{
%line
/*---------------------------------------------------------------------------
* LPC compiler
*
*---------------------------------------------------------------------------
* TODO: Some code parts 'know' which instructions are xcodes and which normal.
* TODO:: Conditional compiles would be nice there.
* TODO: The handling of virtual inherits is a bit vague, too.
*
* This is the grammar definition and bytecode compiler of LPC. However, this
* file is not passed to byacc directly, but first preprocessed by make_func,
* among other things to synchronise the tokens with the other bytecodes
* (reason being that yacc doesn't know an include construct). The following
* keywords are recognized and replaced by make_func:
*
* %line: generates a #line statement to synchronize the C compiler.
*
* %typemap TYPE<name>:<value>,...,TYPE_<name>:<value>
* Generates a lookup table TYPE_<name> -> <value>. Unspecified
* TYPEs are given the value 0.
*
* %hookmap <hookname>:<value>,...,<hookname>:<value>
* Generates a lookup table <hookname> -> <value>. Unspecified
* driverhook entries are given the value 0.
*
* In addition, make_func implements a simple preprocessor using the
* keywords %if, %elif, %else and %endif so that parsing rules can be
* activated/deactivated from config.h defines.
*---------------------------------------------------------------------------
* To compile a file, open the file to yield a filedescriptor 'fd', then call
*
* compile_file(fd, <filename>, <isMasterObj>);
*
* then close the file again. The compiled program is 'returned' in
* the global compiled_prog - on error, this variable is returned as NULL.
* If after the compilation the variable inherit_file is
* not NULL, the compilation failed because it encountered an
* "inherit 'name'" statement for which no object could be found: the
* 'name' was stored in inherit_file and has to be compiled first.
*
* It is the task of the caller to make sure that the compiler is not called
* recursively.
*
* If there is any initialization of a global variable, a function '__INIT'
* is generated with the initialization code. The code is generated in
* fragments whenever a variable initialization is encountered; the fragments
* are therefore potentially spread over the whole program code. The fragments
* are linked by JUMP instructions with jump to the next fragment, just
* the last fragment ends in a RETURN0.
*
* When inheriting from another object, a call will automatically be made
* to call __INIT in that code from the current __INIT.
*---------------------------------------------------------------------------
* The compiler is a simple one-pass compiler with immediate code generation.
* The problem of forward references is solved with various backpatching
* structures (explained where declared).
*
* The most tricky part is that of lvalue (and with it reference) generation
* in contexts where rvalues are sensible as well. This is so especially
* because the order of arguments on the stack differs between the
* instructions :-(. The approach is to generate rvalues, but keep the
* position, and size and alternatives of the instruction(s) in a struct
* lrvalue, so that a later change into lvalues is possible. Additionally
* these instructions can be modified to generated protected lvalues as well.
* TODO: This whole thing is quite complex and not very well documented.
* TODO:: It's propably easier to rewrite interpreter and compiler...
*
#ifdef USE_NEW_INLINES
* Another challenge is the compilation of inline closures, as they
* are implemented as separate lfuns (with synthetic names), but encountered
* in the middle of a regular lfun or even another inline closure. The
* compiler therefore stores his state when it recognizes another
* inline closures, and then resets its state as if a normal lfun is
* compiled. When the inline closure is complete, its data is moved into
* a backup storage area, and the compiler restores its previous state.
#endif
*---------------------------------------------------------------------------
*/
#undef lint /* undef so that precompiled headers can be used */
#include "driver.h"
#include "typedefs.h"
#include "my-alloca.h"
#include <ctype.h>
#include <stdio.h>
#include <stdarg.h>
#include <assert.h>
#include "prolang.h"
#include "array.h"
#include "backend.h"
#include "closure.h"
#include "exec.h"
#include "gcollect.h"
#include "interpret.h"
#include "instrs.h"
#include "lex.h"
#include "main.h"
#include "mapping.h"
#include "mstrings.h"
#include "object.h"
#include "simulate.h"
#include "simul_efun.h"
#include "stdstrings.h"
#ifdef USE_STRUCTS
#include "structs.h"
#endif
#include "svalue.h"
#include "swap.h"
#include "switch.h"
#include "wiz_list.h"
#include "xalloc.h"
#include "i-eval_cost.h"
#include "../mudlib/sys/driver_hook.h"
#ifdef USE_NEW_INLINES
# undef DEBUG_INLINES
/* Define this to activate lots of debugging output during the compilation
* of inline closures.
*/
#endif /* USE_NEW_INLINES */
#define lint /* redef again to prevent spurious warnings */
#define YYMAXDEPTH 600
/*-------------------------------------------------------------------------*/
typedef struct block_scope_s block_scope_t;
typedef struct const_list_s const_list_t;
typedef struct const_list_svalue_s const_list_svalue_t;
#ifdef USE_STRUCTS
typedef struct struct_init_s struct_init_t;
#endif /* USE_STRUCTS */
typedef struct efun_shadow_s efun_shadow_t;
typedef struct mem_block_s mem_block_t;
/*-------------------------------------------------------------------------*/
/* Exported result variables */
int32 current_id_number = 0;
/* The id-number of the compiled program.
*/
int num_virtual_variables;
/* Number of virtual variables.
* When creating the bytecode, the non-virtual variable indices
* are offset by this value, in effect collecting the virtual
* variables at the start of the variable indices.
*/
program_t *compiled_prog;
/* After yyparse(), the finished program.
*/
string_t *inherit_file;
/* Used as a flag: if it is set to a tabled string after yyparse(),
* this string should be loaded as an object, and the original object
* must be loaded again.
*/
int num_parse_error;
/* Number of errors in the compile.
*/
Bool variables_defined;
/* TRUE: Variable definitions have been encountered.
*/
/*-------------------------------------------------------------------------*/
/* Table which hook may be of which type.
* It is here because make_func has to touch this file anyway, but
* it will be used by simulate:f_set_driver_hook().
*/
#define SH(x) - -(1 << (x))
short hook_type_map[NUM_DRIVER_HOOKS] =
%hookmap \
H_MOVE_OBJECT0: 0, \
H_MOVE_OBJECT1: 0, \
H_LOAD_UIDS: SH(T_CLOSURE), \
H_CLONE_UIDS: SH(T_CLOSURE), \
H_CREATE_SUPER: SH(T_STRING), \
H_CREATE_OB: SH(T_STRING), \
H_CREATE_CLONE: SH(T_STRING), \
H_RESET: SH(T_STRING), \
H_CLEAN_UP: SH(T_CLOSURE) SH(T_STRING), \
H_MODIFY_COMMAND: SH(T_CLOSURE) SH(T_STRING) SH(T_MAPPING), \
H_NOTIFY_FAIL: SH(T_CLOSURE) SH(T_STRING), \
H_NO_IPC_SLOT: SH(T_STRING), \
H_INCLUDE_DIRS: SH(T_CLOSURE) SH(T_POINTER), \
H_TELNET_NEG: SH(T_CLOSURE) SH(T_STRING), \
H_NOECHO: SH(T_CLOSURE) SH(T_STRING), \
H_ERQ_STOP: SH(T_CLOSURE), \
H_MODIFY_COMMAND_FNAME: SH(T_STRING), \
H_COMMAND: SH(T_CLOSURE) SH(T_STRING), \
H_SEND_NOTIFY_FAIL: SH(T_CLOSURE) SH(T_STRING), \
H_AUTO_INCLUDE: SH(T_CLOSURE) SH(T_STRING), \
H_DEFAULT_METHOD: SH(T_CLOSURE) SH(T_STRING), \
H_DEFAULT_PROMPT: SH(T_CLOSURE) SH(T_STRING), \
H_PRINT_PROMPT: SH(T_CLOSURE) SH(T_STRING), \
H_REGEXP_PACKAGE: SH(T_NUMBER), \
#undef SH
/*-------------------------------------------------------------------------*/
/* Types */
/* --- struct const_list_s: One element in a constant list ---
*
* When initializing variables statically with arrays ({ ... }),
* a list of these structures is used to collect the information about
* the array content.
*/
struct const_list_s
{
const_list_t *next;
svalue_t val;
#ifdef USE_STRUCTS
string_t * member; /* NULL, or the member name to initialize */
#endif
};
/* --- struct const_list_svalue_s: Head of a constant list ---
*
* When initializing variables statically with arrays ({ ... }),
* the initializer-svalue_t* will point to an instance of this c_l_svalue_s.
* In fact, the initializer points to the .head member.
*
* The .head svalue_t is a T_ERROR_HANDLER pointing to a deallocation
* function for the list.
*/
struct const_list_svalue_s
{
svalue_t head; /* the error handler */
const_list_t list; /* First element of the list */
#ifdef USE_STRUCTS
const_list_t *last_member; /* For nested struct initialisations */
#endif /* USE_STRUCTS */
};
#ifdef USE_STRUCTS
/* --- struct struct_init_s: Descriptor for one struct literal member
*
* When createing struct literals at runtime, a list of these structures
* keeps the information about the order and type of members encountered.
*/
struct struct_init_s
{
struct_init_t * next; /* Next member entry */
vartype_t type; /* Type of expression */
string_t * name; /* Member name, or NULL if unnamed */
};
#endif /* USE_STRUCTS */
/* --- struct efun_shadow_s: Store info about masked efuns ---
*
* This structure is used when global identifiers shadow efun names.
*/
struct efun_shadow_s
{
efun_shadow_t *next; /* Linkpointer for the list of shadows */
ident_t *shadow; /* Identifier of the shadow */
};
/*-------------------------------------------------------------------------*/
/* Macros */
#define NON_VIRTUAL_OFFSET_TAG 0x4000
/* Tag or'ed on inherit.variable_index_offset for non-virtual
* inherits for the duration of the compilation.
* The variable_index_offsets of such marked variables do not
* yet the the num_virtual_variables offset into account.
*/
#define align(x) (((x) + (sizeof(char*)-1) ) & ~(sizeof(char*)-1) )
#define defined_function(s) \
((s)->type == I_TYPE_GLOBAL ? (s)->u.global.function : -1)
/* Return the index of the function <s> if global (and therefore existing),
* and -1 otherwise.
*/
#ifdef USE_STRUCTS
#define set_vartype(t, id, ptr) \
( t.type = (id), t.t_struct = (ptr) )
#define set_fulltype(t, id, ptr) \
( t.typeflags = (id), t.t_struct = (ptr) )
#else
#define set_vartype(t, id, ptr) \
( t.type = (id) )
#define set_fulltype(t, id, ptr) \
( t.typeflags = (id) )
#endif
/* Set the full/vartype <t> to type(flags) <id> and the struct
* typeobject pointer to <ptr>.
*/
#define NEW_INHERITED_INDEX (0xfffff)
/* While inserting a new inherit, this marks the newly inherited
* things.
*/
/* Values for %type <number> foreach_expr
*/
#define FOREACH_LOOP 0 /* Normal foreach loop value */
#define FOREACH_REF 1 /* Referenced foreach loop value */
#define FOREACH_RANGE 2 /* Integer range as loop value */
/*-------------------------------------------------------------------------*/
/* The generated information (code and otherwise) is kept in several
* memory areas, each of which can grow dynamically and independent
* from the others.
*
* The first NUMPAREAS are save with the program code after compilation,
* the others are of internal use for the compiler only.
*/
enum e_saved_areas {
A_PROGRAM = 0
/* (bytecode_t): Program code.
*/
, A_STRINGS
/* (string_t*) Strings used by the program, all tabled.
*/
, A_VARIABLES
/* (variable_t) The information for all non-virtual variables.
*/
, A_VIRTUAL_VAR
/* (variable_t) The information for all virtual variables.
*/
, A_LINENUMBERS
/* (char) The linenumber information.
*/
, A_INHERITS
/* (inherit_t) The information for the inherited programs.
*/
, A_ARGUMENT_TYPES
/* (vartype_t) Types of the arguments of all functions with
* typechecking. The argument types for a specific function
* can be found using the ARGUMENT_INDEX
*/
, A_ARGUMENT_INDEX
/* (unsigned short) Index of the first argument type of function <n>.
* INDEX_START_NONE is used for functions with no type information.
*/
, A_INCLUDES
/* (include_t) Tabled descriptors of all included files, in the order
* of appearance.
*/
#ifdef USE_STRUCTS
, A_STRUCT_DEFS
/* (struct_def_t) Tabled descriptors of all struct definitions.
*/
#endif /* USE_STRUCTS */
, NUMPAREAS /* Number of saved areas */
};
enum e_internal_areas {
A_FUNCTIONS = NUMPAREAS
/* (function_t): Function definitions
*/
, A_STRING_NEXT
/* (int) During compilation, the strings in A_STRINGS are organized
* in a hash table (prog_string_indizes/_tags). The hash chains are
* linked together using the indizes in this area. The end of
* a chain is marked by a negative next-index.
*/
, A_LOCAL_TYPES
/* (fulltype_t) The full types of local and context variables.
#ifdef USE_NEW_INLINES
* For normal functions, only the beginning of the area is used.
* The rest is used stack-wise for nested inline closures.
#endif
*/
%ifdef USE_NEW_INLINES
, A_INLINE_PROGRAM
/* (bytecode_t, char): Program and linenumbers saved from the compiled
* but not yet inserted inline closures.
*/
, A_INLINE_CLOSURE
/* (inline_closure_t): The currently pending inline closures. The lexical
* nesting is achieved with the .prev/.next pointers in the
* inline_closure_t structures.
*/
%endif /* USE_NEW_INLINES */
#ifdef USE_STRUCTS
, A_STRUCT_MEMBERS
/* (struct_member_t) While a struct definition is parsed, the member
* descriptors are collected here.
*/
#endif /* USE_STRUCTS */
, NUMAREAS /* Total number of areas */
};
/* --- struct mem_block_s: One memory area ---
* Every mem_block keeps one memory area. As it grows by using realloc(),
* no pointers should be kept into such an area (offsets are ok).
*/
struct mem_block_s
{
char *block; /* Pointer to the allocated memory */
mp_uint current_size; /* Used size of the mem_block */
mp_uint max_size; /* Allocated size of the mem_block */
};
#define START_BLOCK_SIZE 2048
/* Initial size of an area/mem_block.
*/
static mem_block_t mem_block[NUMAREAS];
/* All memory areas.
*/
#define PROGRAM_BLOCK ((bytecode_p)(mem_block[A_PROGRAM].block))
/* The current program block, properly typed.
*/
#define CURRENT_PROGRAM_SIZE (mem_block[A_PROGRAM].current_size)
/* The current program size.
*/
#define LINENUMBER_BLOCK ((char *)(mem_block[A_LINENUMBERS].block))
/* The current linenumber block, properly typed.
*/
#define LINENUMBER_SIZE (mem_block[A_LINENUMBERS].current_size)
/* The current linenumber data size.
*/
#define FUNCTION(n) ((function_t *)mem_block[A_FUNCTIONS].block + (n))
/* Return the function_t* for function number <n>.
*/
#define FUNCTION_COUNT (mem_block[A_FUNCTIONS].current_size / sizeof (function_t))
/* Number of function_t stored so far in A_FUNCTIONS.
*/
#define INHERIT_COUNT (mem_block[A_INHERITS].current_size / sizeof(inherit_t))
/* Number of inherit_t stored so far in A_INHERITS.
*/
#define ARGUMENT_INDEX(n) ((unsigned short *)mem_block[A_ARGUMENT_INDEX].block)[n]
/* Lookup the start index of the types for function number <n>.
*/
#define ARGTYPE_COUNT (mem_block[A_ARGUMENT_TYPES].current_size / sizeof(vartype_t))
/* Number of vartype_t stored so far in A_ARGUMENT_TYPES.
*/
#define ARGUMENT_TYPE(n) ((vartype_t *)mem_block[A_ARGUMENT_TYPES].block)[n]
/* Index the vartype_t <n>.
*/
#define NV_VARIABLE(n) ((variable_t *)mem_block[A_VARIABLES].block + (n))
/* Return the variable_t* for the non-virtual variable <n>.
*/
#define NV_VARIABLE_COUNT (mem_block[A_VARIABLES].current_size / sizeof(variable_t))
#define V_VARIABLE_COUNT (mem_block[A_VIRTUAL_VAR].current_size / sizeof(variable_t))
/* Number of variables stored so var in A_VARIABLES resp. A_VIRTUAL_VAR.
*/
#define V_VARIABLE(n) ((variable_t *)mem_block[A_VIRTUAL_VAR].block + \
(n) - VIRTUAL_VAR_TAG)
/* Return the variable_t* for the virtual variable <n> (still including
* the offset).
*/
#define VARIABLE(n) ((n) & VIRTUAL_VAR_TAG ? V_VARIABLE(n) : NV_VARIABLE(n))
/* Return the variable_t* for the variable <n>, virtual or not.
*/
#define INHERIT(n) ((inherit_t *)mem_block[A_INHERITS].block)[n]
/* Index the inherit_t <n>.
*/
#define INHERIT_COUNT (mem_block[A_INHERITS].current_size / sizeof(inherit_t))
/* Return the number of inherits encountered so far.
*/
#ifdef USE_STRUCTS
#define STRUCT_DEF(n) ((struct_def_t *)mem_block[A_STRUCT_DEFS].block)[n]
/* Index the struct_def_t <n>.
*/
#define STRUCT_COUNT (mem_block[A_STRUCT_DEFS].current_size / sizeof(struct_def_t))
/* Return the number of structs encountered so far.
*/
#define STRUCT_MEMBER(n) ((struct_member_t *)mem_block[A_STRUCT_MEMBERS].block)[n]
/* Index the struct_member_t <n>.
*/
#define STRUCT_MEMBER_COUNT (mem_block[A_STRUCT_MEMBERS].current_size / sizeof(struct_member_t))
/* Return the number of struct members stored.
*/
#endif /* USE_STRUCTS */
#define PROG_STRING(n) ((string_t **)mem_block[A_STRINGS].block)[n]
/* Index the pointer for program string <n>.
*/
#define STRING_COUNT (mem_block[A_STRINGS].current_size / sizeof(string_t *))
/* Return the number of program strings encountered so far.
*/
#define PROG_STRING_NEXT(n) ((int *)mem_block[A_STRING_NEXT].block)[n]
/* Index the chain-index for program string <n>.
*/
#define INCLUDE_COUNT (mem_block[A_INCLUDES].current_size / sizeof(include_t))
/* Return the total number of include files encountered so far.
*/
#define LOCAL_TYPE_COUNT (mem_block[A_LOCAL_TYPES].current_size / sizeof(fulltype_t))
/* Return the total number of types.
*/
#define LOCAL_TYPE(n) ((fulltype_t *)mem_block[A_LOCAL_TYPES].block)[n]
/* Return the local/context var type at index <n>.
*/
%ifdef USE_NEW_INLINES
#define INLINE_PROGRAM_BLOCK(n) ((bytecode_p)(mem_block[A_INLINE_PROGRAM].block + (n)))
/* Return the inline-closure program block at address <n>, properly typed.
*/
#define INLINE_PROGRAM_SIZE (mem_block[A_INLINE_PROGRAM].current_size)
/* The current program size.
*/
#define INLINE_CLOSURE(n) ((inline_closure_t *)mem_block[A_INLINE_CLOSURE].block)[n]
/* Return the inline-closure program block at address <n>, properly typed.
*/
#define INLINE_CLOSURE_COUNT (mem_block[A_INLINE_CLOSURE].current_size/sizeof(inline_closure_t))
/* Return the number of saved inline-closures.
*/
%endif /* USE_NEW_INLINES */
/*-------------------------------------------------------------------------*/
/* Information describing nested local blocks (scopes).
*/
struct block_scope_s
{
int first_local; /* Number of first local defined in this scope */
int num_locals; /* Number of locals defined in this scope */
int num_cleared;
/* Number of locals that have been cleared by earlier CLEAR_LOCALS */
Bool clobbered;
/* Local variables beyond num_locals may be clobbered */
mp_uint addr;
/* Address of CLEAR_LOCALS instruction, needed for backpatching */
};
static block_scope_t block_scope[COMPILER_STACK_SIZE];
/* A static stack of block scopes, indexed by <block_depth>-1.
* TODO: This should be dynamic.
*/
static int block_depth;
/* The nesting depth of blocks ( '{ ... }' ), used to distinguish
* local variable definitions.
* block_depth = 0: not used, would mean 'global'
* = 1: function arguments
* = 2: function local variables
* > 2: vars of nested blocks within the function
*/
static Bool use_local_scopes;
/* Copy of pragma_use_local_scopes, updated at every entry into
* a function. Reason is that the pragma must not change inside
* a function.
*/
/*-------------------------------------------------------------------------*/
#ifdef USE_NEW_INLINES
/* Information describing inline closures.
*/
typedef struct inline_closure_s inline_closure_t;
struct inline_closure_s
{
mp_int prev;
/* Index of the enclosing inline closure, or -1 if none.
*/
/* --- Compilation information --- */
mp_uint end;
/* While compiling the closure: end of the program code before
* the closure. It is not identical to .start because of alignment.
*/
mp_uint start;
/* While compiling the closure: start address of the code in A_PROGRAM.
* For pending closures: start address of the code in A_INLINE_PROGRAM.
*/
mp_uint length;
/* Length of the compiled code.
*/
mp_uint li_start;
/* While compiling the closure: start address of the data in
* A_LINENUMBERS.
* For pending closures: start address of the data in A_INLINE_PROGRAM.
*/
mp_uint li_length;
/* Length of the linenumber data.
*/
int function;
/* Function index
*/
fulltype_t returntype;
/* The return type (uncounted reference).
*/
ident_t * ident;
/* The ident entry with the function name.
*/
int num_args;
/* Number of arguments.
*/
Bool parse_context;
/* TRUE if the context variable definitions are parsed.
*/
int start_line;
/* Starting line number, used to adjust the generated linenumbers.
*/
int end_line;
/* Ending line number, used to adjust the generated linenumbers.
*/
/* --- Saved Globals --- */
void * include_handle;
/* Current include state.
*/
fulltype_t exact_types;
/* The enclosing return type setting (reference not counted).
*/
int block_depth;
/* Block depth at definition point.
* +1: Context depth
* +2: Argument depth
*/
int num_locals;
int max_num_locals;
/* Current and max number of locals at definition point.
*/
int break_stack_size;
int max_break_stack_size;
/* Current and max break stack size at definition point.
*/
mp_uint full_local_type_start;
mp_uint full_context_type_start;
/* Start indices of the local/context variable type information
* in A_LOCAL_TYPES.
*/
mp_uint full_local_type_size;
/* Current size of the A_LOCAL_TYPES memblocks.
*/
};
static inline_closure_t * current_inline;
/* NULL, or pointer to the current inline_closure_t structure while
* compiling an inline closure.
* This variable is also used as flag that we're currently compiling
* an inline_closure.
*/
static unsigned int inline_closure_id;
/* ID Number for the inline closure name.
*/
#endif /* USE_NEW_INLINES */
/*-------------------------------------------------------------------------*/
/* Other Variables */
static Bool disable_sefuns;
/* TRUE: Sefuns will be ignored.
*/
static char *last_yalloced = NULL;
/* Head of blocklist allocated with yalloc().
*/
static program_t NULL_program;
/* Empty program_t structure for initialisations.
*/
static p_int comp_stack[COMPILER_STACK_SIZE];
/* A stack of addresses (offsets) in the generated program code for
* later backpatching.
*/
static size_t comp_stackp;
/* Index of the next unused entry in <comp_stack>.
*/
static p_int last_initializer_end;
/* Address of the argument of the final JUMP instruction of the
* previous INIT fragment.
* A negative value if there is no previous fragment (this also means
* that the INIT functions hasn't been created yet).
*/
static p_int first_initializer_start;
/* Address of the 'num_arg' byte in the function header of the first
* INIT fragment.
*/
static Bool variables_initialized;
/* TRUE if the code for all variables has been created.
*/
static fulltype_t def_function_returntype;
static ident_t * def_function_ident;
static int def_function_num_args;
/* Globals to keep the state while a function is parsed:
* _returntype: the returntype (uncounted reference)
* _ident: the function's identifier.
* _num_args: number of formal arguments.
*/
static mem_block_t type_of_arguments;
/* The vartypes of arguments when calling functions must be saved,
* to be used afterwards for checking. And because function calls
* can be done as an argument to a function calls, a stack of argument types
* is needed. This stack does not need to be freed between compilations,
* but will be reused.
*/
static fulltype_t * type_of_locals = NULL;
/* The full types of the local variables.
* Points to a location in mem_block A_LOCAL_TYPES, it is NULL between
* compilations.
*/
#ifdef USE_NEW_INLINES
static fulltype_t * type_of_context = NULL;
/* The full types of the context variables.
* Points to a location in mem_block A_LOCAL_TYPES, it is NULL between
* compilations.
*/
#endif /* USE_NEW_INLINES */
static int current_number_of_locals = 0;
/* Current (active) number of local variables at this point in the
* function.
*/
static int max_number_of_locals = 0;
/* Total number of local variables used in this function so far.
*/
static ident_t *all_locals = NULL;
/* List of defined local variables, listed in reverse order of definition.
* This also means that the variables are listed in reverse order of
* nested block scopes.
*/
static fulltype_t exact_types;
/* If .typeflags is 0, don't check nor require argument and function types.
* Otherwise it's the full return type of the function, including
* visibility (reference not counted).
*/
static funflag_t default_varmod;
static funflag_t default_funmod;
/* Default visibility modifiers for variables resp. function.
*/
static int heart_beat;
/* Number of the heart_beat() function, or < 0 if none.
*/
static int call_other_sefun;
/* Index of the call_other() sefun, or < 0 if none;
*/
static ident_t *all_globals = NULL;
/* List of all created global identifiers (variables and functions).
*/
static efun_shadow_t *all_efun_shadows = NULL;
/* List of all shadow markers for efuns shadowed by global identifiers.
*/
static p_int switch_pc;
/* When compiling a switch, this is the address of the first byte
* after the SWITCH instruction.
*/
static p_int current_break_address;
/* If != 0, the compiler is in a break-able environment and this
* variable points to the first offset-part of a series of LBRANCHes
* which implement the break statement. Stored in every offset-part
* is the address of the offset of the next LBRANCH in the series. The
* last FBRANCH is marked by having a negative offset value.
*
* There are a few special values/flags for this variable:
*/
#define BREAK_ADDRESS_MASK 0x0003ffff
/* Mask for the offset-address part of the variable.
*/
#define BREAK_ON_STACK (0x04000000)
/* Bitflag: true when the break-address is stored on the break stack,
* and therefore the BREAK instruction has to be used.
*/
#define BREAK_FROM_SWITCH (0x08000000)
/* TODO: We are compiling a switch instruction.
*/
#define CASE_LABELS_ENABLED (0x10000000)
/* The "case" and "default" statements are allowed since we're
* compiling a switch(). This flag is turned off for loops or
* conditions embedded in a switch().
*/
#define BREAK_DELIMITER (-0x20000000)
/* Special value: no break encountered (yet).
*/
static p_int current_continue_address;
/* If != 0, the compiler is in a continue-able environment and this
* variable points to the first offset-part of a series of FBRANCHes
* which implement the continue statement. Stored in every offset-part
* is the address of the offset of the next FBRANCH in the series. The
* last FBRANCH is marked by having a negative offset value.
*
* A special case are continues inside a switch, as for these the
* switch()es have to be terminated too using the BREAK_CONTINUE
* instructions (which also have an offset-part). The c_c_a therefore
* also encodes the switch()-nesting depth in the top bits of the
* variable.
*/
#define CONTINUE_ADDRESS_MASK 0x0003ffff
/* Mask for the offset-address part of the variable.
*/
#define SWITCH_DEPTH_UNIT 0x00040000
/* The switch depth is encoded in multiples of this value.
* This way we don't have to shift.
*/
#define SWITCH_DEPTH_MASK 0x3ffc0000
/* Mask for the switch-nesting depth part of the variable.
*/
#define CONTINUE_DELIMITER -0x40000000
/* Special value: no continue encountered (yet).
*/
#ifdef USE_STRUCTS
static int current_struct;
/* Index of the current structure to be defined.
*/
#endif /* USE_STRUCTS */
static p_uint last_expression;
/* If >= 0, the address of the last instruction which by itself left
* a value on the stack. If there is no such instruction, the value
* is (unsigned)-1.
*/
static Bool last_string_is_new;
/* TRUE: the last string stored with store_prog_string() was indeed
* a new string.
*/
static int prog_string_indizes[0x100];
/* Hash table for the program strings holding the initial indices
* for the hash chains.
*/
static char prog_string_tags[32];
/* Bitflags showing which entries in prog_string_indizes[] are valid:
* if (_tags[n] & (1 << b)) then _indizes[n*8 + b] is valid.
*/
static string_t *last_string_constant = NULL;
/* The current (last) string constant, a tabled string.
* It is also used to optimize "foo"+"bar" constructs.
*/
static int current_break_stack_need = 0;
/* Current depth of the required switch/break stack at this point
* in a function.
*/
static int max_break_stack_need = 0;
/* Total depth of the required switch/break stack for this function.
* This information is required when computing the 'num_locals'
* for the function header.
*/
static p_int stored_bytes;
/* Size of the program at the last time of store_line_number_info().
*/
static p_int stored_lines;
/* Current linenumber at the last time of store_line_number_info().
*/
static int simple_includes;
/* Number of simple includes since the last real one.
*/
static p_uint last_include_start;
/* Address in A_LINENUMBERS of the last include information.
* It is used to remove information about includes which do
* not generate information ('simple includes').
*/
static int argument_level;
/* Nesting level of function call arguments.
* Used to detect nested function calls, like foo( bar () ).
*/
static Bool got_ellipsis[COMPILER_STACK_SIZE];
/* Flags indexed by <argument_level>, telling if the current function
* arguments used the L_ELLIPSIS operator.
* TODO: This should be dynamic.
*/
#ifdef USE_STRUCTS
static const char * compiled_file;
/* The name of the program to be compiled. While current_loc.file reflects
* the name of the source file currently being read, this name is always
* the program's name. Set by prolog().
*/
static const fulltype_t Type_Any = { TYPE_ANY, NULL };
static const fulltype_t Type_Unknown = { TYPE_UNKNOWN, NULL };
static const vartype_t VType_Unknown = { TYPE_UNKNOWN, NULL };
static const fulltype_t Type_Number = { TYPE_NUMBER, NULL };
static const fulltype_t Type_Float = { TYPE_FLOAT, NULL };
static const fulltype_t Type_String = { TYPE_STRING, NULL };
static const fulltype_t Type_Object = { TYPE_OBJECT, NULL };
static const fulltype_t Type_Closure = { TYPE_CLOSURE, NULL };
static const fulltype_t Type_Mapping = { TYPE_MAPPING, NULL };
static const fulltype_t Type_Symbol = { TYPE_SYMBOL, NULL };
static const fulltype_t Type_Void = { TYPE_VOID, NULL };
static const fulltype_t Type_Quoted_Array = { TYPE_QUOTED_ARRAY, NULL };
static const fulltype_t Type_Ptr_Any = { TYPE_ANY|TYPE_MOD_POINTER, NULL };
static const fulltype_t Type_Ref_Any = { TYPE_ANY|TYPE_MOD_REFERENCE, NULL };
static const fulltype_t Type_Ref_Number = { TYPE_NUMBER|TYPE_MOD_REFERENCE, NULL };
#else
static const fulltype_t Type_Any = { TYPE_ANY };
static const fulltype_t Type_Unknown = { TYPE_UNKNOWN };
static const vartype_t VType_Unknown = { TYPE_UNKNOWN };
static const fulltype_t Type_Number = { TYPE_NUMBER };
static const fulltype_t Type_Float = { TYPE_FLOAT };
static const fulltype_t Type_String = { TYPE_STRING };
static const fulltype_t Type_Object = { TYPE_OBJECT };
static const fulltype_t Type_Closure = { TYPE_CLOSURE };
static const fulltype_t Type_Mapping = { TYPE_MAPPING };
static const fulltype_t Type_Symbol = { TYPE_SYMBOL };
static const fulltype_t Type_Void = { TYPE_VOID };
static const fulltype_t Type_Quoted_Array = { TYPE_QUOTED_ARRAY };
static const fulltype_t Type_Ptr_Any = { TYPE_ANY|TYPE_MOD_POINTER };
static const fulltype_t Type_Ref_Any = { TYPE_ANY|TYPE_MOD_REFERENCE };
static const fulltype_t Type_Ref_Number = { TYPE_NUMBER|TYPE_MOD_REFERENCE };
#endif /* USE_STRUCTS */
/* Constants for the known simple types.
*/
/*-------------------------------------------------------------------------*/
/* Forward declarations */
struct lvalue_s; /* Defined within YYSTYPE aka %union */
static void define_local_variable (ident_t* name, fulltype_t actual_type, typeflags_t opt_star, struct lvalue_s *lv, Bool redeclare, Bool with_init);
static void init_local_variable (ident_t* name, struct lvalue_s *lv, int assign_op, fulltype_t type2);
static Bool add_lvalue_code ( struct lvalue_s * lv, int instruction);
static void insert_pop_value(void);
static void arrange_protected_lvalue(p_int, int, p_int, int);
static int insert_inherited(char *, string_t *, program_t **, function_t *, int, bytecode_p);
/* Returnvalues from insert_inherited(): */
# define INHERITED_NOT_FOUND (-1)
# define INHERITED_WILDCARDED_ARGS (-2)
# define INHERITED_WILDCARDED_NOT_FOUND (-3)
static void store_line_number_relocation(int relocated_from);
int yyparse(void);
static void add_new_init_jump(void);
static void transfer_init_control(void);
static void copy_variables(program_t *, funflag_t);
static int copy_functions(program_t *, funflag_t type);
#ifdef USE_STRUCTS
static void copy_structs(program_t *, funflag_t);
#endif /* USE_STRUCTS */
#ifdef USE_NEW_INLINES
static void new_inline_closure (void);
#endif /* USE_NEW_INLINES */
static void fix_function_inherit_indices(program_t *);
static void fix_variable_index_offsets(program_t *);
static short store_prog_string (string_t *str);
/*-------------------------------------------------------------------------*/
void
yyerror (const char *str)
/* Raise the parse error <str>: usually generate the error message and log it.
* If this is the first error in this file, account the wizard with an error.
* If too many errors occured already, do nothing.
*/
{
char *context;
if (num_parse_error > 5)
return;
context = lex_error_context();
fprintf(stderr, "%s %s line %d: %s%s.\n"
, time_stamp(), current_loc.file->name, current_loc.line
, str, context);
/* TODO: lex should implement a function get_include_stack() which
* TODO:: returns an svalue-array with the current include stack.
* TODO:: This could be printed, and also passed to parse_error().
*/
fflush(stderr);
parse_error(MY_FALSE, current_loc.file->name, current_loc.line
, str, context);
if (num_parse_error == 0)
save_error(str, current_loc.file->name, current_loc.line);
num_parse_error++;
} /* yyerror() */
/*-------------------------------------------------------------------------*/
void
yyerrorf (const char *format, ...)
/* Generate an yyerror() 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);
yyerror(buff);
} /* yyerrorf() */
/*-------------------------------------------------------------------------*/
void
yywarn (const char *str)
/* Raise the parse warning <str>: usually generate the warning message and
* log it.
*/
{
char *context;
context = lex_error_context();
fprintf(stderr, "%s %s line %d: Warning: %s%s.\n"
, time_stamp(), current_loc.file->name, current_loc.line
, str, context);
/* TODO: lex should implement a function get_include_stack() which
* TODO:: returns an svalue-array with the current include stack.
* TODO:: This could be printed, and also passed to parse_error().
*/
fflush(stderr);
parse_error(MY_TRUE, current_loc.file->name, current_loc.line
, str, context);
if (master_ob && num_parse_error == 0)
save_error(str, current_loc.file->name, current_loc.line);
/* TODO: Introduce a 'master_is_loading' flag to prevent this call while
* TODO:: the master is inactive.
*/
} /* yywarn() */
/*-------------------------------------------------------------------------*/
void
yywarnf (const char *format, ...)
/* Generate an yywarn() 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);
yywarn(buff);
} /* yywarnf() */
/*-------------------------------------------------------------------------*/
static void *
yalloc (size_t size)
/* Allocate a block of <size>, add it at the head of the last_yalloced
* list, and return the pointer.
*
* Together with yfree(), this allocator is able to free intermediate
* results in the epilog() which were thrown away due to an error.
* TODO: A stack'ish mempool could do this?
*/
{
char **p;
p = xalloc(size+sizeof(char*));
if (!p)
{
fatal("Out of memory in compiler.\n");
return NULL;
}
*p++ = last_yalloced;
last_yalloced = (char *)p;
return p;
} /* yalloc() */
/*-------------------------------------------------------------------------*/
static void
yfree (void *block)
/* Free the block last allocated by yalloc().
*/
{
char **p;
p = (char **)block;
if (p != (char **)last_yalloced)
{
debug_message("%s Block mismatch", time_stamp());
return;
}
last_yalloced = *--p;
xfree(p);
} /* yfree() */
/*-------------------------------------------------------------------------*/
static char *
ystring_copy (char *str)
/* Duplicate the string <str> using yalloc() and return the new one.
*/
{
char *p;
p = yalloc(strlen(str)+1);
strcpy(p, str);
return p;
} /* ystring_copy() */
/*-------------------------------------------------------------------------*/
static void
add_string_constant (void)
/* Add the string <last_lex_string> to the string in <last_string_constant>.
* This is used to optimize "foo" + "bar" constructs.
*/
{
string_t *tmp;
tmp = mstr_add(last_string_constant, last_lex_string);
if (!tmp)
{
yyerrorf("Out of memory for string literal (%zu bytes)"
, (mstrsize(last_string_constant)
+mstrsize(last_lex_string))
);
return;
}
free_mstring(last_string_constant);
free_mstring(last_lex_string); last_lex_string = NULL;
last_string_constant = make_tabled(tmp);
if (!last_string_constant)
{
yyerrorf("Out of memory for string literal (%zu bytes)",
mstrsize(tmp));
}
} /* add_string_constant() */
/*-------------------------------------------------------------------------*/
static char *
realloc_mem_block (mem_block_t *mbp, mp_int size)
/* Resize memblock <mbp> to hold at least <size> bytes, but at least
* double its current size.
*
* Return NULL when out of memory, or a pointer to the newly allocated
* memory area (ie. mbp->block).
*/
{
mp_uint max_size;
char *p;
max_size = mbp->max_size;
do {
max_size *= 2;
} while ((mp_uint)size > max_size);
p = rexalloc(mbp->block, max_size);
if (!p)
{
lex_close("Out of memory");
return NULL;
}
mbp->block = p;
mbp->max_size = max_size;
return p;
} /* realloc_mem_block() */
/*-------------------------------------------------------------------------*/
static INLINE void
extend_mem_block (int n, size_t size)
/* Reserve <size> bytes at the current position in memory area <n>.
* This does increase the .current_size .
*/
{
mem_block_t *mbp = &mem_block[n];
if (size)
{
if (mbp->current_size + size > mbp->max_size)
{
if (!realloc_mem_block(mbp, mbp->current_size + size))
return;
}
mbp->current_size += size;
}
} /* extend_mem_block() */
/*-------------------------------------------------------------------------*/
static INLINE void
add_to_mem_block (int n, void *data, size_t size)
/* Add the <data> block of <size> bytes to the memory area <n>.
*/
{
mem_block_t *mbp = &mem_block[n];
if (size)
{
if (mbp->current_size + size > mbp->max_size)
{
if (!realloc_mem_block(mbp, mbp->current_size + size))
return;
}
memcpy(mbp->block + mbp->current_size, data, size);
mbp->current_size += size;
}
} /* add_to_mem_block() */
/*-------------------------------------------------------------------------*/
#define byte_to_mem_block(n, b) \
((void)((mem_block[n].current_size == mem_block[n].max_size \
? !!realloc_mem_block(&mem_block[n],0) : 1) \
? (mem_block[n].block[mem_block[n].current_size++] = (char)(b)) \
: 0)\
)
/* Add the byte <b> to the memory area <n>, which is resized
* if necessary.
*/
/* ============================== TYPES ============================== */
/*-------------------------------------------------------------------------*/
static INLINE void
assign_full_to_vartype(vartype_t * dest, fulltype_t src)
/* Assign a fulltype_t variable to a vartype_t variable.
*/
{
dest->type = src.typeflags;
#ifdef USE_STRUCTS
dest->t_struct = src.t_struct;
#endif
} /* assign_full_to_vartype() */
/*-------------------------------------------------------------------------*/
static INLINE void
assign_var_to_fulltype(fulltype_t * dest, vartype_t src)
/* Assign a vartype_t variable to a fulltype_t variable.
*/
{
dest->typeflags = src.type;
#ifdef USE_STRUCTS
dest->t_struct = src.t_struct;
#endif
} /* assign_var_to_fulltype() */
/*-------------------------------------------------------------------------*/
static INLINE Bool
equal_types (fulltype_t e, fulltype_t t)
/* Return TRUE if <e> and <t> are compatible basic types.
*/
{
return (e.typeflags & TYPEID_MASK) == (t.typeflags & TYPEID_MASK)
#ifdef USE_STRUCTS
&& e.t_struct == t.t_struct
#endif
;
} /* equal_types() */
static INLINE Bool
basic_type (typeflags_t e, typeflags_t t)
/* Return TRUE if <e> and <t> are compatible basic types.
*/
{
e &= TYPEID_MASK;
t &= TYPEID_MASK;
return e == TYPE_ANY
|| e == t
|| t == TYPE_ANY
;
} /* basic_type() */
static INLINE Bool
BASIC_TYPE (fulltype_t e, fulltype_t t)
/* Return TRUE if <e> and <t> are compatible basic types.
*/
{
return basic_type(e.typeflags, t.typeflags);
} /* BASIC_TYPE() */
static INLINE Bool
TYPE (fulltype_t e, fulltype_t t)
/* Return TRUE if <e> and <t> are compatible basic xor pointer types.
*/
{
typeflags_t ef = e.typeflags & TYPEID_MASK;
typeflags_t tf = t.typeflags & TYPEID_MASK;
return basic_type(ef & TYPE_MOD_MASK, tf & TYPE_MOD_MASK)
|| ( (ef & TYPE_MOD_POINTER) && (tf & TYPE_MOD_POINTER)
&& basic_type( ef & (TYPE_MOD_MASK & ~TYPE_MOD_POINTER)
, tf & (TYPE_MOD_MASK & ~TYPE_MOD_POINTER))
)
;
} /* TYPE() */
static INLINE Bool
vtype (vartype_t e, vartype_t t)
/* Return TRUE if <e> and <t> are compatible basic xor pointer types.
*/
{
fulltype_t et, tt;
assign_var_to_fulltype(&et, e);
assign_var_to_fulltype(&tt, t);
return TYPE(et, tt);
} /* vtype() */
static INLINE Bool
MASKED_TYPE (fulltype_t e, fulltype_t t)
/* Return TRUE if <e> and <t> are compatible basic types, or if both
* are pointer types and one of them is a *ANY.
*/
{
typeflags_t ef = e.typeflags & TYPEID_MASK;
typeflags_t tf = t.typeflags & TYPEID_MASK;
return basic_type(ef, tf)
|| ( ef == (TYPE_MOD_POINTER|TYPE_ANY) && ef & TYPE_MOD_POINTER )
|| ( tf == (TYPE_MOD_POINTER|TYPE_ANY) && ef & TYPE_MOD_POINTER )
;
} /* MASKED_TYPE() */
static INLINE Bool
REDEFINED_TYPE (fulltype_t e, fulltype_t t)
/* Return TRUE if type <t> is a proper redefinition of <e>.
* This is the case if <e> and <t> are compatible base types,
* or if one of them is *ANY.
*/
{
typeflags_t ef = e.typeflags & TYPEID_MASK;
typeflags_t tf = t.typeflags & TYPEID_MASK;
return basic_type(ef, tf )
|| (tf == (TYPE_MOD_POINTER|TYPE_ANY) )
|| (ef == (TYPE_MOD_POINTER|TYPE_ANY) )
;
} /* REDEFINED_TYPE() */
/*-------------------------------------------------------------------------*/
static char *
get_f_visibility (funflag_t flags)
/* Return (in a static buffer) a textual representation of the visibility
* flags in <flags>.
*/
{
static char buff[100];
size_t len;
buff[0] = '\0';
if (flags & TYPE_MOD_STATIC)
strcat(buff, "static ");
if (flags & TYPE_MOD_NO_MASK)
strcat(buff, "nomask ");
if (flags & TYPE_MOD_PRIVATE)
strcat(buff, "private ");
if (flags & TYPE_MOD_PROTECTED)
strcat(buff, "protected ");
if (flags & TYPE_MOD_PUBLIC)
strcat(buff, "public ");
if (flags & TYPE_MOD_VARARGS)
strcat(buff, "varargs ");
len = strlen(buff);
if (len)
buff[len-1] = '\0';
return buff;
} /* get_f_visibility() */
/*-------------------------------------------------------------------------*/
static char *
get_visibility (fulltype_t type)
/* Return (in a static buffer) a textual representation of the visibility
* portion of <type>.
*/
{
return get_f_visibility(type.typeflags);
} /* get_visibility() */
/*-------------------------------------------------------------------------*/
static char *
get_type_name (fulltype_t type)
/* Return (in a static buffer) a textual representation of <type>.
*/
{
static char buff[100];
static char *type_name[] = { "unknown", "int", "string", "void", "object",
"mapping", "float", "mixed", "closure",
"symbol", "quoted_array", "struct" };
Bool pointer = MY_FALSE, reference = MY_FALSE;
buff[0] = '\0';
if (type.typeflags & TYPE_MOD_STATIC)
strcat(buff, "static ");
if (type.typeflags & TYPE_MOD_NO_MASK)
strcat(buff, "nomask ");
if (type.typeflags & TYPE_MOD_PRIVATE)
strcat(buff, "private ");
if (type.typeflags & TYPE_MOD_PROTECTED)
strcat(buff, "protected ");
if (type.typeflags & TYPE_MOD_PUBLIC)
strcat(buff, "public ");
if (type.typeflags & TYPE_MOD_VARARGS)
strcat(buff, "varargs ");
type.typeflags &= TYPE_MOD_MASK;
if (type.typeflags & TYPE_MOD_POINTER)
{
pointer = MY_TRUE;
type.typeflags &= ~TYPE_MOD_POINTER;
}
if (type.typeflags & TYPE_MOD_REFERENCE)
{
reference = MY_TRUE;
type.typeflags &= ~TYPE_MOD_REFERENCE;
}
if (type.typeflags >= sizeof type_name / sizeof type_name[0])
fatal("Bad type %"PRIu32": %s line %d\n"
, type.typeflags, current_loc.file->name, current_loc.line);
strcat(buff, type_name[type.typeflags]);
#ifdef USE_STRUCTS
if (type.typeflags == TYPE_STRUCT)
{
strcat(buff, " ");
if (type.t_struct)
{
char buff2[100];
strcat(buff, get_txt(type.t_struct->name));
sprintf(buff2, " %p", type.t_struct);
strcat(buff, buff2);
}
}
#endif /* USE_STRUCTS */
if (pointer)
strcat(buff, " *");
if (reference)
strcat(buff, " &");
return buff;
} /* get_type_name() */
/*-------------------------------------------------------------------------*/
static char *
get_two_types (fulltype_t type1, fulltype_t type2)
/* Return (in a static buffer) the text "(<type1> vs. <type2>)".
*/
{
static char buff[100];
strcpy(buff, "(");
strcat(buff, get_type_name(type1));
strcat(buff, " vs ");
strcat(buff, get_type_name(type2));
strcat(buff, ")");
return buff;
} /* get_two_types() */
#ifdef USE_STRUCTS
/*-------------------------------------------------------------------------*/
static char *
get_two_vtypes (vartype_t type1, vartype_t type2)
/* Return (in a static buffer) the text "(<type1> vs. <type2>)".
*/
{
fulltype_t ftype1, ftype2;
assign_var_to_fulltype(&ftype1, type1);
assign_var_to_fulltype(&ftype2, type2);
return get_two_types(ftype1, ftype2);
} /* get_two_vtypes() */
#endif /* USE_STRUCTS */
/*-------------------------------------------------------------------------*/
static void
type_error (char *str, fulltype_t type)
/* Generate an yyerror with the message "<str>: <type>".
*/
{
char *p;
p = get_type_name(type);
yyerrorf("%s: \"%s\"", str, p);
} /* type_error() */
/*-------------------------------------------------------------------------*/
static void
argument_type_error (int instr, fulltype_t type)
/* Generate an yyerror with the message "Bad argument to <instr>: <type>".
*/
{
char *p;
p = get_type_name(type);
yyerrorf("Bad argument to %s: \"%s\"", instrs[instr].name, p);
} /* argument_type_error() */
/*-------------------------------------------------------------------------*/
static void
efun_argument_error(int arg, int instr
, fulltype_t * expected, fulltype_t got
)
{
char msg[1024];
msg[0] = '\0';
for (; expected->typeflags; expected++)
{
if (msg[0] != '\0')
strcat(msg, "/");
strcat(msg, get_type_name(*expected));
}
yyerrorf("Bad arg %d type to %s(): got %s, expected %s"
, arg, instrs[instr].name, get_type_name(got), msg);
} /* efun_argument_error() */
/*-------------------------------------------------------------------------*/
static Bool
compatible_types (fulltype_t t1, fulltype_t t2, Bool is_assign)
/* Compare the two types <t1> and <t2> and return TRUE if they are compatible.
* Rules:
* - every type is compatible to itself
* - TYPE_UNKNOWN is incompatible to everything
* - TYPE_ANY is compatible to everything
* - two POINTER types are compatible if at least one is *TYPE_ANY.
*
* If <is_assign> is true, it is assumed that <t2> will be assigned
* to a var of <t1>, and the following rules have to match as well:
* - a struct <t1> is compatible to a derived struct <t2>.
* - if <t1> is a struct, <t2> must be a struct or TYPE_ANY.
*/
{
t1.typeflags &= TYPEID_MASK;
t2.typeflags &= TYPEID_MASK;
if (t1.typeflags == TYPE_UNKNOWN || t2.typeflags == TYPE_UNKNOWN)
return MY_FALSE;
if (t1.typeflags == TYPE_ANY || t2.typeflags == TYPE_ANY)
return MY_TRUE;
#ifdef USE_STRUCTS
if (is_assign
&& (t1.typeflags & PRIMARY_TYPE_MASK) == T_STRUCT
&& (t2.typeflags & PRIMARY_TYPE_MASK) == T_STRUCT
)
{
struct_type_t * id1, * id2;
/* Check if t1 is a base-struct of t2 */
id1 = t1.t_struct;
id2 = t2.t_struct;
while (id2 != NULL && id1 != id2)
{
id2 = id2->base;
}
/* If the base structs match, just pretend that t2 is the
* same struct as t1. This will make the following tests
* work as normal.
*/
if (id2 != NULL)
t2.t_struct = id1;
}
#endif
if (t1.typeflags == t2.typeflags)
{
#ifdef USE_STRUCTS
if (t1.t_struct == t2.t_struct)
return MY_TRUE;
#else
return MY_TRUE;
#endif
}
if ((t1.typeflags & TYPE_MOD_POINTER) && (t2.typeflags & TYPE_MOD_POINTER))
{
if ((t1.typeflags & TYPE_MOD_MASK) == (TYPE_ANY|TYPE_MOD_POINTER)
|| (t2.typeflags & TYPE_MOD_MASK) == (TYPE_ANY|TYPE_MOD_POINTER))
return MY_TRUE;
}
#ifdef USE_STRUCTS
if (is_assign && (t1.typeflags & PRIMARY_TYPE_MASK) == T_STRUCT)
{
/* Check if t2 is a struct. If it is, the above
* check already made sure that the type matches.
*/
if ((t2.typeflags & PRIMARY_TYPE_MASK) != T_STRUCT)
return MY_FALSE;
}
#endif
return MY_FALSE;
} /* compatible_types() */
/*-------------------------------------------------------------------------*/
static INLINE void
i_add_arg_type (fulltype_t type)
/* Add another function argument type to the argument type stack.
*/
{
mem_block_t *mbp = &type_of_arguments;
if (mbp->current_size + sizeof type > mbp->max_size)
{
mbp->max_size *= 2;
mbp->block = rexalloc((char *)mbp->block, mbp->max_size);
}
assign_full_to_vartype((vartype_t*)(mbp->block + mbp->current_size), type);
mbp->current_size += sizeof(vartype_t);
} /* i_add_arg_type() */
#define add_arg_type(t) i_add_arg_type(t)
/*-------------------------------------------------------------------------*/
static INLINE void
pop_arg_stack (int n)
/* Pop (remove) the last <n> types from the argument stack.
*/
{
vartype_t * vp;
vp = (vartype_t*)(type_of_arguments.block + type_of_arguments.current_size);
while (n > 0)
{
type_of_arguments.current_size -= sizeof (vartype_t);
n--;
vp--;
}
} /* pop_arg_stack() */
/*-------------------------------------------------------------------------*/
static INLINE vartype_t *
get_argument_types_start (int n)
/* Get the type of the <n>th last argument from the stack.
* <n> must be >= 1.
*/
{
return
&((vartype_t *)
(type_of_arguments.block + type_of_arguments.current_size))[ - n];
} /* get_arguments_type_start() */
/*-------------------------------------------------------------------------*/
static INLINE void
check_aggregate_types (int n)
/* The last <n> types on the argument stack are an aggregate type.
* Combine the single types and make sure that none is a reference type.
*/
{
vartype_t *argp;
typeid_t mask;
argp = (vartype_t *) (type_of_arguments.block +
(type_of_arguments.current_size -= sizeof (vartype_t) * n) );
/* We're just interested in TYPE_MOD_REFERENCE, so we preset all
* other bits with 1.
*/
for (mask = ~TYPE_MOD_REFERENCE; --n >= 0; )
{
mask |= argp->type;
argp++;
}
if (!(~mask & 0xffff))
yyerror("Can't trace reference assignments.");
} /* check_aggregate_types() */
/*-------------------------------------------------------------------------*/
static INLINE void
warn_function_shadow ( const string_t *pubProg, string_t * pubFun
, const string_t *privProg, string_t * privFun
)
/* Issue a warning that the public function <pubProg>::<pubFun>() shadows the
* private function <privProg>::<privFun>().
* Both <pubProg> and <privProg> can be NULL.
* If the function is __INIT(), no warning is printed.
*/
{
string_t *pubCProg = NULL;
string_t *privCProg = NULL;
if (mstreq(pubFun, STR_VARINIT)
&& mstreq(privFun, STR_VARINIT))
return;
if (pubProg != NULL) pubCProg = cvt_progname(pubProg);
if (privProg != NULL) privCProg = cvt_progname(privProg);
if (pubCProg != NULL)
{
if (privCProg != NULL)
yywarnf("public %s::%s() shadows private %s::%s()"
, get_txt(pubCProg), get_txt(pubFun)
, get_txt(privCProg), get_txt(privFun)
);
else
yywarnf("public %s::%s() shadows private %s()"
, get_txt(pubCProg), get_txt(pubFun)
, get_txt(privFun)
);
}
else if (privCProg != NULL)
yywarnf("public %s() shadows private %s::%s()"
, get_txt(pubFun)
, get_txt(privCProg), get_txt(privFun)
);
else
yywarnf("public %s() shadows private %s()"
, get_txt(pubFun)
, get_txt(privFun)
);
if (pubCProg != NULL) free_mstring(pubCProg);
if (privCProg != NULL) free_mstring(privCProg);
} /* warn_function_shadow() */
/* ============================= CODEGEN ============================= */
/*-------------------------------------------------------------------------*/
static INLINE char *
realloc_a_program (size_t size)
/* If necessary, increase the allocated size of the A_PROGRAM area so that at
* least <size> more bytes can be stored in it.
*
* Return NULL when out of memory, or a pointer to the (possibly newly
* allocated) memory area (ie. mem_block[A_PROGRAM].block).
*/
{
mem_block_t * mbp = &mem_block[A_PROGRAM];
mp_uint new_size = mbp->current_size + size;
if (new_size <= mbp->max_size)
return mbp->block;
return realloc_mem_block(mbp, new_size);
} /* realloc_a_program() */
/*-------------------------------------------------------------------------*/
#define ins_byte(b) byte_to_mem_block(A_PROGRAM, b)
#ifndef ins_byte
static INLINE void
ins_byte (unsigned char b)
/* Add the byte <b> to the A_PROGRAM area.
*/
{
if (mem_block[A_PROGRAM].current_size == mem_block[A_PROGRAM].max_size )
{
if (!realloc_a_program(1))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + 1);
return;
}
}
mem_block[A_PROGRAM].block[mem_block[A_PROGRAM].current_size++] = b;
} /* ins_byte() */
#endif
/*-------------------------------------------------------------------------*/
static void
ins_f_code (unsigned int b)
/* Add the instruction <b> to the A_PROGRAM area, taking care of encoding
* multi-byte instructions properly.
*/
{
if (instrs[b].prefix)
ins_byte(instrs[b].prefix);
ins_byte(instrs[b].opcode);
} /* ins_f_code() */
/*-------------------------------------------------------------------------*/
static void
ins_short (long l)
/* Add the 2-byte number <l> to the A_PROGRAM area in a fixed byteorder.
*/
{
short s = (short)l;
if (l > (long)USHRT_MAX || l < SHRT_MIN)
yyerrorf("Compiler error: too large number %lx passed to ins_short()"
, l);
if (realloc_a_program(2))
{
mp_uint current_size;
char *dest;
current_size = CURRENT_PROGRAM_SIZE;
CURRENT_PROGRAM_SIZE = current_size + 2;
dest = mem_block[A_PROGRAM].block + current_size;
PUT_SHORT(dest, s);
}
else
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + 2);
}
} /* ins_short() */
/*-------------------------------------------------------------------------*/
static void
upd_short (mp_uint offset, long l)
/* Store the 2-byte number <l> at <offset> in the A_PROGRAM are in
* a fixed byteorder.
*/
{
char *dest;
short s = (short)l;
if (l > (long)USHRT_MAX || l < SHRT_MIN)
yyerrorf("Compiler error: too large number %ld passed to upd_short()"
, l);
dest = mem_block[A_PROGRAM].block + offset;
PUT_SHORT(dest, s);
} /* upd_short() */
/*-------------------------------------------------------------------------*/
static short
read_short (mp_uint offset)
/* Return the 2-byte number stored at <offset> in the A_PROGRAM area.
*/
{
short l;
char *dest;
dest = mem_block[A_PROGRAM].block + offset;
GET_SHORT(l, dest);
return l;
} /* read_short() */
/*-------------------------------------------------------------------------*/
static void
upd_jump_offset (mp_uint offset, long l)
/* Store the 3-byte number <l> at <offset> in the A_PROGRAM are in
* a fixed byteorder.
*/
{
char *dest;
dest = mem_block[A_PROGRAM].block + offset;
PUT_3BYTE(dest, l);
} /* upd_jump_offset() */
/*-------------------------------------------------------------------------*/
static void
ins_int32 (int32 l)
/* Add the 4-byte number <l> to the A_PROGRAM area in a fixed byteorder.
*/
/* TODO: check callers for assumptions that a long is always 4 bytes. */
{
if (realloc_a_program(4))
{
mp_uint current_size;
char *dest;
current_size = CURRENT_PROGRAM_SIZE;
CURRENT_PROGRAM_SIZE = current_size + 4;
dest = mem_block[A_PROGRAM].block + current_size;
PUT_INT32(dest, l);
}
else
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + 4);
}
} /* ins_int32() */
/*-------------------------------------------------------------------------*/
static void
upd_int32 (mp_uint offset, int32 l)
/* Store the 4-byte number <l> at <offset> in the A_PROGRAM are in
* a fixed byteorder.
*/
/* TODO: check callers for assumptions that a long is always 4 bytes. */
{
char *dest;
dest = mem_block[A_PROGRAM].block + offset;
PUT_INT32(dest, l);
} /* upd_int32() */
/*-------------------------------------------------------------------------*/
static int32
read_int32 (mp_uint offset)
/* Return the 4-byte number stored at <offset> in the A_PROGRAM area.
*/
/* TODO: this should probably read in a int32. */
{
long l;
char *dest;
dest = mem_block[A_PROGRAM].block + offset;
GET_INT32(l, dest);
return l;
} /* read_int32() */
/*-------------------------------------------------------------------------*/
static void
ins_number (long num)
/* Insert code to push number <num> onto the stack.
* The function tries to find the shortest sequence to do so.
*/
{
if (num == 0)
ins_f_code(F_CONST0);
else if (num == 1)
{
ins_f_code(F_CONST1);
}
else if (num == -1)
ins_f_code(F_NCONST1);
else if (num >= 0 && num <= 0x0FF)
{
ins_f_code(F_CLIT);
ins_byte((num & 0xFF));
}
else if (num < 0 && num >= -0x0FF)
{
ins_f_code(F_NCLIT);
ins_byte(((-num) & 0xFF));
}
else
{
ins_f_code(F_NUMBER);
ins_int32(num); /* this was still ins_long after zippo's patch */
}
} /* ins_number() */
/*-------------------------------------------------------------------------*/
/* The following macros are used for a speedy codegeneration within bigger
* functions.
*
* To insert at max <n> bytes, the function has to declare
*
* PREPARE_INSERT(n)
*
* among the variables and can the use the following macros to add bytes:
*
* add_f_code(i): to add instruction <i> to the program
* add_byte(b): to add byte <b> to the program
* add_short(s): to add short <s> to the program
*
* Except for add_f_code(), none of the macros adapts CURRENT_PROGRAM_SIZE,
* and add_f_code() increments the _SIZE only for the prefix byte if any.
*/
#define PREPARE_INSERT(n) \
bytecode_p __PREPARE_INSERT__p = (\
realloc_a_program(n) ? (PROGRAM_BLOCK + CURRENT_PROGRAM_SIZE) : NULL);
#define add_byte(b) (void) STORE_INT8(__PREPARE_INSERT__p, (b))
#define add_short(s) STORE_SHORT(__PREPARE_INSERT__p, (s))
#define add_f_code(i) \
do{ if (instrs[i].prefix) { \
add_byte(instrs[i].prefix); \
CURRENT_PROGRAM_SIZE++; \
}\
add_byte(instrs[i].opcode); \
}while(0)
/*-------------------------------------------------------------------------*/
static void
push_address (void)
/* Push the current program size as address onto the compiler stack.
*/
{
if (comp_stackp >= COMPILER_STACK_SIZE)
{
yyerror("Compiler stack overflow");
/* Don't store the address, but keep proper track of the depth.
*/
comp_stackp++;
return;
}
comp_stack[comp_stackp++] = mem_block[A_PROGRAM].current_size;
} /* push_address() */
/*-------------------------------------------------------------------------*/
static void
push_explicit (p_int address)
/* Push the program <address> onto the compiler stack.
*/
{
if (comp_stackp >= COMPILER_STACK_SIZE)
{
yyerror("Compiler stack overflow");
/* Don't store the address, but keep proper track of the depth.
*/
comp_stackp++;
return;
}
comp_stack[comp_stackp++] = address;
} /* push_explicit() */
/*-------------------------------------------------------------------------*/
static p_int
pop_address (void)
/* Pop the most recent stored address from the compiler stack and return
* it.
*/
{
if (comp_stackp == 0)
fatal("Compiler stack underflow.\n");
if (comp_stackp > COMPILER_STACK_SIZE)
{
/* Nothing to retrieve, but keep track of the depth */
--comp_stackp;
return 0;
}
return comp_stack[--comp_stackp];
} /* pop_address() */
/*-------------------------------------------------------------------------*/
static Bool
fix_branch (int ltoken, p_int dest, p_int loc)
/* Backpatch a branch instruction at <loc> to jump to <dest>.
* If the offset exceeds the 255 range, the branch instruction is changed
* into its long-branch variant <ltoken>.
*
* Return TRUE if the long branch had to be used, FALSE otherwise.
* TODO: This really confuses the line number detection code, as suddenly
* TODO:: the recorded offset are no longer accurate.
*/
{
p_int offset; /* The branch offset */
offset = dest - (loc +1);
if (offset > 0xff)
{
/* We need a long branch. That also means that we have to
* move the following code and adapt remembered addresses.
*/
p_int i, j;
bytecode_p p;
mem_block[A_PROGRAM].block[loc] = 0; /* Init it */
/* Update the break address */
if ( current_break_address > loc
&& !(current_break_address & (BREAK_ON_STACK|BREAK_DELIMITER) ) )
{
for (i = current_break_address & BREAK_ADDRESS_MASK
; (j = read_int32(i)) > loc; )
{
upd_int32(i, j+1);
i = j;
}
current_break_address++;
}
/* Update the continue address */
if ( (current_continue_address & CONTINUE_ADDRESS_MASK) > loc
&& !(current_continue_address & CONTINUE_DELIMITER ) )
{
for(i = current_continue_address & CONTINUE_ADDRESS_MASK;
(j=read_int32(i)) > loc; )
{
upd_int32(i, j+1);
i = j;
}
current_continue_address++;
}
ins_byte(0); /* Just to make sure the memory is there */
/* Move the code */
p = PROGRAM_BLOCK + mem_block[A_PROGRAM].current_size-1;
i = mem_block[A_PROGRAM].current_size - loc;
for( ; --i >= 0; --p )
{
PUT_CODE(p, GET_CODE(p-1));
}
/* Store the new branch instruction */
PUT_CODE(p, ltoken);
upd_short(loc, offset+2);
if (offset > 0x7ffd)
yyerrorf("Compiler limit: Too much code to branch over: %"
PRIdPINT" bytes", offset);
return MY_TRUE;
}
else
{
/* Just update the offset */
mem_block[A_PROGRAM].block[loc] = offset;
return MY_FALSE;
}
} /* fix_branch() */
/*-------------------------------------------------------------------------*/
static bytecode_p
yyget_space (p_int size)
/* Callback function for switch: return a pointer to <size> more bytes
* in the program area.
*/
{
if (realloc_a_program(size))
{
CURRENT_PROGRAM_SIZE += size;
return PROGRAM_BLOCK + CURRENT_PROGRAM_SIZE - size;
}
yyerrorf("Out of memory: program size %"PRIdMPINT"\n"
, mem_block[A_PROGRAM].current_size + size);
return NULL;
} /* yyget_space() */
/*-------------------------------------------------------------------------*/
static void
yymove_switch_instructions (int len, p_int blocklen)
/* Callback function for switch: move the <blocklen> bytecodes at <switch_pc>
* back by <len> bytes to <switch_pc>+<len>. A continue address in the
* affected area is corrected.
*/
{
mp_int i, j;
if (realloc_a_program(len))
{
CURRENT_PROGRAM_SIZE += len;
/* Adjust the continue address, if any */
if ( (current_continue_address & CONTINUE_ADDRESS_MASK) > switch_pc
&& !(current_continue_address & CONTINUE_DELIMITER ) )
{
for(i = current_continue_address & CONTINUE_ADDRESS_MASK;
(j=read_int32(i)) > switch_pc; )
{
upd_int32(i, j+len);
i = j;
}
current_continue_address += len;
}
move_memory(
mem_block[A_PROGRAM].block + switch_pc + len,
mem_block[A_PROGRAM].block + switch_pc,
blocklen
);
}
else
{
yyerrorf("Out of memory: program size %"PRIdMPINT"\n"
, mem_block[A_PROGRAM].current_size + len);
}
} /* yymove_switch_instructions() */
/*-------------------------------------------------------------------------*/
static void
yycerrorl (const char *s1, const char *s2, int line1, int line2)
/* Callback function for switch: Raise an error <s1> in file <s2> at
* lines <line1> and <line2>.
* <s1> may contain one '%s' to insert s2, <s2> may contain one or
* or two '%d' to insert line1 and line2.
*/
{
char buff[100];
sprintf(buff, s2, line1, line2);
yyerrorf(s1, buff);
} /* yycerrorl() */
/*-------------------------------------------------------------------------*/
static void
update_lop_branch ( p_uint address, int instruction )
/* <address> points to the branch offset value of an LAND/LOR operation,
* currently set to 0. Update that offset to branch to the current end
* of the program.
*
* If that branch is too long, the code is rewritten:
*
* Original: Rewritten:
*
* <expr1> <expr1>
* LOR/LAND l DUP
* <expr2> LBRANCH_<instruction>
* l: POP_VALUE
* <expr2>
* l:
*
* The extra DUP compensates the svalue the LBRANCH eats.
* The LBRANCH_<instruction> needs to be passed suiting the logical
* operator: LBRANCH_WHEN_ZERO for LAND, LBRANCH_WHEN_NON_ZERO for LOR.
*/
{
p_int offset;
last_expression = -1;
offset = mem_block[A_PROGRAM].current_size - ( address + 1);
if (offset > 0xff)
{
/* A long branch is needed */
int i;
bytecode_p p;
ins_short(0);
ins_byte(0);
p = PROGRAM_BLOCK + mem_block[A_PROGRAM].current_size-1;
for (i = offset; --i >= 0; --p )
*p = p[-3];
p[-4] = F_DUP;
p[-3] = instruction;
upd_short(address+1, offset+3);
if (offset > 0x7ffc)
yyerrorf("Compiler limit: Too much code to skip for ||/&&:"
" %"PRIdPINT" bytes" , offset);
p[0] = F_POP_VALUE;
}
else
{
mem_block[A_PROGRAM].block[address] = offset;
}
} /* update_lop_branch() */
/*-------------------------------------------------------------------------*/
static void
shuffle_code (p_uint start1, p_uint start2, p_uint end)
/* Reverse the order of the program blocks [start1..start2[ and [start2..end[
*/
{
p_uint len1 = start2 - start1;
p_uint len2 = end - start2;
bytecode_p pStart1 = PROGRAM_BLOCK + start1;
bytecode_p pStart2 = PROGRAM_BLOCK + start2;
bytecode_p * pTmp;
if (!len1 || !len2)
return;
pTmp = xalloc(len1);
if (!pTmp)
{
yyerror("(shuffle_code) Out of memory");
return;
}
memmove(pTmp, pStart1, len1);
memmove(pStart1, pStart2, len2);
memmove(pStart1+len2, pTmp, len1);
xfree(pTmp);
} /* shuffle_code() */
/* ======================== LOCALS and SCOPES ======================== */
/*-------------------------------------------------------------------------*/
void
free_all_local_names (void)
/* Free all local names, and reset the counters.
*/
{
ident_t *p,*q;
for (q = all_locals; NULL != (p = q);)
{
q = p->next_all;
free_shared_identifier(p);
}
while (current_number_of_locals > 0 && type_of_locals)
{
current_number_of_locals--;
free_fulltype_data(&type_of_locals[current_number_of_locals]);
}
all_locals = NULL;
current_number_of_locals = 0;
max_number_of_locals = 0;
current_break_stack_need = 0;
max_break_stack_need = 0;
} /* free_all_local_names() */
/*-------------------------------------------------------------------------*/
static void
free_local_names (int depth)
/* Free all locals in the all_locals list which are of higher or
* the same <depth>, and adjust the counters.
* A <depth> of 0 is equivalent to calling free_all_local_names().
*/
{
ident_t *q;
if (!depth)
{
free_all_local_names();
return;
}
/* Are the locals of the given depth? */
if (!all_locals || all_locals->u.local.depth < depth)
return;
if (all_locals->u.local.depth > depth)
fatal("List of locals clobbered: depth %d, block_depth %d\n"
, all_locals->u.local.depth, depth);
while (all_locals != NULL && all_locals->u.local.depth >= depth)
{
q = all_locals;
all_locals = q->next_all;
free_shared_identifier(q);
current_number_of_locals--;
free_fulltype_data(&type_of_locals[current_number_of_locals]);
}
} /* free_local_names() */
/*-------------------------------------------------------------------------*/
static ident_t *
add_local_name (ident_t *ident, fulltype_t type, int depth
#ifndef USE_NEW_INLINES
, Bool may_shadow
#endif /* USE_NEW_INLINES */
)
/* Declare a new local variable <ident> with the type <type> on
* the scope depth <depth>. The references of <type> are NOT adopted.
#ifndef USE_NEW_INLINES
* If <may_shadow> is TRUE, the declaration is
* allowed to shadow a previous one without generating a warning (this is
* used to declare inline functions on the fly).
#endif
* Return the (adjusted) ident for the new variable.
*/
{
if ((type.typeflags & PRIMARY_TYPE_MASK) == TYPE_VOID)
{
yyerrorf( "Illegal to define variable '%s' as type 'void'"
, get_txt(ident->name));
}
if (current_number_of_locals >= MAX_LOCAL /* size of type recording array */
|| current_number_of_locals >= 256)
yyerror("Too many local variables");
else
{
ref_fulltype_data(&type);
if (ident->type != I_TYPE_UNKNOWN)
{
/* We're overlaying some other definition.
* If it's a global, or if we are in an inline-closure arg list,
* it's ok.
*/
#ifdef USE_NEW_INLINES
#ifdef DEBUG_INLINES
if (current_inline && current_inline->block_depth+2 == block_depth
&& ident->type != I_TYPE_GLOBAL)
printf("DEBUG: redeclare local '%s' as inline arg, depth %d\n",
get_txt(ident->name), block_depth);
#endif /* DEBUG_INLINES */
if (ident->type != I_TYPE_GLOBAL
&& !(current_inline && current_inline->block_depth+2 == block_depth)
)
{
yywarnf( "Variable '%s' shadows previous declaration"
, get_txt(ident->name));
}
#else /* USE_NEW_INLINES */
if (!may_shadow && ident->type != I_TYPE_GLOBAL)
{
yywarnf( "Variable '%s' shadows previous declaration"
, get_txt(ident->name));
}
#endif /* USE_NEW_INLINES */
ident = make_shared_identifier(get_txt(ident->name), I_TYPE_LOCAL, depth);
}
/* Initialize the ident */
ident->type = I_TYPE_LOCAL;
ident->u.local.num = current_number_of_locals;
ident->u.local.depth = depth;
#ifdef USE_NEW_INLINES
ident->u.local.context = -1;
#endif /* USE_NEW_INLINES */
/* Put the ident into the list of all locals */
if (all_locals && all_locals->u.local.depth > depth)
fatal("List of locals clobbered: depth %d, adding depth %d\n"
, all_locals->u.local.depth, depth);
ident->next_all = all_locals;
all_locals = ident;
/* Record the type */
type_of_locals[current_number_of_locals++] = type;
/* And update the scope information */
if (current_number_of_locals > max_number_of_locals)
max_number_of_locals = current_number_of_locals;
block_scope[depth-1].num_locals++;
}
return ident;
} /* add_local_name() */
/*-------------------------------------------------------------------------*/
static ident_t *
redeclare_local (ident_t *ident, fulltype_t type, int depth)
/* Redeclare a local name <ident>, to <type> at <depth>; the references
* of <type> are NOT adopted (nor freed on error).
* If this happens on a deeper level, it is legal: the new declaration
* is added and the new identifier is returned.
* If it is illegal, an yyerror() is risen and the ident of the older
* declaration is returned for error recovery.
*/
{
if (all_locals && all_locals->u.local.depth > depth)
{
fatal("List of locals clobbered: list depth %d, "
"block depth %d\n"
, all_locals->u.local.depth, depth);
}
if (ident->u.local.depth >= depth
|| (ident->u.local.depth == 1 && depth == 2)
#ifdef USE_NEW_INLINES
|| (current_inline && ident->u.local.depth == current_inline->block_depth+2
&& depth == current_inline->block_depth+3
)
#endif /* USE_NEW_INLINES */
)
{
yyerrorf("Illegal to redeclare local name '%s'", get_txt(ident->name));
}
else
{
#ifdef USE_NEW_INLINES
ident = add_local_name(ident, type, depth);
#else /* USE_NEW_INLINES */
ident = add_local_name(ident, type, depth, MY_FALSE);
#endif /* USE_NEW_INLINES */
}
return ident;
} /* redeclare_local() */
#ifdef USE_NEW_INLINES
/*-------------------------------------------------------------------------*/
static ident_t *
add_context_name (ident_t *ident, fulltype_t type, int num)
/* Declare a new context variable <ident> with the type <type> for the
* currently compiled inline closure. The references of <type> are NOT adopted.
* <num> is -1 for independent context
* variables, or the index of the inherited local variable.
* Return the (adjusted) ident for the new variable.
*/
{
int depth;
block_scope_t * block;
depth = current_inline->block_depth+1;
block = & block_scope[depth-1];
#ifdef DEBUG_INLINES
printf("DEBUG: add_context_name('%s', num %d) depth %d, context %d\n",
get_txt(ident->name), num, depth, block->num_locals);
#endif /* DEBUG_INLINES */
if (block->num_locals >= 256
|| block->num_locals >= MAX_LOCAL /* size of type recording array */
)
{
yyerror("Too many context variables");
}
else
{
ref_fulltype_data(&type);
if (ident->type != I_TYPE_UNKNOWN)
{
/* We're overlaying some other definition, but that's ok.
*/
ident = make_shared_identifier(get_txt(ident->name), I_TYPE_LOCAL, depth);
}
/* Initialize the ident */
ident->type = I_TYPE_LOCAL;
ident->u.local.num = num;
ident->u.local.depth = depth;
ident->u.local.context = block->num_locals;
/* Put the ident into the list of all locals.
*/
if (all_locals && all_locals->u.local.depth > depth)
{
/* This context variable was detected after we already
* added locals - find the proper insertion point.
*/
ident_t * prev, *this;
for ( prev = all_locals, this = all_locals->next_all
; this && this->u.local.depth > depth
; prev = this, this = this->next_all) NOOP;
ident->next_all = this;
prev->next_all = ident;
}
else
{
ident->next_all = all_locals;
all_locals = ident;
}
/* Record the type */
type_of_context[block->num_locals] = type;
block->num_locals++;
}
return ident;
} /* add_context_name() */
/*-------------------------------------------------------------------------*/
static ident_t *
check_for_context_local (ident_t *ident, fulltype_t * pType)
/* The LPC code uses local variable <ident>. If we're compiling
* an inline closure, check if it is an inherited local for which
* no context variable has been created yet. If yes, create the context
* variable.
* Return the (possibly updated) ident, and store the variables type
* in *<pType>.
*/
{
int depth = ident->u.local.depth;
if (current_inline
&& depth <= current_inline->block_depth
)
{
/* This local has been inherited - create the
* proper context variable.
*/
if (ident->u.local.context >= 0)
{
if (!current_inline->parse_context
&& current_inline->prev != -1
&& depth <= INLINE_CLOSURE(current_inline->prev).block_depth
)
{
/* Can't use outer context variables when compiling
* an inline closure body.
*/
yyerrorf("Can't use context variable '%s' "
"across closure boundaries", get_txt(ident->name));
ident = redeclare_local(ident, Type_Any, block_depth);
*pType = Type_Any;
}
else
{
/* We can use outer context variables when compiling
* an inline closure context.
*/
*pType = LOCAL_TYPE(current_inline->full_context_type_start
+ ident->u.local.context
);
}
}
else /* it's a local */
{
fulltype_t type;
type = LOCAL_TYPE(current_inline->full_local_type_start
+ ident->u.local.num
);
if (!current_inline->parse_context)
{
ref_fulltype_data(&type);
ident = add_context_name( ident, type, ident->u.local.num);
}
*pType = type;
}
}
else if (ident->u.local.context >= 0)
*pType = type_of_context[ident->u.local.context];
else
*pType = type_of_locals[ident->u.local.num];
return ident;
} /* check_for_context_local() */
#endif /* USE_NEW_INLINES */
/*-------------------------------------------------------------------------*/
static void
init_scope (int depth)
/* Initialize the block_scope entry for block_depth <depth>.
*/
{
block_scope[depth-1].num_locals = 0;
block_scope[depth-1].first_local = current_number_of_locals;
block_scope[depth-1].num_cleared = 0;
block_scope[depth-1].clobbered = MY_FALSE;
block_scope[depth-1].addr = 0;
} /* init_scope() */
/*-------------------------------------------------------------------------*/
static void
enter_block_scope (void)
/* Enter a new scope and initialize it (if use_local_scopes requires it).
*/
{
if (block_depth == COMPILER_STACK_SIZE)
yyerror("Too deep nesting of local blocks.\n");
if (use_local_scopes)
{
block_depth++;
init_scope(block_depth);
}
} /* enter_block_scope() */
/*-------------------------------------------------------------------------*/
static void
leave_block_scope (Bool dontclobber)
/* Leave the current scope (if use_local_scopes requires it), freeing
* all local names defined in that scope.
*
* <dontclobber> should be MY_TRUE if the stack of the to-be-left scope
* is independent of the outer scope (i.e. the scope of closures).
*/
{
if (use_local_scopes)
{
free_local_names(block_depth);
block_depth--;
if (block_depth && !dontclobber
&& (block_scope[block_depth].num_locals
|| block_scope[block_depth].clobbered))
{
/* the block we just left may have clobbered local variables */
block_scope[block_depth-1].clobbered = MY_TRUE;
}
}
} /* leave_block_scope() */
/* ====================== GLOBALS and FUNCTIONS ====================== */
/*-------------------------------------------------------------------------*/
static unsigned short
store_argument_types ( int num_arg )
/* Store the <num_arg> argument types from global type_of_locals[] into
* the proper memblock and return the new argument start index.
* It is task of the caller to store this start index where it belongs.
*
* If exact_types are not required, the function just returns
* INDEX_START_NONE.
*/
{
unsigned short argument_start_index;
/* Store the function arguments, if required.
*/
if (!exact_types.typeflags)
{
argument_start_index = INDEX_START_NONE;
}
else
{
int i;
/* Save the argument types.
*/
argument_start_index = ARGTYPE_COUNT;
for (i = 0; i < num_arg; i++)
{
vartype_t vt;
assign_full_to_vartype(&vt, type_of_locals[i]);
ref_vartype_data(&vt);
add_to_mem_block(A_ARGUMENT_TYPES, &vt, sizeof vt);
}
}
return argument_start_index;
} /* store_argument_types() */
/*-------------------------------------------------------------------------*/
static int
define_new_function ( Bool complete, ident_t *p, int num_arg, int num_local
, p_int offset, funflag_t flags, fulltype_t type)
/* Define a new function <p> with the characteristics <num_arg>, <num_local>,
* program <offset>, <flags> and <type>.
* The references of <type> are NOT adopted.
* Result is the number (index) of the function.
*
* The function is called whenever a function header (return type, name
* and arguments) has been parsed - <complete> is FALSE then. Additionally,
* the function is called as well after a functionbody has been parsed,
* <complete> is TRUE then.
*
* This function is called at least twice for all function definitions:
* first as prototype (flags & NAME_PROTOTYPE) when the function def is
* encountered, then a second time for real when the function has been
* completed. Explicite prototypes can cause additional calls.
*/
{
int num;
function_t fun;
unsigned short argument_start_index;
/* Move the visibility-info into flags */
flags |= type.typeflags & ~TYPE_MOD_MASK;
do {
function_t *funp;
Bool args_differ, compare_args;
if (p->type != I_TYPE_GLOBAL) break;
if ((num = p->u.global.function) < 0) break;
funp = FUNCTION(num);
if ((funp->flags & (NAME_INHERITED|TYPE_MOD_PRIVATE|NAME_HIDDEN|NAME_UNDEFINED))
== (NAME_INHERITED|TYPE_MOD_PRIVATE|NAME_HIDDEN))
{
break;
}
/* The function was already defined. It may be one of several reasons:
*
* 1. There has been a prototype.
* 2. There was the same function defined by inheritance.
* 3. This function has been called, but not yet defined.
* 4. The function is defined twice.
* 5. A "late" prototype has been encountered.
*/
args_differ = MY_FALSE;
compare_args = MY_FALSE;
/* The following checks are useful only when done before
* a functionbody appears, otherwise the warning/error message
* line numbers will be misleading.
*/
if (!complete)
{
if ((funp->flags & TYPE_MOD_NO_MASK)
&& !(funp->flags & (NAME_PROTOTYPE|NAME_UNDEFINED))
&& ((flags & (NAME_PROTOTYPE|NAME_UNDEFINED)) == (NAME_PROTOTYPE|NAME_UNDEFINED))
)
yyerrorf("Illegal to redefine 'nomask' function \"%s\""
, get_txt(p->name));
if (!(funp->flags & (NAME_UNDEFINED|NAME_PROTOTYPE|NAME_INHERITED) ) )
{
yyerrorf("Redeclaration of function %s.", get_txt(p->name));
if ( !(flags & NAME_PROTOTYPE) )
free_mstring(p->name);
return num;
}
/* It was either an undefined but used function, or an inherited
* function. In both cases, we now consider this to be THE new
* definition. It might also have been a prototype to an already
* defined function.
*
* Check arguments only when types are supposed to be tested,
* and if this function really has been defined already.
*
* 'nomask' functions may not be redefined.
*/
if (exact_types.typeflags && funp->type.typeflags != TYPE_UNKNOWN)
{
fulltype_t t1, t2;
if (funp->num_arg > num_arg && !(funp->flags & TYPE_MOD_VARARGS))
yyerrorf("Incorrect number of arguments in redefinition of '%s'.", get_txt(p->name));
else if (funp->num_arg == num_arg
&& ((funp->flags ^ flags) & TYPE_MOD_XVARARGS)
&& !(funp->flags & TYPE_MOD_VARARGS))
yyerrorf("Incorrect number of arguments in redefinition of '%s'.", get_txt(p->name));
else
{
unsigned short first_arg;
first_arg = ARGUMENT_INDEX(num);
if (first_arg == INDEX_START_NONE)
{
if (num_arg && !(funp->flags & NAME_TYPES_LOST) )
yyerrorf(
"Redefined function '%s' not compiled with type testing."
, get_txt(p->name));
}
else
{
/* We can compare the arguments */
compare_args = MY_TRUE;
}
} /* cases (number of arguments) */
/* If it's a prototype->function redefinition, check if the
* visibility is conserved.
*/
{
# define TYPE_MOD_VIS \
( TYPE_MOD_NO_MASK \
| TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC \
| TYPE_MOD_PROTECTED)
funflag_t f1 = funp->flags;
funflag_t f2 = flags;
/* Smooth out irrelevant differences */
if (f1 & TYPE_MOD_STATIC) f1 |= TYPE_MOD_PROTECTED;
if (f2 & TYPE_MOD_STATIC) f2 |= TYPE_MOD_PROTECTED;
if (!(f1 & (NAME_INHERITED|NAME_TYPES_LOST))
&& ((f1 ^ f2) & TYPE_MOD_VIS)
)
{
char buff[100];
t2 = funp->type;
strcpy(buff, get_visibility(t2));
yywarnf("Inconsistent declaration of '%s': Visibility changed from '%s' to '%s'"
, get_txt(p->name), buff, get_visibility(type));
}
# undef TYPE_MOD_VIS
}
/* Check if the 'varargs' attribute is conserved */
t1 = type; t1.typeflags &= TYPE_MOD_MASK;
t2 = funp->type; t2.typeflags &= TYPE_MOD_MASK;
if (!MASKED_TYPE(t1, t2))
{
if (pragma_pedantic)
yyerrorf("Inconsistent declaration of '%s': Return type mismatch %s", get_txt(p->name), get_two_types(t2, t1));
else if (pragma_check_overloads)
yywarnf("Inconsistent declaration of '%s': Return type mismatch %s", get_txt(p->name), get_two_types(t2, t1));
}
if (pragma_pedantic
&& (funp->flags ^ flags) & TYPE_MOD_VARARGS
&& funp->flags & TYPE_MOD_VARARGS
)
{
yywarnf("Redefinition of '%s' loses 'varargs' modifier."
, get_txt(p->name));
}
/* Check that the two argument lists are compatible */
if (compare_args)
{
int i;
unsigned short first_arg;
vartype_t *argp;
int num_args = num_arg;
/* Don't check newly added arguments */
if (num_args > funp->num_arg)
num_args = funp->num_arg;
first_arg = ARGUMENT_INDEX(num);
argp = (vartype_t *)mem_block[A_ARGUMENT_TYPES].block
+ first_arg;
if (funp->flags & TYPE_MOD_XVARARGS)
num_args--; /* last argument is ok */
for (i = 0; i < num_args; i++ )
{
t1 = type_of_locals[i];
t1.typeflags &= TYPE_MOD_RMASK;
assign_var_to_fulltype(&t2, argp[i]);
t2.typeflags &= TYPE_MOD_MASK;
if (!MASKED_TYPE(t1, t2))
{
args_differ = MY_TRUE;
if (pragma_pedantic)
yyerrorf("Argument type mismatch in "
"redefinition of '%s': arg %d %s"
, get_txt(p->name), i+1, get_two_types(t1, t2)
);
else if (pragma_check_overloads)
yywarnf("Argument type mismatch in "
"redefinition of '%s': arg %d %s"
, get_txt(p->name), i+1, get_two_types(t1, t2)
);
}
} /* for (all args) */
} /* if (compare_args) */
} /* if (exact_types && already defined) */
} /* if (!complete) */
/* Remember the heart_beat() function */
if (mstreq(p->name, STR_HEART_BEAT))
heart_beat = num;
/* If it was yet another prototype, then simply return. */
if (flags & NAME_PROTOTYPE)
{
return num;
}
/* This is the completion of an earlier prototype: check
* and update the arguments if necessary, and flesh
* out the function structure.
*/
if (funp->num_arg != num_arg || args_differ)
{
/* Arguments changed. The only reasonable way this can happen
* is if this function redefined an inherited one.
* For that case, we re-create the arguments, for all other cases
* (to be on the safe side), we turn off type
* checking as we have no way of deciding which definition is the
* correct one.
*/
if (funp->flags & NAME_INHERITED)
{
funp->num_arg = num_arg;
ARGUMENT_INDEX(num) = store_argument_types(num_arg);
}
else
{
funp->num_arg = num_arg;
ARGUMENT_INDEX(num) = INDEX_START_NONE;
flags |= NAME_TYPES_LOST;
}
}
funp->num_local = num_local;
funp->flags = flags;
funp->offset.pc = offset;
free_fulltype_data(&funp->type);
funp->type = type;
ref_fulltype_data(&funp->type);
/* That's it */
return num;
} while(0); /* Test and handle for already defined functions */
/* It's a new function! */
if (mstreq(p->name, STR_HEART_BEAT))
heart_beat = FUNCTION_COUNT;
/* Fill in the function_t */
fun.name = p->name; /* adopt the ref */
fun.offset.pc = offset;
fun.flags = flags;
fun.num_arg = num_arg;
fun.num_local = num_local; /* will be updated later */
fun.type = type;
ref_fulltype_data(&fun.type);
num = FUNCTION_COUNT;
if (p->type != I_TYPE_GLOBAL)
{
/* This is the first _GLOBAL use of this identifier:
* make an appropriate entry in the identifier table.
*/
if (p->type != I_TYPE_UNKNOWN)
{
/* The ident has been used before otherwise, so
* get a fresh structure.
*/
p = make_shared_identifier(get_txt(p->name), I_TYPE_GLOBAL, 0);
}
/* should be I_TYPE_UNKNOWN now. */
init_global_identifier(p, /* bVariable: */ MY_TRUE);
p->next_all = all_globals;
all_globals = p;
}
else if (p->u.global.variable == I_GLOBAL_VARIABLE_FUN)
{
/* The previous _GLOBAL use is the permanent efun definition:
* mark the efun as shadowed.
*/
efun_shadow_t *q;
q = xalloc(sizeof(efun_shadow_t));
q->shadow = p;
q->next = all_efun_shadows;
all_efun_shadows = q;
}
/* else: Other cases don't need special treatment */
p->u.global.function = num;
/* Store the function_t in the functions area */
add_to_mem_block(A_FUNCTIONS, &fun, sizeof fun);
/* Store the function arguments, if required,
* and save the position of the argument types.
*/
argument_start_index = store_argument_types(num_arg);
add_to_mem_block( A_ARGUMENT_INDEX, &argument_start_index
, sizeof argument_start_index);
return num;
} /* define_new_function() */
/*-------------------------------------------------------------------------*/
static void
define_variable (ident_t *name, fulltype_t type)
/* Define a new global variable <name> of type <type>.
* The references of <type> are NOT adopted.
*/
{
variable_t dummy;
typeflags_t flags = type.typeflags;
int n;
if ((flags & PRIMARY_TYPE_MASK) == TYPE_VOID)
{
yyerrorf( "Illegal to define variable '%s' as type 'void'"
, get_txt(name->name));
}
if (name->type != I_TYPE_GLOBAL)
{
/* This is the first _GLOBAL use of this identifier:
* make an appropriate entry in the identifier table.
*/
if (name->type != I_TYPE_UNKNOWN)
{
/* The ident has been used before otherwise, so
* get a fresh structure.
*/
name = make_shared_identifier(get_txt(name->name), I_TYPE_GLOBAL, 0);
}
init_global_identifier(name, /* bVariable: */ MY_TRUE);
name->next_all = all_globals;
all_globals = name;
}
else if (name->u.global.function == I_GLOBAL_FUNCTION_OTHER
&& (name->u.global.efun >= 0 || name->u.global.sim_efun >= 0)
)
{
/* The previous _GLOBAL use is the permanent efun definition:
* mark the efun as shadowed.
*/
efun_shadow_t *q;
q = xalloc(sizeof(efun_shadow_t));
q->shadow = name;
q->next = all_efun_shadows;
all_efun_shadows = q;
}
/* Prepare the new variable_t */
if (flags & TYPE_MOD_NOSAVE)
{
/* 'nosave' is internally saved as 'static' (historical reason) */
flags |= TYPE_MOD_STATIC;
flags ^= TYPE_MOD_NOSAVE;
}
/* If the variable already exists, make sure that we can redefine it */
if ( (n = name->u.global.variable) >= 0)
{
typeflags_t vn_flags = VARIABLE(n)->type.typeflags;
/* Visible nomask variables can't be redefined */
if ( vn_flags & TYPE_MOD_NO_MASK && !(flags & NAME_HIDDEN))
yyerrorf( "Illegal to redefine 'nomask' variable '%s'"
, get_txt(name->name));
/* We can redefine inherited variables if they are private or hidden,
* or if at least one of them is static.
*/
if ( ( !(vn_flags & NAME_INHERITED)
|| ( !(vn_flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN))
&& !((flags | vn_flags) & TYPE_MOD_STATIC)
)
)
&& !(flags & NAME_INHERITED)
)
{
if (vn_flags & NAME_INHERITED)
yyerrorf("Illegal to redefine inherited variable '%s'"
, get_txt(name->name));
else
yyerrorf("Illegal to redefine global variable '%s'"
, get_txt(name->name));
}
if (((flags | vn_flags) & (TYPE_MOD_STATIC|TYPE_MOD_PRIVATE))
== TYPE_MOD_STATIC
&& !(flags & NAME_INHERITED)
)
{
yywarnf("Redefining inherited %s variable '%s' with a %s variable"
, (vn_flags & TYPE_MOD_STATIC)
? "nosave" : "non-nosave"
, get_txt(name->name)
, (flags & TYPE_MOD_STATIC) ? "nosave" : "non-nosave"
);
}
/* Make sure that at least one of the two definitions is 'static'.
* The variable which has not been inherited gets first pick.
*/
if (flags & NAME_INHERITED)
{
flags |= ~(vn_flags) & TYPE_MOD_STATIC;
}
else
{
vn_flags |= ~flags & TYPE_MOD_STATIC;
VARIABLE(n)->type.typeflags = vn_flags;
}
}
type.typeflags = flags;
dummy.name = ref_mstring(name->name);
dummy.type = type;
ref_fulltype_data(&dummy.type);
if (flags & TYPE_MOD_VIRTUAL)
{
if (!(flags & NAME_HIDDEN))
name->u.global.variable = VIRTUAL_VAR_TAG | V_VARIABLE_COUNT;
add_to_mem_block(A_VIRTUAL_VAR, &dummy, sizeof dummy);
}
else
{
if (!(flags & NAME_HIDDEN))
name->u.global.variable = NV_VARIABLE_COUNT;
add_to_mem_block(A_VARIABLES, &dummy, sizeof dummy);
}
} /* define_variable() */
/*-------------------------------------------------------------------------*/
static void
redeclare_variable (ident_t *name, fulltype_t type, int n)
/* The variable <name> is inherited virtually with number <n>.
* Redeclare it from its original type to <type>.
*/
{
typeflags_t flags = type.typeflags;
if (name->type != I_TYPE_GLOBAL)
{
/* This is the first _GLOBAL use of this identifier:
* make an appropriate entry in the identifier table.
*/
/* I_TYPE_UNKNOWN */
init_global_identifier(name, /* bVariable: */ MY_TRUE);
name->next_all = all_globals;
all_globals = name;
}
else if (name->u.global.function == I_GLOBAL_FUNCTION_OTHER
&& (name->u.global.efun >= 0 || name->u.global.sim_efun >= 0)
)
{
/* The previous _GLOBAL use is the permanent efun definition:
* mark the efun as shadowed.
*/
efun_shadow_t *q;
q = xalloc(sizeof(efun_shadow_t));
q->shadow = name;
q->next = all_efun_shadows;
all_efun_shadows = q;
}
/* else: the variable is inherited after it has been defined
* in the child program.
*/
/* The variable is hidden, do nothing else */
if (flags & NAME_HIDDEN)
return;
if (name->u.global.variable >= 0 && name->u.global.variable != n)
{
if (VARIABLE(name->u.global.variable)->type.typeflags & TYPE_MOD_NO_MASK )
yyerrorf( "Illegal to redefine 'nomask' variable '%s'"
, get_txt(name->name));
}
else if (V_VARIABLE(n)->type.typeflags & TYPE_MOD_NO_MASK
&& !(V_VARIABLE(n)->type.typeflags & NAME_HIDDEN)
&& (V_VARIABLE(n)->type.typeflags ^ flags) & TYPE_MOD_STATIC )
{
yyerrorf("Illegal to redefine 'nomask' variable \"%s\""
, get_txt(name->name));
}
if (flags & TYPE_MOD_NOSAVE)
{
/* 'nosave' is internally saved as 'static' (historical reason) */
flags |= TYPE_MOD_STATIC;
flags ^= TYPE_MOD_NOSAVE;
}
type.typeflags = flags;
name->u.global.variable = n;
free_fulltype_data(&V_VARIABLE(n)->type);
V_VARIABLE(n)->type = type;
ref_fulltype_data(&V_VARIABLE(n)->type);
} /* redeclare_variable() */
/*-------------------------------------------------------------------------*/
static int
verify_declared (ident_t *p)
/* Check that <p> is a global variable.
* If yes, return the index of that variable, -1 otherwise.
*/
{
int r;
if (p->type != I_TYPE_GLOBAL
|| (r = p->u.global.variable) < 0)
{
yyerrorf("Variable %s not declared !", get_txt(p->name));
return -1;
}
return r;
} /* verify_declared() */
/*-------------------------------------------------------------------------*/
static int
define_global_variable (ident_t* name, fulltype_t actual_type, typeflags_t opt_star, Bool with_init)
/* This is called directly from a parser rule: <type> [*] <name>
* if with_init is true, then an initialization of this variable will follow.
* It creates the global variable and returns its index.
*/
{
int i;
variables_defined = MY_TRUE;
if (!(actual_type.typeflags & (TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC
| TYPE_MOD_PROTECTED)))
{
actual_type.typeflags |= default_varmod;
}
if (actual_type.typeflags & TYPE_MOD_VARARGS)
{
yyerror("can't declare a variable as varargs");
actual_type.typeflags &= ~TYPE_MOD_VARARGS;
}
actual_type.typeflags |= opt_star;
if (!pragma_share_variables)
actual_type.typeflags |= VAR_INITIALIZED;
define_variable(name, actual_type);
i = verify_declared(name); /* Is the var declared? */
/* Initialize float values with 0.0. */
if (with_init
|| (!(actual_type.typeflags & TYPE_MOD_POINTER)
&& (actual_type.typeflags & PRIMARY_TYPE_MASK) == TYPE_FLOAT
))
{
/* Prepare the init code */
transfer_init_control();
/* If this is the first variable initialization and
* pragma_share_variables is in effect, insert
* the check for blueprint/clone initialisation:
* if (clonep(this_object())) return 1;
*/
if (!variables_initialized && pragma_share_variables)
{
ins_f_code(F_THIS_OBJECT);
ins_f_code(F_CLONEP);
ins_f_code(F_BRANCH_WHEN_ZERO);
ins_byte(2);
ins_f_code(F_CONST1);
ins_f_code(F_RETURN);
}
/* Initialize floats with 0.0 */
if(!with_init)
{
PREPARE_INSERT(5)
/* Must come after the non-local program code inserts! */
add_f_code(F_FCONST0);
#ifdef DEBUG
if (i & VIRTUAL_VAR_TAG)
{
/* When we want to allow 'late' initializers for
* inherited variables, it must have a distinct syntax,
* lest name clashs remain undetected, making LPC code
* hard to debug.
*/
fatal("Newly declared variable is virtual\n");
}
#endif
variables_initialized = MY_TRUE; /* We have __INIT code */
if (!pragma_share_variables)
VARIABLE(i)->type.typeflags |= VAR_INITIALIZED;
/* Push the variable reference and create the assignment */
if (i + num_virtual_variables > 0xff)
{
add_f_code(F_PUSH_IDENTIFIER16_LVALUE);
add_short(i + num_virtual_variables);
CURRENT_PROGRAM_SIZE += 1;
}
else
{
add_f_code(F_PUSH_IDENTIFIER_LVALUE);
add_byte(i + num_virtual_variables);
}
/* Ok, assign */
add_f_code(F_VOID_ASSIGN);
CURRENT_PROGRAM_SIZE += 4;
add_new_init_jump();
} /* PREPARE_INSERT() block */
} /* if (float variable) */
return i;
} /* define_global_variable() */
/*-------------------------------------------------------------------------*/
static void
init_global_variable (int i, ident_t* name, fulltype_t actual_type
, typeflags_t opt_star, int assign_op, fulltype_t exprtype)
/* This is called directly from a parser rule: <type> [*] <name> = <expr>
* It will be called after the call to define_global_variable().
* It assigns the result of <expr> to the variable.
*/
{
PREPARE_INSERT(4)
if (!(actual_type.typeflags & (TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC
| TYPE_MOD_PROTECTED)))
{
actual_type.typeflags |= default_varmod;
}
actual_type.typeflags |= opt_star;
#ifdef DEBUG
if (i & VIRTUAL_VAR_TAG)
{
/* When we want to allow 'late' initializers for
* inherited variables, it must have a distinct syntax,
* lest name clashs remain undetected, making LPC code
* hard to debug.
*/
fatal("Newly declared variable is virtual\n");
}
#endif
variables_initialized = MY_TRUE; /* We have __INIT code */
/* Push the variable reference and create the assignment */
if (i + num_virtual_variables > 0xff)
{
add_f_code(F_PUSH_IDENTIFIER16_LVALUE);
add_short(i + num_virtual_variables);
CURRENT_PROGRAM_SIZE += 1;
}
else
{
add_f_code(F_PUSH_IDENTIFIER_LVALUE);
add_byte(i + num_virtual_variables);
}
/* Only simple assigns are allowed */
if (assign_op != F_ASSIGN)
yyerror("Illegal initialization");
/* Do the types match? */
actual_type.typeflags &= TYPE_MOD_MASK;
if (!compatible_types(actual_type, exprtype, MY_TRUE))
{
yyerrorf("Type mismatch %s when initializing %s"
, get_two_types(actual_type, exprtype)
, get_txt(name->name));
}
/* Ok, assign */
add_f_code(F_VOID_ASSIGN);
CURRENT_PROGRAM_SIZE += 3;
add_new_init_jump();
} /* init_global_variable() */
/*-------------------------------------------------------------------------*/
static void
store_function_header ( p_int start
, string_t * name, fulltype_t returntype
, int num_args, int num_vars
)
/* Store a function header into the program block at address <start>.
* The caller has to make sure that there is enough space.
* The references of <returntype> are adopted.
*/
{
bytecode_p p;
vartype_t rtype;
p = &(PROGRAM_BLOCK[start]);
/* FUNCTION_NAME */
memcpy(p, &name, sizeof name);
p += sizeof name;
(void)ref_mstring(name);
/* FUNCTION_TYPE */
assign_full_to_vartype(&rtype, returntype);
memcpy(p, &rtype, sizeof(rtype));
p += sizeof(rtype);
/* FUNCTION_NUM_ARGS */
if (returntype.typeflags & TYPE_MOD_XVARARGS)
*p++ = num_args | ~0x7f;
else
*p++ = num_args;
/* FUNCTION_NUM_VARS */
*p = num_vars;
} /* store_function_header() */
/*-------------------------------------------------------------------------*/
static void
get_function_information (function_t * fun_p, program_t * prog, int ix)
/* Read the function information for function <ix> in program <prog>
* (which may be inherited) and store it in *<fun_p>. It is the callers
* responsibility to set <fun_p>->flags _before_ calling this function.
*
* In particular, this function sets these <fun_p> fields: .name, .rtype
* .num_args, and it modifies .flags.
*/
{
fun_hdr_p funstart;
vartype_t rtype;
funflag_t flags;
/* Find the real function code */
while ( (flags = prog->functions[ix]) & NAME_INHERITED)
{
inherit_t * ip;
ip = &prog->inherit[flags & INHERIT_MASK];
ix -= ip->function_index_offset;
prog = ip->prog;
}
funstart = &prog->program[flags & FUNSTART_MASK];
memcpy(&fun_p->name, FUNCTION_NAMEP(funstart), sizeof fun_p->name);
memcpy(&rtype, FUNCTION_TYPEP(funstart), sizeof(rtype));
assign_var_to_fulltype(&fun_p->type, rtype);
ref_fulltype_data(&fun_p->type);
fun_p->num_arg = FUNCTION_NUM_ARGS(funstart) & 0x7f;
if (FUNCTION_NUM_ARGS(funstart) & ~0x7f)
fun_p->type.typeflags |= TYPE_MOD_XVARARGS;
if (FUNCTION_CODE(funstart)[0] == F_UNDEF)
{
fun_p->flags |= NAME_UNDEFINED;
}
} /* get_function_information() */
/*-------------------------------------------------------------------------*/
static void
def_function_typecheck (fulltype_t returntype, ident_t * ident
#ifdef USE_NEW_INLINES
, Bool is_inline
#endif /* USE_NEW_INLINES */
)
/* Called after parsing the '<type> <functionname>' part of a function
* definition, this function performs the typecheck, makes sure that
* the function name is put into the list of globals, and initialises
* the block scoping.
*
* If <is_inline> is TRUE, the function to be compiled is an inline closure,
* which requires a slightly different handling. This function is called
* after 'func <type>' has been parsed, and is provided with a synthetic
* function name.
*/
{
#ifdef USE_NEW_INLINES
if (is_inline)
{
new_inline_closure();
enter_block_scope(); /* Scope for context */
enter_block_scope(); /* Argument scope */
}
else
{
#endif /* USE_NEW_INLINES */
use_local_scopes = pragma_use_local_scopes;
block_depth = 1;
init_scope(block_depth);
#ifdef USE_NEW_INLINES
}
#endif /* USE_NEW_INLINES */
if (!(returntype.typeflags & (TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC
| TYPE_MOD_PROTECTED | TYPE_MOD_STATIC)))
{
returntype.typeflags |= default_funmod;
}
/* Require exact types? */
if (returntype.typeflags & TYPE_MOD_MASK)
{
exact_types = returntype;
}
else
{
if (pragma_strict_types != PRAGMA_WEAK_TYPES)
yyerrorf("\"#pragma %s_types\" requires type of function"
, pragma_strict_types == PRAGMA_STRICT_TYPES
? "strict" : "strong" );
exact_types.typeflags = 0;
}
if (returntype.typeflags & TYPE_MOD_NOSAVE)
{
yyerror("can't declare a function as nosave");
returntype.typeflags &= ~TYPE_MOD_NOSAVE;
}
if (ident->type == I_TYPE_UNKNOWN)
{
/* prevent freeing by exotic name clashes */
init_global_identifier(ident, /* bVariable: */ MY_TRUE);
ident->next_all = all_globals;
all_globals = ident;
}
/* Store the data */
#ifdef USE_NEW_INLINES
if (is_inline)
{
current_inline->ident = ident;
current_inline->returntype = returntype;
}
else
{
#endif /* USE_NEW_INLINES */
def_function_returntype = returntype;
def_function_ident = ident;
#ifdef USE_NEW_INLINES
}
#endif /* USE_NEW_INLINES */
} /* def_function_typecheck() */
/*-------------------------------------------------------------------------*/
static void
def_function_prototype (int num_args
#ifdef USE_NEW_INLINES
, Bool is_inline
#endif /* USE_NEW_INLINES */
)
/* Called after parsing '<type> <name> ( <args> ) of a function definition,
* this function creates the function prototype entry.
*
* If <is_inline> is TRUE, the function to be compiled is an inline closure,
* which requires a slightly different handling. This function is called
* after 'func <type> <arguments> <context>' has been parsed.
*/
{
ident_t * ident;
fulltype_t returntype;
int fun;
#ifdef USE_NEW_INLINES
if (is_inline)
{
ident = current_inline->ident;
returntype = current_inline->returntype;
}
else
#endif /* USE_NEW_INLINES */
{
ident = def_function_ident;
returntype = def_function_returntype;
}
/* We got the complete prototype: define it */
if ( current_number_of_locals
&& (type_of_locals[current_number_of_locals-1].typeflags
& TYPE_MOD_VARARGS)
)
{
/* The last argument has to allow an array. */
fulltype_t *t;
returntype.typeflags |= TYPE_MOD_XVARARGS;
t = type_of_locals + (current_number_of_locals-1);
if (!(t->typeflags & TYPE_MOD_POINTER)
&& (t->typeflags & TYPE_MOD_RMASK) != TYPE_ANY
)
{
if ((t->typeflags & TYPE_MOD_RMASK) != TYPE_UNKNOWN)
yyerror(
"varargs parameter must be declared array or mixed");
/* Keep the visibility, but change the type to
* '&any'
*/
t->typeflags &= ~TYPE_MOD_RMASK;
t->typeflags |= TYPE_ANY;
}
}
/* Define a prototype. If it is a real function, then the
* prototype will be updated below.
*/
fun = define_new_function( MY_FALSE, ident, num_args, 0, 0
, NAME_UNDEFINED|NAME_PROTOTYPE
, returntype);
/* Store the data */
#ifdef USE_NEW_INLINES
if (is_inline)
{
current_inline->returntype = returntype;
current_inline->num_args = num_args;
current_inline->function = fun;
}
else
#endif /* USE_NEW_INLINES */
{
def_function_returntype = returntype;
def_function_num_args = num_args;
}
} /* def_function_prototype() */
/*-------------------------------------------------------------------------*/
static void
def_function_complete ( p_int body_start
#ifdef USE_NEW_INLINES
, Bool is_inline
#endif /* USE_NEW_INLINES */
)
/* Called after completely parsing a function definition,
* this function updates the function header and closes all scopes..
* Argument is the program index where the space for the function header
* was made, or -1 if there was no body.
*
* If <is_inline> is TRUE, the function to be compiled is an inline closure,
* which requires a slightly different handling. This function is called
* after the complete closure has been parsed.
*/
{
ident_t * ident;
fulltype_t returntype;
int num_args;
#ifdef USE_NEW_INLINES
if (is_inline)
{
ident = current_inline->ident;
returntype = current_inline->returntype;
num_args = current_inline->num_args;
}
else
#endif /* USE_NEW_INLINES */
{
ident = def_function_ident;
returntype = def_function_returntype;
num_args = def_function_num_args;
}
if (body_start < 0)
{
/* function_body was a ';' -> prototype
* Just norm the visibility flags unless it is a prototype
* for an already inherited function.
*/
funflag_t *flagp;
flagp = (funflag_t *)(&FUNCTION(ident->u.global.function)->flags);
if (!(*flagp & NAME_INHERITED))
{
*flagp |= returntype.typeflags
& (*flagp & TYPE_MOD_PUBLIC
? (TYPE_MOD_NO_MASK)
: (TYPE_MOD_NO_MASK|TYPE_MOD_PRIVATE
|TYPE_MOD_STATIC|TYPE_MOD_PROTECTED
|TYPE_MOD_PUBLIC)
);
}
}
else
{
/* function_body was a block: generate the
* function header and update the ident-table entry.
*/
int num_vars = max_number_of_locals - num_args
+ max_break_stack_need;
store_function_header( body_start
, ident->name
, returntype
, num_args
, num_vars
);
define_new_function(MY_TRUE, ident
, num_args
, num_vars
, body_start + FUNCTION_PRE_HDR_SIZE
, 0, returntype);
/* Catch a missing return if the function has a return type */
if ((returntype.typeflags & PRIMARY_TYPE_MASK) != TYPE_VOID
&& ( (returntype.typeflags & PRIMARY_TYPE_MASK) != TYPE_UNKNOWN
|| pragma_strict_types
)
)
{
/* Check if the previous instruction is a RETURN, or
* at least a non-continuing instruction.
*/
bytecode_t last = PROGRAM_BLOCK[CURRENT_PROGRAM_SIZE-1];
if (F_RETURN == last || F_RETURN0 == last
|| F_RAISE_ERROR == last || F_THROW == last
)
{
/* Good, the last instruction seems to be a 'return'.
* But just in case we're looking at the data field
* of a different opcode or a conditional return: insert a
* proper default return as well.
*/
if (pragma_warn_missing_return)
ins_f_code(F_DEFAULT_RETURN);
else
ins_f_code(F_RETURN0);
}
else
{
/* There is no 'return' here: most likely it is missing
* altogether.
* If warn_missing_return is enabled, issue the warning,
* but always insert a normal F_RETURN0: with the pragma
* active it's no use to warn again at runtime, and without
* the pragma no warning is desired anyway.
*/
if (pragma_warn_missing_return)
yywarnf("Missing 'return <value>' statement");
ins_f_code(F_RETURN0);
}
}
else
{
ins_f_code(F_RETURN0);
}
}
/* Clean up for normal functions.
* Do not free the function returntype - it is still held in A_FUNCTIONS
* and freed after the compile.
* Inline closures need some of the information for some more processing.
*/
#ifdef USE_NEW_INLINES
if (is_inline)
{
/* Keep block_depth, and local names */
}
else
#endif /* USE_NEW_INLINES */
{
free_all_local_names();
block_depth = 0;
}
} /* def_function_complete() */
/* ============================= STRUCTS ============================= */
#ifdef USE_STRUCTS
/*-------------------------------------------------------------------------*/
static int
define_new_struct ( Bool proto, ident_t *p, funflag_t flags)
/* Define a new struct <p> with the visibility <flags>.
* If <proto> is TRUE, the function is called for a struct forward
* declaration; if <proto> is FALSE, the struct is about to be defined.
*
* Result is the index (id) of the struct in the struct_defs table.
* If the struct would be a duplicate, -1 is returned instead of the index.
*
* If a prototype is encountered, the struct definition is stored
* with an additional visibility flag of NAME_PROTOTYPE.
*
* If NAME_HIDDEN is set in flags, the struct is added to the program
* but no visibility checks occur - this is for inherited structs
* which are no longer visible, but have to be kept in order to
* keep the struct ids intact.
*/
{
int num;
struct_def_t sdef;
/* If this is a redeclaration, check for consistency. */
if (p->type == I_TYPE_GLOBAL && (num = p->u.global.struct_id) >= 0
&& !(flags & NAME_HIDDEN)
)
{
struct_def_t *pdef;
pdef = &STRUCT_DEF(num);
/* Check if the visibility is conserved.
*/
{
# define TYPE_MOD_VIS \
( TYPE_MOD_NO_MASK \
| TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC \
| TYPE_MOD_PROTECTED)
funflag_t f1 = pdef->flags;
funflag_t f2 = flags;
/* Smooth out irrelevant differences */
if (f1 & TYPE_MOD_STATIC) f1 |= TYPE_MOD_PROTECTED;
if (f2 & TYPE_MOD_STATIC) f2 |= TYPE_MOD_PROTECTED;
if ( ((f1 ^ f2) & TYPE_MOD_VIS) )
{
char buff[100];
strcpy(buff, get_f_visibility(pdef->flags));
yywarnf("Inconsistent declaration of struct %s: "
"Visibility changed from '%s' to '%s'"
, get_txt(p->name), buff, get_f_visibility(flags));
}
# undef TYPE_MOD_VIS
}
/* If this is just another prototype, return */
if (proto)
return num;
/* If this is a redefinition of a completed struct, complain
* and return.
*/
if (!proto && !(pdef->flags & NAME_PROTOTYPE))
{
yyerrorf("Duplicate definition of struct %s"
, get_txt(p->name));
return -1;
}
/* At this point, we have in our hands the definition of a
* previously just declared struct.
* Update the stored information and return its index.
*/
pdef->flags = flags & ~NAME_PROTOTYPE;
return num;
}
/* This is a new struct! */
/* Fill in the struct_def_t */
sdef.type = struct_new_prototype(ref_mstring(p->name));
sdef.flags = proto ? (flags | NAME_PROTOTYPE)
: (flags & ~NAME_PROTOTYPE);
sdef.inh = -1;
num = STRUCT_COUNT;
if (p->type != I_TYPE_GLOBAL)
{
/* This is the first _GLOBAL use of this identifier:
* make an appropriate entry in the identifier table.
*/
if (p->type != I_TYPE_UNKNOWN)
{
/* The ident has been used before otherwise, so
* get a fresh structure.
*/
p = make_shared_identifier(get_txt(p->name), I_TYPE_GLOBAL, 0);
}
/* should be I_TYPE_UNKNOWN now. */
init_global_identifier(p, /* bVariable: */ MY_FALSE);
p->next_all = all_globals;
all_globals = p;
}
if (!(flags & NAME_HIDDEN))
p->u.global.struct_id = num;
/* Store the function_t in the functions area */
add_to_mem_block(A_STRUCT_DEFS, &sdef, sizeof sdef);
return num;
} /* define_new_struct() */
/*-------------------------------------------------------------------------*/
static int
find_struct ( string_t * name )
/* Find the struct <name> and return its index. Return -1 if not found.
*/
{
ident_t * p;
p = find_shared_identifier(get_txt(name), I_TYPE_GLOBAL, 0);
/* Find the global struct identifier */
while (p != NULL && p->type != I_TYPE_GLOBAL)
p = p->inferior;
if (p == NULL || p->u.global.struct_id < 0)
return -1;
if (STRUCT_DEF(p->u.global.struct_id).flags & NAME_HIDDEN)
return -1;
return p->u.global.struct_id;
} /* find_struct() */
/*-------------------------------------------------------------------------*/
static void
add_struct_member ( string_t *name, vartype_t type
, struct_type_t * from_struct )
/* Add a new member <name> with type <type> to A_STRUCT_MEMBERS for the
* to the most recently defined struct <current_struct>.
* If <from_struct> is not NULL, it is the type of the struct from
* which the member is inherited.
* Raise an error if a member of the same name already exists.
*/
{
struct_def_t *pdef;
pdef = &STRUCT_DEF(current_struct);
if (STRUCT_MEMBER_COUNT != 0)
{
/* Not the first member: check if the name already occured */
int i;
for ( i = STRUCT_MEMBER_COUNT-1 ; i >= 0 ; i--)
{
if (mstreq(name, STRUCT_MEMBER(i).name))
{
if (pdef->type->base
&& pdef->type->base->num_members > i
)
yyerrorf("Duplicate member '%s' in struct '%s', "
"inherited from struct '%s'"
, get_txt(name)
, get_txt(struct_t_name(pdef->type))
, get_txt(struct_t_name(pdef->type->base))
);
else
yyerrorf("Duplicate member '%s' in struct '%s'"
, get_txt(name)
, get_txt(struct_t_name(pdef->type))
);
return;
}
}
}
/* Member is ok: add it */
if (STRUCT_MEMBER_COUNT == 0)
{
/* First member */
if (from_struct)
{
pdef->type->base = ref_struct_type(from_struct);
}
}
if (STRUCT_MEMBER_COUNT == STRUCT_MAX_MEMBERS)
{
yyerrorf("Too many members for struct '%s'"
, get_txt(struct_t_name(pdef->type)));
}
else
{
struct_member_t member;
member.name = ref_mstring(name);
member.type = type;
ref_vartype_data(&member.type);
add_to_mem_block(A_STRUCT_MEMBERS, &member, sizeof member);
}
} /* add_struct_member() */
/*-------------------------------------------------------------------------*/
static void
finish_struct ( const char * prog_name, int32 prog_id)
/* The definition for struct <current_struct> has been parsed completely,
* now complete the struct type object with the A_STRUCT_MEMBERS data.
*/
{
struct_def_t *pdef;
struct_type_t *base;
string_t *name;
pdef = &STRUCT_DEF(current_struct);
/* Retrieve the .base pointer so that the error handling won't
* get confused about it.
* Also get a safety copy of the name.
*/
base = pdef->type->base;
pdef->type->base = NULL;
name = ref_mstring(struct_t_name(pdef->type));
/* Fill in the prototype */
pdef->type = struct_fill_prototype(pdef->type
, new_tabled(prog_name)
, prog_id
, base
, STRUCT_MEMBER_COUNT
, &STRUCT_MEMBER(0)
);
if (pdef->type)
{
/* Success: Free the safety copies */
free_mstring(name);
}
else
{
/* Failure: Recreate the prototype as the old one got deleted */
pdef->type = struct_new_prototype(name);
}
/* Clear the STRUCT_MEMBER block - the definitions have already
* been adopted or cleared by the struct_fill_prototype().
*/
mem_block[A_STRUCT_MEMBERS].current_size = 0;
} /* finish_struct() */
/*-------------------------------------------------------------------------*/
static Bool
create_struct_literal ( struct_def_t * pdef, int length, struct_init_t * list)
/* The compiler has created code for <length> expressions in order
* to create a struct literal of struct <pdef>.
* Analyze the <list> of member descriptions and generate the appropriate
* bytecode.
*
* Return TRUE on success, and FALSE if an error occured (the caller will
* then clean up the bytecode).
*/
{
struct_init_t * p;
struct_member_t * pmember;
void * block; /* Allocation block for flags and index */
Bool * flags; /* Flag: which struct members have been set */
int * ix; /* For each expr in order, list the struct member index */
int consumed; /* To check if we used all elements */
int count, member;
int i;
Bool got_error = MY_FALSE;
/* Check if there is one member assigned by name */
for (p = list; p != NULL; p = p->next)
if (p->name != NULL)
break;
if (length == 0 || p == NULL)
{
/* Simplest case: all members assigned by position. */
/* Check the types */
if (exact_types.typeflags && length > 0)
{
for (member = 0, pmember = pdef->type->member, p = list
; member < length && member < struct_t_size(pdef->type)
; member++, pmember++, p = p->next
)
{
if (!vtype(pmember->type, p->type) )
{
yyerrorf("Type mismatch %s for member '%s' "
"in struct '%s'"
, get_two_vtypes(pmember->type, p->type)
, get_txt(pmember->name)
, get_txt(struct_t_name(pdef->type))
);
got_error = MY_TRUE;
}
}
if (got_error)
return MY_FALSE;
}
/* The types check out - create the bytecode */
ins_f_code(F_S_AGGREGATE);
ins_short(pdef - &STRUCT_DEF(0));
ins_byte(length);
return MY_TRUE;
}
/* We have named members in there - sort them out */
consumed = 0;
block = xalloc( struct_t_size(pdef->type) * sizeof(*flags)
+ length * sizeof(*ix));
flags = (Bool *)block;
ix = (int *)((char *)block + struct_t_size(pdef->type) * sizeof(*flags));
for (i = 0; i < struct_t_size(pdef->type); i++)
{
flags[i] = MY_FALSE;
}
for (i = 0; i < length; i++)
{
ix[i] = -1;
}
/* Loop through list: assign the named members.
*/
for (p = list, count = 0; p != NULL; p = p->next, count++)
{
if (p->name == NULL)
{
if (!got_error)
{
yyerrorf( "Can't mix named and unnamed initializers "
"in struct '%s'"
, get_txt(struct_t_name(pdef->type))
);
got_error = MY_TRUE;
}
continue;
}
consumed++;
pmember = NULL; /* avoids a warning */
member = struct_find_member(pdef->type, p->name);
if (member >= 0)
pmember = &pdef->type->member[member];
if (member < 0)
{
yyerrorf( "No such member '%s' in struct '%s'"
, get_txt(p->name)
, get_txt(struct_t_name(pdef->type))
);
got_error = MY_TRUE;
}
else if (flags[member])
{
yyerrorf( "Multiple initializations of member '%s' "
"in struct '%s'"
, get_txt(p->name)
, get_txt(struct_t_name(pdef->type))
);
got_error = MY_TRUE;
}
else if (exact_types.typeflags
&& !vtype( pmember->type , p->type) )
{
yyerrorf("Type mismatch %s when initializing member '%s' "
"in struct '%s'"
, get_two_vtypes(pmember->type, p->type)
, get_txt(p->name)
, get_txt(struct_t_name(pdef->type))
);
got_error = MY_TRUE;
}
else
{
flags[member] = MY_TRUE;
ix[count] = member;
}
} /* for() */
if (got_error)
{
xfree(block);
return MY_FALSE;
}
/* Sanity checks */
if (consumed < length)
{
yyerrorf("Too many elements for struct '%s'"
, get_txt(struct_t_name(pdef->type))
);
xfree(block);
return MY_FALSE;
}
for (i = 0; i < length; i++)
{
if (ix[i] < 0)
{
fatal("struct literal: expression %d not assigned to any member.\n"
, i);
/* NOTREACHED */
}
}
/* Finally, create the code */
ins_f_code(F_S_M_AGGREGATE);
ins_short(pdef - &STRUCT_DEF(0));
ins_byte(length);
for (i = length-1; i >= 0; i--)
ins_byte(ix[i]);
/* Done */
xfree(block);
return MY_TRUE;
} /* create_struct_literal() */
/*-------------------------------------------------------------------------*/
static short
get_struct_index (struct_type_t * pType)
/* Return the index of struct type <pType> in this program's A_STRUCT_DEFS.
* Return -1 if not found.
*/
{
short i;
for (i = 0; (size_t)i < STRUCT_COUNT; i++)
{
if (STRUCT_DEF(i).type == pType)
return i;
}
return -1;
} /* get_struct_index() */
/*-------------------------------------------------------------------------*/
static short
find_struct_by_member (string_t * name, int * pNum)
/* Among the structs known by this program, find the (smallest) one
* defining member <name>.
* Result:
* >= 0: Index of the struct in A_STRUCT_DEFS, *<pNum> index of the member
* FSM_NO_STRUCT (-1): No struct with such a member
* FSM_AMBIGUOUS (-2): Multiple unrelated structs define the member
* In case of the errors, the function also issues a compiler error.
*/
#define FSM_NO_STRUCT (-1)
#define FSM_AMBIGUOUS (-2)
{
short rc = FSM_NO_STRUCT;
struct_def_t * pRC = NULL;
int member = -1;
int i;
for (i = 0; (size_t)i < STRUCT_COUNT; i++)
{
int num;
struct_def_t * pdef = &STRUCT_DEF(i);
/* If we already found a struct, check if this one is
* a relative. If yes, we can immediately continue
* to the next.
*/
if (pRC != NULL)
{
struct_type_t * pTest;
for ( pTest = pdef->type
; pTest != NULL && pTest != pRC->type
; pTest = pTest->base
)
NOOP;
if (pTest != NULL)
continue;
}
/* Lookup the member in this struct. If not found,
* continue to the next struct.
*/
num = struct_find_member(pdef->type, name);
if (num < 0)
continue;
/* If we already found a struct, check if this one is
* a relative.
*/
if (pRC != NULL)
{
struct_type_t * pTest;
/* Is the newly found struct a child of the
* one we already know? If yes, skip it.
*/
for ( pTest = pdef->type
; pTest != NULL && pTest != pRC->type
; pTest = pTest->base
)
NOOP;
if (pTest != NULL)
continue;
/* Is the newly found struct a parent of
* the one we already know? If yes, keep it
* instead of the one we have; if no, the two
* structs are completely unrelated and the
* lookup is ambiguous.
*/
for ( pTest = pRC->type
; pTest != NULL && pTest != pdef->type
; pTest = pTest->base
)
NOOP;
if (pTest == NULL)
{
yyerrorf("Multiple structs found for member '%s': "
"struct %s, struct %s"
, get_txt(name)
, get_txt(struct_t_name(pRC->type))
, get_txt(struct_t_name(pdef->type))
);
*pNum = -1;
return FSM_AMBIGUOUS;
}
} /* if (pRC) */
/* It's a successful lookup */
rc = i;
pRC = pdef;
member = num;
} /* for (all structs) */
if (rc < 0)
{
yyerrorf("No struct found for member '%s'", get_txt(name));
}
*pNum = member;
return rc;
} /* find_struct_by_member() */
/*-------------------------------------------------------------------------*/
static void
struct_epilog (void)
/* After a successful parse, make sure that all structs are defined,
* try to reactivate existing structs, and publish the new ones.
*
* If an error occures, num_parse_error will be incremented.
*/
{
int i;
/* Check that all structs are defined.
*/
for (i = 0; (size_t)i < STRUCT_COUNT; i++)
{
if (STRUCT_DEF(i).flags & NAME_PROTOTYPE)
{
yyerrorf("struct '%s' defined just as prototype"
, get_txt(struct_t_name(STRUCT_DEF(i).type))
);
return;
}
}
/* For all structs defined in this program, check if they just
* replicate an existing older struct.
*/
for (i = 0; (size_t)i < STRUCT_COUNT; i++)
{
struct_type_t *pSType = STRUCT_DEF(i).type;
struct_type_t *pOld;
int ii;
if (STRUCT_DEF(i).inh >= 0)
continue;
pOld = struct_lookup_type(pSType);
if (!pOld || !struct_type_equivalent(pSType, pOld))
continue;
/* pOld has the same structure as pSType, so lets
* replace the latter with the former.
* First in the structs themselves.
*/
for (ii = 0; (size_t)ii < STRUCT_COUNT; ii++)
{
if (ii != i)
struct_type_update(STRUCT_DEF(ii).type, pSType, pOld);
}
/* Update variable types */
for (ii = 0; (size_t)ii < NV_VARIABLE_COUNT; ii++)
{
fulltype_t * pType = &NV_VARIABLE(ii)->type;
if ((pType->typeflags & PRIMARY_TYPE_MASK) == TYPE_STRUCT
&& pType->t_struct == pSType
)
{
free_struct_type(pType->t_struct);
pType->t_struct = ref_struct_type(pOld);
}
}
for (ii = 0; (size_t)ii < V_VARIABLE_COUNT; ii++)
{
fulltype_t * pType = &V_VARIABLE(ii)->type;
if ((pType->typeflags & PRIMARY_TYPE_MASK) == TYPE_STRUCT
&& pType->t_struct == pSType
)
{
free_struct_type(pType->t_struct);
pType->t_struct = ref_struct_type(pOld);
}
}
/* Update the function return types */
{
int num_functions = FUNCTION_COUNT;
function_t * f = (function_t *)mem_block[A_FUNCTIONS].block;
for (ii = num_functions; --ii >= 0; f++)
{
/* Ignore all functions but those actually defined in
* this program.
*/
if (f->flags & (NAME_INHERITED|NAME_UNDEFINED|NAME_CROSS_DEFINED))
continue;
if ((f->type.typeflags & PRIMARY_TYPE_MASK) == TYPE_STRUCT
&& f->type.t_struct == pSType
)
{
vartype_t type;
fun_hdr_p funhdr;
free_struct_type(f->type.t_struct);
f->type.t_struct = ref_struct_type(pOld);
funhdr = (fun_hdr_p)
&mem_block[A_PROGRAM].block[f->offset.pc];
memcpy(&type, FUNCTION_TYPEP(funhdr), sizeof(type));
type.t_struct = pOld;
memcpy(FUNCTION_TYPEP(funhdr), &type, sizeof(type));
}
} /* for(ii) */
}
/* Update function argument types */
for (ii = 0; (size_t)ii < ARGTYPE_COUNT; ii++)
{
vartype_t * pType = &ARGUMENT_TYPE(ii);
if ((pType->type & PRIMARY_TYPE_MASK) == TYPE_STRUCT
&& pType->t_struct == pSType
)
{
free_struct_type(pType->t_struct);
pType->t_struct = ref_struct_type(pOld);
}
}
/* And finally, replace the struct in the A_STRUCT memblock */
free_struct_type(pSType);
STRUCT_DEF(i).type = ref_struct_type(pOld);
} /* for(i) */
/* Publish all struct types defined in this program.
* It is safe to publish types twice.
*/
for (i = 0; (size_t)i < STRUCT_COUNT; i++)
{
if (STRUCT_DEF(i).inh < 0)
struct_publish_type(STRUCT_DEF(i).type);
} /* for(i) */
} /* struct_epilog() */
#endif /* USE_STRUCTS */
#ifdef USE_NEW_INLINES
/* ========================= Inline Closures =-======================= */
/*-------------------------------------------------------------------------*/
static void
new_inline_closure (void)
/* Create a new inline closure structure and push it on top of the stack.
*/
{
inline_closure_t ict;
if (current_inline == NULL)
{
ict.prev = -1;
}
else
{
ict.prev = current_inline - &(INLINE_CLOSURE(0));
}
#ifdef DEBUG_INLINES
printf("DEBUG: new inline #%"PRIuMPINT": prev %"PRIdMPINT"\n", INLINE_CLOSURE_COUNT, ict.prev);
#endif /* DEBUG_INLINES */
/* Initialize the other fields */
ict.end = CURRENT_PROGRAM_SIZE;
ict.start = CURRENT_PROGRAM_SIZE;
ict.length = 0;
ict.li_start = LINENUMBER_SIZE;
ict.li_length = 0;
ict.function = -1;
ict.ident = NULL;
ict.returntype.typeflags = 0;
#ifdef USE_STRUCTS
ict.returntype.t_struct = NULL;
#endif
ict.num_args = 0;
ict.parse_context = MY_FALSE;
ict.start_line = stored_lines;
ict.end_line = stored_lines;
#ifdef DEBUG_INLINES
printf("DEBUG: start: %"PRIuMPINT", depth %d, locals: %d/%d, break: %d/%d\n",
CURRENT_PROGRAM_SIZE, block_depth, current_number_of_locals,
max_number_of_locals, current_break_stack_need, max_break_stack_need);
#endif /* DEBUG_INLINES */
ict.block_depth = block_depth;
ict.break_stack_size = current_break_stack_need;
ict.max_break_stack_size = max_break_stack_need;
ict.num_locals = current_number_of_locals;
ict.max_num_locals = max_number_of_locals;
ict.exact_types = exact_types;
ict.include_handle = get_include_handle();
ict.full_local_type_start = type_of_locals - &(LOCAL_TYPE(0));
ict.full_context_type_start = type_of_context - &(LOCAL_TYPE(0));
ict.full_local_type_size = mem_block[A_LOCAL_TYPES].current_size;
#ifdef DEBUG_INLINES
printf("DEBUG: local types: %"PRIuMPINT", context types: %"PRIuMPINT"\n",
ict.full_local_type_start, ict.full_context_type_start);
#endif /* DEBUG_INLINES */
/* Extend the type memblocks */
{
mp_uint type_count = LOCAL_TYPE_COUNT;
extend_mem_block(A_LOCAL_TYPES, 2 * MAX_LOCAL * sizeof(fulltype_t));
memset(&LOCAL_TYPE(type_count), 0
, (LOCAL_TYPE_COUNT - type_count) * sizeof(fulltype_t));
type_of_context = &(LOCAL_TYPE(type_count));
type_of_locals = &(LOCAL_TYPE(type_count+MAX_LOCAL));
#ifdef DEBUG_INLINES
printf("DEBUG: type ptrs: %p, %p\n",
type_of_locals, type_of_context );
#endif /* DEBUG_INLINES */
}
max_break_stack_need = current_break_stack_need = 0;
max_number_of_locals = current_number_of_locals = 0;
/* Add the structure to the memblock */
add_to_mem_block(A_INLINE_CLOSURE, &ict, sizeof(ict));
current_inline = &(INLINE_CLOSURE(INLINE_CLOSURE_COUNT-1));
} /* new_inline_closure() */
/*-------------------------------------------------------------------------*/
static void
finish_inline_closure (Bool bAbort)
/* The compilation of the current inline closure is finished - move
* everything out of the way of the ongoing compilation.
* Note that only the codeblock .start/.length is saved; if there is
* already code generated afterwards, it is moved forward. Ditto for
* the linenumbers.
*
* If <bAbort> is TRUE, the closure is just finished, but not stored.
*/
{
mp_uint backup_start, start, length, end;
int offset;
#ifdef DEBUG_INLINES
{
mp_int index = current_inline - &(INLINE_CLOSURE(0));
printf("DEBUG: %s inline #%"PRIdMPINT": prev %"PRIdMPINT", end %"PRIuMPINT
", start %"PRIuMPINT", length %"PRIuMPINT", function %d pc %"PRIu32"\n",
bAbort ? "abort" : "finish", index, current_inline->prev,
current_inline->end, current_inline->start, current_inline->length,
current_inline->function, FUNCTION(current_inline->function)->offset.pc);
printf("DEBUG: depth %d, locals: %d/%d, break: %d/%d\n",
current_inline->block_depth, current_inline->num_locals,
current_inline->max_num_locals, current_inline->break_stack_size,
current_inline->max_break_stack_size);
}
#endif /* DEBUG_INLINES */
/* Move the program code into the backup storage */
start = current_inline->start;
length = current_inline->length;
end = current_inline->end;
if (!bAbort)
{
backup_start = INLINE_PROGRAM_SIZE;
#ifdef DEBUG_INLINES
printf("DEBUG: move code to backup %"PRIuMPINT"\n", backup_start);
#endif /* DEBUG_INLINES */
add_to_mem_block( A_INLINE_PROGRAM, PROGRAM_BLOCK+start, length);
current_inline->start = backup_start;
}
else
{
current_inline->length = 0; /* Marks this one invalid */
}
if (start + length < CURRENT_PROGRAM_SIZE)
{
#ifdef DEBUG_INLINES
printf("DEBUG: move code forward: from %"PRIuMPINT", length %"PRIuMPINT
", to %"PRIuMPINT"\n",
start+length, CURRENT_PROGRAM_SIZE - length - start, end);
#endif /* DEBUG_INLINES */
memmove( PROGRAM_BLOCK+end
, PROGRAM_BLOCK+start+length
, CURRENT_PROGRAM_SIZE - length - start
);
}
CURRENT_PROGRAM_SIZE -= length + (start - end);
stored_bytes -= length + (start - end);
#ifdef DEBUG_INLINES
printf("DEBUG: program size: %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
/* Move the linenumber data into the backup storage */
start = current_inline->li_start;
length = current_inline->li_length;
if (!bAbort)
{
backup_start = INLINE_PROGRAM_SIZE;
#ifdef DEBUG_INLINES
printf("DEBUG: move li data to %"PRIuMPINT", from %"PRIuMPINT" length %"
PRIuMPINT"\n",
backup_start, start, length);
#endif /* DEBUG_INLINES */
add_to_mem_block( A_INLINE_PROGRAM, LINENUMBER_BLOCK+start, length);
current_inline->li_start = backup_start;
}
/* Skip the lines with the closure. */
offset = current_inline->end_line - current_inline->start_line;
while (offset > 0)
{
int lines;
lines = offset;
if (lines > LI_MAXEMPTY)
lines = LI_MAXEMPTY;
offset -= lines;
LINENUMBER_BLOCK[start++] = (char)(256 - lines);
length--;
}
if (start + length < LINENUMBER_SIZE)
{
#ifdef DEBUG_INLINES
printf("DEBUG: move li data forward: from %"PRIuMPINT", length %"PRIuMPINT
", to %"PRIuMPINT"\n",
start+length, LINENUMBER_SIZE - length - start, start);
#endif /* DEBUG_INLINES */
memmove( LINENUMBER_BLOCK+start
, LINENUMBER_BLOCK+start+length
, LINENUMBER_SIZE - length - start
);
}
LINENUMBER_SIZE -= length;
free_local_names(current_inline->block_depth+1);
/* Restore the globals */
block_depth = current_inline->block_depth;
current_number_of_locals = current_inline->num_locals;
max_number_of_locals = current_inline->max_num_locals;
current_break_stack_need = current_inline->break_stack_size;
max_break_stack_need = current_inline->max_break_stack_size;
exact_types = current_inline->exact_types;
#ifdef DEBUG_INLINES
printf("DEBUG: local types: %"PRIuMPINT", context types: %"PRIuMPINT"\n",
current_inline->full_local_type_start, current_inline->full_context_type_start);
#endif /* DEBUG_INLINES */
type_of_locals = &(LOCAL_TYPE(current_inline->full_local_type_start));
type_of_context = &(LOCAL_TYPE(current_inline->full_context_type_start));
#ifdef DEBUG_INLINES
printf("DEBUG: type ptrs: %p, %p\n", type_of_locals, type_of_context );
#endif /* DEBUG_INLINES */
/* Don't free the current_inline->returntype as it's not counted. */
while (mem_block[A_LOCAL_TYPES].current_size
> current_inline->full_local_type_size)
{
mem_block[A_LOCAL_TYPES].current_size -= sizeof(fulltype_t);
free_fulltype_data( (fulltype_t*)
(mem_block[A_LOCAL_TYPES].block
+ mem_block[A_LOCAL_TYPES].current_size)
);
}
/* Remove the structure from the lexical nesting stack */
if (current_inline->prev == -1)
current_inline = NULL;
else
current_inline = &(INLINE_CLOSURE(current_inline->prev));
} /* finish_inline_closure() */
/*-------------------------------------------------------------------------*/
static void
insert_pending_inline_closures (void)
/* The compilation is a point where pending inline closures can be
* inserted. Do that now.
*/
{
mp_int ix;
#ifdef DEBUG_INLINES
if (INLINE_CLOSURE_COUNT != 0) printf("DEBUG: insert_inline_closures(): %"
PRIuMPINT" pending\n",
INLINE_CLOSURE_COUNT);
#endif /* DEBUG_INLINES */
for (ix = 0; (size_t)ix < INLINE_CLOSURE_COUNT; ix++)
{
inline_closure_t * ict = &(INLINE_CLOSURE(ix));
#ifdef DEBUG_INLINES
printf("DEBUG: #%"PRIdMPINT": start %"PRIuMPINT", length %"PRIuMPINT
", function %d: new start %"PRIuMPINT"\n",
ix, ict->start, ict->length, ict->function, CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
if (ict->length != 0)
{
CURRENT_PROGRAM_SIZE = align(CURRENT_PROGRAM_SIZE);
store_line_number_info();
if (stored_lines > ict->start_line)
store_line_number_backward(stored_lines - ict->start_line);
else
while (stored_lines < ict->start_line)
{
int lines;
lines = ict->start_line - stored_lines;
if (lines > LI_MAXEMPTY)
lines = LI_MAXEMPTY;
stored_lines += lines;
byte_to_mem_block(A_LINENUMBERS, 256 - lines);
}
FUNCTION(ict->function)->offset.pc = CURRENT_PROGRAM_SIZE + FUNCTION_PRE_HDR_SIZE;
add_to_mem_block(A_PROGRAM, INLINE_PROGRAM_BLOCK(ict->start)
, ict->length);
#ifdef DEBUG_INLINES
printf("DEBUG: li_start %"PRIuMPINT", li_length %"PRIuMPINT
", new li_start %"PRIuMPINT"\n",
ict->li_start, ict->li_length, LINENUMBER_SIZE);
#endif /* DEBUG_INLINES */
add_to_mem_block(A_LINENUMBERS, INLINE_PROGRAM_BLOCK(ict->li_start)
, ict->li_length);
stored_lines = ict->end_line;
stored_bytes += ict->length;
}
}
/* Empty the datastorages */
mem_block[A_INLINE_CLOSURE].current_size = 0;
mem_block[A_INLINE_PROGRAM].current_size = 0;
} /* insert_pending_inline_closure() */
/*-------------------------------------------------------------------------*/
static Bool
prepare_inline_closure (fulltype_t returntype)
/* Called after parsing 'func <type>', this creates the identifier
* with the synthetic function name. The function also sets up the inline
* closure structure and block scope.
*
* If the name can't be generated, FALSE is returned, otherwise TRUE.
*/
{
char name[256+MAXPATHLEN+1];
ident_t * ident;
if (!use_local_scopes)
{
yyerror("Inline closures require local scoping");
return MY_FALSE;
}
/* Create the name of the new inline function.
* We have to make sure the name is really unique.
*/
do
{
char * start;
sprintf(name, "__inline_%s_%d_#%04x", current_loc.file->name
, current_loc.line, inline_closure_id++);
/* Convert all non-alnums (but '#') to '_' */
for (start = name; *start != '\0'; start++)
{
if (!isalnum((unsigned char)(*start)) && '#' != *start)
*start = '_';
}
} while ( find_shared_identifier(name, 0, 0)
&& inline_closure_id != 0);
if (inline_closure_id == 0)
{
yyerror("Can't generate unique name for inline closure");
return MY_FALSE;
}
ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
/* The lfuns implementing the inline closures should not
* be callable directly (without the CLOSURE svalue), and also not
* overrideable.
*/
returntype.typeflags |= TYPE_MOD_NO_MASK | TYPE_MOD_PRIVATE;
def_function_typecheck(returntype, ident, MY_TRUE);
#ifdef DEBUG_INLINES
printf("DEBUG: New inline closure name: '%s'\n", name);
printf("DEBUG: current_inline->depth: %d\n", current_inline->block_depth);
printf("DEBUG: context depth: %d\n", current_inline->block_depth+1);
printf("DEBUG: arg depth: %d\n", current_inline->block_depth+2);
printf("DEBUG: current depth: %d\n", block_depth);
#endif /* DEBUG_INLINES */
return MY_TRUE;
} /* prepare_inline_closure() */
/*-------------------------------------------------------------------------*/
static Bool
inline_closure_prototype (int num_args)
/* Called after parsing 'func <type> <arguments> <context>', this function
* creates the function prototype entry.
*
* Return FALSE if out of memory (the internal structures have been cleaned
* up then), TRUE otherwise.
*
* TODO: This function shares a lot of code with the generic function
* TODO:: setup. To do this, use entry#0 for gathering the normal
* TODO:: function information, and entries #1.. for the actual inlines.
* TODO:: Or use a handful of globals, and save the in the closure entries
* TODO:: as needed.
*/
{
#ifdef DEBUG_INLINES
printf("DEBUG: inline_closure_prototype(%d)\n", num_args);
#endif /* DEBUG_INLINES */
def_function_prototype(num_args, MY_TRUE);
#ifdef DEBUG_INLINES
printf("DEBUG: current_inline->depth: %d: %d\n", current_inline->block_depth, block_scope[current_inline->block_depth-1].num_locals);
printf("DEBUG: context depth: %d: %d\n", current_inline->block_depth+1, block_scope[current_inline->block_depth+1-1].num_locals);
printf("DEBUG: arg depth: %d: %d\n", current_inline->block_depth+2, block_scope[current_inline->block_depth+2-1].num_locals);
printf("DEBUG: current depth: %d: %d\n", block_depth, block_scope[block_depth].num_locals);
printf("DEBUG: Function index: %d\n", current_inline->function);
#endif /* DEBUG_INLINES */
store_line_number_info();
/* A function with code: align the function and
* make space for the function header.
*/
current_inline->end = CURRENT_PROGRAM_SIZE;
#ifdef DEBUG_INLINES
printf("DEBUG: program size: %"PRIuMPINT" align to %"PRIuMPINT"\n",
CURRENT_PROGRAM_SIZE, align(CURRENT_PROGRAM_SIZE));
#endif /* DEBUG_INLINES */
CURRENT_PROGRAM_SIZE = align(CURRENT_PROGRAM_SIZE);
current_inline->start = CURRENT_PROGRAM_SIZE;
current_inline->li_start = LINENUMBER_SIZE;
current_inline->start_line = stored_lines;
stored_bytes = CURRENT_PROGRAM_SIZE; /* Ignore the alignment. */
if (realloc_a_program(FUNCTION_HDR_SIZE))
{
CURRENT_PROGRAM_SIZE += FUNCTION_HDR_SIZE;
}
else
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + FUNCTION_HDR_SIZE);
finish_inline_closure(MY_TRUE);
return MY_FALSE;
}
return MY_TRUE;
} /* inline_closure_prototype() */
/*-------------------------------------------------------------------------*/
static void
complete_inline_closure ( void )
/* Called after parsing 'func <type> <arguments> <block>', this function
* updates the function header and moves the closure into the pending
* area. After that, the function also completes the generation of
* the F_CONTEXT_CLOSURE instruction.
*
* TODO: This function shares a lot of code with the generic function
* TODO:: setup. To do this, use entry#0 for gathering the normal
* TODO:: function information, and entries #1.. for the actual inlines.
* TODO:: Or use a handful of globals, and save the in the closure entries
* TODO:: as needed.
*/
{
p_int start, li_start;
#ifdef DEBUG_INLINES
printf("DEBUG: Generate inline closure function:\n");
#endif /* DEBUG_INLINES */
if (current_inline->include_handle != get_include_handle())
{
yyerror("Implementation restriction: Inline closure must not span "
"include file limits");
/* Clean up */
leave_block_scope(MY_TRUE); /* Argument scope */
leave_block_scope(MY_TRUE); /* Context scope */
finish_inline_closure(MY_TRUE);
return;
}
start = current_inline->start;
li_start = current_inline->li_start;
#ifdef DEBUG_INLINES
printf("DEBUG: current_inline->depth: %d: %d\n", current_inline->block_depth, block_scope[current_inline->block_depth-1].num_locals);
printf("DEBUG: context depth: %d: %d\n", current_inline->block_depth+1, block_scope[current_inline->block_depth+1-1].num_locals);
printf("DEBUG: arg depth: %d: %d\n", current_inline->block_depth+2, block_scope[current_inline->block_depth+2-1].num_locals);
printf("DEBUG: current depth: %d: %d\n", block_depth, block_scope[block_depth-1].num_locals);
#endif /* DEBUG_INLINES */
/* Generate the function header and update the ident-table entry.
*/
def_function_complete(start, MY_TRUE);
current_inline->length = CURRENT_PROGRAM_SIZE - start;
store_line_number_info();
current_inline->li_length = LINENUMBER_SIZE - li_start;
current_inline->end_line = stored_lines;
/* Add the code to push the values of the inherited local
* variables onto the stack, followed by the F_CONTEXT_CLOSURE
* instruction. Since this code is after the recorded .length,
* the finish_inline_closure() call will move it backward into
* its rightful place.
*/
{
int depth = current_inline->block_depth+1;
block_scope_t * context = &(block_scope[depth-1]);
#ifdef DEBUG_INLINES
printf("DEBUG: %d context vars, depth %d\n", context->num_locals, depth);
#endif /* DEBUG_INLINES */
if (context->num_locals != 0)
{
Bool got_mapped;
/* To get the context->local information in the right order
* we read the locals as they are and store the information
* in an array.
*/
int * lcmap = alloca(context->num_locals * sizeof(int));
ident_t * id;
int i;
for (i = 0; i < context->num_locals; i++)
lcmap[i] = -1;
for (id = all_locals
; id && id->u.local.depth >= depth
; id = id->next_all)
{
#ifdef DEBUG_INLINES
if (id->u.local.depth == depth) printf("DEBUG: '%s': local %d, context %d\n",
get_txt(id->name), id->u.local.num, id->u.local.context);
#endif /* DEBUG_INLINES */
if (id->u.local.depth == depth
&& id->u.local.context >= 0
&& id->u.local.num >= 0
)
{
lcmap[id->u.local.context] = id->u.local.num;
}
}
/* Got all context->local mappings, now create the bytecode */
got_mapped = MY_FALSE;
for (i = 0; i < context->num_locals; i++)
{
if (lcmap[i] != -1)
{
ins_f_code(F_LOCAL);
ins_byte(lcmap[i]);
got_mapped = MY_TRUE;
#ifdef DEBUG_INLINES
printf("DEBUG: -> F_LOCAL %d\n", lcmap[i]);
#endif /* DEBUG_INLINES */
}
else if (got_mapped)
{
/* This shouldn't happen, as all explicite context
* variables are created before the first implicite
* reference can be encountered.
*/
fatal("Explicite context var #%d has higher index than "
"implicite context variables.", i);
}
}
} /* Push local vars */
/* Add the context_closure instruction */
#ifdef DEBUG_INLINES
printf("DEBUG: -> F_CONTEXT_CLOSURE %d %d\n", current_inline->function, context->num_locals);
#endif /* DEBUG_INLINES */
ins_f_code(F_CONTEXT_CLOSURE);
ins_short(current_inline->function);
ins_short(context->num_locals);
} /* Complete F_CONTEXT_CLOSURE instruction */
/* Clean up */
leave_block_scope(MY_TRUE); /* Argument scope */
leave_block_scope(MY_TRUE); /* Context scope */
finish_inline_closure(MY_FALSE);
} /* complete_inline_closure() */
#endif /* USE_NEW_INLINES */
/* ========================= PROGRAM STRINGS ========================= */
/*-------------------------------------------------------------------------*/
static short
store_prog_string (string_t *str)
/* Add the tabled string <str> to the strings used by the program.
* The function takes care that the same string is not stored twice.
* Result is the index of the string in the table, the function
* adopts the reference of <str>.
*/
{
mp_uint str_size, next_size;
long hash;
char mask, *tagp;
int i, *indexp;
/* Compute the hash and the tagmask for the hash table */
/* TODO: This assumes 32-Bit pointers */
hash = (long)str ^ (long)str >> 16;
hash = (hash ^ hash >> 8);
mask = 1 << (hash & 7);
hash = hash & 0xff;
indexp = &prog_string_indizes[hash];
tagp = &prog_string_tags[hash >> 3];
if (*tagp & mask)
{
/* There is a hash chain for this hash: search the
* string in there.
*/
i = *indexp;
for(;;)
{
if ( PROG_STRING(i) == str )
{
free_mstring(str); /* Drop the extra ref. */
last_string_is_new = MY_FALSE;
return i;
}
if ((i = PROG_STRING_NEXT(i)) < 0)
break;
}
/* Not found: re-get the initial 'next'-index */
i = *indexp;
}
else
{
/* The first time this hash shows up (which also implies
* that <str> is a new string.
*/
*tagp |= mask;
i = -1;
}
/* Add a totally new string */
str_size = mem_block[A_STRINGS].current_size;
next_size = mem_block[A_STRING_NEXT].current_size;
/* Make sure we have enough memory */
if (str_size + sizeof(string_t *) > mem_block[A_STRINGS].max_size
|| next_size + sizeof(int) > mem_block[A_STRING_NEXT].max_size
)
{
if (!realloc_mem_block(&mem_block[A_STRINGS], 0)
|| !realloc_mem_block(&mem_block[A_STRING_NEXT], 0))
{
if (i < 0)
*tagp &= ~mask;
last_string_is_new = MY_FALSE;
return 0;
}
}
/* Add the string pointer */
mem_block[A_STRINGS].current_size = str_size + sizeof(string_t *);
*((string_t **)(mem_block[A_STRINGS].block+str_size)) = str;
/* Add the old prog_string_index[] */
mem_block[A_STRING_NEXT].current_size = next_size + sizeof(int);
*((int *)(mem_block[A_STRING_NEXT].block+next_size)) = i;
/* Store the string index as new prog_string_index[] */
*indexp = str_size / sizeof str;
last_string_is_new = MY_TRUE;
return *indexp;
} /* store_prog_string() */
/*-------------------------------------------------------------------------*/
static void
delete_prog_string (void)
/* Remove the program string last added with store_prog_string().
*/
{
string_t *str;
int size;
long hash;
char mask, *tagp;
int *indexp;
/* Remove the string from the A_STRINGS area and free it */
size = mem_block[A_STRINGS].current_size - sizeof(string_t *);
free_mstring(
str = *(string_t**)(mem_block[A_STRINGS].block+size)
);
mem_block[A_STRINGS].current_size = size;
/* Remove the string from the hash table */
size = (mem_block[A_STRING_NEXT].current_size -= sizeof(int));
/* TODO: Assumes 32-Bit pointers */
hash = (long)str ^ (long)str >> 16;
hash = (hash ^ hash >> 8);
mask = 1 << (hash & 7);
hash = hash & 0xff;
indexp = &prog_string_indizes[hash];
tagp = &prog_string_tags[hash >> 3];
if ( ( *indexp = *((int *)(mem_block[A_STRING_NEXT].block+size)) ) < 0)
/* Hash chain empty */
*tagp &= ~mask;
} /* delete_prog_string() */
/*=========================================================================*/
#if defined(__MWERKS__) && !defined(WARN_ALL)
# pragma warn_possunwant off
# pragma warn_implicitconv off
#endif
%}
/*=========================================================================*/
/* P A R S E R */
/*-------------------------------------------------------------------------*/
%token L_ASSIGN
%token L_ARROW
%token L_BREAK
%token L_CASE
%token L_CATCH
%token L_CLOSURE
%token L_CLOSURE_DECL
%token L_COLON_COLON
%token L_CONTINUE
%token L_DEC
%token L_DEFAULT
%token L_DO
%token L_ELLIPSIS
%token L_ELSE
%token L_EQ
%ifdef USE_NEW_INLINES
%token L_FUNC
%token L_BEGIN_INLINE
%token L_END_INLINE
%endif /* USE_NEW_INLINES */
%token L_FLOAT
%token L_FLOAT_DECL
%token L_FOR
%token L_FOREACH
%token L_GE
%token L_IDENTIFIER
%token L_IF
%token L_INC
%token L_INHERIT
%token L_INLINE_FUN
%token L_INT
%token L_LAND
%token L_LE
%token L_LOCAL
%token L_LOR
%token L_LSH
%token L_MAPPING
%token L_MIXED
%token L_NE
%token L_NO_MASK
%token L_NOSAVE
%token L_NOT
%token L_NUMBER
%token L_OBJECT
%ifdef USE_PARSE_COMMAND
%token L_PARSE_COMMAND
%endif
%token L_PRIVATE
%token L_PROTECTED
%token L_PUBLIC
%token L_QUOTED_AGGREGATE
%token L_RANGE
%token L_RETURN
%token L_RSH
%token L_RSHL
%token L_SSCANF
%token L_STATIC
%token L_STATUS
%token L_STRING
%token L_STRING_DECL
%ifdef USE_STRUCTS
%token L_STRUCT
%endif
%token L_SWITCH
%token L_SYMBOL
%token L_SYMBOL_DECL
%token L_VARARGS
%token L_VIRTUAL
%token L_VOID
%token L_WHILE
/* Textbook solution to the 'dangling else' shift/reduce conflict.
*/
%nonassoc LOWER_THAN_ELSE
%nonassoc L_ELSE
/*-------------------------------------------------------------------------*/
/* The yacc stack type */
/* Note: vartype_t and fulltype_t references are not counted!
* Throughout the compiler fulltype_ts are used even if the values
* are not intended to have visibility information.
*/
%union
{
%line
p_int number;
/* Literal numbers, or whereever a number is required.
*/
double float_number;
/* Literal floats */
struct {
p_int number;
unsigned short inhIndex;
} closure;
/* A closure (#'xxx). The .number determines the exact
* nature of the closure.
* For lfun closures, an inhIndex > 0 determines the
* (inheritance index + 1) of a direct reference to an
* inherited closure.
*/
struct {
string_t *name; /* The tabled string with the name */
int quotes; /* Number of quotes */
} symbol;
/* A literal symbol.
*/
ident_t *ident;
/* L_IDENTIFIER, L_INLINE_FUN: The recognized identifier
*/
typeflags_t typeflags;
/* Just the typeflags (reference, pointer, visibility).
*/
fulltype_t type;
/* The datatype, not intended to have visibility flags.
*/
fulltype_t fulltype;
/* The fulltype (datatype plus visibility) of entities.
*/
funflag_t inh_flags[2];
/* Inheritance: [0]: code inheritance qualifiers
* [1]: variable inheritance qualifiers
*/
svalue_t *initialized;
/* Position where to store the variable initializer.
*/
p_int numbers[2];
/* Often used to save the current break/continue address.
*/
p_uint address;
/* Address of an instruction. */
struct {
bytecode_p p; /* The condition code */
unsigned short length; /* Length of the condition code */
unsigned short line; /* Last source line of the condition code */
} expression;
/* Expressions are used to save the code for a loop-condition
* while the body is compiled.
*/
struct s_lrvalue
{
fulltype_t type; /* Type of the expression */
uint32 start; /* Startaddress of the instruction */
short code; /* Alternative instruction */
uint32 end; /* Endaddress+1 of the instruction */
}
lrvalue;
/* Used for expressions which may return a rvalue or lvalues.
* It is also used by the index range generation to move around
* the index expressions.
* Lvalue generation in places where either a r- or an lvalue
* is acceptible first generates the rvalue code, but stores
* the necessary information to patch the code to produce
* lvalues in this structure.
* For more information, see arrange_protected_lvalue().
*/
struct s_index
{
int inst; /* Type of the index */
uint32 start; /* Startaddress of the index */
uint32 end; /* Endaddress+1 of the index */
fulltype_t type1; /* Type of index, resp. lower bound */
fulltype_t type2; /* Type of other index, resp. upper bound */
}
index;
/* This is used to parse and return the indexing operation
* of an array or mapping.
* .inst gives the type of the operation:
* F_INDEX: [x]
* F_RINDEX: [<x]
* F_AINDEX: [>x]
* F_RANGE: [ x.. y]
* F_RN_RANGE: [<x.. y]
* F_NR_RANGE: [ x..<y]
* F_RR_RANGE: [<x..<y]
* F_AN_RANGE: [>x.. y]
* F_AR_RANGE: [>x..<y]
* F_NA_RANGE: [ x..>y]
* F_RA_RANGE: [<x..>y]
* F_AA_RANGE: [>x..>y]
* F_NX_RANGE: [ x.. ]
* F_RX_RANGE: [<x.. ]
* F_AX_RANGE: [>x.. ]
* .start and .end are the bytecode limits of the whole
* operation.
* .type1 and optionally .type2 are the types of the
* index values.
*/
struct lvalue_s {
union {
bytecode_p p;
bytecode_t simple[2];
} u;
unsigned short length;
fulltype_t type;
} lvalue;
/* Used in assigns to communicate how an lvalue has to be accessed
* (by passing on the bytecode to create) and what type it is.
* .length = 0: u.simple contains the bytecode to create
* .length != 0: u.p points to the bytecode of .length bytes.
*/
struct {
p_int key; /* shared string ptr, or a number */
Bool numeric; /* TRUE: .key is a number */
} case_label;
/* Used to return the value of a 'case' label.
*/
char *string;
/* An allocated string */
string_t *sh_string;
/* A shared string */
struct {
char *super; /* NULL, or the allocated qualifier */
ident_t *real; /* The function identifier */
} function_name;
/* A qualified function name: "<super>::<func>" */
struct {
int simul_efun; /* -1, or index of the simul_efun */
p_int start; /* Address of the function call */
} function_call_head;
/* Used to save address and possible sefun-index over
* the argument parsing in a function call.
*/
%ifdef USE_STRUCTS
struct {
int length; /* Number of initializers parsed */
/* Description of initializers parsed: */
struct struct_init_s * list; /* Head of list */
struct struct_init_s * last; /* Tail of list */
} struct_init_list;
/* For runtime struct literals: head of the list describing
* the encountered member initializers.
*/
struct {
string_t * name; /* Member name, or NULL if unnamed */
vartype_t type; /* Member expr type */
} struct_init_member;
/* For runtime struct literals: information about a single
* member initializer.
*/
%endif /* USE_STRUCTS */
} /* YYSTYPE */
/*-------------------------------------------------------------------------*/
%type <number> L_NUMBER constant
%type <float_number> L_FLOAT
%type <closure> L_CLOSURE
%type <symbol> L_SYMBOL
%type <number> L_QUOTED_AGGREGATE
%type <ident> L_IDENTIFIER L_INLINE_FUN L_LOCAL
%type <typeflags> optional_star type_modifier type_modifier_list
%type <fulltype> type
%type <fulltype> opt_basic_type basic_type
%type <fulltype> non_void_type opt_basic_non_void_type basic_non_void_type
%type <fulltype> name_list local_name_list
%type <inh_flags> inheritance_qualifier inheritance_qualifiers
%type <typeflags> inheritance_modifier_list inheritance_modifier
%ifdef USE_NEW_INLINES
%type <fulltype> inline_opt_type
%endif /* USE_NEW_INLINES */
%type <type> decl_cast cast
%type <lrvalue> note_start comma_expr expr0 expr4
%type <lrvalue> function_call
%ifdef USE_NEW_INLINES
%type <lrvalue> inline_func
%else /* USE_NEW_INLINES */
%type <lrvalue> inline_fun
%endif /* USE_NEW_INLINES */
%type <lrvalue> catch sscanf
%type <lrvalue> for_init_expr for_expr
%type <lrvalue> comma_expr_decl expr_decl
%ifdef USE_PARSE_COMMAND
%type <lrvalue> parse_command
%endif
%type <lvalue> lvalue name_lvalue local_name_lvalue foreach_var_lvalue
%type <index> index_range index_expr
%type <case_label> case_label
%type <address> optional_else
%type <string> anchestor
%type <sh_string> call_other_name identifier
%ifdef USE_STRUCTS
%type <fulltype> member_name_list
%type <struct_init_member> struct_init
%type <struct_init_list> opt_struct_init opt_struct_init2
%type <sh_string> struct_member_name
%endif /* USE_STRUCTS */
%type <function_name> function_name
/* Special uses of <number> */
%type <number> function_body
/* program address or -1 */
%type <number> argument argument_list lvalue_list
%ifdef USE_NEW_INLINES
%type <number> inline_opt_args
%endif /* USE_NEW_INLINES */
/* number of arguments */
%type <number> expr_list expr_list3 e_expr_list2 expr_list2
/* Number of expressions in an expression list */
%type <number> m_expr_values
/* Number of values for a mapping entry (ie the 'width') */
%type <number> L_ASSIGN
/* Instruction code of the assignment, e.g. F_ADD_EQ */
%type <number> foreach_expr
/* FOREACH_LOOP (0) Normal foreach loop value
* FOREACH_REF (1) Referenced foreach loop value
* FOREACH_RANGE (2) Integer range as loop value
*/
%type <number> foreach_vars
/* Number of variables given to foreach
*/
%type <number> opt_catch_mods opt_catch_mod_list opt_catch_modifier
/* Bitflags for catch() modes: CATCH_FLAG_xxx from simulate.h
*/
/* Special uses of <numbers> */
%type <numbers> condStart
/* [0]: current_break_address
* [1]: address of the branch-offset of the if
*/
%type <numbers> m_expr_list m_expr_list2
/* [0]: number of entries in a mapping literal
* [1]: width of the mapping literal
*/
/* Special uses of <lrvalue> */
%type <lrvalue> pre_inc_dec
/* .code: The instruction F_PRE_INC or F_PRE_DEC.
* .start: The CURRENT_PROGRAM_SIZE where this inst was encountered.
*/
/*-------------------------------------------------------------------------*/
%right L_ASSIGN
%right '?'
%left L_LOR
%left L_LAND
%left '|'
%left '^'
%left '&'
%left L_EQ L_NE
%left '<' L_LE '>' L_GE
%left L_LSH L_RSH L_RSHL
%left '+' '-'
%left '*' '/' '%'
%right '~' L_NOT
%nonassoc L_INC L_DEC
%left L_ARROW '['
%%
/*-------------------------------------------------------------------------*/
all: program;
program:
program def possible_semi_colon
| /* empty */ ;
possible_semi_colon:
/* empty */
| ';' { yywarn("Extra ';' ignored"); };
note_start: { $$.start = CURRENT_PROGRAM_SIZE; };
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Function prototypes
* Function definitions
* Variable definitions
* Inheritance
* Default visibility
*/
def: type optional_star L_IDENTIFIER /* Function definition or prototype */
{
$1.typeflags |= $2;
#ifdef USE_NEW_INLINES
def_function_typecheck($1, $3, MY_FALSE);
#else /* USE_NEW_INLINES */
def_function_typecheck($1, $3);
#endif /* USE_NEW_INLINES */
}
'(' argument ')'
{
#ifdef USE_NEW_INLINES
def_function_prototype($6, MY_FALSE);
#else /* USE_NEW_INLINES */
def_function_prototype($6);
#endif /* USE_NEW_INLINES */
}
function_body
{
#ifdef USE_NEW_INLINES
def_function_complete($9, MY_FALSE);
#else /* USE_NEW_INLINES */
def_function_complete($9);
#endif /* USE_NEW_INLINES */
#ifndef USE_NEW_INLINES
if (first_inline_fun)
insert_inline_fun_now = MY_TRUE;
#else
insert_pending_inline_closures();
#endif /* USE_NEW_INLINES */
}
| name_list ';' /* Variable definition */
{
#ifndef USE_NEW_INLINES
if (first_inline_fun)
insert_inline_fun_now = MY_TRUE;
#else
insert_pending_inline_closures();
#endif /* USE_NEW_INLINES */
}
%ifdef USE_STRUCTS
| struct_decl
%endif /* USE_STRUCTS */
| inheritance
| default_visibility
; /* def */
function_body:
/* A function with code: align the function and
* make space for the function header.
* Result is the address of the FUNCTION_NAME space.
*/
{
%line
CURRENT_PROGRAM_SIZE = align(CURRENT_PROGRAM_SIZE);
$<number>$ = CURRENT_PROGRAM_SIZE;
if (realloc_a_program(FUNCTION_HDR_SIZE))
{
CURRENT_PROGRAM_SIZE += FUNCTION_HDR_SIZE;
}
else
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + FUNCTION_HDR_SIZE);
YYACCEPT;
}
}
block
{ $$ = $<number>1; }
| ';' { $$ = -1; }
; /* function_body */
%ifdef USE_NEW_INLINES
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Inline functions
*/
inline_func:
L_FUNC inline_opt_type
{
#ifdef DEBUG_INLINES
printf("DEBUG: After inline_opt_type: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
if (!prepare_inline_closure($2))
YYACCEPT;
}
inline_opt_args
{
#ifdef DEBUG_INLINES
printf("DEBUG: After inline_opt_args: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
current_inline->parse_context = MY_TRUE;
}
inline_opt_context
{
#ifdef DEBUG_INLINES
printf("DEBUG: After inline_opt_context: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
current_inline->parse_context = MY_FALSE;
if (!inline_closure_prototype($4))
YYACCEPT;
}
block
{
#ifdef DEBUG_INLINES
printf("DEBUG: After inline block: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
$$.start = current_inline->end;
$$.code = -1;
$$.type = Type_Closure;
complete_inline_closure();
}
| L_BEGIN_INLINE
{
int i;
#ifdef DEBUG_INLINES
printf("DEBUG: After L_BEGIN_INLINE: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
if (!prepare_inline_closure(Type_Any))
YYACCEPT;
/* Synthesize $1..$9 as arguments */
for (i = 1; i < 10; i++)
{
char name[4];
ident_t *ident;
sprintf(name, "$%d", i);
ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
add_local_name(ident, Type_Any, block_depth);
}
if (!inline_closure_prototype(9))
YYACCEPT;
/* Put the code block in its own scope apart from the
* parameters, so that define_local_variable doesn't
* assume that there are already 9 Variables.
*/
enter_block_scope();
#ifdef DEBUG_INLINES
printf("DEBUG: Before comma_expr: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
}
statements inline_comma_expr
L_END_INLINE
{
#ifdef DEBUG_INLINES
printf("DEBUG: After L_END_INLINE: program size %"PRIuMPINT"\n", CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
/* Complete the F_CLEAR_LOCALS at the baginning of the block. */
block_scope_t *scope = block_scope + block_depth - 1;
if (use_local_scopes && scope->num_locals > scope->num_cleared)
{
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - scope->num_cleared);
}
leave_block_scope(MY_FALSE);
$$.start = current_inline->end;
$$.code = -1;
$$.type = Type_Closure;
complete_inline_closure();
}
; /* inline_func */
inline_opt_args:
/* empty */
{
int i;
/* Synthesize $1..$9 as arguments */
for (i = 1; i < 10; i++)
{
char name[4];
ident_t *ident;
sprintf(name, "$%d", i);
ident = make_shared_identifier(name, I_TYPE_UNKNOWN, 0);
add_local_name(ident, Type_Any, block_depth);
}
$$ = 9;
}
| '(' argument ')' { $$ = $2; }
; /* inline_opt_args */
inline_opt_type:
/* empty */
{
#ifdef DEBUG_INLINES
printf("DEBUG: inline_opt_type default: ANY\n");
#endif /* DEBUG_INLINES */
$$ = Type_Any;
}
| basic_type optional_star
{
#ifdef DEBUG_INLINES
printf("DEBUG: inline_opt_type: %c%s\n", $2 ? '*' : ' ', get_type_name($1));
#endif /* DEBUG_INLINES */
set_fulltype($$, $1.typeflags | $2, $1.t_struct);
}
; /* inline_opt_type */
inline_opt_context:
/* empty */
| ':' inline_context_list inline_semi
; /* inline_opt_context */
inline_semi:
/* empty */
| ';'
; /* inline_semi */
inline_context_list:
/* empty */
| context_decl
| inline_context_list ';' context_decl
; /* inline_context_list */
context_decl:
local_name_list
{ /* Empty action to void value from local_name_list */ }
; /* context_decl */
inline_comma_expr:
/* Empty: nothing to do */
| comma_expr
{
/* Add a F_RETURN to complete the statement */
ins_f_code(F_RETURN);
}
; /* inline_comma_expr */
%endif /* USE_NEW_INLINES */
%ifdef USE_STRUCTS
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Definition of a struct
*/
struct_decl:
type_modifier_list L_STRUCT L_IDENTIFIER ';'
{
(void)define_new_struct(MY_TRUE, $3, $1);
}
| type_modifier_list L_STRUCT L_IDENTIFIER
{
size_t i;
/* Free any struct members left over from a previous
* struct parse. This should happen only in case
* of errors.
*/
for (i = 0; i < STRUCT_MEMBER_COUNT; i++)
{
free_struct_member_data(&STRUCT_MEMBER(i));
}
mem_block[A_STRUCT_MEMBERS].current_size = 0;
current_struct = define_new_struct(MY_FALSE, $3, $1);
if (current_struct < 0)
YYACCEPT;
}
opt_base_struct '{' opt_member_list '}' ';'
{
finish_struct(compiled_file, current_id_number+1);
}
; /* struct_decl */
opt_base_struct:
/* empty */ { }
| '(' L_IDENTIFIER ')'
{
/* Look up the struct id for the given identifier */
int num = -1;
if ($2->type == I_TYPE_UNKNOWN)
{
/* Identifier -> no such struct encountered yet */
yyerrorf("Unknown base struct '%s'", get_txt($2->name));
}
else
{
ident_t *p = $2;
/* Find the global struct identifier */
while (p != NULL && p->type != I_TYPE_GLOBAL)
p = p->inferior;
if (p == NULL || (num = p->u.global.struct_id) < 0)
{
yyerrorf("Unknown base struct '%s'", get_txt($2->name));
}
else if (STRUCT_DEF(num).flags & NAME_PROTOTYPE)
{
yyerrorf("Undefined base struct '%s'", get_txt($2->name));
}
else if (!struct_t_unique_name(STRUCT_DEF(num).type))
{
yyerrorf("Incomplete base struct '%s'", get_txt($2->name));
}
else
{
struct_type_t *ptype;
ptype = STRUCT_DEF(num).type;
if (struct_t_size(ptype) > 0)
{
int count;
struct_member_t *member;
member = ptype->member;
count = struct_t_size(ptype);
for ( ; count > 0; count--, member++ )
add_struct_member(member->name, member->type, ptype);
}
}
} /* if type == UNKNOWN */
}
; /* opt_base_struct */
opt_member_list:
/* empty */
| member_list
; /* opt_member_list */
member_list:
member
| member_list member
; /* member_list */
member:
member_name_list ';'
{
/* The member_name_list adds the struct members. */
}
; /* member */
member_name_list:
basic_non_void_type optional_star L_IDENTIFIER
{
fulltype_t actual_type = $1;
vartype_t type;
actual_type.typeflags |= $2;
assign_full_to_vartype(&type, actual_type);
add_struct_member($3->name, type, NULL);
$$ = $1;
}
| member_name_list ',' optional_star L_IDENTIFIER
{
fulltype_t actual_type = $1;
vartype_t type;
actual_type.typeflags |= $3;
assign_full_to_vartype(&type, actual_type);
add_struct_member($4->name, type, NULL);
$$ = $1;
}
; /* member_name_list */
%endif /* USE_STRUCTS */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Inheritance specification
*/
inheritance:
inheritance_qualifiers L_INHERIT string_constant ';'
{
%line
/* We got an inheritance: look up the name object and copy
* the functions and variables into this program.
*
* If the inherited object hasn't been loaded yet, store the
* name in inherit_file and abort the compile.
*
* copy_variables() might add extra inherits for virtual inheritance.
* For this reason, copy_functions() can't know the actual index
* of the new inherit, so it sets it to NEW_INHERITED_INDEX instead.
* This is changed later to the actual value by
* fix_function_inherit_indices() .
*/
object_t *ob;
inherit_t inherit;
if (CURRENT_PROGRAM_SIZE
&& !(((function_t *)(mem_block[A_FUNCTIONS].block+
mem_block[A_FUNCTIONS].current_size))[-1].flags &
NAME_INHERITED)
)
{
yyerror("illegal to inherit after defining functions");
}
/* Check the inheritance qualifiers.
* A variable 'nosave' inherit is internally stored as 'static',
* a functions 'nosave' inherit is not allowed.
*/
if ($1[1] & TYPE_MOD_NOSAVE)
{
$1[1] |= TYPE_MOD_STATIC;
$1[1] ^= TYPE_MOD_NOSAVE;
}
if ($1[0] & TYPE_MOD_NOSAVE)
{
$1[0] ^= TYPE_MOD_NOSAVE;
yyerror("illegal to inherit code as 'nosave'");
}
/* First, try to call master->inherit_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_ref_string(inter_sp, last_string_constant);
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);
res = apply_master(STR_INHERIT_FILE, 2);
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 inherit file '%s'."
, get_txt(last_string_constant));
YYACCEPT;
}
for (cp = get_txt(res->u.str); *cp == '/'; cp++) NOOP;
if (!legal_path(cp))
{
yyerrorf("Illegal path '%s'.", get_txt(res->u.str));
YYACCEPT;
}
/* Ok, now replace the parsed string with the name
* we just got.
*/
free_mstring(last_string_constant);
last_string_constant = new_tabled(cp);
}
/* else: no result - use the string as it is */
}
else if (EVALUATION_TOO_LONG())
{
yyerrorf("Can't call master::%s for "
"'%s': eval cost too big"
, get_txt(STR_INHERIT_FILE)
, get_txt(last_string_constant));
/* use the string as it is */
}
/* Look up the inherited object and swap it in.
*/
ob = find_object(last_string_constant);
if (ob == 0)
{
inherit_file = last_string_constant;
last_string_constant = NULL;
/* Return back to load_object() */
YYACCEPT;
}
ob->time_of_ref = current_time;
#ifdef USE_SWAP
if (ob->flags & O_SWAPPED && load_ob_from_swap(ob) < 0)
{
free_mstring(last_string_constant);
last_string_constant = NULL;
yyerrorf("Out of memory when unswapping '%s'", get_txt(ob->name));
YYACCEPT;
}
#endif
/* Legal to inherit? */
if (ob->prog->flags & P_NO_INHERIT)
{
yyerror("Illegal to inherit an object which sets "
"'#pragma no_inherit'.");
YYACCEPT;
}
free_mstring(last_string_constant);
last_string_constant = NULL;
/* Set up the inherit structure */
inherit.prog = ob->prog;
if ($1[1] & TYPE_MOD_VIRTUAL)
inherit.inherit_type = INHERIT_TYPE_VIRTUAL;
else
inherit.inherit_type = INHERIT_TYPE_NORMAL;
inherit.function_index_offset = FUNCTION_COUNT;
inherit.inherit_depth = 1;
/* If it's a virtual inherit, check if it has been
* inherited virtually before. If yes, don't bother to insert it
* again.
* For all types of inherits, check if the same program has already
* been inherited at the toplevel.
*/
{
inherit_t *inheritp;
int j;
Bool duplicate_toplevel = MY_FALSE;
inheritp = (inherit_t *)(mem_block[A_INHERITS].block);
j = mem_block[A_INHERITS].current_size;
for (; (j -= sizeof(inherit_t)) >= 0; inheritp++)
{
if (inheritp->prog == ob->prog)
{
/* Check for duplicate toplevel inherit.
* Since the check for duplicate virtual inherits
* may change the inherit_depth, this test must
* come first
*/
if (inheritp->inherit_depth == 1)
duplicate_toplevel = MY_TRUE;
/* Check for duplicate virtual inherit */
if (($1[1] & TYPE_MOD_VIRTUAL)
&& !(inheritp->variable_index_offset & NON_VIRTUAL_OFFSET_TAG)
&& !(inherit.inherit_type & INHERIT_TYPE_DUPLICATE)
)
{
inherit.inherit_type |= INHERIT_TYPE_DUPLICATE;
inheritp->inherit_depth = 1;
}
}
}
if (duplicate_toplevel)
{
if (pragma_pedantic)
{
yyerrorf("Program '%s' already inherited"
, get_txt(inherit.prog->name));
YYACCEPT;
}
else
yywarnf("Program '%s' already inherited"
, get_txt(inherit.prog->name));
}
}
if (!(inherit.inherit_type & INHERIT_TYPE_DUPLICATE))
{
/* Copy the functions and variables, and take
* care of the initializer.
*/
int initializer;
#ifdef USE_STRUCTS
copy_structs(ob->prog, $1[0]);
#endif
initializer = copy_functions(ob->prog, $1[0]);
copy_variables(ob->prog, $1[1]);
if (initializer > -1)
{
/* We inherited a __INIT() function: create a call */
transfer_init_control();
ins_f_code(F_SAVE_ARG_FRAME);
ins_f_code(F_CALL_INHERITED);
ins_short(INHERIT_COUNT);
ins_short(initializer);
ins_f_code(F_RESTORE_ARG_FRAME);
ins_f_code(F_POP_VALUE);
add_new_init_jump();
}
/* Fix up the inherit indices */
fix_function_inherit_indices(ob->prog);
/* Update and store the inherit structure.
*
* If the program was inherited non-virtual, the v_i_offset
* may become negative here if the program itself inherits
* other programs with variables virtually. That is ok
* because in the final program the sub-inherited virtual
* variables no longer are immediately before the programs
* non-virtual variables, but the program's code doesn't know
* that and continues to 'offset over' them.
*/
inherit.variable_index_offset
= $1[1] & TYPE_MOD_VIRTUAL
? V_VARIABLE_COUNT - ob->prog->num_variables
: (NV_VARIABLE_COUNT - ob->prog->num_variables)
| NON_VIRTUAL_OFFSET_TAG;
add_to_mem_block(A_INHERITS, &inherit, sizeof inherit);
num_virtual_variables = V_VARIABLE_COUNT;
} /* if (!(inherit.inherit_type & INHERIT_TYPE_DUPLICATE)) */
}
; /* inheritance */
inheritance_qualifiers:
/* Inheritance can be qualified simple ("public inherit...")
* or separate for code and variables.
*/
inheritance_modifier_list
{
$$[0] = $$[1] = $1;
/* Allow 'static nosave inherit foo' as the short form
* of 'static functions nosave variables inherit foo'; meaning
* that we have to prevent the qualifier test in the
* inheritance rule from triggering.
*/
if ($1 & TYPE_MOD_NOSAVE)
{
$$[0] ^= TYPE_MOD_NOSAVE;
}
}
| inheritance_qualifier inheritance_qualifiers
{
$$[0] = $1[0] | $2[0];
$$[1] = $1[1] | $2[1];
}
; /* inheritance_qualifiers */
inheritance_modifier:
L_VIRTUAL { $$ = TYPE_MOD_VIRTUAL; } ;
inheritance_modifier_list:
type_modifier_list
{ $$ = $1; }
| inheritance_modifier_list inheritance_modifier type_modifier_list
{ $$ = $1 | $2 | $3; }
; /* inheritance_modifier_list */
inheritance_qualifier:
type optional_star L_IDENTIFIER
{
static ident_t *last_identifier;
static typeflags_t last_modifier;
%line
/* The inherit statement must only specify visibility
* e.g. not "inherit int * foobar"
*/
if ($1.typeflags & TYPE_MOD_MASK)
{
yyerror("syntax error");
}
/* Check if there were any modifiers at all */
if ( !($1.typeflags & ~TYPE_MOD_MASK) )
{
/* take lookahead into account */
if ($3 == last_identifier)
{
last_identifier = NULL;
$$[0] = $$[1] = 0;
break; /* TODO: Assumes that byacc uses a switch() */
}
}
else
{
last_modifier = $1.typeflags & ~TYPE_MOD_MASK;
}
last_identifier = $3;
if ($2) /* No "*" allowed TODO: So why it's there? */
{
yyerror("syntax error");
}
/* The L_IDENTIFIER must be one of "functions" or "variables" */
if (mstreq(last_identifier->name, STR_FUNCTIONS))
{
$$[0] = last_modifier;
$$[1] = 0;
}
else if (mstreq(last_identifier->name, STR_VARIABLES))
{
$$[0] = 0;
$$[1] = last_modifier;
}
else
{
yyerrorf("Unrecognized inheritance modifier '%s'"
, get_txt(last_identifier->name));
$$[0] = $$[1] = 0;
}
}
; /* inheritance_qualifier */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Default visibility.
*
* We use the inheritance modifier notation to specify the default
* visibility of functions and variables.
*/
default_visibility:
L_DEFAULT inheritance_qualifiers ';'
{
if ($2[0] & ~( TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC
| TYPE_MOD_PROTECTED | TYPE_MOD_STATIC)
)
{
yyerror("Default visibility specification for functions "
"accepts only 'private', 'protected', 'public' or "
"'static'");
YYACCEPT;
}
if ($2[1] & ~( TYPE_MOD_PRIVATE | TYPE_MOD_PUBLIC
| TYPE_MOD_PROTECTED)
)
{
yyerror("Default visibility specification for variables "
"accepts only 'private', 'protected' or 'public'"
);
YYACCEPT;
}
default_funmod = $2[0];
default_varmod = $2[1];
}
; /* default_visibility */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Type specifications and casts
*
* The type rules are used to parse variable and function types, casts,
* or just visibility e.g for inheritance.
*/
optional_star:
/* empty */ { $$ = 0; }
| '*' { $$ = TYPE_MOD_POINTER; } ;
type: type_modifier_list opt_basic_type
{
set_fulltype($$, $1 | $2.typeflags, $2.t_struct);
} ;
non_void_type: type_modifier_list opt_basic_non_void_type
{
set_fulltype($$, $1 | $2.typeflags, $2.t_struct);
} ;
type_modifier_list:
/* empty */ { $$ = 0; }
| type_modifier_list type_modifier { $$ = $1 | $2; } ;
type_modifier:
L_NO_MASK { $$ = TYPE_MOD_NO_MASK; }
| L_STATIC { $$ = TYPE_MOD_STATIC; }
| L_PRIVATE { $$ = TYPE_MOD_PRIVATE; }
| L_PUBLIC { $$ = TYPE_MOD_PUBLIC; }
| L_VARARGS { $$ = TYPE_MOD_VARARGS; }
| L_PROTECTED { $$ = TYPE_MOD_PROTECTED; }
| L_NOSAVE { $$ = TYPE_MOD_NOSAVE; }
;
opt_basic_type:
basic_type
| /* empty */ { $$ = Type_Unknown; } ;
opt_basic_non_void_type:
basic_non_void_type
| /* empty */ { $$ = Type_Unknown; } ;
basic_non_void_type:
L_STATUS { $$ = Type_Number; }
| L_INT { $$ = Type_Number; }
| L_STRING_DECL { $$ = Type_String; }
| L_OBJECT { $$ = Type_Object; }
| L_CLOSURE_DECL { $$ = Type_Closure; }
| L_SYMBOL_DECL { $$ = Type_Symbol; }
| L_FLOAT_DECL { $$ = Type_Float; }
| L_MAPPING { $$ = Type_Mapping; }
| L_MIXED { $$ = Type_Any; }
%ifdef USE_STRUCTS
| L_STRUCT identifier
{
int num;
num = find_struct($2);
if (num < 0)
{
yyerrorf("Unknown struct '%s'", get_txt($2));
$$ = Type_Unknown;
}
else
{
$$.typeflags = TYPE_STRUCT;
$$.t_struct = STRUCT_DEF(num).type;
}
free_mstring($2);
}
%endif /* USE_STRUCTS */
; /* basic_non_void_type */
basic_type:
basic_non_void_type
| L_VOID { $$ = Type_Void; }
; /* basic_type */
cast:
'(' basic_type optional_star ')'
{
set_fulltype($$, $2.typeflags | $3, $2.t_struct);
}
;
/* TODO: Remove decl_casts - they are practically useless */
decl_cast:
'(' '{' basic_type optional_star '}' ')'
{
set_fulltype($$, $3.typeflags | $4, $3.t_struct);
}
;
/* A generic identifier */
identifier:
L_IDENTIFIER
{
string_t *p;
/* Extract the string from the ident structure */
p = ref_mstring($1->name);
$$ = p;
}
| L_LOCAL
{
$$ = ref_mstring($1->name);
}
;
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Argument and variable definitions
*/
argument:
/* empty */ { $$ = 0; }
| L_VOID { $$ = 0; }
| argument_list ;
argument_list:
new_arg_name { $$ = 1; }
| argument_list ',' new_arg_name { $$ = $1 + 1; } ;
new_arg_name:
non_void_type optional_star L_IDENTIFIER
{
if (exact_types.typeflags && $1.typeflags == 0)
{
yyerror("Missing type for argument");
#ifdef USE_NEW_INLINES
add_local_name($3, Type_Any, block_depth);
#else /* USE_NEW_INLINES */
add_local_name($3, Type_Any, block_depth, MY_FALSE);
#endif /* USE_NEW_INLINES */
/* Supress more errors */
}
else
{
fulltype_t argtype;
set_fulltype(argtype, $1.typeflags | $2, $1.t_struct);
#ifdef USE_NEW_INLINES
add_local_name($3, argtype, block_depth);
#else /* USE_NEW_INLINES */
add_local_name($3, argtype, block_depth, MY_FALSE);
#endif /* USE_NEW_INLINES */
}
}
| non_void_type optional_star L_LOCAL
{
%ifndef USE_NEW_INLINES
/* A local name is redeclared. Since this is the argument list of a
* function, it can't be legal.
*/
yyerror("Illegal to redeclare local name");
%else
/* A local name is redeclared. */
if (current_inline == NULL)
{
/* Since this is the argument list of a function, it can't be
* legal.
*/
yyerror("Illegal to redeclare local name");
}
else
{
/* However, it is legal for the argument list of an inline
* closure.
*/
fulltype_t argtype;
set_fulltype(argtype, $1.typeflags | $2, $1.t_struct);
redeclare_local($3, argtype, block_depth);
}
%endif
}
; /* new_arg_name */
name_list:
/* Simple variable definition */
type optional_star L_IDENTIFIER
{
%line
if ($1.typeflags == 0)
yyerror("Missing type");
define_global_variable($3, $1, $2, MY_FALSE);
$$ = $1;
}
/* Variable definition with initialization */
| type optional_star L_IDENTIFIER
{
if ($1.typeflags == 0)
yyerror("Missing type");
$<number>$ = define_global_variable($3, $1, $2, MY_TRUE);
}
L_ASSIGN expr0
{
init_global_variable($<number>4, $3, $1, $2, $5, $6.type);
$$ = $1;
}
| name_list ',' optional_star L_IDENTIFIER
{
define_global_variable($4, $1, $3, MY_FALSE);
$$ = $1;
}
/* Variable definition with initialization */
| name_list ',' optional_star L_IDENTIFIER
{
$<number>$ = define_global_variable($4, $1, $3, MY_TRUE);
}
L_ASSIGN expr0
{
init_global_variable($<number>5, $4, $1, $3, $6, $7.type);
$$ = $1;
}
; /* name_list */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Blocks and simple statements.
*/
block: '{' statements_block '}'
statements_block:
{ enter_block_scope(); }
statements
{
/* If this is a local block, the declarations inserted
* a code fragment to zero out the locals (previous blocks
* may have left values in them). Complete the fragment
* with the number of locals to clear, now that we
* know it.
*/
{
block_scope_t *scope = block_scope + block_depth - 1;
if (use_local_scopes && scope->num_locals > scope->num_cleared)
{
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - scope->num_cleared);
}
}
leave_block_scope(MY_FALSE);
}
; /* block_statements */
statements:
/* empty */
| statements local_name_list ';'
| statements statement
;
local_name_list:
basic_type optional_star L_IDENTIFIER
{
struct lvalue_s lv;
define_local_variable($3, $1, $2, &lv, MY_FALSE, MY_FALSE);
$$ = $1;
}
| basic_type optional_star L_LOCAL
{
struct lvalue_s lv;
define_local_variable($3, $1, $2, &lv, MY_TRUE, MY_FALSE);
$$ = $1;
}
| basic_type optional_star L_IDENTIFIER
{
define_local_variable($3, $1, $2, &$<lvalue>$, MY_FALSE, MY_TRUE);
}
L_ASSIGN expr0
{
init_local_variable($3, &$<lvalue>4, $5, $6.type);
$$ = $1;
}
| basic_type optional_star L_LOCAL
{
define_local_variable($3, $1, $2, &$<lvalue>$, MY_TRUE, MY_TRUE);
}
L_ASSIGN expr0
{
init_local_variable($3, &$<lvalue>4, $5, $6.type);
$$ = $1;
}
| local_name_list ',' optional_star L_IDENTIFIER
{
struct lvalue_s lv;
define_local_variable($4, $1, $3, &lv, MY_FALSE, MY_FALSE);
$$ = $1;
}
| local_name_list ',' optional_star L_LOCAL
{
struct lvalue_s lv;
define_local_variable($4, $1, $3, &lv, MY_TRUE, MY_FALSE);
$$ = $1;
}
| local_name_list ',' optional_star L_IDENTIFIER
{
define_local_variable($4, $1, $3, &$<lvalue>$, MY_FALSE, MY_TRUE);
}
L_ASSIGN expr0
{
init_local_variable($4, &$<lvalue>5, $6, $7.type);
$$ = $1;
}
| local_name_list ',' optional_star L_LOCAL
{
define_local_variable($4, $1, $3, &$<lvalue>$, MY_TRUE, MY_TRUE);
}
L_ASSIGN expr0
{
init_local_variable($4, &$<lvalue>5, $6, $7.type);
$$ = $1;
}
; /* local_name_list */
statement:
comma_expr ';'
{
insert_pop_value();
#ifdef F_BREAK_POINT
if (d_flag)
ins_f_code(F_BREAK_POINT);
#endif /* F_BREAK_POINT */
/* if (exact_types && !BASIC_TYPE($1.type, TYPE_VOID))
* yyerror("Value thrown away");
*/
}
| error ';' /* Synchronisation point */
| cond | while | do | for | foreach | switch
| return ';'
| block
| /* empty */ ';'
| L_BREAK ';'
{
/* Compile the break statement */
if (current_break_address == 0)
yyerror("break statement outside loop");
if (current_break_address & BREAK_ON_STACK)
{
/* We break from a switch() */
ins_f_code(F_BREAK);
}
else
{
/* A normal loop break: add the FBRANCH to the list */
ins_f_code(F_FBRANCH);
ins_int32(current_break_address & BREAK_ADDRESS_MASK);
current_break_address = CURRENT_PROGRAM_SIZE - 4;
if (current_break_address > BREAK_ADDRESS_MASK)
yyerrorf("Compiler limit: (L_BREAK) value too large: %"PRIdPINT
, current_break_address);
}
}
| L_CONTINUE ';' /* This code is a jump */
{
p_int depth;
%line
if (current_continue_address == 0)
yyerror("continue statement outside loop");
if ( 0 != (depth = (current_continue_address & SWITCH_DEPTH_MASK)) )
{
/* A continue inside a switch */
/* For more than 255 nested switches, generate a series
* of BREAKN_CONTINUE instructions.
*/
while (depth > SWITCH_DEPTH_UNIT*256)
{
ins_f_code(F_BREAKN_CONTINUE);
ins_byte(255);
ins_int32(4);
depth -= SWITCH_DEPTH_UNIT*256;
}
/* BREAK_CONTINUE the last switches */
if (depth > SWITCH_DEPTH_UNIT)
{
depth /= SWITCH_DEPTH_UNIT;
ins_f_code(F_BREAKN_CONTINUE);
ins_byte(depth-1);
}
else
{
ins_f_code(F_BREAK_CONTINUE);
}
}
else
{
/* Normal continue */
ins_f_code(F_FBRANCH);
}
/* In either case, handle the list of continues alike */
ins_int32(current_continue_address & CONTINUE_ADDRESS_MASK);
current_continue_address =
( current_continue_address & SWITCH_DEPTH_MASK ) |
( CURRENT_PROGRAM_SIZE - 4 );
}
; /* statement */
return:
L_RETURN
{
fulltype_t rtype = exact_types;
rtype.typeflags &= TYPE_MOD_MASK;
if (exact_types.typeflags
&& !BASIC_TYPE(rtype, Type_Void))
type_error("Must return a value for a function declared",
exact_types);
ins_f_code(F_RETURN0);
}
| L_RETURN comma_expr
{
%line
fulltype_t type2 = $2.type;
if (exact_types.typeflags)
{
fulltype_t rtype = exact_types;
rtype.typeflags &= TYPE_MOD_MASK;
/* More checks, ie. mixed vs non-mixed, would be nice,
* but the general type tracking is too lacking for it.
*/
if (!MASKED_TYPE(type2, rtype))
{
char tmp[100];
strcpy(tmp, get_type_name(type2));
yyerrorf("Return type not matching: got %s, expected %s"
, tmp, get_type_name(rtype));
}
}
if (type2.typeflags & TYPE_MOD_REFERENCE)
{
yyerror("May not return a reference");
}
if (last_expression == CURRENT_PROGRAM_SIZE - 1
&& mem_block[A_PROGRAM].block[last_expression] ==
F_CONST0 )
{
/* Optimize "CONST0 RETURN" to "RETURN0" */
mem_block[A_PROGRAM].block[last_expression] =
F_RETURN0;
last_expression = -1;
}
else
ins_f_code(F_RETURN);
}
; /* return */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The while() statement
*
* It is compiled into:
*
* BRANCH c
* l: <body>
* c: <cond>
* BBRANCH_WHEN_NON_ZERO l
*/
while:
{
/* Save the previous environment */
$<numbers>$[0] = current_continue_address;
$<numbers>$[1] = current_break_address;
push_address(); /* Remember the starting address */
}
L_WHILE '(' comma_expr ')'
{
%line
p_int addr = pop_address();
p_int length = CURRENT_PROGRAM_SIZE - addr;
bytecode_p expression;
/* Take the <cond> code, add the BBRANCH instruction and
* store all of it outside the program. After the <body>
* has been compiled, the code will be put back in.
*/
expression = yalloc(length+2);
memcpy(expression, mem_block[A_PROGRAM].block+addr, length);
if (last_expression == CURRENT_PROGRAM_SIZE - 1
&& expression[length-1] == F_NOT
)
{
/* Optimizize
* NOT
* BBRANCH_WHEN_NON_ZERO
* into
* BBRANCH_WHEN_ZERO
*/
length--;
expression[length] = F_BBRANCH_WHEN_ZERO;
}
else
{
expression[length] = F_BBRANCH_WHEN_NON_ZERO;
}
/* Save the code as 'expression' */
$<expression>$.p = expression;
$<expression>$.length = length;
$<expression>$.line = current_loc.line;
/* Restart codegeneration for the body where we began */
CURRENT_PROGRAM_SIZE = addr;
last_expression = -1;
/* The initial branch to the condition code */
ins_f_code(F_BRANCH);
push_address();
ins_byte(0);
current_continue_address = CONTINUE_DELIMITER;
current_break_address = BREAK_DELIMITER;
}
statement
{
%line
/* The body compiled ok. Now patch up the breaks and continues
* and insert the condition checking.
*/
p_int offset;
p_int next_addr;
p_int addr = pop_address();
/* Update the offsets of all continue BRANCHes
* (resp BREAK_CONTINUEs) to branch to the current address.
*/
for ( ; current_continue_address > 0
; current_continue_address = next_addr)
{
next_addr = read_int32(current_continue_address);
upd_int32(current_continue_address,
CURRENT_PROGRAM_SIZE - current_continue_address);
}
/* If necessary, update the leading BRANCH to an LBRANCH */
offset = fix_branch( F_LBRANCH, CURRENT_PROGRAM_SIZE, addr);
/* Add the condition code to the program */
if ($<expression>6.line != current_loc.line)
store_line_number_info();
add_to_mem_block(A_PROGRAM, $<expression>6.p, $<expression>6.length+2);
yfree($<expression>6.p);
/* Complete the branch at the end of the condition code */
offset += addr + 1 - ( CURRENT_PROGRAM_SIZE - 1 );
if (offset < -0xff)
{
/* We need a LBRANCH instead of the BBRANCH */
bytecode_p codep;
if (offset < -0x8000)
yyerror("offset overflow");
codep = PROGRAM_BLOCK + --CURRENT_PROGRAM_SIZE - 1;
*codep = *codep == F_BBRANCH_WHEN_NON_ZERO
? F_LBRANCH_WHEN_NON_ZERO
: F_LBRANCH_WHEN_ZERO
;
ins_short(offset);
}
else
{
/* Just add the short offset */
mem_block[A_PROGRAM].block[CURRENT_PROGRAM_SIZE-1] = -offset;
}
if ($<expression>6.line != current_loc.line)
store_line_number_relocation($<expression>6.line);
/* Now that we have the end of the while(), we can finish
* up the breaks.
*/
for( ; current_break_address > 0
; current_break_address = next_addr)
{
next_addr = read_int32(current_break_address);
upd_int32(current_break_address,
CURRENT_PROGRAM_SIZE - current_break_address);
}
/* Restore the previous environment */
current_continue_address = $<numbers>1[0];
current_break_address = $<numbers>1[1];
}
; /* while */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The do-while() statement
*
* It is compiled into:
*
* l: <body>
* <cond>
* BBRANCH_WHEN_NON_ZERO l
*/
do:
{
/* Save the previous environment */
$<numbers>$[0] = current_continue_address;
$<numbers>$[1] = current_break_address;
current_break_address = BREAK_DELIMITER;
current_continue_address = CONTINUE_DELIMITER;
push_address(); /* Address to branch back to */
}
L_DO statement L_WHILE
{
/* The body is complete - we can already patch up
* the continue statements.
*/
p_int next_addr;
p_int current;
%line
current = CURRENT_PROGRAM_SIZE;
for(; current_continue_address > 0
; current_continue_address = next_addr)
{
next_addr = read_int32(current_continue_address);
upd_int32(current_continue_address,
current - current_continue_address);
}
}
'(' comma_expr ')' ';'
{
%line
/* The loop is complete - we just need the final branch
* instruction and to patch up the breaks.
*/
p_int offset;
p_int next_addr;
p_int addr = pop_address();
mp_uint current;
bytecode_p dest;
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(3))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n", current+3);
YYACCEPT;
}
/* Add the branch statement */
dest = PROGRAM_BLOCK + current;
if (current == last_expression + 1 && dest[-1] == F_NOT)
{
/* Optimize 'NOT BBRANCH_WHEN_NON_ZERO' to 'BBRANCH_WHEN_ZERO'
*/
offset = addr - current;
if (offset < -0xff)
{
if (offset < -0x8000)
yyerror("offset overflow");
PUT_CODE(dest-1, F_LBRANCH_WHEN_ZERO);
PUT_SHORT(dest, offset);
current += 2;
}
else
{
PUT_CODE(dest-1, F_BBRANCH_WHEN_ZERO);
PUT_UINT8(dest, -offset);
current++;
}
}
else
{
offset = addr - ( current + 1 );
if (offset < -0xff) {
if (offset < -0x8000)
yyerror("offset overflow");
STORE_CODE(dest, F_LBRANCH_WHEN_NON_ZERO);
STORE_SHORT(dest, offset);
current += 3;
} else {
STORE_CODE(dest, F_BBRANCH_WHEN_NON_ZERO);
STORE_UINT8(dest, -offset);
current += 2;
}
}
CURRENT_PROGRAM_SIZE = current;
/* Now that we have the end of the do-while(), we can finish
* up the breaks.
*/
for (; current_break_address > 0
; current_break_address = next_addr)
{
next_addr = read_int32(current_break_address);
upd_int32(current_break_address,
current - current_break_address);
}
/* Restore the previous environment */
current_continue_address = $<numbers>1[0];
current_break_address = $<numbers>1[1];
}
; /* do */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The for() statement.
*
* It is compiled as:
*
* CLEAR_LOCALS
* <init>
* POP
* BRANCH c
* l: <body>
* <incr>
* POP
* c: <cond>
* BBRANCH_WHEN_NON_ZERO l
*/
for:
L_FOR '('
{
%line
/* Save the previous environment */
$<numbers>$[0] = current_continue_address;
$<numbers>$[1] = current_break_address;
/* Open a new scope to all variables local to the
* for-statement as a whole.
*/
enter_block_scope();
}
for_init_expr ';'
{
%line
/* Get rid of whatever init_expr computed */
insert_pop_value();
/* From here, the <body> will be placed eventually */
current_continue_address = CONTINUE_DELIMITER;
$<number>$ = CURRENT_PROGRAM_SIZE;
}
for_expr ';'
{
%line
/* Add the BBRANCH to the condition and save it all
* in an 'expression' on the compiler stack for later
* re-insertion.
*/
p_int start, length;
bytecode_p expression;
start = $<number>6;
length = CURRENT_PROGRAM_SIZE - start;
expression = yalloc(length+2);
memcpy(expression, mem_block[A_PROGRAM].block + start, length );
/* Add the branch instruction */
if (last_expression == CURRENT_PROGRAM_SIZE - 1
&& expression[length-1] == F_NOT
)
{
/* Optimize 'NOT BBRANCH_WHEN_NON_ZERO'
* to 'BBRANCH_WHEN_ZERO'
*/
length--;
expression[length] = F_BBRANCH_WHEN_ZERO;
}
else
{
expression[length] = F_BBRANCH_WHEN_NON_ZERO;
}
/* Save the codeblock on the stack */
$<expression>$.p = expression;
$<expression>$.length = length;
$<expression>$.line = current_loc.line;
/* Restart codegeneration from here */
CURRENT_PROGRAM_SIZE = start;
last_expression = -1;
}
for_expr ')'
{
%line
/* Save the <incr> code block on the compiler stack
* for later re-insertion and start the compilation
* of the loop body.
*/
p_int length;
/* Save the code block */
insert_pop_value();
length = CURRENT_PROGRAM_SIZE - $<number>6;
$<expression>$.p = yalloc(length);
if (length)
memcpy( $<expression>$.p
, mem_block[A_PROGRAM].block + $<number>6
, length );
$<expression>$.length = length;
$<expression>$.line = current_loc.line;
/* Restart the codegeneration for the body */
CURRENT_PROGRAM_SIZE = $<number>6;
last_expression = -1;
current_break_address = BREAK_DELIMITER;
ins_f_code(F_BRANCH); /* over the body to the condition */
ins_byte(0);
/* Fix the number of locals to clear, now that we know it
*/
{
block_scope_t *scope = block_scope + block_depth - 1;
if (use_local_scopes && scope->num_locals > scope->num_cleared)
{
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - scope->num_cleared);
}
}
}
statement
{
%line
/* The loop is complete, now add the <incr> and <cond>
* code saved on the compiler stack and patch up
* the break and continues.
*/
p_int offset;
p_int next_addr;
/* Patch up the continues */
for (; current_continue_address > 0
; current_continue_address = next_addr)
{
next_addr = read_int32(current_continue_address);
upd_int32(current_continue_address,
CURRENT_PROGRAM_SIZE - current_continue_address);
}
if ( $<expression>9.line != current_loc.line
|| ( $<expression>12.line != current_loc.line
&& $<expression>12.length)
)
store_line_number_info();
/* Add the <incr> code block if needed */
if ($<expression>12.length)
{
add_to_mem_block(A_PROGRAM, $<expression>12.p
, $<expression>12.length);
if ($<expression>12.line != $<expression>9.line)
store_line_number_relocation($<expression>12.line);
}
yfree($<expression>12.p);
/* Fix the branch over the body */
offset =
fix_branch( F_LBRANCH, CURRENT_PROGRAM_SIZE, $<number>6 + 1);
/* Add the <cond> code block */
add_to_mem_block(A_PROGRAM, $<expression>9.p, $<expression>9.length+2);
yfree($<expression>9.p);
/* Create the branch back after the condition */
offset += $<number>6 + 2 - ( CURRENT_PROGRAM_SIZE - 1 );
if (offset < -0xff)
{
bytecode_p codep;
if (offset < -0x8000)
yyerror("offset overflow");
codep = PROGRAM_BLOCK + --CURRENT_PROGRAM_SIZE - 1;
*codep = *codep == F_BBRANCH_WHEN_NON_ZERO
? F_LBRANCH_WHEN_NON_ZERO
: F_LBRANCH_WHEN_ZERO
;
ins_short(offset);
}
else
{
mem_block[A_PROGRAM].block[CURRENT_PROGRAM_SIZE-1] = -offset;
}
if ($<expression>9.line != current_loc.line)
store_line_number_relocation($<expression>9.line);
/* Now complete the break instructions.
*/
for (; current_break_address > 0
; current_break_address = next_addr)
{
next_addr = read_int32(current_break_address);
upd_int32(current_break_address,
CURRENT_PROGRAM_SIZE - current_break_address);
}
/* Restore the previous environment */
current_continue_address = $<numbers>3[0];
current_break_address = $<numbers>3[1];
/* and leave the for scope */
leave_block_scope(MY_FALSE);
}
; /* for */
/* Special rules for 'int <name> = <expr>' declarations in the first
* for() expression.
*/
for_init_expr:
/* EMPTY */
{
last_expression = mem_block[A_PROGRAM].current_size;
ins_number(1);
/* insert_pop_value() will optimize this away */
}
| comma_expr_decl
; /* for_init_expr */
comma_expr_decl:
expr_decl
| comma_expr_decl
{
insert_pop_value();
}
',' expr_decl
; /* comma_expr_decl */
expr_decl:
expr0 /* compile the expression as usual */
| local_name_lvalue L_ASSIGN expr0
{
/* We got a "int <name> = <expr>" type expression. */
%line
fulltype_t type2;
/* Check the assignment for validity */
type2 = $3.type;
if (exact_types.typeflags
&& !compatible_types($1.type, type2, MY_TRUE))
{
yyerrorf("Bad assignment %s", get_two_types($1.type, type2));
}
if ($2 != F_ASSIGN)
{
yyerror("Only plain assignments allowed here");
}
if (type2.typeflags & TYPE_MOD_REFERENCE)
yyerror("Can't trace reference assignments");
/* Add the bytecode to create the lvalue and do the
* assignment.
*/
if (!add_lvalue_code(&$1, $2))
YYACCEPT;
}
| local_name_lvalue
{
/* We got a "int <name>" type expression.
* Compile it as if it was a "int <name> = 0" expression.
*/
%line
/* Insert the implied push of number 0 */
ins_number(0);
/* Add the bytecode to create the lvalue and do the
* assignment.
*/
if (!add_lvalue_code(&$1, F_ASSIGN))
YYACCEPT;
}
; /* expr_decl */
for_expr:
/* EMPTY */
{
last_expression = mem_block[A_PROGRAM].current_size;
ins_number(1);
}
| comma_expr
; /* for_expr */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The foreach() statement
*
* It is compiled into: or when <statement> is empty:
*
* CLEAR_LOCALS CLEAR_LOCALS
* PUSH_(LOCAL_)LVALUE <var1> <expr>
* ... POP_VALUE
* PUSH_(LOCAL_)LVALUE <varn> [POP_VALUE for integer ranges]
* <expr>
* FOREACH(_REF) <numargs> c
* l: <body>
* c: FOREACH_NEXT l
* e: FOREACH_END
*
* continue's branch to c, break's to e.
*/
foreach:
L_FOREACH '('
{
/* Save the previous environment */
$<numbers>$[0] = current_continue_address;
$<numbers>$[1] = current_break_address;
current_break_address = BREAK_DELIMITER;
current_continue_address = CONTINUE_DELIMITER;
/* Open a new scope to all variables local to the
* foreach-statement as a whole.
*/
enter_block_scope();
}
foreach_vars foreach_in
{
%line
/* Remember the starting address of the expression */
$<address>$ = CURRENT_PROGRAM_SIZE;
}
foreach_expr ')'
{
%line
/* Fix the number of locals to clear, now that we know it
*/
{
block_scope_t *scope = block_scope + block_depth - 1;
if (use_local_scopes && scope->num_locals > scope->num_cleared)
{
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - scope->num_cleared);
}
}
/* Create the FOREACH instruction, leaving the branch field
* blank.
*/
switch ($7)
{
case FOREACH_LOOP:
ins_f_code(F_FOREACH); break;
case FOREACH_REF:
ins_f_code(F_FOREACH_REF); break;
case FOREACH_RANGE:
ins_f_code(F_FOREACH_RANGE); break;
default:
yyerrorf("Unknown foreach_expr type %ld.\n", (long)$7);
fatal("Unknown foreach_expr type %ld.\n", (long)$7);
/* NOTREACHED */
}
ins_byte($4+1);
ins_short(0);
push_address(); /* Address to branch back to */
}
statement
{
/* The body is complete - patch up the continue and
* break statements and generate the remaining statements.
*/
p_int next_addr;
p_int addr;
mp_uint current;
%line
current = CURRENT_PROGRAM_SIZE;
addr = pop_address(); /* Where the body began */
/* One obvious optimisation: when there is no code in
* the body, we can save space and even more time by
* just compiling the expression.
* Too bad that we can't find out whether the expression
* has side effects or not, otherwise we could try to
* remove it, too.
*/
if (addr == (p_int)current)
{
p_int expr_addr; /* Address of the expr0 */
p_int start_addr; /* Address of the first PUSH_LOCAL_LVALUE */
bytecode_p src, dest;
expr_addr = $<address>6;
start_addr = expr_addr - $4*2;
current = start_addr + (addr - 4 - expr_addr);
for ( src = PROGRAM_BLOCK + expr_addr,
dest = PROGRAM_BLOCK + start_addr
; expr_addr < addr-4
; src++, dest++, expr_addr++)
*dest = *src;
CURRENT_PROGRAM_SIZE = current;
ins_f_code(F_POP_VALUE);
current++;
if ($7 == FOREACH_RANGE)
{
ins_f_code(F_POP_VALUE);
current++;
}
}
else /* Create the full statement */
{
/* First patch up the continue statements */
for(; current_continue_address > 0
; current_continue_address = next_addr)
{
next_addr = read_int32(current_continue_address);
upd_int32(current_continue_address,
current - current_continue_address);
}
/* Create the FOREACH_NEXT instruction and update
* the branch of the earlier F_FOREACH.
*/
upd_short(addr - 2, current - addr);
ins_f_code(F_FOREACH_NEXT);
ins_short(current + 3 - addr);
current += 3;
/* Finish up the breaks.
*/
for (; current_break_address > 0
; current_break_address = next_addr)
{
next_addr = read_int32(current_break_address);
upd_int32(current_break_address,
current - current_break_address);
}
/* Finish with the FOREACH_END.
*/
ins_f_code(F_FOREACH_END);
}
/* Restore the previous environment */
current_continue_address = $<numbers>3[0];
current_break_address = $<numbers>3[1];
/* and leave the scope */
leave_block_scope(MY_FALSE);
}
; /* foreach */
foreach_vars : /* Parse and count the number of lvalues */
foreach_var_decl { $$ = 1; }
| foreach_vars ',' foreach_var_decl { $$ = $1 + 1; }
; /* foreach_vars */
foreach_var_decl: /* Generate the code for one lvalue */
/* TODO: It is tempting to add an alternative "| lvalue",
* TODO:: but then we get masses of reduce/reduce conflicts
* TODO:: between lvalue and expr4. Dunno why.
*/
foreach_var_lvalue
{
/* Add the bytecode to create the lvalue, and good is.
*/
%line
if (!add_lvalue_code(&$1, 0))
YYACCEPT;
}
; /* foreach_var_decl */
foreach_var_lvalue: /* Gather the code for one lvalue */
local_name_lvalue
| name_lvalue
; /* foreach_var_lvalue */
foreach_in:
/* The purpose of this rule is to avoid making "in" a reserved
* word. Instead we require an identifier/local with the
* name "in" as alternative to ":". Main reason to allow "in"
* is MudOS compatibility.
* TODO: Make MudOS-compats switchable.
*/
identifier
{
if (!mstreq($1, STR_IN))
yyerror("Expected keyword 'in' in foreach()");
free_mstring($1);
}
| ':'
; /* foreach_in */
foreach_expr:
expr0
{
fulltype_t dtype;
Bool gen_refs;
%line
gen_refs = ($1.type.typeflags & TYPE_MOD_MASK & (~TYPE_MOD_RMASK)) != 0;
set_fulltype(dtype, $1.type.typeflags & TYPE_MOD_RMASK, $1.type.t_struct);
if (!(dtype.typeflags & TYPE_MOD_POINTER)
&& dtype.typeflags != TYPE_ANY
&& dtype.typeflags != TYPE_STRING
&& dtype.typeflags != TYPE_MAPPING
&& (dtype.typeflags != TYPE_NUMBER || gen_refs)
&& (exact_types.typeflags || dtype.typeflags != TYPE_UNKNOWN)
)
{
type_error("Expression for foreach() of wrong type", $1.type);
}
$$ = gen_refs ? FOREACH_REF : FOREACH_LOOP;
}
| expr0 L_RANGE expr0
{
fulltype_t dtype;
%line
if (($1.type.typeflags & (~TYPE_MOD_RMASK)) != 0)
{
type_error("Expression for foreach() of wrong type", $1.type);
}
set_fulltype(dtype, $1.type.typeflags & TYPE_MOD_RMASK, $1.type.t_struct);
if (dtype.typeflags != TYPE_ANY
&& dtype.typeflags != TYPE_NUMBER
&& (exact_types.typeflags || dtype.typeflags != TYPE_UNKNOWN)
)
{
type_error("Expression for foreach() of wrong type", $1.type);
}
if (($3.type.typeflags & (~TYPE_MOD_RMASK)) != 0)
{
type_error("Expression for foreach() of wrong type", $3.type);
}
set_fulltype(dtype, $3.type.typeflags & TYPE_MOD_RMASK, $3.type.t_struct);
if (dtype.typeflags != TYPE_ANY
&& dtype.typeflags != TYPE_NUMBER
&& (exact_types.typeflags || dtype.typeflags != TYPE_UNKNOWN)
)
{
type_error("Expression for foreach() of wrong type", $3.type);
}
$$ = FOREACH_RANGE;
}
; /* foreach_expr */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The switch statement.
*
* switch.h explains how the bytecode looks like.
*
* Note that the actual switch rule is:
*
* switch: L_SWITCH ( comma_expr ) '{' switch_block '}'
*
* and that case and default are explicitly parsed in the
* switch_block rule. Each group of statements after a
* label have their own scope, so that variable declarations
* within the switch block may not cross case labels.
*
* That also means that in contrast to C the code
*
* switch(x);
* or switch(x) write("Foo");
* or switch(x) {{ case "foo": break; }}
*
* is syntactically not ok.
*/
switch:
L_SWITCH '(' comma_expr ')'
{
/* We start a new switch(), which might be nested into
* an outer switch().
*/
case_state_t *statep;
%line
current_break_stack_need++;
if ( current_break_stack_need > max_break_stack_need )
max_break_stack_need = current_break_stack_need;
/* Save the previous switch state */
if ( !(statep = yalloc(sizeof(case_state_t))) )
{
yyerrorf("Out of memory: case state (%zu bytes)"
, sizeof(case_state_t));
YYACCEPT;
}
*statep = case_state;
case_state.previous = statep;
push_explicit(current_break_address);
push_explicit(switch_pc);
/* Create the SWITCH instruction plus two empty bytes */
ins_f_code(F_SWITCH);
switch_pc = mem_block[A_PROGRAM].current_size;
ins_short(0);
/* Set up the new switch generation */
case_state.list0 = case_state.list1 = NULL;
case_state.zero = NULL;
case_state.no_string_labels = MY_TRUE;
case_state.some_numeric_labels = MY_FALSE;
case_state.default_addr = 0;
current_break_address =
BREAK_ON_STACK | BREAK_FROM_SWITCH | CASE_LABELS_ENABLED ;
if (current_continue_address)
current_continue_address += SWITCH_DEPTH_UNIT;
}
'{'
switch_block
'}'
{
%line
/* The statement (which hopefully contained cases) is complete.
* Now create the lookup tables and restore the previous state.
*/
case_state_t *statep;
current_break_address &=
~(BREAK_ON_STACK|BREAK_FROM_SWITCH|CASE_LABELS_ENABLED);
if (!case_state.default_addr)
{
/* no default given -> create one */
case_state.default_addr = CURRENT_PROGRAM_SIZE-switch_pc;
}
/* it isn't unusual that the last case/default has no break */
ins_f_code(F_BREAK);
/* Create the lookup tables */
store_case_labels(
CURRENT_PROGRAM_SIZE-switch_pc,
case_state.default_addr,
case_state.no_string_labels || case_state.some_numeric_labels,
case_state.zero,
yyget_space, yymove_switch_instructions, yyerror, yycerrorl
);
/* Restore the previous state */
switch_pc = pop_address();
current_break_address = pop_address();
statep = case_state.previous;
case_state = *statep;
yfree(statep);
if (current_continue_address)
current_continue_address -= SWITCH_DEPTH_UNIT;
current_break_stack_need--;
}
; /* switch */
switch_block:
switch_block switch_statements
| switch_statements
; /* switch_block */
switch_statements: switch_label statements_block ;
switch_label: case | default ;
case: L_CASE case_label ':'
{
%line
/* Mark the current program address as another
* case target for the current switch.
*/
case_list_entry_t *temp;
/* Should be within a switch statement. */
assert(current_break_address & CASE_LABELS_ENABLED);
/* Get and fill in a new case entry structure */
if ( !(temp = new_case_entry()) )
{
yyerror("Out of memory: new case entry");
break;
}
if ( !(temp->key = $2.key) )
{
case_state.zero = temp;
}
temp->addr = mem_block[A_PROGRAM].current_size - switch_pc;
temp->line = current_loc.line;
}
| L_CASE case_label L_RANGE case_label ':'
{
%line
/* Mark the current program address as another
* range-case target for the current switch.
*/
case_list_entry_t *temp;
if ( !$2.numeric || !$4.numeric )
yyerror("String case labels not allowed as range bounds");
/* Should be within a switch statement. */
assert(current_break_address & CASE_LABELS_ENABLED);
/* A range like "case 4..2" is illegal,
* a range like "case 4..4" counts as simple "case 4".
*/
if ($2.key >= $4.key)
{
if ($2.key > $4.key)
{
yyerrorf("Illegal case range: lower limit %ld > upper limit %ld"
, (long)$2.key, (long)$4.key);
break;
}
if ( !(temp = new_case_entry()) )
{
yyerror("Out of memory: new case entry");
break;
}
temp->key = $2.key;
temp->addr = CURRENT_PROGRAM_SIZE - switch_pc;
temp->line = current_loc.line;
}
/* Get and fill in the two case entries */
if ( !(temp = new_case_entry()) )
{
yyerror("Out of memory: new case entry");
break;
}
temp->key = $2.key;
temp->addr = 1; /* marks the lower bound of the range */
temp->line = current_loc.line;
if ( !(temp = new_case_entry()) ) {
yyerror("Out of memory: new case entry");
break;
}
temp->key = $4.key;
temp->addr = CURRENT_PROGRAM_SIZE - switch_pc;
temp->line = 0; /* marks the upper bound of the range */
}
; /* case */
case_label:
constant
{
%line
if ( 0 != ($$.key = $1) ) {
if ( !(case_state.no_string_labels) )
yyerror("Mixed case label list not allowed");
case_state.some_numeric_labels = 1;
}
$$.numeric = MY_TRUE;
}
| string_constant
{
%line
if ( case_state.some_numeric_labels )
yyerror("Mixed case label list not allowed");
case_state.no_string_labels = MY_FALSE;
store_prog_string(last_string_constant);
$$.key = (p_int)last_string_constant;
$$.numeric = MY_FALSE;
last_string_constant = NULL;
}
; /* case_label */
default:
L_DEFAULT ':'
{
%line
/* Mark the current program address as the default target
* for the current switch.
*/
/* Should be within a switch statement. */
assert(current_break_address & CASE_LABELS_ENABLED);
if (case_state.default_addr)
yyerror("Duplicate default");
case_state.default_addr = CURRENT_PROGRAM_SIZE - switch_pc;
}
; /* default */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The if()-statement.
*
* This is compiled as: resp. as:
*
* <cond> <cond>
* BRANCH_WHEN_ZERO e BRANCH_WHEN_ZERO e
* <if-part> <if-part>
* e: BRANCH f
* e: <else-part>
* f:
*
*/
condStart:
L_IF '(' comma_expr ')'
{
/* When we enter a condition, we must not allow case labels
* anymore.
*/
mp_uint current;
bytecode_p current_code;
/* Turn off the case labels */
$$[0] = current_break_address;
current_break_address &= ~CASE_LABELS_ENABLED;
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n", current+3);
YYACCEPT;
}
current_code = PROGRAM_BLOCK + current;
/* Add the branch instruction, with the usual optimization */
if (last_expression == current - 1
&& current_code[-1] == F_NOT)
{
current_code[-1] = F_BRANCH_WHEN_NON_ZERO;
}
else
{
*current_code = F_BRANCH_WHEN_ZERO;
current++;
}
$$[1] = current;
CURRENT_PROGRAM_SIZE = current + 1;
}
; /* condStart */
cond:
condStart
statement
optional_else
{
p_int destination, location, offset;
/* Complete the branch over the if-part */
destination = (p_int)$3;
location = $1[1];
if ( (offset = destination - location) > 0x100)
{
fix_branch(
mem_block[A_PROGRAM].block[location-1] ==
F_BRANCH_WHEN_ZERO ?
F_LBRANCH_WHEN_ZERO :
F_LBRANCH_WHEN_NON_ZERO
,
destination, location
);
}
else
{
mem_block[A_PROGRAM].block[location] = offset - 1;
}
/* Restore the previous case-labels status without
* changing the actual break-address.
*/
current_break_address |= $1[0] & CASE_LABELS_ENABLED;
}
; /* cond */
optional_else:
/* empty */ %prec LOWER_THAN_ELSE
{
/* The if-part ends here */
$$ = CURRENT_PROGRAM_SIZE;
}
| L_ELSE
{
/* Add the branch over the else part */
ins_f_code(F_BRANCH);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
statement
{
/* Fix up the branch over the else part and return
* the start address of the else part.
*/
$$ = fix_branch( F_LBRANCH, CURRENT_PROGRAM_SIZE, $<address>2);
$$ += $<address>2 + 1;
}
; /* optional_else */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Constants
*
* The rules here implement constant folding for numeric and string constants.
*/
constant:
constant '|' constant { $$ = $1 | $3; }
| constant '^' constant { $$ = $1 ^ $3; }
| constant '&' constant { $$ = $1 & $3; }
| constant L_EQ constant { $$ = $1 == $3; }
| constant L_NE constant { $$ = $1 != $3; }
| constant '>' constant { $$ = $1 > $3; }
| constant L_GE constant { $$ = $1 >= $3; }
| constant '<' constant { $$ = $1 < $3; }
| constant L_LE constant { $$ = $1 <= $3; }
| constant L_LSH constant { $$ = (p_uint)$3 > MAX_SHIFT ? 0 : $1 << $3; }
| constant L_RSH constant { $$ = (p_uint)$3 > MAX_SHIFT ? ($1 >= 0 ? 0 : -1) : ($1 >> $3); }
| constant L_RSHL constant { $$ = (p_uint)$3 > MAX_SHIFT ? 0 : ((p_uint)$1 >> $3); }
| constant '+' constant { $$ = $1 + $3; }
| constant '-' constant { $$ = $1 - $3; }
| constant '*' constant { $$ = $1 * $3; }
| constant '%' constant
{
if ($3)
{
$$ = $1 % $3;
}
else
{
yyerror("modulus by zero");
$$ = 0;
}
}
| constant '/' constant
{
if ($3) {
$$ = $1 / $3;
} else {
yyerror("division by zero");
$$ = 0;
}
}
| '(' constant ')' { $$ = $2; }
| '-' constant %prec '~' { $$ = -$2; }
| L_NOT constant { $$ = !$2; }
| '~' constant { $$ = ~$2; }
| L_NUMBER
; /* constant */
string_constant:
L_STRING
{
last_string_constant = last_lex_string;
last_lex_string = NULL;
}
| string_constant '+' L_STRING
{
add_string_constant();
}
| L_STRING L_STRING
{ fatal("L_STRING LSTRING: presence of rule should prevent its reduction\n"); }
| string_constant '+' L_STRING L_STRING
{ fatal("L_STRING LSTRING: presence of rule should prevent its reduction\n"); }
| '(' string_constant ')'
; /* string_constant */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Expressions
*
* expr0 (with the help of the precedence and assoc specifications) handles
* most of the expressions, and returns normal rvalues (as lrvalues).
*
* expr4 contains the expressions atoms (literal values), function calls
* and expressions returning values which might be used as rvalues
* as well as lvalues. It returns full lrvalues.
*
* lvalue contains expressions for unprotected lvalues and returns lvalues.
*
* name_lvalue is a subrule of lvalue and can be used where lvalues of
* variables are needed (foreach() is one example).
*
* local_name_lvalue is to be used in contexts where new local variables
* may be defined on the fly (for example "for(int i...").
*
* index_expr and index_range are used to parse and compile the two
* forms of array indexing operations.
*/
comma_expr:
expr0
| comma_expr
{
insert_pop_value();
}
',' expr0
{
$$.type = $4.type;
}
; /* comma_expr */
expr0:
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Normal assign: ||= (&&= analog):
*
* <expr0> <lvalue> <lvalue>
* <lvalue> LDUP LDUP
* ASSIGN-operator LOR l DUP
* <expr0> LBRANCH_WHEN_NON_ZERO l
* l: SWAP_VALUES POP_VALUE
* ASSIGN <expr0>
* l: SWAP_VALUES
* ASSIGN
*/
lvalue L_ASSIGN
{
if ($2 == F_LAND_EQ || $2 == F_LOR_EQ)
{
if (!add_lvalue_code(&$1, 0))
YYACCEPT;
/* Add the operator specific code */
if ($2 == F_LAND_EQ)
{
/* Insert the LDUP, LAND and remember the position */
ins_f_code(F_LDUP);
ins_f_code(F_LAND);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
else if ($2 == F_LOR_EQ)
{
/* Insert the LDUP, LOR and remember the position */
ins_f_code(F_LDUP);
ins_f_code(F_LOR);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
}
}
expr0 %prec L_ASSIGN
{
fulltype_t type1, type2, restype;
%line
$$ = $4;
type1 = $1.type;
type2 = $4.type;
restype = type2; /* Assume normal assignment */
/* Check the validity of the assignment */
if (exact_types.typeflags
&& !compatible_types(type1, type2, MY_TRUE)
)
{
Bool ok = MY_FALSE;
switch($2)
{
case F_LAND_EQ:
case F_LOR_EQ:
ok = MY_TRUE;
break;
case F_ADD_EQ:
switch(type1.typeflags)
{
case TYPE_STRING:
if (type2.typeflags == TYPE_NUMBER
|| type2.typeflags == TYPE_FLOAT)
{
ok = MY_TRUE;
}
break;
case TYPE_FLOAT:
if (type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
break;
}
break;
case F_SUB_EQ:
switch(type1.typeflags)
{
case TYPE_FLOAT:
if (type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
break;
}
break;
case F_MULT_EQ:
switch(type1.typeflags)
{
case TYPE_STRING:
if (type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
break;
case TYPE_FLOAT:
if (type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
break;
default:
if ((type1.typeflags & TYPE_MOD_POINTER) && type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
}
break;
case F_DIV_EQ:
switch(type1.typeflags)
{
case TYPE_FLOAT:
if (type2.typeflags == TYPE_NUMBER)
{
ok = MY_TRUE;
}
break;
}
break;
case F_AND_EQ:
switch(type1.typeflags)
{
case TYPE_MAPPING:
if (type2.typeflags & TYPE_MOD_POINTER)
{
ok = MY_TRUE;
}
break;
default:
if ((type1.typeflags & TYPE_MOD_POINTER)
&& type2.typeflags == TYPE_MAPPING
)
{
ok = MY_TRUE;
}
break;
}
break;
} /* switch(assign op) */
if (!ok)
{
yyerrorf("Bad assignment %s", get_two_types(type1, type2));
}
/* Operator assignment: result type is determined by assigned-to
* type.
*/
restype = type1;
}
if (type2.typeflags & TYPE_MOD_REFERENCE)
yyerror("Can't trace reference assignments.");
#ifdef USE_STRUCTS
/* Special checks for struct assignments */
if (IS_TYPE_STRUCT(type1) || IS_TYPE_STRUCT(type2)
)
{
restype = type1;
if ($2 != F_ASSIGN)
yyerror("Only plain assigment allowed for structs");
}
#endif /* USE_STRUCTS */
if ($2 == F_LAND_EQ || $2 == F_LOR_EQ)
{
/* Update the offset the earlier LAND/LOR instruction */
if ($2 == F_LAND_EQ)
{
update_lop_branch($<address>3, F_LBRANCH_WHEN_ZERO);
}
else if ($2 == F_LOR_EQ)
{
update_lop_branch($<address>3, F_LBRANCH_WHEN_NON_ZERO);
}
/* Insert the SWAP and the ASSIGN */
ins_f_code(F_SWAP_VALUES);
ins_f_code(F_ASSIGN);
}
else
{
if (!add_lvalue_code(&$1, $2))
YYACCEPT;
}
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = restype;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| error L_ASSIGN expr0 %prec L_ASSIGN
{
yyerror("Bad assignment: illegal lhs (target)");
$$ = $3;
$$.type = Type_Any;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '?'
{
/* Insert the branch to the :-part and remember this address */
ins_f_code(F_BRANCH_WHEN_ZERO);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
expr0
{
/* Insert the branch over the :-part, and update
* the earlier branch to the :-part.
*/
p_int address, offset;
address = (p_int)$<address>3;
/* The branch to the end */
ins_f_code(F_BRANCH);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
/* Update the earlier branch to point here */
offset = CURRENT_PROGRAM_SIZE - ( address + 1);
if (offset > 0xff - 1)
{
/* We have to make it a long branch and move the code
* generated so far.
*/
int i;
bytecode_p p;
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
p = PROGRAM_BLOCK + mem_block[A_PROGRAM].current_size-1;
for (i = offset; --i >= 0; --p )
*p = p[-1];
p[-2] = F_LBRANCH_WHEN_ZERO;
upd_short(address, offset+2);
if (offset > 0x7ffd)
yyerror("offset overflow");
}
else
{
mem_block[A_PROGRAM].block[address] = offset;
}
}
':' expr0 %prec '?'
{
/* Update the earlier branch skipping the :-part
* and check the types of the two parts.
*/
p_int address, old_address;
int offset;
fulltype_t type1, type2;
last_expression = -1;
old_address = $<address>3;
address = $<address>5;
offset = mem_block[A_PROGRAM].current_size - ( address + 1);
if (offset > 0xff)
{
/* We have to make the branch a long branch.
* This could also mean that the first branch now
* have to become a long branch, too.
*/
int i;
bytecode_p p;
ins_byte(0);
p = PROGRAM_BLOCK + mem_block[A_PROGRAM].current_size-1;
for( i = offset; --i >= 0; --p )
*p = p[-1];
p[-2] = F_LBRANCH;
upd_short(address, offset+2);
if (offset > 0x7ffd)
yyerror("offset overflow");
if ( mem_block[A_PROGRAM].block[old_address-1] ==
F_BRANCH_WHEN_ZERO )
mem_block[A_PROGRAM].block[old_address]++;
else
upd_short(old_address,read_short(old_address)+1);
}
else
{
mem_block[A_PROGRAM].block[address] = offset;
}
/* Check the types and determine the result type */
type1 = $4.type;
type2 = $7.type;
$$ = $1;
$$.end = CURRENT_PROGRAM_SIZE;
if (!compatible_types(type1, type2, MY_FALSE))
{
$$.type = Type_Any;
if ((type1.typeflags & TYPE_MOD_POINTER) != 0
&& (type2.typeflags & TYPE_MOD_POINTER) != 0)
$$.type.typeflags |= TYPE_MOD_POINTER;
/* TODO: yyinfof("Different types to ?: */
}
else if (type1.typeflags == TYPE_ANY)
$$.type = type2;
else if (type2.typeflags == TYPE_ANY)
$$.type = type1;
else if (type1.typeflags == (TYPE_MOD_POINTER|TYPE_ANY) )
$$.type = type2;
else if (type2.typeflags == (TYPE_MOD_POINTER|TYPE_ANY) )
$$.type = type1;
else
$$.type = type1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_LOR %prec L_LOR
{
/* Insert the LOR and remember the position */
ins_f_code(F_LOR);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
expr0
{
/* Update the offset the earlier LOR instruction */
update_lop_branch($<address>3, F_LBRANCH_WHEN_NON_ZERO);
$$ = $1;
$$.end = CURRENT_PROGRAM_SIZE;
/* Determine the result type */
if (equal_types($1.type, $4.type))
$$.type = $1.type;
else
$$.type = Type_Any; /* Return type can't be known */
} /* LOR */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_LAND %prec L_LAND
{
/* Insert the LAND and remember the position */
ins_f_code(F_LAND);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_byte(0);
}
expr0
{
/* Update the offset the earlier LAND instruction */
update_lop_branch($<address>3, F_LBRANCH_WHEN_ZERO);
$$ = $1;
$$.end = CURRENT_PROGRAM_SIZE;
/* Determine the return type */
if (equal_types($1.type, $4.type))
$$.type = $1.type;
else
$$.type = Type_Any; /* Return type can't be known */
} /* LAND */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '|' expr0
{
$$ = $1;
if (($1.type.typeflags | $3.type.typeflags) & TYPE_MOD_POINTER)
{
if (exact_types.typeflags
&& ($1.type.typeflags ^ $3.type.typeflags) & TYPE_MOD_POINTER
)
yyerrorf("Incompatible types for arguments to | %s"
, get_two_types($1.type, $3.type));
if (equal_types($1.type, $3.type))
$$.type = $1.type;
else
{
$$.type = Type_Ptr_Any;
}
}
else
{
if (exact_types.typeflags
&& !BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument 1 to |", $1.type);
if (exact_types.typeflags
&& !BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument 2 to |", $3.type);
$$.type = Type_Number;
}
ins_f_code(F_OR);
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '^' expr0
{
$$ = $1;
if (($1.type.typeflags | $3.type.typeflags) & TYPE_MOD_POINTER)
{
if (exact_types.typeflags
&& ($1.type.typeflags ^ $3.type.typeflags) & TYPE_MOD_POINTER
)
yyerrorf("Incompatible types for arguments to | %s"
, get_two_types($1.type, $3.type));
if (equal_types($1.type, $3.type))
$$.type = $1.type;
else
$$.type = Type_Ptr_Any;
}
else
{
if (exact_types.typeflags && !BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument 1 to ^", $1.type);
if (exact_types.typeflags && !BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument 2 to ^", $3.type);
$$.type = Type_Number;
}
ins_f_code(F_XOR);
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '&' expr0
{
$$ = $1;
ins_f_code(F_AND);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Any;
/* Check the types */
/* TODO: Implement the typechecks, including result type
* TODO:: by table lookups.
*/
if (exact_types.typeflags)
{
fulltype_t first_type = $1.type;
fulltype_t second_type = $3.type;
if ( first_type.typeflags == TYPE_ANY
&& second_type.typeflags == TYPE_ANY )
{
/* $$ == TYPE_ANY is correct */
}
else if (first_type.typeflags == TYPE_MAPPING)
{
if (second_type.typeflags != TYPE_MAPPING
&& !(second_type.typeflags & TYPE_MOD_POINTER)
&& second_type.typeflags != TYPE_ANY
)
{
type_error("Bad argument 2 to &", second_type );
}
$$.type = Type_Mapping;
}
else if ( (first_type.typeflags | second_type.typeflags) & TYPE_MOD_POINTER)
{
if ((first_type.typeflags & TYPE_MOD_POINTER)
&& second_type.typeflags == TYPE_MAPPING
)
{
$$.type = first_type;
}
else if (first_type.typeflags == TYPE_NUMBER
|| second_type.typeflags == TYPE_NUMBER)
{
yyerrorf("Incompatible types for arguments to & %s"
, get_two_types(first_type, second_type));
}
else if (( !( first_type.typeflags & TYPE_MOD_POINTER )
|| first_type.typeflags & TYPE_MOD_REFERENCE)
&& first_type.typeflags != TYPE_ANY)
{
type_error("Bad argument 1 to &", first_type );
}
else if (( !( second_type.typeflags & TYPE_MOD_POINTER )
|| second_type.typeflags & TYPE_MOD_REFERENCE)
&& second_type.typeflags != TYPE_ANY)
{
type_error("Bad argument 2 to &", first_type );
}
else {
fulltype_t f_type = first_type;
fulltype_t s_type = second_type;
f_type.typeflags &= ~TYPE_MOD_POINTER;
s_type.typeflags &= ~TYPE_MOD_POINTER;
if ( !BASIC_TYPE(f_type, s_type) )
{
yyerrorf("Incompatible types for arguments to & %s"
, get_two_types(first_type, second_type));
}
else
{
$$.type = Type_Ptr_Any;
}
}
}
else
{
if ( !BASIC_TYPE(first_type, Type_Number)
&& !BASIC_TYPE(first_type, Type_String) )
type_error("Bad argument 1 to &", first_type );
if ( !BASIC_TYPE(second_type, Type_Number)
&& !BASIC_TYPE(second_type, Type_String) )
type_error("Bad argument 2 to &", second_type);
if ( first_type.typeflags == TYPE_ANY )
$$.type = BASIC_TYPE(second_type, Type_Number)
? Type_Number : Type_String;
else
$$.type = BASIC_TYPE(first_type, Type_Number)
? Type_Number : Type_String;
}
} /* end of exact_types code */
} /* end of '&' code */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_EQ expr0
{
fulltype_t t1 = $1.type, t2 = $3.type;
$$ = $1;
if (exact_types.typeflags
&& !equal_types(t1, t2)
&& t1.typeflags != TYPE_ANY && t2.typeflags != TYPE_ANY
&& !(t1.typeflags == TYPE_NUMBER && t2.typeflags == TYPE_FLOAT)
&& !(t1.typeflags == TYPE_FLOAT && t2.typeflags == TYPE_NUMBER)
)
{
yyerrorf("== always false because of different types %s"
, get_two_types($1.type, $3.type));
}
ins_f_code(F_EQ);
$$.type = Type_Number;
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_NE expr0
{
fulltype_t t1 = $1.type, t2 = $3.type;
$$ = $1;
if (exact_types.typeflags
&& !equal_types(t1, t2)
&& t1.typeflags != TYPE_ANY && t2.typeflags != TYPE_ANY
&& !(t1.typeflags == TYPE_NUMBER && t2.typeflags == TYPE_FLOAT)
&& !(t1.typeflags == TYPE_FLOAT && t2.typeflags == TYPE_NUMBER)
)
{
yyerrorf("!= always true because of different types %s"
, get_two_types($1.type, $3.type));
}
ins_f_code(F_NE);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '>' expr0
{
$$ = $1;
$$.type = Type_Number;;
ins_f_code(F_GT);
$$.end = CURRENT_PROGRAM_SIZE;
}
| expr0 L_GE expr0
{
$$ = $1;
$$.type = Type_Number;
ins_f_code(F_GE);
$$.end = CURRENT_PROGRAM_SIZE;
}
| expr0 '<' expr0
{
$$ = $1;
$$.type = Type_Number;
ins_f_code(F_LT);
$$.end = CURRENT_PROGRAM_SIZE;
}
| expr0 L_LE expr0
{
$$ = $1;
$$.type = Type_Number;
ins_f_code(F_LE);
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_LSH expr0
{
$$ = $1;
ins_f_code(F_LSH);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
if (exact_types.typeflags)
{
if (!BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument 1 to '<<'", $1.type);
if (!BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument 2 to '<<'", $3.type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_RSH expr0
{
$$ = $1;
ins_f_code(F_RSH);
$$.type = Type_Number;
$$.end = CURRENT_PROGRAM_SIZE;
if (exact_types.typeflags)
{
if (!BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument 1 to '>>'", $1.type);
if (!BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument 2 to '>>'", $3.type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 L_RSHL expr0
{
$$ = $1;
ins_byte(F_RSHL);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
if (exact_types.typeflags)
{
if (!BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument 1 to '>>>'", $1.type);
if (!BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument 2 to '>>>'", $3.type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '+'
{
%line
$<numbers>$[0] = last_expression;
$<numbers>$[1] = last_string_is_new;
}
expr0
{
/* Type checks of this case are complicated, therefore
* we'll do almost all of them at run-time.
* Here we just try to fold "string" + "string", and
* disallow additions of structs.
*/
mp_uint current_size;
bytecode_p p;
%line
$$ = $1;
current_size = CURRENT_PROGRAM_SIZE;
p = &(PROGRAM_BLOCK[current_size]);
/* Check if we can combine strings: the pragma must agree
* and the last four bytes must be two CSTRINGx instructions.
*/
if (pragma_combine_strings
&& last_expression + 2 == current_size
&& $<numbers>3[0] + 4 == (mp_int)current_size
&& ((p[-2]-(F_CSTRING0)) & ~3) == 0
&& ((p[-4]-(F_CSTRING0)) & ~3) == 0
)
{
/* Yup, we can combine the two strings.
*/
string_t *str1, *str2, *sum;
int i;
/* Retrieve both strings from the A_STRINGS area
* and catenate them.
*/
str1 = ((string_t**)(mem_block[A_STRINGS].block))
[p[-3] | (p[-4]-(F_CSTRING0))<<8 ];
str2 = ((string_t**)(mem_block[A_STRINGS].block))
[p[-1] | (p[-2]-(F_CSTRING0))<<8 ];
sum = mstr_add(str1, str2);
if (!sum)
{
yyerrorf("Out of memory for string literal (%zu bytes)"
, (mstrsize(str1)+mstrsize(str2))
);
YYACCEPT;
}
/* If possible, try to delete the constituent strings
* from the string area.
*/
if (last_string_is_new)
delete_prog_string();
if ($<numbers>3[1])
delete_prog_string();
/* Store the new string and update the CSTRING
* instructions.
*/
sum = make_tabled(sum);
if (!sum)
{
yyerror("Out of memory for string literal");
YYACCEPT;
}
i = store_prog_string(sum);
last_expression = current_size - 4;
if (i < 0x400)
{
p[-4] = F_CSTRING0 + (i>>8);
p[-3] = i;
CURRENT_PROGRAM_SIZE = current_size - 2;
}
else
{
p[-4] = F_STRING;
upd_short(current_size - 3, i);
CURRENT_PROGRAM_SIZE = current_size - 1;
}
$$.type = Type_String;
}
else
{
/* Just add */
ins_f_code(F_ADD);
$$.type = Type_Any;
if (equal_types($1.type, $4.type))
$$.type = $1.type;
else if ($1.type.typeflags == TYPE_STRING)
$$.type = Type_String;
else if (($1.type.typeflags == TYPE_NUMBER || $1.type.typeflags == TYPE_FLOAT)
&& $4.type.typeflags == TYPE_STRING)
$$.type = Type_String;
else if ($1.type.typeflags == TYPE_FLOAT
&& ($4.type.typeflags == TYPE_NUMBER || $4.type.typeflags == TYPE_ANY))
$$.type = Type_Float;
else if (($1.type.typeflags == TYPE_NUMBER || $1.type.typeflags == TYPE_ANY)
&& $4.type.typeflags == TYPE_FLOAT)
$$.type = Type_Float;
#ifdef USE_STRUCTS
else if (IS_TYPE_STRUCT($1.type) || IS_TYPE_STRUCT($4.type))
yyerrorf("Bad arguments to '+': %s"
, get_two_types($1.type, $4.type)
);
#endif /* USE_STRUCTS */
}
$$.end = CURRENT_PROGRAM_SIZE;
} /* '+' */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '-' expr0
{
%line
$$ = $1;
$$.type = Type_Any;
if (exact_types.typeflags)
{
fulltype_t type1 = $1.type;
fulltype_t type2 = $3.type;
if (equal_types(type1, type2))
{
static char matchok[] =
%typemap TYPE_ANY:1,TYPE_NUMBER:1,TYPE_FLOAT:1,TYPE_MAPPING:1,TYPE_STRING:1
if ( type1.typeflags & (TYPE_MOD_POINTER|TYPE_MOD_REFERENCE)
? (type1.typeflags & (TYPE_MOD_POINTER|TYPE_MOD_REFERENCE))
== TYPE_MOD_POINTER
: matchok[type1.typeflags]
)
{
$$.type = type1;
}
else
{
type_error("Bad arguments to '-'", type1);
}
}
else if ( (type1.typeflags & (TYPE_MOD_POINTER|TYPE_MOD_REFERENCE))
== TYPE_MOD_POINTER)
{
if ((type2.typeflags | TYPE_MOD_POINTER) == (TYPE_MOD_POINTER|TYPE_ANY)
|| ( type2.typeflags & TYPE_MOD_POINTER
&& type1.typeflags == (TYPE_MOD_POINTER|TYPE_ANY))
)
{
$$.type = type1;
}
else
{
yyerror("Arguments to '-' don't match");
}
}
else switch (type1.typeflags)
{
case TYPE_ANY:
switch (type2.typeflags)
{
case TYPE_NUMBER:
/* number or float -> TYPE_ANY */
break;
case TYPE_MAPPING:
case TYPE_FLOAT:
case TYPE_STRING:
$$.type = type2;
break;
default:
if ( (type2.typeflags & (TYPE_MOD_POINTER|TYPE_MOD_REFERENCE)) ==
TYPE_MOD_POINTER)
{
$$.type = Type_Ptr_Any;
break;
}
else
{
type_error("Bad argument number 2 to '-'", type2);
break;
}
}
break;
case TYPE_NUMBER:
if (type2.typeflags == TYPE_FLOAT || type2.typeflags == TYPE_ANY)
{
$$.type = type2;
}
else
{
yyerror("Arguments to '-' don't match");
}
break;
case TYPE_FLOAT:
if (type2.typeflags == TYPE_NUMBER || type2.typeflags == TYPE_ANY)
{
$$.type = Type_Float;
}
else
{
yyerror("Arguments to '-' don't match");
}
break;
case TYPE_STRING:
if (type2.typeflags == TYPE_STRING || type2.typeflags == TYPE_ANY)
{
$$.type = Type_String;
}
else
{
yyerror("Arguments to '-' don't match");
}
break;
case TYPE_MAPPING:
if (type2.typeflags == TYPE_ANY)
{
$$.type = type1;
}
else
{
yyerror("Arguments to '-' don't match");
}
break;
default:
type_error("Bad argument number 1 to '-'", type1);
break;
}
} /* if (exact_types) */
ins_f_code(F_SUBTRACT);
$$.end = CURRENT_PROGRAM_SIZE;
} /* '-' */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '*' expr0
{
fulltype_t type1, type2;
$$ = $1;
type1 = $1.type;
type2 = $3.type;
if (exact_types.typeflags)
{
if (!BASIC_TYPE(type1, Type_Number)
&& type1.typeflags != TYPE_FLOAT
&& type1.typeflags != TYPE_STRING
&& !(type1.typeflags & TYPE_MOD_POINTER)
)
type_error("Bad argument number 1 to '*'", type1);
if (!BASIC_TYPE(type2, Type_Number)
&& type2.typeflags != TYPE_FLOAT
&& type2.typeflags != TYPE_STRING
&& !(type2.typeflags & TYPE_MOD_POINTER)
)
type_error("Bad argument number 2 to '*'", type2);
}
ins_f_code(F_MULTIPLY);
$$.end = CURRENT_PROGRAM_SIZE;
if (type1.typeflags == TYPE_FLOAT || type2.typeflags == TYPE_FLOAT )
{
$$.type = Type_Float;
}
else if (type1.typeflags == TYPE_STRING || type2.typeflags == TYPE_STRING)
{
$$.type = Type_String;;
}
else if (type1.typeflags & TYPE_MOD_POINTER)
{
$$.type = type1;
}
else if (type2.typeflags & TYPE_MOD_POINTER)
{
$$.type = type2;
}
else if (type1.typeflags == TYPE_ANY || type2.typeflags == TYPE_ANY)
{
$$.type = Type_Any;
}
else
{
$$.type = Type_Number;
}
} /* '*' */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '%' expr0
{
if (exact_types.typeflags)
{
if (!BASIC_TYPE($1.type, Type_Number))
type_error("Bad argument number 1 to '%'", $1.type);
if (!BASIC_TYPE($3.type, Type_Number))
type_error("Bad argument number 2 to '%'", $3.type);
}
$$ = $1;
ins_f_code(F_MOD);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr0 '/' expr0
{
fulltype_t type1, type2;
$$ = $1;
type1 = $1.type;
type2 = $3.type;
if (exact_types.typeflags)
{
if ( !BASIC_TYPE(type1, Type_Number) && type1.typeflags != TYPE_FLOAT)
type_error("Bad argument number 1 to '/'", type1);
if ( !BASIC_TYPE(type2, Type_Number) && type2.typeflags != TYPE_FLOAT)
type_error("Bad argument number 2 to '/'", type2);
}
ins_f_code(F_DIVIDE);
$$.end = CURRENT_PROGRAM_SIZE;
if (type1.typeflags == TYPE_FLOAT || type2.typeflags == TYPE_FLOAT )
{
$$.type = Type_Float;
}
else
{
$$.type = Type_Number;
}
} /* '/' */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| decl_cast expr0 %prec '~'
{
$$ = $2;
$$.type = $1;
if (exact_types.typeflags
&& $2.type.typeflags != TYPE_ANY
&& $2.type.typeflags != TYPE_UNKNOWN
&& $1.typeflags != TYPE_VOID
)
type_error("Casts are only legal for type mixed, or when unknown", $2.type);
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| cast expr0 %prec '~'
{
$$ = $2;
$$.type = $1;
if ($2.type.typeflags != TYPE_ANY
&& $2.type.typeflags != TYPE_UNKNOWN
&& $1.typeflags != TYPE_VOID
&& !equal_types($1, $2.type)
)
{
switch($1.typeflags)
{
default:
#ifdef USE_STRUCTS
if (IS_TYPE_STRUCT($1))
break; /* Do nothing, just adapt the type information */
#endif /* USE_STRUCTS */
type_error("Illegal cast", $1);
break;
case TYPE_ANY:
/* Do nothing, just adapt the type information */
break;
case TYPE_NUMBER:
ins_f_code(F_TO_INT);
break;
case TYPE_FLOAT:
ins_f_code(F_TO_FLOAT);
break;
case TYPE_STRING:
ins_f_code(F_TO_STRING);
break;
case TYPE_OBJECT:
ins_f_code(F_TO_OBJECT);
break;
case TYPE_NUMBER|TYPE_MOD_POINTER:
ins_f_code(F_TO_ARRAY);
break;
}
}
else if (pragma_warn_empty_casts)
{
if (equal_types($1, $2.type))
{ if ($2.type.typeflags != TYPE_ANY)
yywarnf("casting a value to its own type: %s"
, get_type_name($1));
}
else if ($2.type.typeflags != TYPE_UNKNOWN
&& $2.type.typeflags != TYPE_ANY)
yywarnf("cast will not convert the value: %s"
, get_two_types($1, $2.type)
);
}
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| pre_inc_dec L_IDENTIFIER %prec L_INC
{
/* ++/-- of a global variable.
* We have to distinguish virtual and non-virtual
* variables here.
*/
fulltype_t lvtype;
int i;
PREPARE_INSERT(4)
%line
$$.start = $1.start;
i = verify_declared($2);
if (i != -1)
{
if (i & VIRTUAL_VAR_TAG)
{
add_f_code(F_PUSH_VIRTUAL_VARIABLE_LVALUE);
add_byte(i);
lvtype = V_VARIABLE(i)->type;
lvtype.typeflags &= TYPE_MOD_MASK;
}
else
{
if ((i + num_virtual_variables) & ~0xff)
{
add_f_code(F_PUSH_IDENTIFIER16_LVALUE);
add_short(i + num_virtual_variables);
CURRENT_PROGRAM_SIZE += 1;
}
else
{
add_f_code(F_PUSH_IDENTIFIER_LVALUE);
add_byte(i + num_virtual_variables);
}
lvtype = NV_VARIABLE(i)->type;
lvtype.typeflags &= TYPE_MOD_MASK;
}
if (exact_types.typeflags
&& !BASIC_TYPE(lvtype, Type_Number)
&& !BASIC_TYPE(lvtype, Type_Float))
{
argument_type_error($1.code, lvtype);
}
CURRENT_PROGRAM_SIZE += 2;
}
else
{
/* Variable not declared - try to recover */
YYACCEPT;
lvtype = Type_Any;
}
last_expression = CURRENT_PROGRAM_SIZE;
CURRENT_PROGRAM_SIZE += 1;
add_f_code($1.code);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = lvtype;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| pre_inc_dec L_LOCAL %prec L_INC
{
fulltype_t lvtype;
PREPARE_INSERT(3)
%line
$$.start = $1.start;
#ifdef USE_NEW_INLINES
$2 = check_for_context_local($2, &lvtype);
if ($2->u.local.context >= 0)
{
add_f_code(F_PUSH_CONTEXT_LVALUE);
add_byte($2->u.local.context);
}
else
{
add_f_code(F_PUSH_LOCAL_VARIABLE_LVALUE);
add_byte($2->u.local.num);
}
CURRENT_PROGRAM_SIZE =
(last_expression = CURRENT_PROGRAM_SIZE + 2) + 1;
#else /* USE_NEW_INLINES */
add_f_code(F_PUSH_LOCAL_VARIABLE_LVALUE);
add_byte($2->u.local.num);
CURRENT_PROGRAM_SIZE =
(last_expression = CURRENT_PROGRAM_SIZE + 2) + 1;
lvtype = type_of_locals[$2->u.local.num];
#endif /* USE_NEW_INLINES */
add_f_code($1.code);
if (exact_types.typeflags
&& !BASIC_TYPE(lvtype, Type_Number)
&& !BASIC_TYPE(lvtype, Type_Float))
{
argument_type_error($1.code, lvtype);
}
$$.type = lvtype;
$$.end = CURRENT_PROGRAM_SIZE;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| pre_inc_dec expr4 index_expr %prec '['
{
mp_uint current;
bytecode_p p;
int start;
fulltype_t restype;
%line
$$.start = $1.start;
if ($3.type1.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
restype = Type_Any;
/* Check the types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $2.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags & TYPE_MOD_POINTER)
{
if (type.typeflags != (TYPE_MOD_POINTER|TYPE_ANY)
&& type.typeflags != (TYPE_MOD_POINTER|TYPE_NUMBER) )
argument_type_error($1.code, type);
}
else switch (type.typeflags)
{
case TYPE_MAPPING:
if ($3.inst == F_INDEX)
break;
/* FALLTHROUGH */
default:
type_error("Bad type to indexed lvalue", type);
case TYPE_ANY:
if ($3.inst == F_INDEX)
break;
/* FALLTHROUGH */
case TYPE_STRING:
if (!BASIC_TYPE($3.type1, Type_Number))
type_error("Bad type of index", $3.type1);
restype = Type_Number;
break;
}
} /* if (exact_types) */
/* Create the code to index the lvalue */
/* TODO: How does this lvalue-indexing work? */
current = CURRENT_PROGRAM_SIZE;
start = $2.start;
if ($2.code >= 0)
{
if ($2.end)
{
int length;
bytecode_p q;
length = $2.end - start + 1;
if (!realloc_a_program(length))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, current+length);
YYACCEPT;
}
p = PROGRAM_BLOCK;
memcpy(p + current, p + start, length);
p += start;
q = p + length;
length = current - start;
for( ; --length >= 0; )
*p++ = *q++;
if ($2.code == F_PUSH_IDENTIFIER16_LVALUE)
p[-3] = $2.code;
else
p[-1] = $2.code;
if ($3.inst == F_INDEX)
*p++ = F_INDEX_LVALUE;
else if ($3.inst == F_RINDEX)
*p++ = F_RINDEX_LVALUE;
else
*p++ = F_AINDEX_LVALUE;
}
else
{
int i;
int length;
if (!realloc_a_program(3))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n",
current+3);
YYACCEPT;
}
p = PROGRAM_BLOCK + start;
i = p[1];
length = current - start - 2;
for( ; --length >= 0; p++)
*p = p[2];
*p++ = $2.code;
*p++ = i;
if ($3.inst == F_INDEX)
*p++ = F_INDEX_LVALUE;
else if ($3.inst == F_RINDEX)
*p++ = F_RINDEX_LVALUE;
else
*p++ = F_AINDEX_LVALUE;
}
}
else
{
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n",
current+2);
YYACCEPT;
}
p = PROGRAM_BLOCK + start;
if ($3.inst == F_INDEX)
*p++ = F_PUSH_INDEXED_LVALUE;
else if ($3.inst == F_RINDEX)
*p++ = F_PUSH_RINDEXED_LVALUE;
else
*p++ = F_PUSH_AINDEXED_LVALUE;
}
/* Finally store the actual instruction */
*p = $1.code;
last_expression = current + 1;
CURRENT_PROGRAM_SIZE = current + 2;
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = restype;
} /* pre_inc_dec expr4 [index_expr] */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| pre_inc_dec expr4 '[' expr0 ',' expr0 ']' %prec '['
{
mp_uint current;
bytecode_p p;
%line
$$.start = $1.start;
if ($4.type.typeflags & TYPE_MOD_REFERENCE
|| $6.type.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Check the types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $2.type;
type.typeflags &= TYPEID_MASK;
switch (type.typeflags)
{
default:
type_error("Bad type to indexed lvalue", type);
break;
case TYPE_ANY:
case TYPE_MAPPING:
break;
}
} /* if (exact_types) */
/* We don't have to do much: we can take the rvalue
* produced by <expr4> and add our PUSH_INDEXED_MAP_LVALUE
*/
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n",
current+2);
YYACCEPT;
}
p = PROGRAM_BLOCK + current;
*p++ = F_PUSH_INDEXED_MAP_LVALUE;
/* Finally store the actual instruction */
*p = $1.code;
last_expression = current + 1;
CURRENT_PROGRAM_SIZE = current + 2;
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Any;
} /* pre_inc_dec expr4 [expr0 ',' expr0] */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_NOT expr0
{
$$ = $2;
last_expression = CURRENT_PROGRAM_SIZE;
ins_f_code(F_NOT); /* Any type is valid here. */
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '~' expr0
{
%line
$$ = $2;
ins_f_code(F_COMPL);
if (exact_types.typeflags && !BASIC_TYPE($2.type, Type_Number))
type_error("Bad argument to ~", $2.type);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '-' expr0 %prec '~'
{
fulltype_t type;
%line
$$ = $2;
if (CURRENT_PROGRAM_SIZE - last_expression == 2
&& mem_block[A_PROGRAM].block[last_expression] ==
F_CLIT )
{
mem_block[A_PROGRAM].block[last_expression] =
F_NCLIT;
}
else if (CURRENT_PROGRAM_SIZE - last_expression == 1
&& mem_block[A_PROGRAM].block[last_expression] ==
F_CONST1 )
{
mem_block[A_PROGRAM].block[last_expression] =
F_NCONST1;
}
else if (CURRENT_PROGRAM_SIZE - last_expression == 1 + sizeof(p_int)
&& mem_block[A_PROGRAM].block[last_expression] ==
F_NUMBER )
{
p_int number;
memcpy(&number, &(mem_block[A_PROGRAM].block[last_expression+1])
, sizeof(number));
number = -number;
memcpy(&(mem_block[A_PROGRAM].block[last_expression+1]), &number
, sizeof(number));
}
else
{
ins_f_code(F_NEGATE);
}
$$.end = CURRENT_PROGRAM_SIZE;
type = $2.type;
if (exact_types.typeflags
&& !BASIC_TYPE(type, Type_Number)
&& type.typeflags != TYPE_FLOAT )
type_error("Bad argument to unary '-'", type);
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue L_INC %prec L_INC
{
%line
/* Create the code to push the lvalue plus POST_INC */
$$.start = CURRENT_PROGRAM_SIZE;
if (!add_lvalue_code(&$1, F_POST_INC))
YYACCEPT;
$$.end = CURRENT_PROGRAM_SIZE;
/* Check the types */
if (exact_types.typeflags
&& !BASIC_TYPE($1.type, Type_Number)
&& !BASIC_TYPE($1.type, Type_Float)
)
type_error("Bad argument to ++", $1.type);
$$.type = $1.type;
} /* post-inc */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue L_DEC %prec L_DEC
{
%line
$$.start = CURRENT_PROGRAM_SIZE;
/* Create the code to push the lvalue plus POST_DEC */
if (!add_lvalue_code(&$1, F_POST_DEC))
YYACCEPT;
/* Check the types */
if (exact_types.typeflags
&& !BASIC_TYPE($1.type, Type_Number)
&& !BASIC_TYPE($1.type, Type_Float)
)
type_error("Bad argument to --", $1.type);
$$.end = CURRENT_PROGRAM_SIZE;
$$.type = $1.type;
} /* post-dec */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4
{
$$ = $1;
}
; /* expr0 */
pre_inc_dec:
L_INC { $$.code = F_PRE_INC; $$.start = CURRENT_PROGRAM_SIZE; }
| L_DEC { $$.code = F_PRE_DEC; $$.start = CURRENT_PROGRAM_SIZE; }
;
expr4:
function_call %prec '~'
%ifdef USE_NEW_INLINES
| inline_func %prec '~' {}
%else /* USE_NEW_INLINES */
| inline_fun
%endif /* USE_NEW_INLINES */
| catch %prec '~'
| sscanf %prec '~'
%ifdef USE_PARSE_COMMAND
| parse_command %prec '~'
%endif /* USE_PARSE_COMMAND */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_STRING
{
/* Push a constant string */
int string_number;
PREPARE_INSERT(3)
string_t *p;
%line
p = last_lex_string;
last_lex_string = NULL;
$$.start = last_expression = CURRENT_PROGRAM_SIZE;
$$.type = Type_String;
$$.code = -1;
string_number = store_prog_string(p);
if ( string_number <= 0xff )
{
add_f_code(F_CSTRING0);
add_byte(string_number);
}
else if ( string_number <= 0x1ff )
{
add_f_code(F_CSTRING1);
add_byte(string_number);
}
else if ( string_number <= 0x2ff )
{
add_f_code(F_CSTRING2);
add_byte(string_number);
}
else if ( string_number <= 0x3ff )
{
add_f_code(F_CSTRING3);
add_byte(string_number);
}
else
{
add_f_code(F_STRING);
add_short(string_number);
CURRENT_PROGRAM_SIZE++;
}
CURRENT_PROGRAM_SIZE += 2;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_NUMBER
{
/* Store a number */
p_int current;
p_int number;
PREPARE_INSERT(1 + sizeof (p_int))
%line
$$.start = last_expression = current = CURRENT_PROGRAM_SIZE;
$$.code = -1;
number = $1;
if ( number == 0 )
{
current++;
add_f_code(F_CONST0);
$$.type = Type_Any;
/* TODO: Introduce a TYPE_NULL instead */
}
else if ( number == 1 )
{
add_f_code(F_CONST1);
current++;
$$.type = Type_Number;
}
else if ( number >= 0 && number <= 0xff )
{
add_f_code(F_CLIT);
add_byte(number);
current += 2;
$$.type = Type_Number;
}
else if ( number < 0 && number >= -0x0ff )
{
add_f_code(F_NCLIT);
add_byte(-number);
current += 2;
$$.type = Type_Number;
}
else
{
add_f_code(F_NUMBER);
memcpy(__PREPARE_INSERT__p, &$1, sizeof $1);
current += 1 + sizeof (p_int);
$$.type = Type_Number;
}
CURRENT_PROGRAM_SIZE = current;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_CLOSURE
{
int ix, inhIndex;
$$.start = CURRENT_PROGRAM_SIZE;
$$.code = -1;
if (!pragma_warn_deprecated)
ins_byte(F_NO_WARN_DEPRECATED);
ix = $1.number;
inhIndex = $1.inhIndex;
ins_f_code(F_CLOSURE);
ins_short(ix);
ins_short(inhIndex);
$$.type = Type_Closure;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_SYMBOL
{
/* Generate a symbol */
int string_number;
int quotes;
$$.start = CURRENT_PROGRAM_SIZE;
$$.code = -1;
quotes = $1.quotes;
string_number = store_prog_string($1.name);
if (quotes == 1 && string_number < 0x100)
{
/* One byte shorter than the other way */
ins_f_code(F_CSTRING0);
ins_byte(string_number);
ins_f_code(F_QUOTE);
}
else
{
ins_f_code(F_SYMBOL);
ins_short(string_number);
ins_byte(quotes);
}
$$.type = Type_Symbol;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_FLOAT
{
/* Generate a float literal */
int exponent;
$$.start = CURRENT_PROGRAM_SIZE;
$$.code = -1;
ins_f_code(F_FLOAT);
ins_int32 ( SPLIT_DOUBLE( $1, &exponent) );
ins_short( exponent );
$$.type = Type_Float;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '(' note_start comma_expr ')' %prec '~'
{
/* A nested expression */
$$.type = $3.type;
$$.start = $2.start;
$$.code = -1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '(' '{' note_start expr_list '}' ')' %prec '~'
{
/* Generate an array */
check_aggregate_types($4);
/* We don't care about these types,
* unless a reference appears
*/
ins_f_code(F_AGGREGATE);
ins_short($4);
if (max_array_size && $4 > (p_int)max_array_size)
yyerror("Illegal array size");
$$.type = Type_Ptr_Any;
$$.start = $3.start;
$$.code = -1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_QUOTED_AGGREGATE note_start expr_list '}' ')' %prec '~'
{
/* Generate a quoted array by generating a normal
* array first and then applying QUOTE as often
* as possible.
*/
int quotes;
check_aggregate_types($3);
/* We don't care about these types,
* unless a reference appears
*/
ins_f_code(F_AGGREGATE);
ins_short($3);
if (max_array_size && $3 > (p_int)max_array_size)
yyerror("Illegal array size");
$$.type = Type_Quoted_Array;
$$.start = $2.start;
$$.code = -1;
quotes = $1;
do {
ins_f_code(F_QUOTE);
} while (--quotes);
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '(' '[' ':' note_start
/* Generate an empty mapping of given width */
{
ins_number(0);
}
expr0 ']' ')'
{
ins_f_code(F_M_ALLOCATE);
$$.type = Type_Mapping;
$$.start = $4.start;
$$.code = -1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '(' '[' note_start m_expr_list ']' ')'
{
/* Generate a mapping */
mp_int num_keys;
check_aggregate_types($4[0]);
num_keys = $4[0] / ($4[1]+1);
if ((num_keys|$4[1]) & ~0xffff)
yyerror("cannot handle more than 65535 keys/values "
"in mapping aggregate");
if ( (num_keys | $4[1]) &~0xff)
{
ins_f_code(F_M_AGGREGATE);
ins_short(num_keys);
ins_short($4[1]);
}
else
{
ins_f_code(F_M_CAGGREGATE);
ins_byte(num_keys);
ins_byte($4[1]);
}
$$.type = Type_Mapping;
$$.start = $3.start;
$$.code = -1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
%ifdef USE_STRUCTS
| '(' '<' note_start '>' ')'
{
yyerror("Missing identifier for empty struct literal");
$$.type = Type_Unknown;
$$.start = $3.start;
$$.code = -1;
}
| '(' '<' note_start error ')'
{
/* Rule allows the parser to resynchronize after errors */
$$.type = Type_Unknown;
$$.start = $3.start;
$$.code = -1;
}
| '(' '<' identifier '>'
{
int num;
num = find_struct($3);
if (num < 0)
{
yyerrorf("Unknown struct '%s'", get_txt($3));
YYACCEPT;
}
$<number>$ = num;
free_mstring($3);
}
note_start opt_struct_init ')'
{
/* Generate a literal struct */
int num = $<number>5;
struct_def_t *pdef = &(STRUCT_DEF(num));
if ($7.length > STRUCT_MAX_MEMBERS
|| $7.length > struct_t_size(pdef->type))
{
/* Too many elements - create an empty struct */
yyerrorf("Too many elements for literal struct '%s'"
, get_txt(struct_t_name(pdef->type)));
CURRENT_PROGRAM_SIZE = $6.start;
create_struct_literal(pdef, 0, NULL);
}
else if (!create_struct_literal(pdef, $7.length, $7.list))
{
/* Creation failed - create an empty struct */
CURRENT_PROGRAM_SIZE = $6.start;
create_struct_literal(pdef, 0, NULL);
}
/* Free the list of member descriptors */
while ($7.list != NULL)
{
struct_init_t * p = $7.list;
$7.list = p->next;
if (p->name != NULL)
free_mstring(p->name);
xfree(p);
}
$$.type.typeflags = TYPE_STRUCT;
$$.type.t_struct = pdef->type;
$$.start = $6.start;
$$.code = -1;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 L_ARROW struct_member_name
{
/* Lookup a struct member */
short s_index = -1;
$$.start = $1.start;
$$.code = -1;
$$.type = $1.type; /* default */
if (!IS_TYPE_ANY($1.type) && !IS_TYPE_STRUCT($1.type))
{
yyerrorf("Bad type for struct lookup: %s"
, get_type_name($1.type));
}
else
{
if (IS_TYPE_STRUCT($1.type))
{
s_index = get_struct_index($1.type.t_struct);
if (s_index == -1)
yyerrorf("Unknown type in struct dereference: %s\n"
, get_type_name($1.type)
);
}
/* At this point: s_index >= 0: $1 is of type struct
* < 0: $1 is of type mixed
*/
if ($3 != NULL)
{
int num;
struct_type_t * ptype = NULL;
if (s_index >= 0)
{
ptype = $1.type.t_struct;
num = struct_find_member(ptype, $3);
if (num < 0)
{
yyerrorf("No such member '%s' for struct '%s'"
, get_txt($3)
, get_txt(struct_t_name(ptype))
);
}
}
else /* $1 is of type mixed */
{
s_index = find_struct_by_member($3, &num);
if (s_index >= 0)
ptype = STRUCT_DEF(s_index).type;
}
/* If this is a legal struct lookup, num >= 0 at this point
*/
if (num >= 0)
{
ins_number(num);
ins_number(s_index);
ins_f_code(F_S_INDEX);
if (ptype != NULL)
assign_var_to_fulltype(&$$.type
, ptype->member[num].type);
}
}
else /* Runtime lookup */
{
ins_number(s_index);
ins_f_code(F_S_INDEX);
$$.type = Type_Any;
}
$$.end = CURRENT_PROGRAM_SIZE-1;
}
if ($3 != NULL)
free_mstring($3);
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' '(' expr4 L_ARROW struct_member_name ')'
{
/* Create a reference to a struct member */
short s_index = -1;
$$.start = $3.start;
$$.code = -1;
$$.type = $3.type; /* default */
if (!IS_TYPE_ANY($3.type) && !IS_TYPE_STRUCT($3.type))
{
yyerrorf("Bad type for struct lookup: %s"
, get_type_name($3.type));
}
else
{
/* '&(struct->member->member)' generates a simple
* F_S_INDEX for the first lookup instead of a suitable
* lvalue lookup. I don't understand the lvalue generation
* well enough to correct the generated code, so for now
* I restrict the lookup to one level.
*/
if ($3.end != 0
&& F_S_INDEX == mem_block[A_PROGRAM].block[$3.end]
)
{
yyerror("Implementation restriction: Only a single struct "
"member lookup allowed inside a &()");
}
if (IS_TYPE_STRUCT($3.type))
{
s_index = get_struct_index($3.type.t_struct);
if (s_index == -1)
yyerrorf("Unknown type in lvalue struct derefence: %s\n"
, get_type_name($3.type)
);
}
/* At this point: s_index >= 0: $1 is of type struct
* < 0: $1 is of type mixed
*/
if ($5 != NULL)
{
int num;
struct_type_t * ptype = NULL;
if (s_index >= 0)
{
ptype = $3.type.t_struct;
num = struct_find_member(ptype, $5);
if (num < 0)
{
yyerrorf("No such member '%s' for struct '%s'"
, get_txt($5)
, get_txt(struct_t_name(ptype))
);
}
}
else /* $3 is of type mixed */
{
s_index = find_struct_by_member($5, &num);
if (s_index >= 0)
ptype = STRUCT_DEF(s_index).type;
}
/* If this is a legal struct lookup, num >= 0 at this point
*/
if (num >= 0)
{
ins_number(num);
ins_number(s_index);
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_S_LVALUE
);
if (ptype != NULL)
{
assign_var_to_fulltype(&$$.type
, ptype->member[num].type);
$$.type.typeflags |= TYPE_MOD_REFERENCE;
}
}
}
else /* Runtime lookup */
{
ins_number(s_index);
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_S_LVALUE
);
$$.type = Type_Ref_Any;
}
$$.end = CURRENT_PROGRAM_SIZE-1;
}
if ($5 != NULL)
free_mstring($5);
}
%endif /* USE_STRUCTS */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 index_range %prec '['
{
%line
/* Generate a range expression */
$$.start = $1.start;
$$.code = -1;
ins_f_code($2.inst);
/* Check the types */
if (exact_types.typeflags)
{
fulltype_t type;
$1.type.typeflags &= TYPEID_MASK;
$$.type = type = $1.type;
if ((type.typeflags & TYPE_MOD_POINTER) == 0
&& type.typeflags != TYPE_ANY && type.typeflags != TYPE_STRING)
{
type_error("Bad type of argument used for range", type);
$$.type = Type_Any;
}
type = $2.type1;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
type = $2.type2;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
else
{
$$.type = Type_Any;
}
} /* expr4 index_range */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' L_IDENTIFIER %prec '~'
{
/* Reference to a global variable, virtual or non-virtual.
* We generate PUSH_LVALUE code and mark the type
* as TYPE_MOD_REFERENCE.
*/
int i;
mp_uint current;
bytecode_p p;
%line
i = verify_declared($2);
$$.start = current = CURRENT_PROGRAM_SIZE;
$$.code = -1;
if (!realloc_a_program(3))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n", current+3);
YYACCEPT;
}
p = PROGRAM_BLOCK + current;
if (i & VIRTUAL_VAR_TAG)
{
*p++ = F_PUSH_VIRTUAL_VARIABLE_LVALUE;
*p = i;
}
else
{
if ((i + num_virtual_variables) & ~0xff)
{
*p = F_PUSH_IDENTIFIER16_LVALUE;
upd_short(++current, i + num_virtual_variables);
}
else
{
*p++ = F_PUSH_IDENTIFIER_LVALUE;
*p = i + num_virtual_variables;
}
}
CURRENT_PROGRAM_SIZE = current + 2;
if (i == -1)
$$.type = Type_Ref_Any;
else
{
$$.type = VARIABLE(i)->type;
$$.type.typeflags = ($$.type.typeflags & TYPE_MOD_MASK)
| TYPE_MOD_REFERENCE;
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' L_LOCAL %prec '~'
{
/* Reference to a local variable.
* We generate PUSH_LVALUE code and mark the type
* as TYPE_MOD_REFERENCE.
*/
mp_uint current;
bytecode_p p;
%line
#ifdef USE_NEW_INLINES
$2 = check_for_context_local($2, &$$.type);
#endif /* USE_NEW_INLINES */
$$.start = current = CURRENT_PROGRAM_SIZE;
$$.code = -1;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n",
current+2);
YYACCEPT;
}
p = PROGRAM_BLOCK + current;
#ifdef USE_NEW_INLINES
if ($2->u.local.context >= 0)
{
*p++ = F_PUSH_CONTEXT_LVALUE;
*p = $2->u.local.context;
}
else
{
*p++ = F_PUSH_LOCAL_VARIABLE_LVALUE;
*p = $2->u.local.num;
}
$$.type.typeflags |= TYPE_MOD_REFERENCE;
CURRENT_PROGRAM_SIZE = current + 2;
#else /* USE_NEW_INLINES */
*p++ = F_PUSH_LOCAL_VARIABLE_LVALUE;
*p = $2->u.local.num;
CURRENT_PROGRAM_SIZE = current + 2;
$$.type = type_of_locals[$2->u.local.num];
$$.type.typeflags |= TYPE_MOD_REFERENCE;
#endif /* USE_NEW_INLINES */
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' '(' expr4 index_expr ')' %prec '~'
{
%line
/* Generate the proper indexing operator */
if ($4.inst == F_INDEX)
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_LVALUE
);
else if ($4.inst == F_RINDEX)
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_RINDEX_LVALUE
);
else
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_AINDEX_LVALUE
);
$$.start = $3.start;
$$.code = -1;
if ($4.type1.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Compute the result type */
if (!exact_types.typeflags)
{
$$.type = Type_Ref_Any;
}
else
{
fulltype_t type;
type = $3.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags & TYPE_MOD_POINTER)
{
$$.type = type;
$$.type.typeflags &= ~TYPE_MOD_POINTER;
}
else if (type.typeflags == TYPE_MAPPING && $4.inst == F_INDEX)
{
$4.type1 = Type_Any;
$$.type = Type_Ref_Any;
}
else switch (type.typeflags)
{
default:
type_error("Bad type to indexed reference", type);
/* FALLTHROUGH */
case TYPE_ANY:
if ($4.inst == F_INDEX)
$4.type1 = Type_Any;
$$.type = Type_Ref_Any;
break;
case TYPE_STRING:
$$.type = Type_Ref_Number;
break;
}
if (!BASIC_TYPE($4.type1, Type_Number))
type_error("Bad type of index", $4.type1);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' '(' expr4 '[' expr0 ',' expr0 ']' ')'
{
%line
/* Generate the proper indexing operator */
$$.start = $3.start;
$$.code = -1;
$$.type = Type_Ref_Any;
ins_f_code(F_PUSH_PROTECTED_INDEXED_MAP_LVALUE);
if ($5.type.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Compute the result type */
if (exact_types.typeflags)
{
fulltype_t type;
type = $3.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_MAPPING)
{
type_error("Bad type to indexed value", type);
}
type = $7.type;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '&' '(' expr4 index_range ')' %prec '~'
{
%line
/* Generate the proper indexing operator */
int prot_op;
switch($4.inst)
{
case F_RANGE: prot_op = F_PROTECTED_RANGE_LVALUE; break;
case F_NR_RANGE: prot_op = F_PROTECTED_NR_RANGE_LVALUE; break;
case F_RN_RANGE: prot_op = F_PROTECTED_RN_RANGE_LVALUE; break;
case F_RR_RANGE: prot_op = F_PROTECTED_RR_RANGE_LVALUE; break;
case F_NA_RANGE: prot_op = F_PROTECTED_NA_RANGE_LVALUE; break;
case F_AN_RANGE: prot_op = F_PROTECTED_AN_RANGE_LVALUE; break;
case F_RA_RANGE: prot_op = F_PROTECTED_RA_RANGE_LVALUE; break;
case F_AR_RANGE: prot_op = F_PROTECTED_AR_RANGE_LVALUE; break;
case F_AA_RANGE: prot_op = F_PROTECTED_AA_RANGE_LVALUE; break;
case F_NX_RANGE: prot_op = F_PROTECTED_NX_RANGE_LVALUE; break;
case F_RX_RANGE: prot_op = F_PROTECTED_RX_RANGE_LVALUE; break;
case F_AX_RANGE: prot_op = F_PROTECTED_AX_RANGE_LVALUE; break;
default:
fatal("Unsupported range type %d %s\n"
, $4.inst, get_f_name($4.inst));
}
arrange_protected_lvalue($3.start, $3.code, $3.end
, prot_op
);
$$.start = $3.start;
$$.code = -1;
/* Compute the result type */
if (!exact_types.typeflags)
{
$$.type = Type_Ref_Any;
}
else
{
fulltype_t type;
$3.type.typeflags &= TYPEID_MASK;
$$.type = type = $3.type;
if ((type.typeflags & TYPE_MOD_POINTER) == 0
&& type.typeflags != TYPE_ANY && type.typeflags != TYPE_STRING)
{
type_error("Bad type of argument used for range", type);
$$.type = Type_Any;
}
type = $4.type1;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
type = $4.type2;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
%// The following expressions can be patched to lvalues for use in index_lvalue.
| L_IDENTIFIER
{
/* Access a global variable */
int i;
mp_uint current;
bytecode_p p;
%line
i = verify_declared($1);
$$.start = current = CURRENT_PROGRAM_SIZE;
$$.end = 0;
if (!realloc_a_program(3))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n", current+3);
YYACCEPT;
}
p = PROGRAM_BLOCK + current;
if (i & VIRTUAL_VAR_TAG)
{
/* Access a virtual variable */
$$.code = F_PUSH_VIRTUAL_VARIABLE_LVALUE;
*p++ = F_VIRTUAL_VARIABLE;
*p = i;
$$.type = V_VARIABLE(i)->type;
$$.type.typeflags &= TYPE_MOD_MASK;
}
else
{
/* Access a non-virtual variable */
if ((i + num_virtual_variables) & ~0xff)
{
$$.code = F_PUSH_IDENTIFIER16_LVALUE;
*p = F_IDENTIFIER16;
upd_short(++current, i + num_virtual_variables);
$$.end = current+1;
}
else
{
$$.code = F_PUSH_IDENTIFIER_LVALUE;
*p++ = F_IDENTIFIER;
*p = i + num_virtual_variables;
}
$$.type = NV_VARIABLE(i)->type;
$$.type.typeflags &= TYPE_MOD_MASK;
}
CURRENT_PROGRAM_SIZE = current + 2;
if (i == -1)
$$.type = Type_Any;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_LOCAL
{
/* Access a local variable */
mp_uint current;
bytecode_p p;
%line
#ifdef USE_NEW_INLINES
$1 = check_for_context_local($1, &$$.type);
#endif /* USE_NEW_INLINES */
$$.start = current = CURRENT_PROGRAM_SIZE;
$$.end = 0;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n", current+2);
YYACCEPT;
}
p = PROGRAM_BLOCK + current;
#ifdef USE_NEW_INLINES
if ($1->u.local.context >= 0)
{
$$.code = F_PUSH_CONTEXT_LVALUE;
*p++ = F_CONTEXT_IDENTIFIER;
*p = $1->u.local.context;
}
else
{
$$.code = F_PUSH_LOCAL_VARIABLE_LVALUE;
*p++ = F_LOCAL;
*p = $1->u.local.num;
}
CURRENT_PROGRAM_SIZE = current + 2;
#else /* USE_NEW_INLINES */
*p++ = F_LOCAL;
*p = $1->u.local.num;
CURRENT_PROGRAM_SIZE = current + 2;
$$.type = type_of_locals[$1->u.local.num];
#endif /* USE_NEW_INLINES */
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 index_expr %prec '['
{
%line
/* Generate (R)INDEX/PUSH_(R)INDEXED_LVALUE */
$$.start = $1.start;
$$.end = CURRENT_PROGRAM_SIZE;
if ($2.inst == F_INDEX)
{
$$.code = F_PUSH_INDEXED_LVALUE;
ins_f_code(F_INDEX);
}
else if ($2.inst == F_RINDEX)
{
$$.code = F_PUSH_RINDEXED_LVALUE;
ins_f_code(F_RINDEX);
}
else
{
$$.code = F_PUSH_AINDEXED_LVALUE;
ins_f_code(F_AINDEX);
}
if ($2.type1.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Check and compute the types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $1.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags & TYPE_MOD_POINTER)
{
$$.type = type;
$$.type.typeflags &= ~TYPE_MOD_POINTER;
}
else if (type.typeflags == TYPE_MAPPING && $2.inst == F_INDEX)
{
$2.type1 = Type_Any;
$$.type = Type_Any;
}
else switch (type.typeflags)
{
default:
type_error("Bad type to indexed value", type);
/* FALLTHROUGH */
case TYPE_ANY:
if ($2.inst == F_INDEX)
$2.type1 = Type_Any;
$$.type = Type_Any;
break;
case TYPE_STRING:
$$.type = Type_Number;
break;
}
if (!BASIC_TYPE($2.type1, Type_Number))
type_error("Bad type of index", $2.type1);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 '[' expr0 ',' expr0 ']' %prec '['
{
%line
/* Generate MAP_INDEX/PUSH_INDEXED_MAP_LVALUE */
$$.start = $1.start;
$$.end = CURRENT_PROGRAM_SIZE;
$$.code = F_PUSH_INDEXED_MAP_LVALUE;
$$.type = Type_Any;
ins_f_code(F_MAP_INDEX);
if ($3.type.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Check and compute types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $1.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_MAPPING)
{
type_error("Bad type to indexed value", type);
}
type = $5.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
; /* expr4 */
lvalue:
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
name_lvalue
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 index_expr %prec '['
{
/* Generate/add an (R)INDEX_LVALUE */
bytecode_p p, q;
p_int start, current;
%line
start = $1.start;
current = CURRENT_PROGRAM_SIZE;
p = PROGRAM_BLOCK;
q = yalloc(current-start+2); /* assign uses an extra byte */
/* First change the rvalue 'expr4' into an lvalue.
*/
if ($1.code >= 0)
{
p_int end, start2;
if ( 0 != (end = $1.end) )
{
/* Multibyte instruction */
start2 = end+1;
if ($1.code == F_PUSH_IDENTIFIER16_LVALUE)
p[start] = $1.code;
else
p[end] = $1.code;
memcpy(q, p + start2, current - start2);
memcpy(q + current - start2, p + start, start2 - start);
if ($2.inst == F_INDEX)
q[current - start] = F_INDEX_LVALUE;
else if ($2.inst == F_RINDEX)
q[current - start] = F_RINDEX_LVALUE;
else
q[current - start] = F_AINDEX_LVALUE;
}
else
{
/* Simple relocation/insertion */
bytecode_t c;
start2 = start + 2;
c = p[start+1];
memcpy(q, p + start2, current - start2);
p = q + current - start2;
*p++ = $1.code;
*p++ = c;
if ($2.inst == F_INDEX)
*p = F_INDEX_LVALUE;
else if ($2.inst == F_RINDEX)
*p = F_RINDEX_LVALUE;
else
*p = F_AINDEX_LVALUE;
}
}
else
{
/* We can just copy the instruction block
* and add a PUSH_(R)INDEXED_LVALUE
*/
memcpy(q, p + start, current - start);
if ($2.inst == F_INDEX)
q[current - start] = F_PUSH_INDEXED_LVALUE;
else if ($2.inst == F_RINDEX)
q[current - start] = F_PUSH_RINDEXED_LVALUE;
else
q[current - start] = F_PUSH_AINDEXED_LVALUE;
}
/* This is what we return */
$$.length = current + 1 - start;
$$.u.p = q;
CURRENT_PROGRAM_SIZE = start;
last_expression = -1;
if ($2.type1.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Check and compute types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $1.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags & TYPE_MOD_POINTER)
{
$$.type = type;
$$.type.typeflags &= ~TYPE_MOD_POINTER;
}
else if (type.typeflags == TYPE_MAPPING && $2.inst == F_INDEX)
{
$2.type1 = Type_Any;
$$.type = Type_Any;
}
else switch (type.typeflags)
{
default:
type_error("Bad type to indexed lvalue", type);
/* FALLTHROUGH */
case TYPE_ANY:
if ($2.inst == F_INDEX)
$2.type1 = Type_Any;
$$.type = Type_Any;
break;
case TYPE_STRING:
$$.type = Type_Number;
break;
}
if (!BASIC_TYPE($2.type1, Type_Number))
type_error("Bad type of index", $2.type1);
}
else
{
$$.type = Type_Any;
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 '[' expr0 ',' expr0 ']' %prec '['
{
/* Generate/add an PUSH_INDEXED_MAP_LVALUE */
bytecode_p p, q;
p_int start, current;
%line
/* Well, just generate the code: expr4 must be
* a mapping, or a runtime error will occur.
*/
start = $1.start;
current = CURRENT_PROGRAM_SIZE;
p = PROGRAM_BLOCK;
q = yalloc(current-start+2); /* assign uses an extra byte */
memcpy(q, p + start, current - start);
q[current - start] = F_PUSH_INDEXED_MAP_LVALUE;
$$.length = current + 1 - start;
$$.u.p = q;
$$.type = Type_Any;
CURRENT_PROGRAM_SIZE = start;
last_expression = -1;
if ($3.type.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Check and compute types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $1.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_MAPPING)
{
type_error("Bad type to indexed value", type);
}
type = $5.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 index_range %prec '['
{
/* RANGE_LVALUE generation */
bytecode_p p, q;
p_int start, current;
int indexing_code;
%line
switch ($2.inst)
{
case F_RANGE: indexing_code = F_RANGE_LVALUE; break;
case F_NR_RANGE: indexing_code = F_NR_RANGE_LVALUE; break;
case F_RN_RANGE: indexing_code = F_RN_RANGE_LVALUE; break;
case F_RR_RANGE: indexing_code = F_RR_RANGE_LVALUE; break;
case F_NA_RANGE: indexing_code = F_NA_RANGE_LVALUE; break;
case F_AN_RANGE: indexing_code = F_AN_RANGE_LVALUE; break;
case F_RA_RANGE: indexing_code = F_RA_RANGE_LVALUE; break;
case F_AR_RANGE: indexing_code = F_AR_RANGE_LVALUE; break;
case F_AA_RANGE: indexing_code = F_AA_RANGE_LVALUE; break;
case F_NX_RANGE: indexing_code = F_NX_RANGE_LVALUE; break;
case F_RX_RANGE: indexing_code = F_RX_RANGE_LVALUE; break;
case F_AX_RANGE: indexing_code = F_AX_RANGE_LVALUE; break;
default:
errorf("Unsupported range type %d %s\n"
, $2.inst, get_f_name($2.inst));
}
start = $1.start;
current = CURRENT_PROGRAM_SIZE;
p = PROGRAM_BLOCK;
q = yalloc(current-start+3);
/* Change the expr4 into an lvalue
*/
if ($1.code < 0)
{
yyerror("Need lvalue for range lvalue.");
}
else
{
p_int end, start2;
if ( 0 != (end = $1.end) )
{
/* Multibyte instruction */
start2 = end+1;
if ($1.code == F_PUSH_IDENTIFIER16_LVALUE)
{
p[start] = $1.code;
}
else
{
p[end] = $1.code;
}
}
else
{
/* Simple relocation/replacement */
start2 = start+2;
p[start] = $1.code;
}
/* Do the actual relocation */
memcpy(q, p + start2, current - start2);
memcpy(q + current - start2, p + start, start2 - start);
current -= start;
/* Insert the indexing code */
if (instrs[indexing_code].prefix)
{
q[current++] = instrs[indexing_code].prefix;
}
q[current] = instrs[indexing_code].opcode;
}
/* This is what we return */
$$.length = current + 1;
$$.u.p = q;
CURRENT_PROGRAM_SIZE = start;
last_expression = -1;
/* Compute and check the types */
if (exact_types.typeflags)
{
fulltype_t type;
$1.type.typeflags &= TYPEID_MASK;
$$.type = type = $1.type;
if ((type.typeflags & TYPE_MOD_POINTER) == 0
&& type.typeflags != TYPE_ANY
&& type.typeflags != TYPE_STRING)
{
type_error("Bad type of argument used for range", type);
$$.type = Type_Any;
}
type = $2.type1;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
type = $2.type2;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
%ifdef USE_STRUCTS
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 L_ARROW struct_member_name
{
/* Create a struct member lvalue */
short s_index = -1;
int num;
vartype_t member_type;
/* If the struct lookup is ok, set num and member_type */
num = 0;
member_type = VType_Unknown;
if (!IS_TYPE_ANY($1.type) && !IS_TYPE_STRUCT($1.type))
{
yyerrorf("Bad type for struct lookup: %s"
, get_type_name($1.type));
}
else
{
if (IS_TYPE_STRUCT($1.type))
{
s_index = get_struct_index($1.type.t_struct);
if (s_index == -1)
yyerrorf("Unknown type in lvalue struct dereference: %s\n"
, get_type_name($1.type)
);
}
/* At this point: s_index >= 0: $1 is of type struct
* < 0: $1 is of type mixed
*/
if ($3 != NULL)
{
struct_type_t * ptype = NULL;
if (s_index >= 0)
{
ptype = $1.type.t_struct;
num = struct_find_member(ptype, $3);
if (num < 0)
{
yyerrorf("No such member '%s' for struct '%s'"
, get_txt($3)
, get_txt(struct_t_name(ptype))
);
}
else
member_type = ptype->member[num].type;
}
else /* $1 is of type mixed */
{
s_index = find_struct_by_member($3, &num);
if (s_index >= 0)
{
ptype = STRUCT_DEF(s_index).type;
member_type = ptype->member[num].type;
}
}
}
else /* Runtime lookup */
{
assign_full_to_vartype(&member_type, Type_Any);
}
}
/* We have to generate some code, so if the struct lookup is
* invalid, we just play along and generate code to look up
* member #0 in whatever we got.
*/
{
bytecode_p p, q;
p_int start, current;
if ($3 != NULL)
{
/* Insert the index code */
ins_number(num);
}
/* Insert the struct type index */
ins_number(s_index);
/* Generate/add an INDEX_S_LVALUE */
start = $1.start;
current = CURRENT_PROGRAM_SIZE;
p = PROGRAM_BLOCK;
q = yalloc(current-start+2); /* assign uses an extra byte */
/* First change the rvalue 'expr4' into an lvalue.
*/
if ($1.code >= 0)
{
p_int end, start2;
if ( 0 != (end = $1.end) )
{
/* Multibyte instruction */
start2 = end+1;
if ($1.code == F_PUSH_IDENTIFIER16_LVALUE)
p[start] = $1.code;
else
p[end] = $1.code;
memcpy(q, p + start2, current - start2);
memcpy(q + current - start2, p + start, start2 - start);
q[current - start] = F_INDEX_S_LVALUE;
}
else
{
/* Simple relocation/insertion */
bytecode_t c;
start2 = start + 2;
c = p[start+1];
memcpy(q, p + start2, current - start2);
p = q + current - start2;
*p++ = $1.code;
*p++ = c;
*p = F_INDEX_S_LVALUE;
}
}
else
{
/* We can just copy the instruction block
* and add a PUSH_(R)INDEXED_LVALUE
*/
memcpy(q, p + start, current - start);
q[current - start] = F_PUSH_INDEXED_S_LVALUE;
}
/* This is what we return */
$$.length = current + 1 - start;
$$.u.p = q;
CURRENT_PROGRAM_SIZE = start;
last_expression = -1;
assign_var_to_fulltype(&$$.type, member_type);
}
if ($3 != NULL)
free_mstring($3);
}
%endif /* USE_STRUCTS */
; /* lvalue */
name_lvalue:
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
L_IDENTIFIER
{
/* Generate the lvalue for a global */
int i;
%line
$$.length = 0;
i = verify_declared($1);
if (i & VIRTUAL_VAR_TAG)
{
$$.u.simple[0] = F_PUSH_VIRTUAL_VARIABLE_LVALUE;
$$.u.simple[1] = i;
$$.type = V_VARIABLE(i)->type;
$$.type.typeflags &= TYPE_MOD_MASK;
if (i == -1)
$$.type = Type_Any;
}
else
{
if ((i + num_virtual_variables) & ~0xff)
{
bytecode_p q;
q = yalloc(4); /* assign uses an extra byte */
$$.length = 3;
$$.u.p = q;
q[0] = F_PUSH_IDENTIFIER16_LVALUE;
PUT_SHORT(q+1, i + num_virtual_variables);
$$.type = NV_VARIABLE(i)->type;
$$.type.typeflags &= TYPE_MOD_MASK;
}
else
{
$$.u.simple[0] = F_PUSH_IDENTIFIER_LVALUE;
$$.u.simple[1] = i + num_virtual_variables;
}
$$.type = NV_VARIABLE(i)->type;
$$.type.typeflags &= TYPE_MOD_MASK;
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| L_LOCAL
{
%line
/* Generate the lvalue for a local */
#ifdef USE_NEW_INLINES
$1 = check_for_context_local($1, &$$.type);
if ($1->u.local.context >= 0)
{
$$.u.simple[0] = F_PUSH_CONTEXT_LVALUE;
$$.u.simple[1] = $1->u.local.context;
}
else
{
$$.u.simple[0] = F_PUSH_LOCAL_VARIABLE_LVALUE;
$$.u.simple[1] = $1->u.local.num;
}
$$.length = 0;
#else /* USE_NEW_INLINES */
$$.u.simple[0] = F_PUSH_LOCAL_VARIABLE_LVALUE;
$$.u.simple[1] = $1->u.local.num;
$$.length = 0;
$$.type = type_of_locals[$1->u.local.num];
#endif /* USE_NEW_INLINES */
}
; /* name_lvalue */
local_name_lvalue:
basic_type optional_star L_IDENTIFIER
{
define_local_variable($3, $1, $2, &$$, MY_FALSE, MY_TRUE);
}
| basic_type optional_star L_LOCAL
{
define_local_variable($3, $1, $2, &$$, MY_TRUE, MY_TRUE);
}
; /* local_name_lvalue */
/* The following rules are used to parse and compile the various
* forms of array indexing/ranging operations.
* They used at various places in the rules of expr0, expr4 and lvalue.
*/
index_expr :
'[' expr0 ']'
{
$$.inst = F_INDEX;
$$.start = $2.start;
$$.end = $2.end;
$$.type1 = $2.type;
if (!pragma_warn_deprecated)
{
ins_byte(F_NO_WARN_DEPRECATED);
$$.end++;
}
}
| '[' '<' expr0 ']'
{
$$.inst = F_RINDEX;
$$.start = $3.start;
$$.end = $3.end;
$$.type1 = $3.type;
if (!pragma_warn_deprecated)
{
ins_byte(F_NO_WARN_DEPRECATED);
$$.end++;
}
}
| '[' '>' expr0 ']'
{
$$.inst = F_AINDEX;
$$.start = $3.start;
$$.end = $3.end;
$$.type1 = $3.type;
if (!pragma_warn_deprecated)
{
ins_byte(F_NO_WARN_DEPRECATED);
$$.end++;
}
}
; /* index_expr */
index_range :
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
'[' L_RANGE expr0 ']'
{
/* Simulate an expression yielding 0 for the lower bound.
* We pretend that it's part of the upper bound expr.
*/
p_int current;
p_int length;
bytecode_p mark, p;
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(1))
{
yyerrorf("Out of memory: program size %"PRIdPINT"\n", current+1);
YYACCEPT;
}
mark = PROGRAM_BLOCK + $3.start;
p = PROGRAM_BLOCK + current;
length = current - $3.start;
for( ; --length >= 0; p--) PUT_CODE(p, GET_CODE(p-1));
STORE_CODE(mark, F_CONST0);
CURRENT_PROGRAM_SIZE++;
$3.end++;
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$3.end++;
}
/* Return the data */
$$.inst = F_RANGE;
$$.start = $3.start;
$$.end = $3.end;
$$.type1 = Type_Number;
$$.type2 = $3.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' L_RANGE '<' expr0 ']'
{
/* Simulate an expression yielding 0 for the lower bound.
* We pretend that it's part of the upper bound expr.
*/
p_int current;
p_int length;
bytecode_p mark, p;
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(1))
{
yyerrorf("Out of memory: program size %"PRIdPINT"\n", current+1);
YYACCEPT;
}
mark = PROGRAM_BLOCK + $4.start;
p = PROGRAM_BLOCK + current;
length = current - $4.start;
for( ; --length >= 0; p--) PUT_CODE(p, GET_CODE(p-1));
STORE_CODE(mark, F_CONST0);
CURRENT_PROGRAM_SIZE++;
$4.end++;
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$4.end++;
}
/* Return the data */
$$.inst = F_NR_RANGE;
$$.start = $4.start;
$$.end = $4.end;
$$.type1 = Type_Number;
$$.type2 = $4.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' L_RANGE '>' expr0 ']'
{
/* Simulate an expression yielding 0 for the lower bound.
* We pretend that it's part of the upper bound expr.
*/
p_int current;
p_int length;
bytecode_p mark, p;
current = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(1))
{
yyerrorf("Out of memory: program size %"PRIdPINT"\n", current+1);
YYACCEPT;
}
mark = PROGRAM_BLOCK + $4.start;
p = PROGRAM_BLOCK + current;
length = current - $4.start;
for( ; --length >= 0; p--) PUT_CODE(p, GET_CODE(p-1));
STORE_CODE(mark, F_CONST0);
CURRENT_PROGRAM_SIZE++;
$4.end++;
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$4.end++;
}
/* Return the data */
$$.inst = F_NA_RANGE;
$$.start = $4.start;
$$.end = $4.end;
$$.type1 = Type_Number;
$$.type2 = $4.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' expr0 L_RANGE expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$4.end++;
}
$$.inst = F_RANGE;
$$.start = $2.start;
$$.end = $4.end;
$$.type1 = $2.type;
$$.type2 = $4.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' expr0 L_RANGE '<' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$5.end++;
}
$$.inst = F_NR_RANGE;
$$.start = $2.start;
$$.end = $5.end;
$$.type1 = $2.type;
$$.type2 = $5.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '<' expr0 L_RANGE expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$5.end++;
}
$$.inst = F_RN_RANGE;
$$.start = $3.start;
$$.end = $5.end;
$$.type1 = $3.type;
$$.type2 = $5.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '<' expr0 L_RANGE '<' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$6.end++;
}
$$.inst = F_RR_RANGE;
$$.start = $3.start;
$$.end = $6.end;
$$.type1 = $3.type;
$$.type2 = $6.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' expr0 L_RANGE '>' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$5.end++;
}
$$.inst = F_NA_RANGE;
$$.start = $2.start;
$$.end = $5.end;
$$.type1 = $2.type;
$$.type2 = $5.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '>' expr0 L_RANGE expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$5.end++;
}
$$.inst = F_AN_RANGE;
$$.start = $3.start;
$$.end = $5.end;
$$.type1 = $3.type;
$$.type2 = $5.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '<' expr0 L_RANGE '>' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$6.end++;
}
$$.inst = F_RA_RANGE;
$$.start = $3.start;
$$.end = $6.end;
$$.type1 = $3.type;
$$.type2 = $6.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '>' expr0 L_RANGE '<' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$6.end++;
}
$$.inst = F_AR_RANGE;
$$.start = $3.start;
$$.end = $6.end;
$$.type1 = $3.type;
$$.type2 = $6.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '>' expr0 L_RANGE '>' expr0 ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$6.end++;
}
$$.inst = F_AA_RANGE;
$$.start = $3.start;
$$.end = $6.end;
$$.type1 = $3.type;
$$.type2 = $6.type;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' expr0 L_RANGE ']'
{
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$2.end++;
}
$$.inst = F_NX_RANGE;
$$.start = $2.start;
$$.end = $2.end;
$$.type1 = $2.type;
$$.type2 = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '<' expr0 L_RANGE ']'
{
/* Simulate an expression yielding <1 for the upper bound.
* We pretend that it's part of the lower bound expr.
*/
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$3.end++;
}
$$.inst = F_RX_RANGE;
$$.start = $3.start;
$$.end = $3.end;
$$.type1 = $3.type;
$$.type2 = Type_Number;
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| '[' '>' expr0 L_RANGE ']'
{
/* Simulate an expression yielding <1 for the upper bound.
* We pretend that it's part of the lower bound expr.
*/
if (pragma_range_check)
{
ins_byte(F_ARRAY_RANGE_CHECK);
$3.end++;
}
$$.inst = F_AX_RANGE;
$$.start = $3.start;
$$.end = $3.end;
$$.type1 = $3.type;
$$.type2 = Type_Number;
}
; /* index_range */
/* The following rules are used to construct array and
* mapping literals in expr4, and argument lists in function calls.
* Besides compiling the values, the rules count the number
* of values generated and add the types to the arg_types[].
*/
expr_list:
/* empty */ { $$ = 0; }
| expr_list2 { $$ = $1; }
| expr_list2 ',' { $$ = $1; } /* Allow a terminating comma */
; /* expr_list */
expr_list2:
expr0 { $$ = 1; add_arg_type($1.type); }
| expr_list2 ',' expr0 { $$ = $1 + 1; add_arg_type($3.type); }
; /* expr_list2 */
e_expr_list2:
expr0
{
$$ = 1;
if (!got_ellipsis[argument_level])
add_arg_type($1.type);
else
add_arg_type(Type_Any);
}
| expr0 L_ELLIPSIS
{
PREPARE_INSERT(2);
$$ = 0;
got_ellipsis[argument_level] = MY_TRUE;
add_f_code(F_FLATTEN_XARG);
CURRENT_PROGRAM_SIZE++;
}
| e_expr_list2 ',' expr0
{
$$ = $1 + 1;
if (!got_ellipsis[argument_level])
add_arg_type($3.type);
else
add_arg_type(Type_Any);
}
| e_expr_list2 ',' expr0 L_ELLIPSIS
{
PREPARE_INSERT(2);
$$ = $1;
got_ellipsis[argument_level] = MY_TRUE;
add_f_code(F_FLATTEN_XARG);
CURRENT_PROGRAM_SIZE++;
}
; /* e_expr_list2 */
expr_list3:
/* empty */
{ $$ = 0; }
| expr0
{
$$ = 1;
if (!got_ellipsis[argument_level])
add_arg_type($1.type);
else
add_arg_type(Type_Any);
}
| expr0 L_ELLIPSIS
{
PREPARE_INSERT(2);
$$ = 0;
got_ellipsis[argument_level] = MY_TRUE;
add_f_code(F_FLATTEN_XARG);
CURRENT_PROGRAM_SIZE++;
}
| e_expr_list2 ',' expr0
{
$$ = $1 + 1;
if (!got_ellipsis[argument_level])
add_arg_type($3.type);
else
add_arg_type(Type_Any);
}
| e_expr_list2 ',' expr0 L_ELLIPSIS
{
PREPARE_INSERT(2);
$$ = $1;
got_ellipsis[argument_level] = MY_TRUE;
add_f_code(F_FLATTEN_XARG);
CURRENT_PROGRAM_SIZE++;
}
; /* expr_list3 */
m_expr_list:
/* empty */ { $$[0] = 0; $$[1]= 1; }
| m_expr_list2 /* { $$ = $1; } */
| m_expr_list2 ',' /* { $$ = $1; } Allow a terminating comma */
| expr_list2 { $$[0] = $1; $$[1] = 0; }
| expr_list2 ',' { $$[0] = $1; $$[1] = 0; }
; /* m_expr_list */
m_expr_list2:
expr0 m_expr_values
{
$$[0] = 1 + $2;
$$[1] = $2;
add_arg_type($1.type); /* order doesn't matter */
}
| m_expr_list2 ',' expr0 m_expr_values
{
if ($1[1] != $4) {
yyerror("Inconsistent number of values in mapping literal");
}
$$[0] = $1[0] + 1 + $4;
$$[1] = $1[1];
add_arg_type($3.type);
}
; /* m_expr_list2 */
m_expr_values:
':' expr0 { $$ = 1; add_arg_type($2.type); }
| m_expr_values ';' expr0 { $$ = $1 + 1; add_arg_type($3.type); }
; /* m_expr_values */
%ifdef USE_STRUCTS
/* Rule used to parse a static or dynamic member name in lookups */
struct_member_name:
identifier
{ $$ = $1; }
| L_STRING L_STRING
{ fatal("presence of rule should prevent its reduction"); }
| L_STRING
{
$$ = last_lex_string; /* Adopt the reference */
last_lex_string = NULL;
}
| '(' expr0 ')'
{
$$ = NULL;
if ($2.type.typeflags != TYPE_STRING
&& (pragma_strict_types != PRAGMA_WEAK_TYPES
|| $2.type.typeflags != TYPE_UNKNOWN)
&& $2.type.typeflags != TYPE_ANY
&& $2.type.typeflags != TYPE_NUMBER
)
type_error("Illegal type for struct member name", $2.type);
}
; /* struct_member_name */
/* The following rules are used to parse struct literals in expressions */
opt_struct_init:
/* empty */ { $$.length = 0; $$.list = $$.last = NULL; }
| opt_struct_init2 possible_comma { $$ = $1; }
| opt_struct_init2 ',' error
{
/* Allow the parser to resynchronize */
$$.length = 0; $$.list = $$.last = NULL;
}
; /* opt_struct_init */
possible_comma :
/* empty */
| ','
; /* possible_comma */
opt_struct_init2:
/* empty */
{
/* The end of a struct_init (or a list with just one
* element) - this is the first rule reduced.
*/
$<struct_init_list>$.list = NULL;
$<struct_init_list>$.last = NULL;
$<struct_init_list>$.length = 0;
}
struct_init
{
struct_init_t * p;
p = xalloc(sizeof(*p));
p->next = NULL;
p->name = $2.name;
p->type = $2.type;
$$.length = 1;
$$.list = p;
$$.last = p;
}
| opt_struct_init2 ',' struct_init
{
struct_init_t * p;
p = xalloc(sizeof(*p));
p->next = NULL;
p->name = $3.name;
p->type = $3.type;
$$.length = $1.length + 1;
$$.list = $1.list;
$1.last->next = p;
$$.last = p;
}
; /* opt_struct_init2 */
struct_init:
identifier ':' expr0
{
$$.name = $1;
assign_full_to_vartype(&$$.type, $3.type);
}
| expr0
{
$$.name = NULL;
assign_full_to_vartype(&$$.type, $1.type);
}
; /* struct_init */
%endif /* USE_STRUCTS */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Function calls and inline functions.
*/
function_call:
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
function_name
{
%line
/* The generic function call by name.
*
* It may be an ordinary intra-object function call.
* But, if the function is not defined, then it might be a call
* to a simul_efun. If it is, then we make it a simul_efun or
* even call_other(), of which the latter requires the function
* name as argument.
* It might even be a real efun.
*/
ident_t *real_name;
/* Save the (simple) state */
$<function_call_head>$.start = CURRENT_PROGRAM_SIZE;
$<function_call_head>$.simul_efun = -1;
/* Insert the save_arg_frame instruction.
* If it's not really needed, we'll remove it later.
*/
{
PREPARE_INSERT(2)
add_f_code(F_SAVE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
if (argument_level+1 == sizeof(got_ellipsis)/sizeof(got_ellipsis[0]))
{
yyerror("Functions nested too deeply.");
YYACCEPT;
}
argument_level++;
got_ellipsis[argument_level] = MY_FALSE;
real_name = $1.real;
/* we rely on the fact that $1.real->type is either
* I_TYPE_UNKNOWN or I_TYPE_GLOBAL here. All others are filtered
* by the lexical analysis.
*/
if (real_name->type == I_TYPE_UNKNOWN)
{
/* prevent freeing by exotic name clashes */
/* also makes life easier below */
init_global_identifier(real_name, /* bVariable: */ MY_TRUE);
real_name->next_all = all_globals;
all_globals = real_name;
}
else if (!$1.super
&& real_name->u.global.function < 0
&& real_name->u.global.sim_efun >= 0
&& !disable_sefuns)
{
/* It's a real simul-efun */
$<function_call_head>$.simul_efun = real_name->u.global.sim_efun;
/* real_name->u.global.sim_efun is >=0 (see above), so it can
* be casted to unsigned long before comparison (SEFUN_TABLE_SIZE
* is unsigned long) */
if ((unsigned long)real_name->u.global.sim_efun >= SEFUN_TABLE_SIZE)
{
/* The simul-efun has to be called by name:
* prepare the extra args for the call_other
*/
PREPARE_INSERT(8)
string_t *p;
p = ref_mstring(real_name->name);
add_f_code(F_STRING);
add_short(store_prog_string(
ref_mstring(query_simul_efun_file_name())));
add_f_code(F_STRING);
add_short(store_prog_string(p));
CURRENT_PROGRAM_SIZE += 6;
}
}
}
'(' expr_list3 ')'
{
/* We got the arguments. Now we have to generate the
* proper instructions to call the function.
*/
%line
int f = 0; /* Function index */
Bool efun_override; /* TRUE on explicite efun calls */
int simul_efun;
vartype_t *arg_types = NULL; /* Argtypes from the program */
int first_arg; /* Startindex in arg_types[] */
Bool ap_needed; /* TRUE if arg frame is needed */
Bool has_ellipsis; /* TRUE if '...' was used */
has_ellipsis = got_ellipsis[argument_level];
ap_needed = MY_FALSE;
efun_override = ($1.super && strcmp($1.super, get_txt(STR_EFUN)) == 0);
$$.start = $<function_call_head>2.start;
$$.code = -1;
if ( $4 >= 0xff )
/* since num_arg is encoded in just one byte, and 0xff
* is taken for SIMUL_EFUN_VARARG */
yyerrorf("Too many arguments to function");
do {
/* The function processing is in a big do...while(0)
* block so we can exit out of it prematurely and
* still get the required arg-frame handling
* afterwards
*/
if ( !disable_sefuns
&& (simul_efun = $<function_call_head>2.simul_efun) >= 0)
{
/* SIMUL EFUN */
PREPARE_INSERT(6)
function_t *funp;
funp = &simul_efunp[simul_efun];
if (funp->num_arg != SIMUL_EFUN_VARARGS
&& !(funp->flags & TYPE_MOD_XVARARGS))
{
if ($4 > funp->num_arg)
yyerrorf("Too many arguments to simul_efun %s"
, get_txt(funp->name));
if ($4 < funp->num_arg && !has_ellipsis)
{
if (pragma_pedantic)
yyerrorf("Missing arguments to simul_efun %s"
, get_txt(funp->name));
else
{
yywarnf("Missing arguments to simul_efun %s"
, get_txt(funp->name));
ap_needed = MY_TRUE;
}
}
}
if (funp->num_arg == SIMUL_EFUN_VARARGS
|| (funp->flags & TYPE_MOD_XVARARGS)
|| has_ellipsis)
ap_needed = MY_TRUE;
/* simul_efun is >= 0, see above) */
if ((unsigned long)simul_efun >= SEFUN_TABLE_SIZE)
{
/* call-other: the number of arguments will be
* corrected at runtime.
*/
add_f_code(F_CALL_DIRECT);
CURRENT_PROGRAM_SIZE++;
ap_needed = MY_TRUE;
}
else
{
/* Direct call */
if (ap_needed)
{
add_f_code(F_USE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
add_f_code(F_SIMUL_EFUN);
add_short(simul_efun);
CURRENT_PROGRAM_SIZE += 3;
}
$$.type = funp->type;
$$.type.typeflags &= TYPE_MOD_MASK;
} /* if (simul-efun) */
else if ($1.super ? !efun_override
: (f = defined_function($1.real)) >= 0
)
{
/* LFUN or INHERITED LFUN */
PREPARE_INSERT(6)
function_t *funp;
function_t inherited_function;
ap_needed = MY_TRUE;
if ($1.super)
{
/* Inherited lfun: check its existance and call it */
program_t *super_prog;
int ix;
ix = insert_inherited( $1.super, $1.real->name
, &super_prog, &inherited_function
, $4, (bytecode_p)__PREPARE_INSERT__p
);
if (ix < 0)
{
switch(ix) {
case INHERITED_NOT_FOUND:
yyerror("function not defined by inheritance as specified");
break;
case INHERITED_WILDCARDED_ARGS:
yyerror("wildcarded call to inherited function can't pass arguments");
break;
case INHERITED_WILDCARDED_NOT_FOUND:
ap_needed = MY_FALSE;
/* Not an error, but we can't do argument
* checks either.
*/
break;
default:
fatal("Unknown return code %d from insert_inherited()\n", ix);
break;
}
$$.type = Type_Any;
break; /* Out of do..while(0) */
}
/* Find the argument types */
if (super_prog
&& NULL != (arg_types = super_prog->argument_types))
{
first_arg = super_prog->type_start[ix];
}
else
{
first_arg = INDEX_START_NONE;
}
funp = &inherited_function;
}
else
{
/* Normal lfun in this program */
ap_needed = MY_TRUE;
add_f_code(F_CALL_FUNCTION);
add_short(f);
funp = FUNCTION(f);
arg_types = (vartype_t *)mem_block[A_ARGUMENT_TYPES].block;
first_arg = ARGUMENT_INDEX(f);
CURRENT_PROGRAM_SIZE += 3;
}
/* Verify that the function has been defined already.
* For inherited functions this is a no-brainer.
*/
if (funp->flags & (NAME_UNDEFINED|NAME_HIDDEN))
{
if ( !(funp->flags & (NAME_PROTOTYPE|NAME_INHERITED))
&& exact_types.typeflags )
{
yyerrorf("Function %.50s undefined", get_txt(funp->name));
}
else if ((funp->flags
& (NAME_UNDEFINED|NAME_PROTOTYPE|NAME_HIDDEN))
== NAME_HIDDEN)
{
yyerrorf("Function %.50s is private", get_txt(funp->name));
}
}
$$.type = funp->type; /* Result type */
$$.type.typeflags &= TYPE_MOD_MASK;
/* Check number of arguments.
*/
if (funp->num_arg != $4
&& !(funp->flags & TYPE_MOD_VARARGS)
&& (first_arg != INDEX_START_NONE)
&& exact_types.typeflags
&& !has_ellipsis)
{
if (funp->num_arg-1 > $4 || !(funp->flags & TYPE_MOD_XVARARGS))
yyerrorf("Wrong number of arguments to %.60s: "
"expected %ld, got %ld"
, get_txt($1.real->name)
, (long)funp->num_arg, (long)$4);
}
/* Check the argument types.
*/
if (exact_types.typeflags && first_arg != INDEX_START_NONE)
{
int i;
vartype_t *argp;
int num_arg, anum_arg;
if ( 0 != (num_arg = funp->num_arg) )
{
/* There are arguments to check */
int argno; /* Argument number for error message */
if (funp->flags & TYPE_MOD_XVARARGS)
num_arg--; /* last argument is checked separately */
if (num_arg > (anum_arg = $4) )
num_arg = anum_arg;
arg_types += first_arg;
argp = get_argument_types_start(anum_arg);
for (argno = 1, i = num_arg; --i >= 0; argno++)
{
fulltype_t tmp1, tmp2;
assign_var_to_fulltype(&tmp1, *argp);
tmp1.typeflags &= TYPE_MOD_RMASK;
assign_var_to_fulltype(&tmp2, *arg_types);
tmp2.typeflags &= TYPE_MOD_MASK;
argp++;
arg_types++;
if (!REDEFINED_TYPE(tmp1, tmp2))
{
yyerrorf("Bad type for argument %d of %s %s",
argno,
get_txt(funp->name),
get_two_types(tmp2, tmp1));
}
} /* for (all args) */
if (funp->flags & TYPE_MOD_XVARARGS)
{
fulltype_t tmp1, tmp2;
/* varargs argument is either a pointer type or mixed */
assign_var_to_fulltype(&tmp2, *arg_types);
tmp2.typeflags &= TYPE_MOD_MASK;
tmp2.typeflags &= ~TYPE_MOD_POINTER;
for (i = anum_arg - num_arg; --i >=0; )
{
assign_var_to_fulltype(&tmp1, *argp);
tmp1.typeflags &= TYPE_MOD_RMASK;
argp++;
if (!MASKED_TYPE(tmp1,tmp2))
{
yyerrorf("Bad type for argument %d of %s %s",
anum_arg - i,
get_txt(funp->name),
get_two_types(tmp2, tmp1));
}
}
} /* if (xvarargs) */
} /* if (has args) */
} /* if (check types) */
} /* if (inherited lfun) */
else if ( (f = lookup_predef($1.real)) != -1 )
{
/* EFUN */
PREPARE_INSERT(8)
fulltype_t *argp;
int min, max, def, num_arg;
int f2;
/* Get the information from the efun table */
min = instrs[f].min_arg;
max = instrs[f].max_arg;
def = instrs[f].Default;
$$.type = instrs[f].ret_type;
argp = &efun_arg_types[instrs[f].arg_index];
/* Warn if the efun is deprecated */
if (pragma_warn_deprecated && instrs[f].deprecated != NULL)
yywarnf("%s() is deprecated: %s"
, instrs[f].name, instrs[f].deprecated);
num_arg = $4;
/* Check and/or complete number of arguments */
if (def && num_arg == min-1 && !has_ellipsis)
{
/* Default argument */
add_f_code(def);
CURRENT_PROGRAM_SIZE++;
max--;
min--;
}
else if (num_arg < min
&& !has_ellipsis
&& ( (f2 = proxy_efun(f, num_arg)) < 0
|| (f = f2, MY_FALSE) )
)
{
/* Not enough args, and no proxy_efun to replace this */
yyerrorf("Too few arguments to %s", instrs[f].name);
}
else if (num_arg > max && max != -1)
{
yyerrorf("Too many arguments to %s", instrs[f].name);
pop_arg_stack (num_arg - max);
$4 -= num_arg - max; /* Don't forget this for the final pop */
num_arg = max;
}
/* Check the types of the arguments
*/
if (max != -1 && exact_types.typeflags && num_arg)
{
int argn;
vartype_t *aargp;
aargp = get_argument_types_start(num_arg);
/* Loop over all arguments and compare each given
* type against all allowed types in efun_arg_types()
*/
for (argn = 0; argn < num_arg; argn++)
{
fulltype_t tmp1, tmp2;
fulltype_t *beginArgp = argp;
assign_var_to_fulltype(&tmp1, *aargp); aargp++;
tmp1.typeflags &= TYPE_MOD_MASK;
for (;;)
{
tmp2 = *argp;
argp++;
if ( !tmp2.typeflags )
{
/* Possible types for this arg exhausted */
efun_argument_error(argn+1, f, beginArgp
, tmp1);
break;
}
/* break if types are compatible; take care to
* handle references correctly
*/
if (equal_types(tmp1, tmp2)
#ifdef USE_STRUCTS
|| (IS_TYPE_STRUCT(tmp1) && IS_TYPE_STRUCT(tmp2))
#endif
)
break;
if ((tmp1.typeflags &
~(TYPE_MOD_POINTER|TYPE_MOD_REFERENCE)) ==
TYPE_ANY)
{
if (tmp1.typeflags & TYPE_MOD_POINTER & ~tmp2.typeflags)
{
if ((tmp2.typeflags & ~TYPE_MOD_REFERENCE) !=
TYPE_ANY)
{
continue;
}
}
if ( !( (tmp1.typeflags ^ tmp2.typeflags) & TYPE_MOD_REFERENCE) )
break;
}
else if ((tmp2.typeflags &
~(TYPE_MOD_POINTER|TYPE_MOD_REFERENCE)) ==
TYPE_ANY)
{
if (tmp2.typeflags & TYPE_MOD_POINTER & ~tmp1.typeflags)
continue;
if ( !( (tmp1.typeflags ^ tmp2.typeflags) & TYPE_MOD_REFERENCE) )
break;
}
} /* end for (efun_arg_types) */
/* Advance argp to point to the allowed argtypes
* of the next arg.
*/
while((argp++)->typeflags) NOOP;
} /* for (all args) */
} /* if (check arguments) */
/* If the function takes a variable number of arguments
* the ap is needed and evaluated automatically.
* If the function takes a fixed number of arguments, but
* the ellipsis has been used, the ap is needed but not
* evaluated automatically.
*/
if (max != min)
{
ap_needed = MY_TRUE;
}
else if (has_ellipsis)
{
ap_needed = MY_TRUE;
add_byte(F_USE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
/* Alias for an efun? */
if (f > LAST_INSTRUCTION_CODE)
f = efun_aliases[f-LAST_INSTRUCTION_CODE-1];
if (instrs[f].prefix)
{
/* This efun needs a prefix byte */
add_byte(instrs[f].prefix);
CURRENT_PROGRAM_SIZE++;
}
add_byte(instrs[f].opcode);
CURRENT_PROGRAM_SIZE++;
/* If the efun doesn't return a value, fake a 0.
* This is especially important is ap_needed, as the
* restore_arg_frame expects a result on the stack.
*/
if ( instrs[f].ret_type.typeflags == TYPE_VOID )
{
last_expression = mem_block[A_PROGRAM].current_size;
add_f_code(F_CONST0);
CURRENT_PROGRAM_SIZE++;
}
} /* efun */
else if (efun_override)
{
yyerrorf("Unknown efun: %s", get_txt($1.real->name));
$$.type = Type_Any;
}
else
{
/* There is no such function, but maybe it's defined later,
* maybe it's resolved through (cross-)inheritance.
* epilog() will take care of it.
*/
PREPARE_INSERT(4)
function_t *funp;
f = define_new_function(MY_FALSE,
$1.real, 0, 0, 0, NAME_UNDEFINED, Type_Unknown
);
ap_needed = MY_TRUE;
add_f_code(F_CALL_FUNCTION);
add_short(f);
CURRENT_PROGRAM_SIZE += 3;
funp = FUNCTION(f);
if (exact_types.typeflags)
{
yyerrorf("Undefined function '%.50s'", get_txt($1.real->name));
}
else if (pragma_pedantic)
{
yywarnf("Undefined function '%.50s'", get_txt($1.real->name));
}
$$.type = Type_Any; /* Just a guess */
}
} while (0); /* Function handling */
/* Do the post processing of the arg frame handling */
if (ap_needed)
{
/* Restore the previous arg frame pointer */
PREPARE_INSERT(2)
add_f_code(F_RESTORE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
else if (!ap_needed)
{
/* Since the arg frame is not needed, remove the
* earlier save_arg_frame instruction.
*/
bytecode_p src, dest;
size_t left;
dest = PROGRAM_BLOCK + $<function_call_head>2.start;
src = dest+1;
left = CURRENT_PROGRAM_SIZE - $<function_call_head>2.start - 1;
while (left-- > 0)
{
*dest++ = *src++;
}
CURRENT_PROGRAM_SIZE--;
last_expression--;
}
argument_level--;
if ($1.super)
yfree($1.super);
pop_arg_stack($4); /* Argument types no longer needed */
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| expr4 L_ARROW call_other_name %prec L_ARROW
{
%line
int string_number;
string_t *name;
/* Save the (simple) state */
$<function_call_head>$.start = CURRENT_PROGRAM_SIZE;
/* Insert the save_arg_frame instruction.
* If it's not really needed, we'll remove it later.
* Putting this code block before the <expr4> in the rule
* however yields a faulty grammar.
*/
{
char *p, *q;
p_int left;
if (!realloc_a_program(1))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + 2);
YYACCEPT;
}
/* Move the generated code forward by 1 */
p = mem_block[A_PROGRAM].block + CURRENT_PROGRAM_SIZE - 1;
q = p + 1;
for (left = CURRENT_PROGRAM_SIZE - $1.start
; left > 0
; left--, p--, q--)
*q = *p;
/* p now points to program[$1.start]-1.
* Store the instruction there.
*/
p[1] = F_SAVE_ARG_FRAME;
CURRENT_PROGRAM_SIZE += 1;
}
if (argument_level+1 == sizeof(got_ellipsis)/sizeof(got_ellipsis[0]))
{
yyerror("Functions nested too deeply.");
YYACCEPT;
}
argument_level++;
got_ellipsis[argument_level] = MY_FALSE;
/* If call_other() has been replaced by a sefun, and
* if we need to use F_CALL_DIRECT to call it, we have
* to insert additional code before the <expr4> already parsed.
* Putting this code block before the <expr4> in the rule
* however yields a faulty grammar.
*/
if (!disable_sefuns
&& call_other_sefun >= 0
&& (unsigned long)call_other_sefun >= SEFUN_TABLE_SIZE)
{
/* The simul-efun has to be called by name:
* insert the extra args for the call_other
*/
char *p, *q;
p_int left;
if (!realloc_a_program(6))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + 2);
YYACCEPT;
}
/* Move the generated code forward by 6 */
p = mem_block[A_PROGRAM].block + CURRENT_PROGRAM_SIZE - 1;
q = p + 6;
for (left = CURRENT_PROGRAM_SIZE - $1.start
; left > 0
; left--, p--, q--)
*q = *p;
/* p now points to program[$1.start]-1.
* Store the first two call-other args there.
*/
p[1] = F_STRING;
upd_short($1.start+1, store_prog_string(
ref_mstring(query_simul_efun_file_name())));
p[4] = F_STRING;
upd_short($1.start+4, store_prog_string(ref_mstring(STR_CALL_OTHER)));
CURRENT_PROGRAM_SIZE += 6;
}
%line
/* If we received a string as call_other_name, it's a constant call.
*/
name = $3;
if (name)
{
/* Push the function name (the expr4 is already on the stack)
*/
string_number = store_prog_string(name);
if (string_number <= 0x0ff )
{
ins_f_code(F_CSTRING0);
ins_byte(string_number);
}
else if ( string_number <= 0x1ff )
{
ins_f_code(F_CSTRING1);
ins_byte(string_number);
}
else if ( string_number <= 0x2ff )
{
ins_f_code(F_CSTRING2);
ins_byte(string_number);
}
else if ( string_number <= 0x3ff )
{
ins_f_code(F_CSTRING3);
ins_byte(string_number);
}
else
{
ins_f_code(F_STRING);
ins_short(string_number);
}
} /* if (name) */
/* otherwise the name was given by an expression for which
* the code and value have been already generated.
*/
}
'(' expr_list3 ')'
{
/* Now generate the CALL_OTHER resp. the SIMUL_EFUN instruction. */
PREPARE_INSERT(10)
Bool has_ellipsis;
Bool ap_needed;
has_ellipsis = got_ellipsis[argument_level];
ap_needed = MY_TRUE;
if (!disable_sefuns && call_other_sefun >= 0)
{
/* SIMUL EFUN */
function_t *funp;
int num_arg;
num_arg = $6 + 2; /* Don't forget the obj and the fun! */
funp = &simul_efunp[call_other_sefun];
if (num_arg > funp->num_arg
&& !(funp->flags & TYPE_MOD_XVARARGS)
&& !has_ellipsis)
yyerrorf("Too many arguments to simul_efun %s"
, get_txt(funp->name));
/* call_other_sefun is >= 0 (see above) */
if ((unsigned long)call_other_sefun >= SEFUN_TABLE_SIZE)
{
/* call-other: the number of arguments will be
* detected and corrected at runtime.
*/
add_f_code(F_CALL_DIRECT);
CURRENT_PROGRAM_SIZE++;
}
else
{
/* Direct call */
if (funp->num_arg != SIMUL_EFUN_VARARGS
&& !(funp->flags & TYPE_MOD_XVARARGS)
&& !has_ellipsis)
{
int i;
i = funp->num_arg - num_arg;
if (funp->flags & TYPE_MOD_XVARARGS)
i--; /* Last argument may be omitted */
if (i > 4)
{
if (!realloc_a_program(i+2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, mem_block[A_PROGRAM].current_size + i+2);
YYACCEPT;
}
__PREPARE_INSERT__p = PROGRAM_BLOCK
+ CURRENT_PROGRAM_SIZE;
}
CURRENT_PROGRAM_SIZE += i;
while ( --i >= 0 )
{
add_f_code(F_CONST0);
}
}
if (funp->num_arg != SIMUL_EFUN_VARARGS
&& !(funp->flags & TYPE_MOD_XVARARGS)
&& !has_ellipsis)
ap_needed = MY_FALSE;
if (ap_needed)
{
add_f_code(F_USE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
add_f_code(F_SIMUL_EFUN);
add_short(call_other_sefun);
CURRENT_PROGRAM_SIZE += 3;
}
$$.type = funp->type;
$$.type.typeflags &= TYPE_MOD_MASK;
}
else /* true call_other */
{
add_f_code(F_CALL_OTHER);
CURRENT_PROGRAM_SIZE++;
$$.type = instrs[F_CALL_OTHER].ret_type;
}
$$.code = -1;
$$.start = $1.start;
pop_arg_stack($6);
/* No good need of these arguments because we don't
* know what we are going to call.
*/
/* Do the post processing of the arg frame handling */
if (ap_needed)
{
/* Restore the previous arg frame pointer */
add_f_code(F_RESTORE_ARG_FRAME);
CURRENT_PROGRAM_SIZE++;
}
else
{
/* Since the arg frame is not needed, remove the
* earlier save_arg_frame instruction.
*/
bytecode_p src, dest;
size_t left;
dest = PROGRAM_BLOCK + $<function_call_head>4.start;
src = dest+1;
left = CURRENT_PROGRAM_SIZE - $<function_call_head>4.start - 1;
while (left-- > 0)
{
*dest++ = *src++;
}
CURRENT_PROGRAM_SIZE--;
}
argument_level--;
}
; /* function_call */
call_other_name:
identifier
{ $$ = $1; }
| L_STRING L_STRING
{ fatal("presence of rule should prevent its reduction"); }
| L_STRING
{
$$ = last_lex_string; /* Adopt the reference */
last_lex_string = NULL;
}
| '(' expr0 ')'
{
$$ = NULL;
if ($2.type.typeflags != TYPE_STRING
&& (pragma_strict_types != PRAGMA_WEAK_TYPES
|| $2.type.typeflags != TYPE_UNKNOWN)
&& $2.type.typeflags != TYPE_ANY)
type_error("Illegal type for lfun name", $2.type);
}
; /* call_other_name */
function_name:
L_IDENTIFIER
{
$$.super = NULL;
$$.real = $1;
}
| L_LOCAL
{
ident_t *lvar = $1;
ident_t *fun = find_shared_identifier(get_txt(lvar->name), I_TYPE_UNKNOWN, 0);
/* Search the inferior list for this identifier for a global
* (function) definition.
*/
while (fun && fun->type > I_TYPE_GLOBAL)
fun = fun->inferior;
if (!fun || fun->type != I_TYPE_GLOBAL)
{
yyerrorf("Undefined function '%.50s'\n", get_txt(lvar->name));
YYACCEPT;
}
$$.super = NULL;
$$.real = fun;
}
| L_COLON_COLON L_IDENTIFIER
{
*($$.super = yalloc(1)) = '\0';
$$.real = $2;
}
| L_COLON_COLON L_LOCAL
{
ident_t *lvar = $2;
*($$.super = yalloc(1)) = '\0';
$$.real = lvar;
}
| anchestor L_COLON_COLON L_IDENTIFIER
{
%line
/* Attempt to call an efun directly even though there
* is a nomask simul-efun for it?
*/
if ( !strcmp($1, "efun")
&& $3->type == I_TYPE_GLOBAL
&& $3->u.global.sim_efun >= 0
&& simul_efunp[$3->u.global.sim_efun].flags & TYPE_MOD_NO_MASK
&& master_ob
&& (!EVALUATION_TOO_LONG())
)
{
/* Yup, check it with a privilege violation.
* If it's denied, ignore the "efun::" qualifier.
*/
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, $3->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($3->name));
yfree($1);
$$.super = NULL;
}
else if (!res->u.number)
{
yfree($1);
$$.super = NULL;
}
else
{
$$.super = $1;
}
}
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($3->name));
yfree($1);
$$.super = NULL;
}
else /* the qualifier is ok */
$$.super = $1;
$$.real = $3; /* and don't forget the function ident */
}
| anchestor L_COLON_COLON L_LOCAL
{
%line
ident_t *lvar = $3;
/* Attempt to call an efun directly even though there
* is a nomask simul-efun for it?
*/
if ( !strcmp($1, "efun")
&& lvar->type == I_TYPE_GLOBAL
&& lvar->u.global.sim_efun >= 0
&& simul_efunp[lvar->u.global.sim_efun].flags & TYPE_MOD_NO_MASK
&& master_ob
&& (!EVALUATION_TOO_LONG())
)
{
/* Yup, check it with a privilege violation.
* If it's denied, ignore the "efun::" qualifier.
*/
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, lvar->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(lvar->name));
yfree($1);
$$.super = NULL;
}
else if (!res->u.number)
{
yfree($1);
$$.super = NULL;
}
else
{
$$.super = $1;
}
}
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(lvar->name));
yfree($1);
$$.super = NULL;
}
else /* the qualifier is ok */
$$.super = $1;
$$.real = lvar; /* and don't forget the function ident */
}
; /* function_name */
anchestor:
L_IDENTIFIER
{
$$ = ystring_copy(get_txt($1->name));
}
| L_STRING L_STRING
{ fatal("presence of rule should prevent its reduction"); }
| L_STRING
{
$$ = ystring_copy(get_txt(last_lex_string));
free_mstring(last_lex_string);
last_lex_string = NULL;
}
; /* anchestor */
%ifndef USE_NEW_INLINES
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The inline function expression.
*
* This expression synthesizes a prototype for the inline function
* and yields a closure-lrvalue suitable for expr4.
* The function definition will be provided by the lexer at the next
* opportunity.
*/
inline_fun:
L_INLINE_FUN
{
/* Synthesize the prototype of the inline function
* Since we have to declare the function arguments for that,
* first save the existing locals.
*/
ident_t * save_all_locals;
int save_current_number_of_locals;
int save_max_number_of_locals;
fulltype_t save_tol[10];
fulltype_t save_ftol[10];
char name[3];
int num, i;
fulltype_t ftype;
/* Save the old locals information */
save_all_locals = all_locals;
save_current_number_of_locals = current_number_of_locals;
save_max_number_of_locals = max_number_of_locals;
/* Simulate 'no locals' */
all_locals = NULL;
current_number_of_locals = 0;
max_number_of_locals = 0;
use_local_scopes = MY_TRUE;
enter_block_scope();
/* Declare the 9 parameters (saving the types of the old ones) */
name[0] = '$'; name[2] = '\0';
for (i = 0; i < 9; i++)
{
save_tol[i] = type_of_locals[i];
save_ftol[i] = type_of_locals[i];
name[1] = (char)('1' + i);
add_local_name(make_shared_identifier( name, I_TYPE_UNKNOWN
, block_depth)
, Type_Any, block_depth, MY_TRUE);
}
/* Declare the function */
ftype = Type_Unknown;
ftype.typeflags |= TYPE_MOD_VARARGS | TYPE_MOD_PRIVATE;
num = define_new_function(MY_FALSE, /* id */ $1, 9, 0, 0
, NAME_UNDEFINED|NAME_PROTOTYPE
, ftype
);
/* Restore the old locals information */
leave_block_scope(MY_TRUE);
use_local_scopes = pragma_use_local_scopes;
all_locals = save_all_locals;
current_number_of_locals = save_current_number_of_locals;
max_number_of_locals = save_max_number_of_locals;
for (i = 0; i < 9; i++)
{
type_of_locals[i] = save_ftol[i];
}
/* Insert the call to the lfun closure */
$$.start = CURRENT_PROGRAM_SIZE;
$$.code = -1;
ins_f_code(F_CLOSURE);
ins_short(num);
ins_short(0);
$$.type = Type_Closure;
}
; /* inline_fun */
%endif /* USE_NEW_INLINES */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* The catch()-statement
*/
catch:
L_CATCH
{
ins_f_code(F_SAVE_ARG_FRAME);
$<address>$ = CURRENT_PROGRAM_SIZE;
ins_f_code(F_CATCH);
ins_byte(0); /* Placeholder for flags */
ins_byte(0); /* Placeholder for the jump offset */
}
'(' comma_expr note_start opt_catch_mods ')'
{
%line
p_int origstart, start, modstart, offset;
p_int flags = $6;
/* Get the address of the CATCH instruction
* and of the modifications
*/
origstart = start = $<address>2;
modstart = $5.start;
/* If there were code creating modifiers, move their code
* before the F_CATCH (currently only 'reserve' does that).
* We need to do this before we add the END_CATCH.
*/
if (flags & CATCH_FLAG_RESERVE)
{
shuffle_code(start, modstart, CURRENT_PROGRAM_SIZE);
start += CURRENT_PROGRAM_SIZE - modstart;
}
ins_f_code(F_END_CATCH);
/* Modify the instruction if necessary */
if (flags)
{
bytecode_p p;
p = PROGRAM_BLOCK + start + 1;
*p = flags & 0xff;
}
/* Update the offset field of the CATCH instruction */
offset = CURRENT_PROGRAM_SIZE - (start + 3);
if (offset >= 0x100)
{
/* Too big offset, change
*
* CATCH l
* <expr>
* l: END_CATCH
*
* to
*
* CATCH l0
* BRANCH l1
* l0: LBRANCH l2
* l1: <expr>
* l2: END_CATCH
*/
int i;
bytecode_p p;
if (!realloc_a_program(5))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, CURRENT_PROGRAM_SIZE + 5);
YYACCEPT;
}
CURRENT_PROGRAM_SIZE += 5;
p = PROGRAM_BLOCK + CURRENT_PROGRAM_SIZE - 1;
for( i = offset; --i >= 0; --p ) *p = p[-5];
p[-5] = 2;
p[-4] = F_BRANCH ;
p[-3] = 3;
p[-2] = F_LBRANCH;
upd_short(start + 6, offset+2);
if (offset > 0x7ffd)
yyerror("offset overflow");
}
else
{
mem_block[A_PROGRAM].block[start+2] = offset;
}
/* Restore the argument frame */
ins_f_code(F_RESTORE_ARG_FRAME);
$$.start = origstart;
$$.type = Type_Any;
$$.code = -1;
}
; /* catch */
opt_catch_mods :
';' opt_catch_mod_list
{
$$ = $2;
}
| /* empty */
{
$$ = 0;
}
; /* opt_catch_mods */
opt_catch_mod_list :
opt_catch_mod_list ',' opt_catch_modifier
{
if ($1 & $3 & CATCH_FLAG_RESERVE)
{
/* On multiple 'reserve's, use only the first one */
yywarnf("Multiple 'reserve' modifiers in catch()");
insert_pop_value();
}
$$ = $1 | $3;
}
| opt_catch_modifier
{
$$ = $1;
}
; /* opt_catch_mod_list */
opt_catch_modifier :
identifier
{
$$ = 0;
if (mstreq($1, STR_NOLOG))
$$ = CATCH_FLAG_NOLOG;
else if (mstreq($1, STR_PUBLISH))
$$ = CATCH_FLAG_PUBLISH;
else if (mstreq($1, STR_RESERVE))
yyerrorf("Bad 'reserve' modifier in catch(): missing expression");
else
yyerrorf("Illegal modifier '%s' in catch() - "
"expected 'nolog', 'publish' or 'reserve <expr>'"
, get_txt($1)
);
free_mstring($1);
}
| identifier expr0
{
$$ = 0;
if (mstreq($1, STR_NOLOG)
|| mstreq($1, STR_PUBLISH)
)
{
yyerrorf("Bad modifier '%s' in catch(): no expression allowed"
, get_txt($1)
);
}
else if (mstreq($1, STR_RESERVE))
{
if ($2.type.typeflags != TYPE_NUMBER
&& $2.type.typeflags != TYPE_UNKNOWN
&& $2.type.typeflags != TYPE_ANY
)
yyerrorf("Bad 'reserve' expression type to catch(): %s, "
"expected int"
, get_type_name($2.type)
);
$$ = CATCH_FLAG_RESERVE;
}
else
yyerrorf("Illegal modifier '%s' in catch() - "
"expected 'nolog', 'publish' or 'reserve <expr>'"
, get_txt($1)
);
free_mstring($1);
}
; /* opt_catch_modifier */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* sscanf() and parse_command()
*
* Both sscanf() and parse_command() are special in that they take
* unmarked lvalues as arguments. Parsing the lvalue arguments
* is the biggest part of the problem.
*
* TODO: Make a special efun-argument type "lvalue" so that this
* TODO:: problem can be solved generically?
*/
sscanf:
L_SSCANF note_start '(' expr0 ',' expr0 lvalue_list ')'
{
ins_f_code(F_SSCANF);
ins_byte($7 + 2);
$$.start = $2.start;
$$.type = Type_Number;
$$.code = -1;
}
; /* sscanf */
%ifdef USE_PARSE_COMMAND
parse_command:
L_PARSE_COMMAND note_start
'(' expr0 ',' expr0 ',' expr0 lvalue_list ')'
{
ins_f_code(F_PARSE_COMMAND);
ins_byte($9 + 3);
$$.start = $2.start;
$$.type = Type_Number;
$$.code = -1;
}
; /* parse_command */
%endif /* USE_PARSE_COMMAND */
lvalue_list:
/* empty */ { $$ = 0; }
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue_list ',' L_IDENTIFIER
{
/* Push the lvalue for a global variable */
int i;
%line
$$ = 1 + $1;
i = verify_declared($3);
if (i & VIRTUAL_VAR_TAG)
{
ins_f_code(F_PUSH_VIRTUAL_VARIABLE_LVALUE);
ins_byte(i);
}
else
{
if ((i + num_virtual_variables) & ~0xff)
{
ins_f_code(F_PUSH_IDENTIFIER16_LVALUE);
ins_short(i + num_virtual_variables);
}
else
{
ins_f_code(F_PUSH_IDENTIFIER_LVALUE);
ins_byte(i + num_virtual_variables);
}
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue_list ',' L_LOCAL
{
%line
/* Push the lvalue for a local variable */
#ifdef USE_NEW_INLINES
fulltype_t dummy;
$3 = check_for_context_local($3, &dummy);
if ($3->u.local.context >= 0)
{
ins_f_code(F_PUSH_CONTEXT_LVALUE);
ins_byte($3->u.local.context);
}
else
{
ins_f_code(F_PUSH_LOCAL_VARIABLE_LVALUE);
ins_byte($3->u.local.num);
}
$$ = 1 + $1;
#else /* USE_NEW_INLINES */
$$ = 1 + $1;
ins_f_code(F_PUSH_LOCAL_VARIABLE_LVALUE);
ins_byte($3->u.local.num);
#endif /* USE_NEW_INLINES */
}
| lvalue_list ',' expr4 index_expr
{
/* Generate a PROTECTED_(R)INDEX_LVALUE */
%line
$$ = 1 + $1;
if ($4.inst == F_INDEX)
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_LVALUE
);
else if ($4.inst == F_RINDEX)
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_RINDEX_LVALUE
);
else
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_AINDEX_LVALUE
);
if ($4.type1.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
if (exact_types.typeflags)
{
fulltype_t type;
type = $3.type;
type.typeflags &= TYPEID_MASK;
if ( !(type.typeflags & TYPE_MOD_POINTER) )
switch (type.typeflags)
{
case TYPE_MAPPING:
if ($4.inst == F_INDEX)
{
$4.type1 = Type_Any;
break;
}
/* FALLTHROUGH */
default:
type_error("Bad type to indexed lvalue", type);
/* FALLTHROUGH */
case TYPE_ANY:
if ($4.inst == F_INDEX)
$4.type1 = Type_Any;
$4.type1 = Type_Any;
break;
case TYPE_STRING:
break;
}
if (!BASIC_TYPE($4.type1, Type_Number))
type_error("Bad type of index", $4.type1);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue_list ',' expr4 '[' expr0 ',' expr0 ']'
{
%line
/* Generate a PUSH_PROTECTED_INDEXED_MAP_LVALUE */
$$ = 1 + $1;
ins_f_code(F_PUSH_PROTECTED_INDEXED_MAP_LVALUE);
if ($5.type.typeflags & TYPE_MOD_REFERENCE)
yyerror("Reference used as index");
/* Compute and check types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $3.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_MAPPING)
{
type_error("Bad type to indexed value", type);
}
type = $7.type;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue_list ',' expr4 index_range
{
%line
/* Generate/add the PROTECTED range LVALUE */
int prot_op;
switch ($4.inst)
{
case F_RANGE: prot_op = F_PROTECTED_RANGE_LVALUE; break;
case F_NR_RANGE: prot_op = F_PROTECTED_NR_RANGE_LVALUE; break;
case F_RN_RANGE: prot_op = F_PROTECTED_RN_RANGE_LVALUE; break;
case F_RR_RANGE: prot_op = F_PROTECTED_RR_RANGE_LVALUE; break;
case F_NA_RANGE: prot_op = F_PROTECTED_NA_RANGE_LVALUE; break;
case F_AN_RANGE: prot_op = F_PROTECTED_AN_RANGE_LVALUE; break;
case F_RA_RANGE: prot_op = F_PROTECTED_RA_RANGE_LVALUE; break;
case F_AR_RANGE: prot_op = F_PROTECTED_AR_RANGE_LVALUE; break;
case F_AA_RANGE: prot_op = F_PROTECTED_AA_RANGE_LVALUE; break;
case F_NX_RANGE: prot_op = F_PROTECTED_NX_RANGE_LVALUE; break;
case F_RX_RANGE: prot_op = F_PROTECTED_RX_RANGE_LVALUE; break;
case F_AX_RANGE: prot_op = F_PROTECTED_AX_RANGE_LVALUE; break;
default:
errorf("Unsupported range type %d %s\n"
, $4.inst, get_f_name($4.inst));
}
$$ = 1 + $1;
arrange_protected_lvalue($3.start, $3.code, $3.end
, prot_op
);
/* Compute and check types */
if (exact_types.typeflags)
{
fulltype_t type;
type = $3.type;
type.typeflags &= TYPEID_MASK;
if ((type.typeflags & TYPE_MOD_POINTER) == 0
&& type.typeflags != TYPE_ANY && type.typeflags != TYPE_STRING)
{
type_error("Bad type of argument used for range", type);
}
type = $4.type1;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
type = $4.type2;
type.typeflags &= TYPEID_MASK;
if (type.typeflags != TYPE_ANY && type.typeflags != TYPE_NUMBER)
type_error("Bad type of index", type);
}
}
%ifdef USE_STRUCTS
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
| lvalue_list ',' expr4 L_ARROW struct_member_name
{
/* Create a reference to a struct member */
short s_index = -1;
$$ = 1 + $1;
if (!IS_TYPE_ANY($3.type) && !IS_TYPE_STRUCT($3.type))
{
yyerrorf("Bad type for struct lookup: %s"
, get_type_name($3.type));
}
else
{
if (IS_TYPE_STRUCT($3.type))
{
s_index = get_struct_index($3.type.t_struct);
if (s_index == -1)
yyerrorf("Unknown type in lvalue struct dereference: %s\n"
, get_type_name($3.type)
);
}
/* At this point: s_index >= 0: $1 is of type struct
* < 0: $1 is of type mixed
*/
if ($5 != NULL)
{
int num;
if (s_index >= 0)
{
struct_type_t * ptype = $3.type.t_struct;
num = struct_find_member(ptype, $5);
if (num < 0)
{
yyerrorf("No such member '%s' for struct '%s'"
, get_txt($5)
, get_txt(struct_t_name(ptype))
);
}
}
else /* $3 is of type mixed */
{
s_index = find_struct_by_member($5, &num);
}
/* If this is a legal struct lookup, num >= 0 at this point
*/
if (num >= 0)
{
ins_number(num);
ins_number(s_index);
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_S_LVALUE
);
}
}
else /* Runtime lookup */
{
ins_number(s_index);
arrange_protected_lvalue($3.start, $3.code, $3.end,
F_PROTECTED_INDEX_S_LVALUE
);
}
}
if ($5 != NULL)
free_mstring($5);
}
%endif /* USE_STRUCTS */
; /* lvalue_list */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
%%
%line
#ifdef __MWERKS__
# pragma warn_possunwant reset
# pragma warn_implicitconv reset
#endif
/*=========================================================================*/
/*-------------------------------------------------------------------------*/
static void
define_local_variable (ident_t* name, fulltype_t actual_type, typeflags_t opt_star, struct lvalue_s *lv, Bool redeclare, Bool with_init)
/* This is called directly from a parser rule: <type> [*] <name>
* if with_init is true, then an initialization of this variable will follow.
* if redeclare is true, then a local name is redeclared.
* It creates the local variable and returns the corresponding lvalue
* in lv.
*/
{
/* redeclare:
* MY_FALSE: A new local variable
* MY_TRUE: A local name is redeclared. If this happens
* on a deeper level, it is even legal.
*/
block_scope_t *scope = block_scope + block_depth - 1;
ident_t *q;
actual_type.typeflags |= opt_star;
#ifdef USE_NEW_INLINES
if (current_inline && current_inline->parse_context)
{
#ifdef DEBUG_INLINES
printf("DEBUG: context name '%s'\n", get_txt(name->name));
#endif /* DEBUG_INLINES */
if (redeclare && current_inline->block_depth+1 <= name->u.local.depth)
yyerrorf("Illegal to redeclare local name '%s'"
, get_txt(name->name));
q = add_context_name(name, actual_type, -1);
lv->u.simple[0] = F_PUSH_CONTEXT_LVALUE;
lv->u.simple[1] = q->u.local.context;
}
else
{
if(redeclare)
q = redeclare_local(name, actual_type, block_depth);
else
q = add_local_name(name, actual_type, block_depth);
if (use_local_scopes && scope->clobbered)
{
/* finish the previous CLEAR_LOCALS, if any */
if (scope->num_locals - 1 > scope->num_cleared)
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - 1 - scope->num_cleared);
scope->clobbered = MY_FALSE;
scope->num_cleared = scope->num_locals - 1;
}
if (use_local_scopes && scope->num_locals == scope->num_cleared + 1)
{
/* First definition of a local, so insert the
* clear_locals bytecode and remember its position
*/
scope->addr = mem_block[A_PROGRAM].current_size;
ins_f_code(F_CLEAR_LOCALS);
ins_byte(scope->first_local + scope->num_cleared);
ins_byte(0);
}
lv->u.simple[0] = F_PUSH_LOCAL_VARIABLE_LVALUE;
lv->u.simple[1] = q->u.local.num;
}
#else /* USE_NEW_INLINES */
if (redeclare)
q = redeclare_local(name, actual_type, block_depth);
else
q = add_local_name(name, actual_type, block_depth, MY_FALSE);
if (use_local_scopes && scope->clobbered)
{
/* finish the previous CLEAR_LOCALS, if any */
if (scope->num_locals - 1 > scope->num_cleared)
mem_block[A_PROGRAM].block[scope->addr+2]
= (char)(scope->num_locals - 1 - scope->num_cleared);
scope->clobbered = MY_FALSE;
scope->num_cleared = scope->num_locals - 1;
}
if (use_local_scopes && scope->num_locals == scope->num_cleared + 1)
{
/* First definition of a local, so insert the
* clear_locals bytecode and remember its position
*/
scope->addr = mem_block[A_PROGRAM].current_size;
ins_f_code(F_CLEAR_LOCALS);
ins_byte(scope->first_local + scope->num_cleared);
ins_byte(0);
}
lv->u.simple[0] = F_PUSH_LOCAL_VARIABLE_LVALUE;
lv->u.simple[1] = q->u.local.num;
#endif /* USE_NEW_INLINES */
lv->length = 0;
lv->type = actual_type;
if (!with_init)
{
/* If this is a float variable, we need to insert an appropriate
* initializer, as the default svalue-0 is not a valid float value.
*/
Bool need_value = MY_FALSE;
%line
#ifdef USE_NEW_INLINES
/* When parsing context variables, the context_closure instruction
* expects a value on the stack. If we do a float initialization,
* we leave the 0.0 on the stack, otherwise we'll push a 0.
* For normal float locals, we'll create the bytecode to assign
* the float 0.
*/
need_value = current_inline && current_inline->parse_context;
#endif /* USE_NEW_INLINES */
if (!(actual_type.typeflags & TYPE_MOD_POINTER)
&& (actual_type.typeflags & PRIMARY_TYPE_MASK) == TYPE_FLOAT
)
{
ins_f_code(F_FCONST0);
if (!need_value)
{
if (!add_lvalue_code(lv, F_VOID_ASSIGN))
return;
}
need_value = MY_FALSE;
} /* if (float variable) */
if (need_value) /* If we still need a value... */
{
ins_number(0);
}
}
} /* define_local_variable() */
/*-------------------------------------------------------------------------*/
static void
init_local_variable ( ident_t* name, struct lvalue_s *lv, int assign_op
, fulltype_t type2)
/* This is called directly from a parser rule: <type> [*] <name> = <expr>
* It will be called after the call to define_local_variable().
* It assigns the result of <expr> to the variable.
*/
{
/* We got a "<name> = <expr>" type declaration. */
%line
#ifdef USE_NEW_INLINES
#ifdef DEBUG_INLINES
if (current_inline && current_inline->parse_context)
printf("DEBUG: inline context decl: name = expr, program_size %"PRIuMPINT"\n",
CURRENT_PROGRAM_SIZE);
#endif /* DEBUG_INLINES */
#endif /* USE_NEW_INLINES */
type2.typeflags &= TYPEID_MASK;
/* Check the assignment for validity */
if (exact_types.typeflags && !compatible_types(lv->type, type2, MY_TRUE))
{
yyerrorf("Bad assignment %s", get_two_types(lv->type, type2));
}
if (assign_op != F_ASSIGN)
{
yyerror("Only plain assignments allowed here");
}
if (type2.typeflags & TYPE_MOD_REFERENCE)
yyerror("Can't trace reference assignments");
/* If we're parsing a context variable, just leave the
* value on the stack for the context_closure instruction.
* For normal locals, add the bytecode to create the lvalue
* and do the assignment.
*/
#ifdef USE_NEW_INLINES
if (!current_inline || !current_inline->parse_context)
#endif /* USE_NEW_INLINES */
{
if (!add_lvalue_code(lv, F_VOID_ASSIGN))
return;
} /* parsed context var */
} /* init_local_variable() */
/*-------------------------------------------------------------------------*/
static Bool
add_lvalue_code ( struct lvalue_s * lv, int instruction)
/* Add the lvalue code held in * <lv> to the end of the program.
* If <instruction> is not zero, it is the code for an instruction
* to be added after the lvalue code.
* Return TRUE on success, and FALSE on failure.
*/
{
p_int length;
/* Create the code to push the lvalue */
length = lv->length;
if (length)
{
add_to_mem_block(A_PROGRAM, lv->u.p, length);
yfree(lv->u.p);
last_expression = CURRENT_PROGRAM_SIZE;
}
else
{
bytecode_p source, dest;
mp_uint current_size;
source = lv->u.simple;
current_size = CURRENT_PROGRAM_SIZE;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, current_size+2);
return MY_FALSE;
}
CURRENT_PROGRAM_SIZE = (last_expression = current_size + 2);
dest = PROGRAM_BLOCK + current_size;
*dest++ = *source++;
*dest++ = *source;
}
if (instruction != 0)
ins_f_code(instruction);
return MY_TRUE;
} /* add_lvalue_code() */
/*-------------------------------------------------------------------------*/
static void
insert_pop_value (void)
/* Remove the last value computed from the stack. If possible, use
* last_expression to prohibit that value from being generated
* in the first place.
*/
{
if (last_expression == CURRENT_PROGRAM_SIZE-1)
{
/* We don't have to fear sideeffects and try to prevent
* the value from being generated.
*/
switch ( mem_block[A_PROGRAM].block[last_expression])
{
case F_ASSIGN:
mem_block[A_PROGRAM].block[last_expression] =
F_VOID_ASSIGN;
break;
case F_ADD_EQ:
mem_block[A_PROGRAM].block[last_expression] =
F_VOID_ADD_EQ;
break;
case F_PRE_INC:
case F_POST_INC:
mem_block[A_PROGRAM].block[last_expression] =
F_INC;
break;
case F_PRE_DEC:
case F_POST_DEC:
mem_block[A_PROGRAM].block[last_expression] =
F_DEC;
break;
case F_CONST0:
case F_CONST1:
case F_NCONST1:
mem_block[A_PROGRAM].current_size = last_expression;
break;
case F_CLIT:
case F_NCLIT:
case F_CSTRING0:
case F_CSTRING1:
case F_CSTRING2:
mem_block[A_PROGRAM].current_size = last_expression-1;
break;
case F_STRING:
mem_block[A_PROGRAM].current_size = last_expression-2;
break;
case F_NUMBER:
mem_block[A_PROGRAM].current_size = last_expression-4;
break;
default: ins_f_code(F_POP_VALUE);
}
last_expression = -1;
}
else
/* The last expression is too long ago: just pop whatever there
* is on the stack.
*/
ins_f_code(F_POP_VALUE);
} /* insert_pop_value() */
/*-------------------------------------------------------------------------*/
static void
arrange_protected_lvalue (p_int start, int code, p_int end, int newcode)
/* Arrange the creation of a (protected) lvalue instead of a normal lvalue
* or even rvalue (mostly used when passing arguments by reference).
* The arguments mean in general:
* start: start address of the instruction
* end: end address+1 of the instruction
* code: lvalue-generating instruction alternative to the one now
* stored at <start>
* newcode: additional instruction to insert.
*
* The following scenarios exist:
*
* code >= 0 && end != 0:
* The multi-byte instruction in [<start>..<end>[ (which might
* be a complete indexing operation, but always excludes the
* actual instruction bytes to change) is moved to the end of
* the current program, then its alternative <code> and <newcode>
* are appended.
*
* Cases are:
* global
* IDENTIFIER16 -> PUSH_IDENTIFIER16_LVALUE
#ifdef USE_STRUCTS
* expr4->x
* S_INDEX -> PUSH_PROTECTED_INDEXED_S_LVALUE
#endif
* expr4[x]
* INDEX -> PUSH_PROTECTED_INDEXED_LVALUE
* expr4[<x]
* RINDEX -> PUSH_PROTECTED_RINDEXED_LVALUE
* expr4[>x]
* AINDEX -> PUSH_PROTECTED_AINDEXED_LVALUE
* expr4[x,y]
* MAP_INDEX -> PUSH_PROTECTED_INDEXED_MAP_LVALUE
*
* The 'global' case is special in that the code block only
* consists of the instruction and its 2-byte argument - all
* other cases are much bigger and the instruction to change
* is right at the end without argument.
*
* code >= 0 && end == 0:
* The instruction at <start> (1 byte code, 1 byte argument)
* removed (the argument byte is preserved), instead the instructions
* <code> plus the preserved argument byte and <newcode> are appended
* to the end of the current code.
*
* Cases are:
* global:
* VIRTUAL_VARIABLE -> PUSH_VIRTUAL_VARIABLE_LVALUE
* IDENTIFIER -> PUSH_IDENTIFIER_LVALUE
* local
* LOCAL -> PUSH_LOCAL_LVALUE
*
* code < 0:
* The original instruction doesn't need or have an alternative,
* and <newcode> is a protected-index-lvalue code, for which
* the appropriate push-protected-index-lvalue code has
* to be appended to the program.
*
* Cases where this code is generated:
* F_STRING, F_NUMBER, F_CLOSURE, F_FLOAT, F_SYMBOL,
* (expr0), ({ expr,... }), '({ expr,... }), ([...]),
* x[a..b], x[<a..b], x[a..<b], x[<a..<b], x[a..], x[<a..],
* &global, &local, &(expr4[x]), &(expr4[<x]), &(expr4[x,y]),
* &(expr4[x..y]), &(expr4[<x..y]), &(expr4[x..<y]),
* &(expr4[<x..<y]).
*
* Cases accepted by the function:
* &(expr4[x]): F_PROTECTED_INDEX_LVALUE
* -> F_PUSH_PROTECTED_INDEXED_LVALUE;
* &(expr4[<x]): F_PROTECTED_RINDEX_LVALUE
* -> F_PUSH_PROTECTED_RINDEXED_LVALUE;
#ifdef USE_STRUCTS
* &(expr4->x): F_PROTECTED_INDEX_S_LVALUE
* -> F_PUSH_PROTECTED_INDEXED_S_LVALUE;
#endif
*
* TODO: I am surprised this works at all.
*/
{
mp_uint current;
bytecode_p p;
current = CURRENT_PROGRAM_SIZE;
if (code >= 0)
{
if (end)
{
/* Variant 1: cycle a codeblock and modify instructions */
p_int length;
bytecode_p q;
length = end - start + 1;
/* Get enough memory */
if (!realloc_a_program(length))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, CURRENT_PROGRAM_SIZE + length);
return;
}
/* Cycle the indexing code to the end, where it belongs:
*
* <indexing-code> <instrs>
* is changed via
* <...> <instrs> <indexing-code>
* to
* <instrs> <indexing-code>
*/
p = PROGRAM_BLOCK;
memcpy(p + current, p + start, length);
p += start;
q = p + length;
length = current - start;
do *p++ = *q++; while (--length);
/* Adjust the code... */
switch(code)
{
#ifdef USE_STRUCTS
case F_PUSH_INDEXED_S_LVALUE:
code = F_PUSH_PROTECTED_INDEXED_S_LVALUE;
break;
#endif /* USE_STRUCTS */
case F_PUSH_INDEXED_LVALUE:
code = F_PUSH_PROTECTED_INDEXED_LVALUE;
break;
case F_PUSH_RINDEXED_LVALUE:
code = F_PUSH_PROTECTED_RINDEXED_LVALUE;
break;
case F_PUSH_AINDEXED_LVALUE:
code = F_PUSH_PROTECTED_AINDEXED_LVALUE;
break;
case F_PUSH_INDEXED_MAP_LVALUE:
code = F_PUSH_PROTECTED_INDEXED_MAP_LVALUE;
break;
case F_PUSH_IDENTIFIER16_LVALUE:
PUT_CODE(p-3, code);
goto code_stored;
default:
fatal("Unexpected lvalue code\n");
}
/* ...and store it in place of the indexing instruction
* right before p == current
*/
PUT_CODE(p-1, instrs[code].opcode);
code_stored:
/* Append the newcode instruction (current will be adjusted
* at the end of the function).
*/
PUT_CODE(p, instrs[newcode].opcode);
}
else
{
/* Variant 2: Change
* <old-code> <arg> <instrs...>
* to
* <instrs...> <code> <arg> <newcode>
*/
int instr_arg;
p_int length;
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, CURRENT_PROGRAM_SIZE + 2);
return;
}
p = PROGRAM_BLOCK + start;
instr_arg = p[1];
length = current - start - 2;
for( ; --length >= 0; p++) PUT_CODE(p, GET_CODE(p+2));
STORE_CODE(p, code);
STORE_CODE(p, instr_arg);
PUT_CODE(p, instrs[newcode].opcode);
}
}
else
{
/* Variant 3: Just add a modified <newcode> */
switch(newcode)
{
#ifdef USE_STRUCTS
case F_PROTECTED_INDEX_S_LVALUE:
newcode = F_PUSH_PROTECTED_INDEXED_S_LVALUE;
break;
#endif /* USE_STRUCTS */
case F_PROTECTED_INDEX_LVALUE:
newcode = F_PUSH_PROTECTED_INDEXED_LVALUE;
break;
case F_PROTECTED_RINDEX_LVALUE:
newcode = F_PUSH_PROTECTED_RINDEXED_LVALUE;
break;
case F_PROTECTED_AINDEX_LVALUE:
newcode = F_PUSH_PROTECTED_AINDEXED_LVALUE;
break;
default:
yyerror("Need lvalue for range lvalue.");
}
if (!realloc_a_program(2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, CURRENT_PROGRAM_SIZE + 2);
return;
}
p = PROGRAM_BLOCK + current;
PUT_CODE(p, instrs[newcode].opcode);
}
/* Correct the program size */
CURRENT_PROGRAM_SIZE = current + 1;
} /* arrange_protected_lvalue() */
/*-------------------------------------------------------------------------*/
int
proxy_efun (int function, int num_arg UNUSED)
/* If the number of arguments doesn't fit the <function>, maybe there
* is an alternative.
* Return the code of the alternative efun, or -1 if there is none.
*/
{
#if defined(__MWERKS__)
# pragma unused(num_arg)
#endif
if (function == F_PREVIOUS_OBJECT)
{
/* num_arg == 0 */
return F_PREVIOUS_OBJECT0;
}
return -1;
} /* proxy_efun() */
/*-------------------------------------------------------------------------*/
static void
transfer_init_control (void)
/* The compiler is about to generate another INIT fragment at the current
* address: update the JUMP of the last INIT fragment to point to this
* address.
* If this is the first call, the function header for __INIT is generated
* as well.
*/
{
if (last_initializer_end < 0)
{
/* First call: we have to generate the __INIT function
* header.
*/
CURRENT_PROGRAM_SIZE = align(CURRENT_PROGRAM_SIZE);
/* Must happen before store_function_header() */
realloc_a_program(FUNCTION_HDR_SIZE);
store_function_header( CURRENT_PROGRAM_SIZE
, STR_VARINIT
, Type_Any
, 0 /* num_args */
, 0 /* num_vars */
);
first_initializer_start = CURRENT_PROGRAM_SIZE
+ FUNCTION_PRE_HDR_SIZE;
CURRENT_PROGRAM_SIZE += FUNCTION_HDR_SIZE;
}
else if ((p_int)(CURRENT_PROGRAM_SIZE - 3) == last_initializer_end)
{
/* The new INIT fragment directly follows the old one, so
* just overwrite the JUMP instruction of the last.
*/
mem_block[A_PROGRAM].current_size -= 4;
}
else
{
/* Change the address of the last jump after the last
* initializer to this point.
*/
upd_jump_offset(last_initializer_end, mem_block[A_PROGRAM].current_size);
}
} /* transfer_init_control() */
/*-------------------------------------------------------------------------*/
static void
add_new_init_jump (void)
/* The compiler just finished an INIT fragment: add a JUMP instruction
* and let last_initializer_end point to its offset.
*/
{
ins_f_code(F_JUMP);
last_initializer_end = (p_int)mem_block[A_PROGRAM].current_size;
ins_byte(0);
ins_short(0);
} /* add_new_init_jump() */
/*-------------------------------------------------------------------------*/
static short
lookup_inherited (const char *super_name, string_t *real_name
, inherit_t **pIP, funflag_t *pFlags)
/* Lookup an inherited function <super_name>::<real_name> and return
* it's function index, setting *pIP to the inherit_t pointer and
* *pFlags to the function flags.
* Return -1 if not found, *pIP set to NULL, and *pFlags set to 0.
*
* <super_name> can be an empty string or the (partial) name of one
* of the inherits. <real_name> must be shared string.
*/
{
inherit_t *ip, *foundp;
int num_inherits, super_length;
short found_ix;
found_ix = -1;
*pIP = NULL;
*pFlags = 0;
if (!real_name)
return -1;
/* Strip leading '/' */
while (*super_name == '/')
super_name++;
super_length = strlen(super_name);
num_inherits = INHERIT_COUNT;
/* TODO: Is this really necessary? real_name should be tabled
* already.
*/
{
string_t *tmp;
tmp = find_tabled(real_name);
#ifdef DEBUG
if (!tmp)
fprintf(stderr, "DEBUG: insert_inherited(): Can't find function "
"'%s'.\n", get_txt(real_name));
else if (tmp != real_name)
fprintf(stderr, "DEBUG: insert_inherited(): Function "
"'%s' is not a tabled string.\n"
, get_txt(real_name));
#endif
if (tmp && tmp != real_name)
{
free_mstring(real_name);
real_name = ref_mstring(tmp);
}
}
/* Search the function in all inherits.
* For normal inherits its sufficient to search the inherits
* from the back in order to get the topmost definition; however,
* with virtual inherits the order gets messed up.
*/
ip = (inherit_t *)mem_block[A_INHERITS].block;
for ( foundp = NULL ; num_inherits > 0 ; ip++, num_inherits--)
{
short i;
if (ip->inherit_type & INHERIT_TYPE_DUPLICATE)
/* this is a duplicate inherit */
continue;
/* Test if super_name matches the end of the name of the inherit. */
if (super_length)
{
/* ip->prog->name includes .c */
int l = mstrsize(ip->prog->name)-2;
if (l < super_length)
continue;
if (l > super_length
&& get_txt(ip->prog->name)[l-super_length-1] != '/')
continue;
if (strncmp(super_name, get_txt(ip->prog->name) + l - super_length,
super_length) != 0)
continue;
}
/* Look for the function */
if ( (i = find_function(real_name, ip->prog)) < 0)
continue;
/* Found one */
if (foundp == NULL
|| ip->inherit_depth < foundp->inherit_depth
)
{
foundp = ip;
found_ix = i;
if (foundp->inherit_depth < 2) /* toplevel inherit */
break;
}
} /* for (all inherits) */
if (foundp != NULL)
{
funflag_t flags;
/* Found it! */
ip = foundp;
*pFlags = flags = ip->prog->functions[found_ix];
if (flags & NAME_INHERITED)
{
/* The parent inherits the function itself: we have to
* check if it's a virtual inheritance.
*/
inherit_t *ip2;
program_t *prog1, *prog2;
int numvar2;
prog1 = ip->prog;
ip2 = &prog1->inherit[flags & INHERIT_MASK];
prog2 = ip2->prog;
if ( 0 != (numvar2 = prog2->num_variables)
&& prog1->variables[ip2->variable_index_offset+numvar2-1
].type.typeflags
& TYPE_MOD_VIRTUAL
&& !(prog2->variables[numvar2-1].type.typeflags & TYPE_MOD_VIRTUAL) )
{
/* The source was virtually inherited - we have to find
* the first inheritance of the program.
* And adjust the function index, of course.
*/
do --ip; while (ip->prog != prog2);
found_ix -= ip2->function_index_offset;
}
}
*pIP = ip;
} /* if (foundp) */
return found_ix;
} /* lookup_inherited() */
/*-------------------------------------------------------------------------*/
short
find_inherited_function ( const char * super_name
, const char * real_name
, unsigned short * pInherit
)
/* Lookup an inherited function <super_name>::<real_name> and return
* it's function index as result, and the inheritance index in *<pInherit>.
* Return -1 if not found.
*
* The returned function index is not adjusted for the compiled program's
* function table.
*
* This function is called by the lexer to resolve #'<inherited_fun> closures,
* and by restore_value()/restore_object() to restore closure values.
*
* <super_name> can be an empty string or the (partial) name of one
* of the inherits.
*/
{
inherit_t *ip;
string_t *rname;
funflag_t flags;
short ix;
rname = find_tabled_str(real_name);
ix = rname ? lookup_inherited(super_name, rname, &ip, &flags) : -1;
if (ix >= 0) /* Also return the inherit index. */
*pInherit = ip - (inherit_t *)mem_block[A_INHERITS].block;
else
*pInherit = 0;
return ix;
} /* find_inherited_function() */
/*-------------------------------------------------------------------------*/
static int
insert_inherited (char *super_name, string_t *real_name
, program_t **super_p, function_t *fun_p
, int num_arg, bytecode_p __prepare_insert__p
)
/* The compiler encountered a <super_name>::<real_name>() call with
* <num_arg> arguments; the codepointer is <__prepare_insert__p>.
*
* Look up the function information and set *<super_p> and *<fun_p>
* the program pointer and the function_t information. Also compile
* the function call(s).
*
* Result is the function index, or one of the negative error codes:
* INHERITED_NOT_FOUND (-1): the function wasn't found.
* INHERITED_WILDCARDED_ARGS (-2): it was a wildcarded supercall with
* arguments
* INHERITED_WILDCARDED_NOT_FOUND (-3): it was a wildcarded supercall,
* but not a single function was found.
* Result is -1 if the function wasn't found, -2 if it was a wildcarded
* supercall to a function with arguments, otherwise the function index.
*
* <super_name> can be an empty string, the (partial) name of one
* of the inherits, or a wildcarded name (and no args). In the latter
* case, the function is called in all inherits matching the pattern.
* The results from such a wildcarded call are returned in an array,
* <super_p>, <fun_p> and the returned function index are those of
* the first function found.
*/
{
inherit_t *ip;
funflag_t flags;
short found_ix;
found_ix = lookup_inherited(super_name, real_name, &ip, &flags);
if (ip != NULL)
{
/* Found it! */
bytecode_p __PREPARE_INSERT__p = __prepare_insert__p;
/* Generate the function call */
add_f_code(F_CALL_INHERITED);
add_short(ip - (inherit_t *)mem_block[A_INHERITS].block);
add_short(found_ix);
CURRENT_PROGRAM_SIZE += 5;
/* Return the program pointer */
*super_p = ip->prog;
/* Return a copy of the function structure */
fun_p->flags = flags & ~INHERIT_MASK;
get_function_information(fun_p, ip->prog, found_ix);
fun_p->name = real_name;
return found_ix;
} /* if (ip) */
/* Inherit not found, maybe it's a wildcarded call */
if (strpbrk(super_name, "*?"))
{
Bool *was_called; /* Flags which inh. fun has been called already */
inherit_t *ip0;
int num_inherits;
int calls = 0;
int ip_index;
int first_index;
short i;
/* Wildcarded supercalls only work without arguments */
if (num_arg)
return INHERITED_WILDCARDED_ARGS;
*super_p = NULL;
num_inherits = INHERIT_COUNT;
was_called = alloca(sizeof(*was_called)*num_inherits);
for (i = 0; i < num_inherits; i++)
was_called[i] = MY_FALSE;
/* Test every inherit if the name matches and if
* it does, generate the function call.
*/
ip0 = (inherit_t *)mem_block[A_INHERITS].block;
first_index = num_inherits > 0 ? INHERITED_WILDCARDED_NOT_FOUND
: INHERITED_NOT_FOUND;
for (; num_inherits > 0; ip0++, num_inherits--)
{
PREPARE_INSERT(10)
/* ip->prog->name includes .c */
int l = mstrsize(ip0->prog->name) - 2;
ip = ip0; /* ip will be changed in the body */
if (ip->inherit_type & INHERIT_TYPE_DUPLICATE)
/* duplicate inherit */
continue;
if (ip->inherit_depth > 1)
/* Only consider direct inherits, otherwise we would even
* call functions in sub-inherits which have been redefined.
*/
continue;
if ( !match_string(super_name, get_txt(ip->prog->name), l) )
continue;
if ( (i = find_function(real_name, ip->prog)) < 0)
continue;
/* Found a match */
flags = ip->prog->functions[i];
if (flags & NAME_INHERITED)
{
/* The parent inherits the function itself: we have to
* check if it's a virtual inheritance.
*/
inherit_t *ip2;
program_t *prog1, *prog2;
int numvar2;
prog1 = ip->prog;
ip2 = &prog1->inherit[flags & INHERIT_MASK];
prog2 = ip2->prog;
if ( 0 != (numvar2 = prog2->num_variables)
&& prog1->variables[ip2->variable_index_offset+numvar2-1
].type.typeflags
& TYPE_MOD_VIRTUAL
&& !(prog2->variables[numvar2-1].type.typeflags & TYPE_MOD_VIRTUAL) )
{
/* The function was virtually inherited - we have to find
* the first inheritance of that program and adjust the
* function index, of course.
*/
do --ip; while (ip->prog != prog2);
i -= ip2->function_index_offset;
} /* if (virtually inherited) */
} /* if (inherited) */
ip_index = ip - (inherit_t *)mem_block[A_INHERITS].block;
/* The (new) ip might be duplicate inherit, or point to
* a virtually inherited function we called already.
*/
if ((ip->inherit_type & INHERIT_TYPE_DUPLICATE)
|| was_called[ip_index])
/* duplicate inherit */
continue;
if (!calls) /* First function found */
first_index = i;
/* Generate the function call.
*/
add_f_code(F_CALL_INHERITED_NOARGS);
add_short(ip_index);
add_short(i);
CURRENT_PROGRAM_SIZE += 5;
/* Mark this function as called */
was_called[ip_index] = MY_TRUE;
/* Return the program pointer to the caller */
*super_p = ip->prog;
/* Return a copy of the function structure to the caller */
fun_p->flags = flags & ~INHERIT_MASK;
get_function_information(fun_p, ip->prog, i);
fun_p->name = real_name;
calls++;
} /* for() */
/* The calls above left their results on the stack.
* Combine them into a single array (which might be empty).
*/
{
PREPARE_INSERT(3)
add_f_code(F_AGGREGATE);
add_short(calls);
CURRENT_PROGRAM_SIZE += 3;
}
return first_index;
}
/* No such function */
return INHERITED_NOT_FOUND;
} /* insert_inherited() */
/*-------------------------------------------------------------------------*/
static void
cross_define (function_t *from, function_t *to, int32 offset)
/* The function <to> is a cross-definition from real function <from>,
* separated by <offset>.
* Set the flags and offset of <to> accordingly to point to <from>, and
* synchronize the NO_MASK flag of both.
*/
{
short nomask;
to->flags = (to->flags & ~NAME_UNDEFINED)
| (from->flags & (NAME_UNDEFINED|NAME_PROTOTYPE))
| NAME_CROSS_DEFINED | NAME_HIDDEN | NAME_INHERITED;
to->offset.func = MAKE_CROSSDEF_OFFSET(offset);
nomask = (from->flags|to->flags) & TYPE_MOD_NO_MASK;
from->flags |= nomask;
to ->flags |= nomask;
} /* cross_define() */
/*-------------------------------------------------------------------------*/
static funflag_t *
get_virtual_function_id (program_t *progp, int fx)
/* Return a pointer to the flags of the first entry of function <fx> in <progp>
* that is inherited virtual (i.e. the first entry we encounter that doesn't have
* TYPE_MOD_VIRTUAL).
*
* This function takes care of resolving cross-definitions and inherits
* to the real function flag.
*/
{
funflag_t flags;
funflag_t *last;
flags = progp->functions[fx];
/* Handle a cross-define */
if (flags & NAME_CROSS_DEFINED)
{
fx += CROSSDEF_NAME_OFFSET(flags);
flags = progp->functions[fx];
}
/* This one is inherited virtual. We wont get called otherwise. */
last = &progp->functions[fx];
/* Walk the inherit chain */
while((flags & (NAME_INHERITED|TYPE_MOD_VIRTUAL)) == (NAME_INHERITED|TYPE_MOD_VIRTUAL))
{
inherit_t *inheritp;
inheritp = &progp->inherit[flags & INHERIT_MASK];
progp = inheritp->prog;
fx -= inheritp->function_index_offset;
flags = progp->functions[fx];
}
/* This is the one */
return &progp->functions[fx];
} /* get_virtual_function_id() */
/*-------------------------------------------------------------------------*/
#ifdef USE_STRUCTS
static void
copy_structs (program_t *from, funflag_t flags)
/* Copy the struct definitions from program <from> which is inherited
* with visibility <flags>.
*/
{
int struct_id;
for (struct_id = 0; struct_id < from->num_structs; struct_id++)
{
int id;
ident_t *p;
struct_def_t *pdef = from->struct_defs + struct_id;
funflag_t f;
f = flags | pdef->flags;
/* Is this struct visible to us? */
if (pdef->flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN))
{
f |= NAME_HIDDEN;
}
/* Duplicate definition? */
id = find_struct(struct_t_name(pdef->type));
if (!(f & NAME_HIDDEN) && id >= 0)
{
/* We have a struct with this name. Check if we just
* inherited it again, or if it's a name clash.
*/
if (STRUCT_DEF(id).type != pdef->type)
{
if (STRUCT_DEF(id).inh >= 0)
{
inherit_t * pInh = &INHERIT(STRUCT_DEF(id).inh);
yyerrorf("Different structs '%s' inherited from '%s' "
"and from '%s'"
, get_txt(struct_t_name(STRUCT_DEF(id).type))
, get_txt(from->name)
, get_txt(pInh->prog->name)
);
}
else
yyerrorf("struct '%s' inherited from '%s' differs "
"from existing struct"
, get_txt(struct_t_name(STRUCT_DEF(id).type))
, get_txt(from->name)
);
continue;
}
f |= NAME_HIDDEN;
}
/* New struct */
p = make_global_identifier(get_txt(struct_t_name(pdef->type)), I_TYPE_GLOBAL);
if (p == NULL)
continue;
/* Create a new struct entry, then replace the struct prototype
* type with the one we inherited.
*/
current_struct = define_new_struct( MY_FALSE, p, f);
free_struct_type(STRUCT_DEF(current_struct).type);
STRUCT_DEF(current_struct).type = ref_struct_type(pdef->type);
STRUCT_DEF(current_struct).inh = INHERIT_COUNT;
}
} /* copy_structs() */
#endif /* USE_STRUCTS */
/*-------------------------------------------------------------------------*/
static int
copy_functions (program_t *from, funflag_t type)
/* The functions of the program <from> are inherited with visibility <type>.
* Copy all the function definitions into this program, but as UNDEFINED
* so that they can be redefined in the current program. The epilog()
* will later update the non-redefined inherited functions and also copy
* the types.
*
* An explicit call to an inherited function will not be
* done through this entry (because this entry can be replaced by a new
* definition). If an function defined by inheritance is called,
* this is done with F_CALL_INHERITED
*
* The result is the function index of the inherited __INIT function,
* or -1 if the inherited program doesn't have an initializer.
*/
{
int initializer = -1;
int i;
uint32 first_func_index, current_func_index;
function_t *fun_p;
unsigned short *ixp;
/* Make space for the inherited function structures */
if (mem_block[A_FUNCTIONS].max_size <
mem_block[A_FUNCTIONS].current_size +
from->num_functions * sizeof(function_t) )
{
if (!realloc_mem_block(&mem_block[A_FUNCTIONS],
mem_block[A_FUNCTIONS].current_size +
from->num_functions * sizeof(function_t)))
return 0;
}
/* The new functions will be stored from here */
fun_p = (function_t *)
(mem_block[A_FUNCTIONS].block + mem_block[A_FUNCTIONS].current_size);
/* Copy the function definitions one by one and adjust the flags.
* For now, we mask out the INHERIT field in the flags and
* use NEW_INHERITED_INDEX for the value.
*/
for (i = 0; i < from->num_functions; i++, fun_p++)
{
funflag_t flags;
int i2; /* The index of the real function */
flags = from->functions[i];
fun_p->offset.inherit = NEW_INHERITED_INDEX;
i2 = i;
if (flags & NAME_INHERITED)
{
/* The inherit-index has to be recomputed */
fun_p->flags =
(flags & ~INHERIT_MASK) | NAME_INHERITED | NAME_HIDDEN;
/* If cross-defined, get the real function index */
if (flags & NAME_CROSS_DEFINED)
{
fun_p->offset.func = flags & INHERIT_MASK;
i2 += CROSSDEF_NAME_OFFSET(flags);
}
}
else
{
/* Also, the function-code offset needs adjustment */
fun_p->flags =
(flags & ~FUNSTART_MASK) | NAME_INHERITED | NAME_HIDDEN;
}
/* Copy the function information */
get_function_information(fun_p, from, i2);
} /* for (inherited functions) pass 1 */
/* Point back to the begin of the copied function data */
fun_p = (function_t *)
(mem_block[A_FUNCTIONS].block + mem_block[A_FUNCTIONS].current_size);
/* Unhide all function for which names exist */
ixp = from->function_names;
for (i = from->num_function_names; --i >= 0; )
{
fun_p[*ixp++].flags &= ~NAME_HIDDEN;
}
first_func_index = current_func_index =
mem_block[A_FUNCTIONS].current_size / sizeof (function_t);
mem_block[A_FUNCTIONS].current_size += sizeof *fun_p * from->num_functions;
/* Loop again over the inherited functions, checking visibility
* and re/crossdefinition, and updating their function indices.
* Do not call define_new_function() from here, as duplicates would
* be removed.
*/
for (i = 0; i < from->num_functions; i++, current_func_index++)
{
function_t fun;
funflag_t new_type;
unsigned short tmp_short;
ident_t* p;
fun = fun_p[i];
/* Prepare some data to be used if this function will not be
* redefined.
* fun.name has already it's ref as a newly defined function in from
*/
fun.flags |= type & TYPE_MOD_NO_MASK;
/* Perform a lot of tests and actions for the visibility
* and definitiability. The switch() allows us to abort
* easily without using gotos.
*/
switch (0) {
default:
/* Ignore cross defines.
* They are the only complete invisible entries.
*/
if (fun.flags & NAME_CROSS_DEFINED)
break;
/* Visible: create a new identifier for it */
p = make_global_identifier(get_txt(fun.name), I_TYPE_GLOBAL);
if (!p)
break;
if (p->type != I_TYPE_UNKNOWN)
{
/* We got this ident already somewhere */
int32 n; /* existing function index */
n = p->u.global.function;
/* If the identifier is (also) an lfun, handle it, even if
* it's overloaded by something else as well. If we didn't
* subsequent inheritors would receive illegal function
* start offsets.
*/
if ( n >= 0)
{
/* Already inherited from somewhere else.
* Don't try to resolve cross-references inside the
* currently inherited program; not only is this superflous,
* but it can also lead to circular cross-inheritance
* when there was a misplaced prototype or an explicit
* directive to inherit a multiply inherited function
* from a particular base class (the latter is not
* implemented). In these cases, the information that lead
* to the non-standard preference would be very hard to
* reconstruct.
*/
if ((uint32)n < first_func_index)
{
/* We already have a function definition/prototype
* for this name.
*/
function_t *OldFunction = FUNCTION(n);
if ( !(OldFunction->flags & NAME_INHERITED) )
{
/* Since inherits are not possible after
* functions have been compiled, the only
* way to get here is when we had a prototype
* for the function.
* It's not fatal, but annoying.
*/
yywarnf(
"Misplaced prototype for %s in %s\n"
, get_txt(fun.name), current_loc.file->name
);
cross_define( &fun, OldFunction
, current_func_index - n );
p->u.global.function = current_func_index;
}
else if ( (fun.flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN|NAME_UNDEFINED))
== (TYPE_MOD_PRIVATE|NAME_HIDDEN) )
{
/* There is already one function with this
* name. Ignore the private one, as we
* only need it for useful error messages.
*/
break;
}
else if ( (OldFunction->flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN|NAME_UNDEFINED))
== (TYPE_MOD_PRIVATE|NAME_HIDDEN) )
{
/* The old one was invisible, ignore it
* and take this one.
*/
p->u.global.function = current_func_index;
}
else if ((fun.flags | type) & TYPE_MOD_VIRTUAL
&& OldFunction->flags & TYPE_MOD_VIRTUAL
&& get_virtual_function_id(from, i)
== get_virtual_function_id(INHERIT(OldFunction->offset.inherit).prog
, n - INHERIT(OldFunction->offset.inherit).function_index_offset
)
)
{
/* Entries denote the same function and both
* entries are visible. We have to use
* cross_define nonetheless, to get consistant
* redefinition (and to avoid the nomask
* checking that comes next), and we prefer
* the first one.
*
* It is important, that both entries are
* indeed visible, because otherwise invisible
* (i.e. private) functions would be made
* visible again by another visible occurrence
* of the same function. The originally invisible
* occurrence would then be subject to
* redefinition and nomask checking.
*/
OldFunction->flags |= fun.flags &
(TYPE_MOD_PUBLIC|TYPE_MOD_NO_MASK);
OldFunction->flags &= fun.flags |
~(TYPE_MOD_STATIC|TYPE_MOD_PRIVATE|TYPE_MOD_PROTECTED|NAME_HIDDEN);
cross_define( OldFunction, &fun
, n - current_func_index );
}
else if ( (fun.flags & OldFunction->flags & TYPE_MOD_NO_MASK)
&& !( (fun.flags|OldFunction->flags) & NAME_UNDEFINED ) )
{
yyerrorf(
"Illegal to inherit 'nomask' function '%s' twice",
get_txt(fun.name));
}
else if (( fun.flags & TYPE_MOD_NO_MASK
|| OldFunction->flags & NAME_UNDEFINED )
&& !(fun.flags & NAME_UNDEFINED)
)
{
/* This function is visible and existing, but the
* inherited one is not, or this one is also nomask:
* prefer this one one.
*/
cross_define( &fun, OldFunction
, current_func_index - n );
p->u.global.function = current_func_index;
}
else
{
/* At least one of the functions is visible
* or redefinable: prefer the first one.
*/
cross_define( OldFunction, &fun
, n - current_func_index );
}
} /* if (n < first_func_index) */
else if ( (fun.flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN|NAME_UNDEFINED))
!= (TYPE_MOD_PRIVATE|NAME_HIDDEN) )
{
/* This is the dominant definition in the superclass,
* inherit this one.
*/
#ifdef DEBUG
/* The definition we picked before can't be
* cross-defined, because cross-defines won't
* be registered as global identifiers.
* So the previous definition should be
* nominally invisible so we can redefine it.
*/
if ( (FUNCTION(n)->flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN|NAME_UNDEFINED))
!= (TYPE_MOD_PRIVATE|NAME_HIDDEN) )
{
fatal(
"Inconsistent definition of %s() within "
"superclass '%s'.\n"
, get_txt(fun.name), get_txt(from->name)
);
}
#endif
p->u.global.function = current_func_index;
}
}
/* Handle the non-lfun aspects of the identifier */
{
if (n != I_GLOBAL_FUNCTION_OTHER
|| (p->u.global.efun < 0 && p->u.global.sim_efun < 0)
|| (fun.flags & (TYPE_MOD_PRIVATE|NAME_HIDDEN)) == 0
|| (fun.flags & (NAME_UNDEFINED)) != 0
)
{
/* This is not an inherited private function shadowing
* a (simul-)efun.
*/
if (p->u.global.efun >= 0 || p->u.global.sim_efun >= 0)
{
/* This inherited function shadows an efun */
efun_shadow_t *q;
q = xalloc(sizeof(efun_shadow_t));
if (!q) {
yyerrorf("Out of memory: efun shadow (%zu bytes)"
, sizeof(efun_shadow_t));
break;
}
q->shadow = p;
q->next = all_efun_shadows;
all_efun_shadows = q;
}
/* Update the symbol table entry to point
* to the newly read function, unless of course
* the code above already took care of that change.
*/
if (p->u.global.function < 0)
p->u.global.function = current_func_index;
}
/* else: inherited private defined function must not hide
* the (simul-)efun and is thusly not added to
* the symbol-table.
*/
}
} /* if (p != I_TYPE_UNKNOWN) */
if (p->type == I_TYPE_UNKNOWN)
{
/* First time this function-ident was ever encountered.
* Just make a new global.
*/
init_global_identifier(p, /* bVariable: */ MY_TRUE);
p->u.global.function = current_func_index;
p->next_all = all_globals;
all_globals = p;
}
/* Done with re/crossdefinition, now handle visibility.
* Especially: public functions should not become private
* when inherited 'private'.
*/
new_type = type;
if (fun.flags & TYPE_MOD_PUBLIC)
new_type &= ~(TYPE_MOD_PRIVATE|TYPE_MOD_STATIC);
fun.flags |= new_type;
/* Recognize an inherited heart_beat(), making it possible
* to mask it.
*/
if ((heart_beat == -1)
&& mstreq(fun.name, STR_HEART_BEAT))
{
heart_beat = current_func_index;
}
/* Recognize the initializer function */
if (mstreq(fun.name, STR_VARINIT))
{
initializer = i;
fun.flags |= NAME_UNDEFINED;
}
} /* switch() for visibility/redefinability */
/* Copy information about the types of the arguments, if it is
* available.
*/
tmp_short = INDEX_START_NONE; /* Presume not available. */
if (from->type_start != 0)
{
if (from->type_start[i] != INDEX_START_NONE)
{
/* They are available for function number 'i'. Copy types of
* all arguments, and remember where they started.
*/
tmp_short = ARGTYPE_COUNT;
if (fun.num_arg)
{
int ix;
ix = ARGTYPE_COUNT;
add_to_mem_block(
A_ARGUMENT_TYPES,
&from->argument_types[from->type_start[i]],
(sizeof (vartype_t)) * fun.num_arg
);
for ( ; (size_t)ix < ARGTYPE_COUNT; ix++)
ref_vartype_data(&ARGUMENT_TYPE(ix));
}
}
}
else
{
fun.flags |= NAME_TYPES_LOST;
}
/* Save the index where they started. Every function will have an
* index where the type info of arguments starts.
*/
add_to_mem_block(A_ARGUMENT_INDEX, &tmp_short, sizeof tmp_short);
/* Finally update the entry in the A_FUNCTIONS area */
fun_p[i] = fun;
} /* for (inherited functions), pass 2 */
return initializer;
} /* copy_functions() */
/*-------------------------------------------------------------------------*/
static void
copy_variables (program_t *from, funflag_t type)
/* Inherit the variables of <from> with visibility <type>.
* The variables are copied into our program, and it is important that
* they are stored in the same order with the same index.
*/
{
int i, j;
int new_bound, last_bound;
int variable_index_offset, fun_index_offset;
uint inheritc;
inherit_t *inheritp;
int previous_variable_index_offset;
int from_variable_index_offset;
type &= ~VAR_INITIALIZED;
/* If this is a virtual inherit, find the first inherit
* for this program and set the from_variable_index_offset.
*/
from_variable_index_offset = -1;
if (type & TYPE_MOD_VIRTUAL)
{
inheritp = (inherit_t *)(mem_block[A_INHERITS].block);
j = mem_block[A_INHERITS].current_size;
for (; (j -= sizeof(inherit_t)) >= 0; inheritp++)
{
if (inheritp->prog == from
&& !(inheritp->variable_index_offset & NON_VIRTUAL_OFFSET_TAG) )
{
from_variable_index_offset =
inheritp->variable_index_offset + VIRTUAL_VAR_TAG;
break;
}
}
if (variables_initialized && from_variable_index_offset < 0)
yyerror(
"illegal to inherit virtually after initializing variables\n"
);
}
fun_index_offset = FUNCTION_COUNT - from->num_functions;
variable_index_offset = V_VARIABLE_COUNT;
/* Loop through the inherits and copy the variables,
* and also in the last run the variables of the inherited program.
*/
last_bound = 0; /* Last variable index handled in the previous run */
i = from->num_inherited;
for (inheritc = 0, inheritp = from->inherit; MY_TRUE; inheritc++, inheritp++)
{
if (--i >= 0)
{
/* It's an inherit */
program_t *progp;
progp = inheritp->prog;
new_bound =
inheritp->variable_index_offset + progp->num_variables;
/* The end of this program's variables in the inherited
* program <from>. This way we can compare the variables
* original type with the type they got through inheritance.
*/
/* Has a new virtual variable been introduced in this program?
*/
if (progp->num_variables
&& from->variables[new_bound-1].type.typeflags & TYPE_MOD_VIRTUAL
&& !(progp->variables[progp->num_variables-1].type.typeflags
& TYPE_MOD_VIRTUAL)
)
{
inherit_t inherit, *inheritp2;
int k, inherit_index;
funflag_t *flagp;
function_t *funp;
if (variables_initialized)
yyerror("illegal to inherit virtually after "
"initializing variables\n"
);
inherit = *inheritp;
inherit.inherit_type = INHERIT_TYPE_EXTRA;
inherit.inherit_depth++;
/* Find the first (virtual) inheritance of this
* program.
*/
inheritp2 = (inherit_t *)(mem_block[A_INHERITS].block);
j = mem_block[A_INHERITS].current_size;
for (; (j -= sizeof(inherit_t)) >= 0; inheritp2++)
{
if (inheritp2->prog == inherit.prog
&& !(inheritp2->variable_index_offset &
NON_VIRTUAL_OFFSET_TAG) )
{
/* Found it: copy the variable_index_offset */
inherit.variable_index_offset =
inheritp2->variable_index_offset;
break;
}
}
if (j < 0)
{
/* First occurence of these virtual variables, we're
* going to copy them into our variables.
*/
inheritp2 = &inherit;
variable_index_offset += new_bound - last_bound;
inherit.variable_index_offset =
variable_index_offset - progp->num_variables;
}
else
inherit.inherit_type |= INHERIT_TYPE_DUPLICATE;
inherit_index = (mem_block[A_INHERITS].current_size) /
sizeof(inherit_t);
inherit.function_index_offset += fun_index_offset;
add_to_mem_block(A_INHERITS, (char *)&inherit, sizeof inherit);
/* If a function is directly inherited from a program that
* introduces a virtual variable, the code therein is not
* aware of virtual inheritance. For this reason, there are
* the extra inherit_ts with an appropriate
* variable_index_offset; we have to redirect inheritance
* to these inherit_ts.
*/
/* Update the offset.inherit in all these functions to point
* to the new inherit_t structure. (But only, if it wasn't
* already cross-defined to something else.)
*/
flagp = from->functions + inheritp->function_index_offset;
funp = (function_t *)mem_block[A_FUNCTIONS].block +
inherit.function_index_offset;
for (k = inherit.prog->num_functions; --k >= 0; funp++)
{
if ( !(funp->flags & NAME_CROSS_DEFINED)
&& (*flagp & (NAME_INHERITED|NAME_CROSS_DEFINED)) ==
NAME_INHERITED
&& (*flagp & INHERIT_MASK) == inheritc )
{
funp->offset.inherit = inherit_index;
}
flagp++;
}
if (j >= 0)
{
/* There has been another instance of this virtual
* superclass before: no need to check the visibility
* of the variables again.
*/
if (new_bound > last_bound)
last_bound = new_bound;
continue;
}
previous_variable_index_offset = -1;
}
else
{
/* Normal, nonvirtual inherit.
* We wait with the visibility check until it's really
* useful, and then do several inherits in one go.
*/
continue;
}
}
else
{
/* Handle the variables of <from>.
* After that, we will loop once more in here, but
* the if() below will notice that.
* As a side effect we terminate immediately if <from>
* had no variables on its own.
*/
previous_variable_index_offset = from_variable_index_offset;
new_bound = from->num_variables;
if (new_bound == last_bound)
break;
}
/* Check the visibility of the newly inspected variables
* [last_bound..new_bound[.
*/
for (j = last_bound; j < new_bound; j++)
{
ident_t *p;
funflag_t new_type;
p = make_global_identifier(get_txt(from->variables[j].name)
, I_TYPE_GLOBAL);
if (!p)
return;
new_type = type;
/* 'public' variables should not become private when inherited
* 'private'.
*/
if (from->variables[j].type.typeflags & TYPE_MOD_PUBLIC)
new_type &= ~TYPE_MOD_PRIVATE;
/* define_variable checks for previous 'nomask' definition. */
if (previous_variable_index_offset >= 0)
{
if ( !(from->variables[j].type.typeflags & TYPE_MOD_PRIVATE) )
{
fulltype_t vartype = from->variables[j].type;
vartype.typeflags |= new_type | NAME_INHERITED;
redeclare_variable(p, vartype,
previous_variable_index_offset + j
);
}
}
else
{
fulltype_t vartype = from->variables[j].type;
vartype.typeflags |= new_type
| (from->variables[j].type.typeflags & TYPE_MOD_PRIVATE
? (NAME_HIDDEN|NAME_INHERITED)
: NAME_INHERITED
)
;
define_variable(p, vartype);
}
} /* end loop through variables */
last_bound = new_bound; /* Mark how far we got */
} /* end of loop through inherits */
} /* copy_variables() */
/*-------------------------------------------------------------------------*/
static void
fix_function_inherit_indices (program_t *from)
/* All functions inherited from <from>, which haven't been resolved
* to belong to some other inherit, are now assigned to the current
* inherit.
*/
{
int i, inherit_index;
function_t *funp;
inherit_index = INHERIT_COUNT;
funp =
(function_t *)
(mem_block[A_FUNCTIONS].block+mem_block[A_FUNCTIONS].current_size) -
from->num_functions;
for (i = from->num_functions; --i >= 0; funp++)
{
if ( funp->offset.inherit == NEW_INHERITED_INDEX
&& !(funp->flags & NAME_CROSS_DEFINED) )
{
funp->offset.inherit = inherit_index;
}
}
} /* fix_function_inherit_indices() */
/*-------------------------------------------------------------------------*/
static void
fix_variable_index_offsets (program_t *new_prog)
/* Add num_virtual_variables to the index_offset of all variables
* in <new_prog> marked with NON_VIRTUAL_OFFSET_TAG. The tag is removed.
*
* Reason is that the non-virtual variables have to be put after
* the virtual variables, so the offsets of these variables are
* first counted from 0 up and then corrected in this function after
* the last virtual inherit.
*/
{
int i;
inherit_t *inheritp;
i = new_prog->num_inherited;
for (inheritp = new_prog->inherit; --i >= 0; inheritp++)
{
if (inheritp->variable_index_offset & NON_VIRTUAL_OFFSET_TAG)
{
inheritp->variable_index_offset += num_virtual_variables;
inheritp->variable_index_offset &= ~NON_VIRTUAL_OFFSET_TAG;
}
}
} /* fix_variable_index_offsets() */
/*-------------------------------------------------------------------------*/
void
store_line_number_info (void)
{
unsigned char c;
short offset;
/* Was code generated since the last call?
* If not, return.
*/
offset = mem_block[A_PROGRAM].current_size - stored_bytes;
if (offset <= 0)
return;
stored_bytes = mem_block[A_PROGRAM].current_size;
/* Less than 8 bytes code in 2..9 lines */
if (offset <= 8
&& current_loc.line - stored_lines >= 2 && current_loc.line - stored_lines <= 9)
{
c = offset + 8*(current_loc.line - stored_lines) + 47;
/* == (lineincr+6) << 3 | (codesize-1) */
byte_to_mem_block(A_LINENUMBERS, c);
stored_lines = current_loc.line;
return;
}
/* Use up the excessive amounts of lines */
stored_lines++;
while (stored_lines > current_loc.line)
{
int lines;
lines = stored_lines - current_loc.line;
if (lines > 256)
lines = 256;
stored_lines -= lines;
byte_to_mem_block(A_LINENUMBERS, LI_BACK);
byte_to_mem_block(A_LINENUMBERS, lines-1);
}
while (stored_lines < current_loc.line)
{
int lines;
lines = current_loc.line - stored_lines;
if (lines > LI_MAXEMPTY)
lines = LI_MAXEMPTY;
stored_lines += lines;
c = 256 - lines;
byte_to_mem_block(A_LINENUMBERS, c);
}
while (offset >= LI_MAXOFFSET)
{
byte_to_mem_block(A_LINENUMBERS, LI_MAXOFFSET);
offset -= LI_MAXOFFSET;
}
byte_to_mem_block(A_LINENUMBERS, offset);
} /* store_line_number_info() */
/*-------------------------------------------------------------------------*/
static void
store_line_number_relocation (int relocated_from)
/* Since the last store_line_number_info(), the compiler added a code
* block which was compiled out of order at the earlier line <relocated_from>.
* Add the relocation marker with the offset to <relocated_from>, call
* store_line_number_info() for the modified linenumbers and the added
* codeblock, then restore the current line number.
*/
{
int save_current, offset;
save_current = current_loc.line;
stored_lines -= 2;
current_loc.line = stored_lines+1;
offset = current_loc.line - relocated_from;
if (offset >= LI_SMALL_REL)
{
byte_to_mem_block(A_LINENUMBERS, LI_L_RELOCATED);
byte_to_mem_block(A_LINENUMBERS, offset >> 8);
byte_to_mem_block(A_LINENUMBERS, offset);
/* trailing LI_L_RELOCATED allows bidirectional traversal */
byte_to_mem_block(A_LINENUMBERS, LI_L_RELOCATED);
}
else
{
byte_to_mem_block(A_LINENUMBERS, LI_RELOCATED + offset);
}
store_line_number_info();
current_loc.line = save_current;
} /* store_line_number_relocation() */
/*-------------------------------------------------------------------------*/
void
store_line_number_backward (int offset)
/* The current line counter is set back by <offset> lines.
* Adapted the stored_lines counter and add the LI_BACK linenumber entry.
*/
{
if (offset > 0)
{
store_line_number_info();
stored_lines -= offset;
while (offset > 256)
{
byte_to_mem_block(A_LINENUMBERS, LI_BACK);
byte_to_mem_block(A_LINENUMBERS, 255);
offset -= 256;
}
byte_to_mem_block(A_LINENUMBERS, LI_BACK);
byte_to_mem_block(A_LINENUMBERS, offset-1);
}
} /* store_line_number_backward() */
/*-------------------------------------------------------------------------*/
mp_uint
store_include_info (char *name, char * filename, char delim, int depth)
/* The lexer is going to include <name>, which can be the filename given
* in an #include directive, or a descriptive name for a different source.
* The full (file)name of the source as seen by the lexer is <filename>.
* This will be include depth <depth>.
* <delim> is either '"' or '>' if this include is from a file, or ')'
* if it's a different source.
*
* Result is the offset of the include information in the mem_block.
* It is to be considered a handle and has to be passed to
* store_include_end().
*/
{
mp_uint rc;
/* Generate and store the plain include information */
{
include_t inc;
char * tmp;
size_t len;
/* Make sure that the filename starts with a leading slash,
* then make it a tabled string and store it.
*/
if (*filename != '/')
{
tmp = alloca(strlen(filename)+2);
if (tmp == NULL)
{
yyerror("Out of stack memory: copy of filename");
}
else
{
*tmp = '/';
strcpy(tmp+1, filename);
filename = tmp;
}
}
inc.filename = new_tabled(filename);
if (inc.filename == NULL)
{
inc.filename = ref_mstring(STR_DEFAULT);
yyerror("Out of memory: sharing include filename");
}
/* Surround the <name> with the delimiters, then
* make it a tabled string and store it.
*/
len = strlen(name);
tmp = alloca(len+3);
if (tmp == NULL)
{
yyerror("Out of stack memory: copy of name");
}
else
{
*tmp = delim == '"' ? delim
: (delim == '>' ? '<' : '(');
strcpy(tmp+1, name);
tmp[len+1] = delim;
tmp[len+2] = '\0';
inc.name = new_tabled(tmp);
if (inc.name == NULL)
{
inc.name = ref_mstring(STR_DEFAULT);
yyerror("Out of memory: sharing include name");
}
}
/* Complete the structure and store it */
inc.depth = depth;
rc = mem_block[A_INCLUDES].current_size;
add_to_mem_block(A_INCLUDES, &inc, sizeof inc);
}
/* Store the information for the linenumber tracing */
{
if (last_include_start == mem_block[A_LINENUMBERS].current_size)
{
simple_includes++;
}
else
{
simple_includes = 0;
}
stored_lines++; /* don't count the #include line */
/* Use up the amounts of lines collected */
while (stored_lines < current_loc.line)
{
int lines;
lines = current_loc.line - stored_lines;
if (lines > LI_MAXEMPTY) lines = LI_MAXEMPTY;
stored_lines += lines;
byte_to_mem_block(A_LINENUMBERS, 256 - lines);
}
/* Store the bytecode and mark the position */
byte_to_mem_block(A_LINENUMBERS, LI_INCLUDE);
last_include_start = mem_block[A_LINENUMBERS].current_size;
/* Restart linecount */
stored_lines = 0;
}
return rc;
} /* store_include_info() */
/*-------------------------------------------------------------------------*/
void
store_include_end (mp_uint inc_offset, int include_line)
/* The current include ended. <inc_offset> has to be the offset returned by
* store_include_info() for this include file, <include_line> is the
* line number of the #include statement in the including file.
*/
{
unsigned char c;
stored_lines = include_line;
if (last_include_start == mem_block[A_LINENUMBERS].current_size)
{
include_t * inc = (include_t *)(mem_block[A_INCLUDES].block + inc_offset);
/* No code was generated in this include - remove the
* line number information stored by store_include_info()
* and tag the include information in A_INCLUDES.
*/
last_include_start = mem_block[A_LINENUMBERS].current_size - 1;
stored_lines--;
while (last_include_start
&& (c = mem_block[A_LINENUMBERS].block[last_include_start - 1])
>= 0x100 - LI_MAXEMPTY)
{
stored_lines += c - 0x100;
last_include_start--;
}
mem_block[A_LINENUMBERS].current_size = last_include_start;
if (--simple_includes < 0)
{
last_include_start--;
}
inc->depth = -inc->depth;
}
else
{
/* Store the include end and correct the linenumber */
byte_to_mem_block(A_LINENUMBERS, LI_INCLUDE_END);
}
} /* store_include_end() */
/*-------------------------------------------------------------------------*/
static void
prolog (const char * fname, Bool isMasterObj)
/* Initialize the compiler environment prior to a compile.
* <fname> is the name of the top LPC file to be compiled.
* <isMasterObj> is TRUE if this compile is part of the compilation of
* the master object (in which case sefuns are disabled).
*/
{
int i;
ident_t *id;
/* Initialize the memory for the argument types */
if (type_of_arguments.block == NULL)
{
type_of_arguments.max_size = 100;
type_of_arguments.block = xalloc(type_of_arguments.max_size);
}
type_of_arguments.current_size = 0;
/* Initialize all the globals */
variables_defined = MY_FALSE;
disable_sefuns = isMasterObj;
last_expression = -1;
compiled_prog = NULL; /* NULL means fail to load. */
heart_beat = -1;
comp_stackp = 0; /* Local temp stack used by compiler */
current_continue_address = 0;
current_break_address = 0;
num_parse_error = 0;
block_depth = 0;
use_local_scopes = MY_TRUE;
default_varmod = 0;
default_funmod = 0;
#ifdef USE_NEW_INLINES
current_inline = NULL;
inline_closure_id = 0;
#endif /* USE_NEW_INLINES */
free_all_local_names(); /* In case of earlier error */
/* Initialize memory blocks where the result of the compilation
* will be stored.
*/
for (i = 0; i < NUMAREAS; i++)
{
mem_block[i].block = xalloc(START_BLOCK_SIZE);
mem_block[i].current_size = 0;
mem_block[i].max_size = START_BLOCK_SIZE;
}
extend_mem_block(A_LOCAL_TYPES, MAX_LOCAL * sizeof(fulltype_t));
memset(&LOCAL_TYPE(0), 0, LOCAL_TYPE_COUNT * sizeof(fulltype_t));
type_of_locals = &(LOCAL_TYPE(0));
#ifdef USE_NEW_INLINES
type_of_context = type_of_locals;
#endif /* USE_NEW_INLINES */
#ifdef DEBUG_INLINES
printf("DEBUG: prolog: type ptrs: %p, %p\n", type_of_locals, type_of_context );
#endif /* DEBUG_INLINES */
#ifdef USE_STRUCTS
compiled_file = fname;
#endif /* USE_STRUCTS */
stored_lines = 0;
stored_bytes = 0;
last_include_start = -1;
memset(prog_string_tags, 0, sizeof prog_string_tags);
num_virtual_variables = 0;
case_state.free_block = NULL;
case_state.next_free = NULL;
last_initializer_end = -4; /* To pass the test in transfer_init_control() */
variables_initialized = 0;
argument_level = 0;
got_ellipsis[0] = MY_FALSE;
/* Check if call_other() has been replaced by a sefun.
*/
call_other_sefun = -1;
if (!disable_sefuns)
{
id = make_shared_identifier(get_txt(STR_CALL_OTHER), I_TYPE_UNKNOWN, 0);
if (!id)
fatal("Out of memory: identifier '%s'.\n", get_txt(STR_CALL_OTHER));
if (id->type != I_TYPE_UNKNOWN)
{
/* This shouldn't be necessary, but just in case... */
while (id && id->type > I_TYPE_GLOBAL)
id = id->inferior;
if ( id
&& id->u.global.function < 0
&& id->u.global.sim_efun >= 0)
{
/* There is a sefun for call_other() */
call_other_sefun = id->u.global.sim_efun;
}
}
} /* if (!disable_sefuns) */
} /* prolog() */
/*-------------------------------------------------------------------------*/
static void
epilog (void)
/* The parser finished - now collect the information and generate
* the program structure, if the parse was successful.
*/
{
int i;
p_int size;
mp_int num_functions;
mp_int num_strings;
mp_int num_variables;
bytecode_p p;
ident_t *g, *q;
function_t *f;
function_t *funname_start1; /* The name chains (to sort) */
function_t *funname_start2;
mp_int num_function_names;
program_t *prog;
/* First, clean up */
#ifdef DEBUG
if (num_parse_error == 0 && type_of_arguments.current_size != 0)
fatal("Failed to deallocate argument type stack\n");
#endif
if (last_string_constant)
{
free_mstring(last_string_constant);
last_string_constant = NULL;
}
free_case_blocks();
%ifdef USE_STRUCTS
for (i = 0; (size_t)i < STRUCT_MEMBER_COUNT; i++)
{
free_struct_member_data(&STRUCT_MEMBER(i));
}
mem_block[A_STRUCT_MEMBERS].current_size = 0;
/* If the parse was successful, Make sure that all structs are defined and
* reactivate old structs where possible.
* If an error occurs, num_parse_error is incremented and epilog() will
* bail out below.
*/
if (!num_parse_error && !inherit_file)
{
struct_epilog();
}
%endif /* USE_STRUCTS */
/* Append the non-virtual variable block to the virtual ones,
* and take care of the initializers.
*/
if (V_VARIABLE_COUNT > 0x100)
{
yyerror("Too many virtual variables");
}
add_to_mem_block(
A_VIRTUAL_VAR,
mem_block[A_VARIABLES].block,
mem_block[A_VARIABLES].current_size
);
mem_block[A_VARIABLES].current_size = 0;
/* Define the __INIT function, but only if there was any code
* to initialize.
*/
if (last_initializer_end > 0)
{
ident_t *ip;
ip = make_global_identifier(get_txt(STR_VARINIT), I_TYPE_UNKNOWN);
if (ip)
define_new_function(MY_FALSE, ip, 0, 0, first_initializer_start
, TYPE_MOD_PROTECTED, Type_Unknown);
/* ref count for ip->name was incremented by transfer_init_control() */
/* Change the last jump after the last initializer into a
* return(1) statement.
*/
mem_block[A_PROGRAM].block[last_initializer_end-1] =
F_CONST1;
mem_block[A_PROGRAM].block[last_initializer_end-0] =
F_RETURN;
} /* if (has initializer) */
/* Check the string block. We don't have to count the include file names
* as those won't be accessed from the program code.
*/
if (mem_block[A_STRINGS].current_size > 0x10000 * sizeof (string_t *))
yyerror("Too many strings");
/* Get and check the numbers of functions, strings, and variables */
num_functions = FUNCTION_COUNT;
if (num_functions > 0x10000)
{
yyerror("Too many functions");
}
num_strings = STRING_COUNT;
num_variables = V_VARIABLE_COUNT;
if (num_variables >= VIRTUAL_VAR_TAG)
{
yyerror("Too many variables");
}
num_function_names = 0;
if (!num_parse_error && !inherit_file)
{
/* If the parse was successful, fill in undefined functions,
* resolve cross-defines, and sort the program names with mergesort.
*/
function_t **link1, **link2; /* Linkpointer for the sort */
f = (function_t *)mem_block[A_FUNCTIONS].block;
link1 = &funname_start2;
link2 = &funname_start1;
for (i = num_functions; --i >= 0; f++)
{
funflag_t flags;
/* If the function was cross-defined, the targeted function might
* be a cross-definition itself. Unravel such a cross-definition
* chain and let f->offset.func point to the actual definition.
*/
if ( f->flags & NAME_CROSS_DEFINED )
{
int32 offset;
offset = GET_CROSSDEF_OFFSET(f->offset.func);
while (f[offset].flags & NAME_CROSS_DEFINED)
{
f->offset.func = offset + f[offset].offset.func;
offset = GET_CROSSDEF_OFFSET(f->offset.func);
}
}
/* If the function is undefined, generate a dummy function
* with UNDEF as body.
* Except __INIT, which is created as CONST1 RETURN.
*/
if ((f->flags & (NAME_UNDEFINED|NAME_INHERITED)) == NAME_UNDEFINED)
{
CURRENT_PROGRAM_SIZE = align(CURRENT_PROGRAM_SIZE);
if (!realloc_a_program(FUNCTION_HDR_SIZE + 2))
{
yyerrorf("Out of memory: program size %"PRIuMPINT"\n"
, CURRENT_PROGRAM_SIZE + FUNCTION_HDR_SIZE + 2);
}
else
{
f->offset.pc = CURRENT_PROGRAM_SIZE + FUNCTION_PRE_HDR_SIZE;
store_function_header( CURRENT_PROGRAM_SIZE
, f->name, f->type, f->num_arg
, f->num_local);
p = PROGRAM_BLOCK + CURRENT_PROGRAM_SIZE
+ FUNCTION_HDR_SIZE;
/* If __INIT() is undefined (i.e. there was a prototype, but
* no explicit function nor the automagic initialization code,
* then a dummy function is generated. This prevents crashes
* when this program is inherited later.
*/
if (mstreq(f->name, STR_VARINIT) && !f->num_arg)
{
f->flags &= ~NAME_UNDEFINED;
*p++ = F_CONST1;
*p = F_RETURN;
} else {
*p = F_UNDEF;
}
CURRENT_PROGRAM_SIZE += FUNCTION_HDR_SIZE + 2;
}
}
/* Set the function address resp. inherit index in
* the function's flags.
*/
flags = f->flags;
f->flags = flags & NAME_INHERITED ?
(flags & ~INHERIT_MASK) | (f->offset.inherit & INHERIT_MASK) :
(flags & ~FUNSTART_MASK) | (f->offset.pc & FUNSTART_MASK);
/* If the function is visible, add it to the list of names
* to be sorted.
*/
if ( !(flags & (NAME_HIDDEN|NAME_UNDEFINED|TYPE_MOD_PRIVATE) ) )
{
*link1 = f;
link1 = link2;
link2 = &f->offset.next;
num_function_names++;
}
}
/* End the two chains */
*link1 = NULL;
*link2 = NULL;
/* Store line number info for undefined functions */
store_line_number_info();
/* Sort the function names */
if (num_function_names <= 1)
{
/* Nothing to sort */
funname_start1 = funname_start2;
}
else
{
/* Mergesort again.
* TODO: Make this a standard function.
*/
int runlength;
runlength = 1;
do {
function_t *out_start1, *out_start2, **out1, **out2;
int count1, count2;
count1 = num_function_names & (runlength-1);
count2 = num_function_names & runlength;
if (!count1)
{
out2 = &out_start1;
*out2 = funname_start2;
while (--count2 >= 0)
{
out2 = &(*out2)->offset.next;
}
funname_start2 = *out2;
count1 = count2 = runlength;
out1 = &out_start2;
}
else if (!count2)
{
out2 = &out_start1;
*out2 = funname_start1;
do
{
out2 = &(*out2)->offset.next;
} while (--count1);
funname_start1 = *out2;
count1 = count2 = runlength;
out1 = &out_start2;
}
else
{
out1 = &out_start1;
out2 = &out_start2;
}
while (funname_start1)
{
while (1) {
/* Compare the two pointers.
* The comparison operation has to match the
* one in closure.c:function_cmp().
*/
if (memcmp(
&funname_start2->name,
&funname_start1->name,
sizeof(char *)
) < 0)
{
*out1 = funname_start2;
out1 = &funname_start2->offset.next;
funname_start2 = *out1;
if (!--count2)
{
*out1 = funname_start1;
do {
out1 = &(*out1)->offset.next;
} while (--count1);
funname_start1 = *out1;
break;
}
}
else
{
*out1 = funname_start1;
out1 = &funname_start1->offset.next;
funname_start1 = *out1;
if (!--count1)
{
*out1 = funname_start2;
do {
out1 = &(*out1)->offset.next;
} while (--count2);
funname_start2 = *out1;
break;
}
}
}
{
function_t **temp;
temp = out1;
out1 = out2;
out2 = temp;
}
count1 = count2 = runlength;
}
*out1 = NULL;
*out2 = NULL;
funname_start1 = out_start1;
funname_start2 = out_start2;
runlength <<= 1;
} while (runlength < num_function_names);
} /* end of sort */
/* either funname_start1 or funname_start2 now has the
* sorted list of function names.
*/
/* If the program is too large, make sure that the
* name strings are freed again.
*/
if (CURRENT_PROGRAM_SIZE > FUNSTART_MASK)
{
function_t *functions;
yyerror("Program too large");
functions = (function_t *)mem_block[A_FUNCTIONS].block;
for (i = num_functions; --i >= 0; functions++)
{
if ( !(functions->flags & (NAME_UNDEFINED|NAME_INHERITED)) ==
NAME_UNDEFINED)
{
free_mstring(functions->name);
}
}
}
/* Done: functions are sorted, resolved, etc etc */
} /* if (parse successful) */
/* Free unneeded memory */
free_all_local_names();
for (q = all_globals; NULL != (g = q); )
{
q = g->next_all;
free_shared_identifier(g);
}
while(last_yalloced)
{
yfree(last_yalloced);
debug_message("%s freeing lost block\n", time_stamp());
}
if (all_efun_shadows)
{
efun_shadow_t *s, *t;
for (t = all_efun_shadows; NULL != (s = t); )
{
s->shadow->u.global.function = I_GLOBAL_FUNCTION_OTHER;
s->shadow->u.global.variable = I_GLOBAL_VARIABLE_FUN;
t = s->next;
xfree(s);
}
all_efun_shadows = NULL;
}
all_globals = NULL;
remove_unknown_identifier();
/* Now create the program structure */
switch (0) { default:
#if 0 && defined(USE_STRUCTS)
{
int i, j;
printf("DEBUG: --- structs in %s ---\n", current_loc.file->name);
for (i = 0; i < STRUCT_COUNT; i++)
{
struct_type_t * ptype;
ptype = STRUCT_DEF(i).type;
printf("DEBUG: [%d] struct %s: (%s #%"PRId32") ref %"PRIdPINT
", %hd members, base %s, flags %"PRIx32"\n"
, i, get_txt(ptype->name)
, ptype->prog_name ? get_txt(ptype->prog_name) : "<none>"
, ptype->prog_id
, ptype->ref
, ptype->num_members
, ptype->base ? get_txt(ptype->base->name) : "<none>"
, STRUCT_DEF(i).flags
);
fflush(stdout);
#if 1
for (j = 0; j < ptype->num_members; j++)
{
fulltype_t ftype;
assign_var_to_fulltype(&ftype, ptype->member[j].type);
printf("DEBUG: [%d] member %s: %s\n"
, j, get_txt(ptype->member[j].name)
, get_type_name(ftype)
);
fflush(stdout);
}
#endif
}
printf("DEBUG: ------\n");
}
#endif /* 0 && USE_STRUCTS */
/* On error, don't create anything */
if (num_parse_error > 0 || inherit_file)
break;
/* Compute the size of the program.
* Right now, we allocate everything in one block.
*/
size = align(sizeof (program_t));
if (!pragma_save_types)
{
for (i = 0; (size_t)i < ARGTYPE_COUNT; i++)
free_vartype_data(&ARGUMENT_TYPE(i));
mem_block[A_ARGUMENT_TYPES].current_size = 0;
mem_block[A_ARGUMENT_INDEX].current_size = 0;
}
for (i = 0; i< NUMPAREAS; i++)
{
if (i != A_LINENUMBERS)
size += align(mem_block[i].current_size);
}
size += align(num_function_names * sizeof *prog->function_names);
size += align(num_functions * sizeof *prog->functions);
/* Get the program structure */
if ( !(p = xalloc(size)) )
{
yyerrorf("Out of memory: program structure (%"PRIdPINT" bytes)",
size);
break;
}
prog = (program_t *)p;
*prog = NULL_program;
/* Set up the program structure */
if ( !(prog->name = new_mstring(current_loc.file->name)) )
{
xfree(prog);
yyerrorf("Out of memory: filename '%s'", current_loc.file->name);
break;
}
prog->blueprint = NULL;
prog->total_size = size;
prog->ref = 0;
prog->heart_beat = heart_beat;
prog->id_number =
++current_id_number ? current_id_number : renumber_programs();
prog->flags = (pragma_no_clone ? P_NO_CLONE : 0)
| (pragma_no_inherit ? P_NO_INHERIT : 0)
| (pragma_no_shadow ? P_NO_SHADOW : 0)
| (pragma_share_variables ? P_SHARE_VARIABLES : 0)
;
prog->load_time = current_time;
total_prog_block_size += prog->total_size + mstrsize(prog->name);
total_num_prog_blocks += 1;
p += align(sizeof (program_t));
/* Add the program code
*/
prog->program = p;
if (mem_block[A_PROGRAM].current_size)
memcpy(p, mem_block[A_PROGRAM].block,
mem_block[A_PROGRAM].current_size);
p += align(mem_block[A_PROGRAM].current_size);
/* Add the function names right after the program code
*/
prog->num_function_names = num_function_names;
prog->function_names = (unsigned short *)p;
{
unsigned short *namep;
namep = (unsigned short *)p;
if ( NULL != (f = funname_start1) || NULL != (f = funname_start2) )
{
do {
*namep++ =
f - (function_t *)mem_block[A_FUNCTIONS].block;
} while ( NULL != (f = f->offset.next) );
}
}
p += align(num_function_names * sizeof *prog->function_names);
/* Add the function flags
*/
prog->num_functions = num_functions;
prog->functions = (funflag_t *)p;
{
funflag_t *flagp;
f = (function_t *)mem_block[A_FUNCTIONS].block;
flagp = (funflag_t *)p;
for (i = num_functions; --i >= 0; f++)
{
*flagp++ = f->flags;
}
}
p += align(num_functions * sizeof *prog->functions);
/* Add the program strings
*/
prog->strings = (string_t **)p;
prog->num_strings = num_strings;
if (mem_block[A_STRINGS].current_size)
memcpy(p, mem_block[A_STRINGS].block,
mem_block[A_STRINGS].current_size);
p += align(mem_block[A_STRINGS].current_size);
/* Add the variable descriptions
*/
prog->variables = (variable_t *)p;
prog->num_variables = num_variables;
if (mem_block[A_VIRTUAL_VAR].current_size)
memcpy(p, mem_block[A_VIRTUAL_VAR].block,
mem_block[A_VIRTUAL_VAR].current_size);
p += align(mem_block[A_VIRTUAL_VAR].current_size);
/* Add the inheritance information, and don't forget
* to delete our internal flags.
*/
prog->num_inherited = mem_block[A_INHERITS].current_size /
sizeof (inherit_t);
if (prog->num_inherited)
{
memcpy(p, mem_block[A_INHERITS].block,
mem_block[A_INHERITS].current_size);
prog->inherit = (inherit_t *)p;
} else {
prog->inherit = NULL;
}
p += align(mem_block[A_INHERITS].current_size);
#ifdef USE_STRUCTS
/* Add the struct information.
*/
prog->num_structs = STRUCT_COUNT;
if (prog->num_structs)
{
memcpy(p, mem_block[A_STRUCT_DEFS].block,
mem_block[A_STRUCT_DEFS].current_size);
prog->struct_defs = (struct_def_t *)p;
} else {
prog->struct_defs = NULL;
}
p += align(mem_block[A_STRUCT_DEFS].current_size);
#endif /* USE_STRUCTS */
/* Add the include file information */
prog->num_includes = INCLUDE_COUNT;
if (prog->num_includes)
{
memcpy(p, mem_block[A_INCLUDES].block
, mem_block[A_INCLUDES].current_size);
prog->includes = (include_t *)p;
}
else
prog->includes = NULL;
p += align(mem_block[A_INCLUDES].current_size);
/* Add the argument type information
*/
if (pragma_save_types)
{
if (mem_block[A_ARGUMENT_TYPES].current_size)
memcpy(p, mem_block[A_ARGUMENT_TYPES].block,
mem_block[A_ARGUMENT_TYPES].current_size);
prog->argument_types = (vartype_t *)p;
p += align(mem_block[A_ARGUMENT_TYPES].current_size);
if (mem_block[A_ARGUMENT_INDEX].current_size)
memcpy(p, mem_block[A_ARGUMENT_INDEX].block,
mem_block[A_ARGUMENT_INDEX].current_size);
prog->type_start = (unsigned short *)p;
p += align(mem_block[A_ARGUMENT_INDEX].current_size);
}
else
{
prog->argument_types = NULL;
prog->type_start = NULL;
}
/* Add the linenumber information.
*/
{
size_t linenumber_size;
linenumber_size = mem_block[A_LINENUMBERS].current_size
+ sizeof(linenumbers_t);
if ( !(prog->line_numbers = xalloc(linenumber_size)) )
{
total_prog_block_size -= prog->total_size + mstrsize(prog->name)+1;
total_num_prog_blocks -= 1;
xfree(prog);
yyerrorf("Out of memory: linenumber structure (%zu bytes)"
, linenumber_size);
break;
}
total_prog_block_size += linenumber_size;
prog->line_numbers->size = linenumber_size;
if (mem_block[A_LINENUMBERS].current_size)
memcpy( prog->line_numbers->line_numbers
, mem_block[A_LINENUMBERS].block
, mem_block[A_LINENUMBERS].current_size);
}
/* Correct the variable index offsets */
fix_variable_index_offsets(prog);
prog->swap_num = -1;
/* Free the memareas */
for (i = 0; (size_t)i < LOCAL_TYPE_COUNT; i++)
free_fulltype_data(&LOCAL_TYPE(i));
for (i = 0; (size_t)i < FUNCTION_COUNT; i++)
free_fulltype_data(&FUNCTION(i)->type);
for (i = 0; i < NUMAREAS; i++)
{
xfree(mem_block[i].block);
}
type_of_locals = NULL;
#ifdef USE_NEW_INLINES
type_of_context = NULL;
#endif /* USE_NEW_INLINES */
/* Reference the program and all inherits, but avoid multiple
* referencing when an object inherits more than one object
* and one of the inherited is already loaded and not the
* last inherited.
*/
reference_prog(prog, "epilog");
for (i = 0; i < prog->num_inherited; i++)
{
reference_prog(prog->inherit[i].prog, "inheritance");
}
/* Return the value */
compiled_prog = prog;
return;
}
/* If we come here, the program couldn't be created - just
* free all memory.
*/
{
function_t *functions;
/* Free all function names and type data. */
functions = (function_t *)mem_block[A_FUNCTIONS].block;
for (i = num_functions; --i >= 0; functions++)
{
if ( !(functions->flags & (NAME_INHERITED|NAME_UNDEFINED))
&& functions->name )
{
free_mstring(functions->name);
}
free_fulltype_data(&functions->type);
}
do_free_sub_strings( num_strings
, (string_t **)mem_block[A_STRINGS].block
, num_variables
, (variable_t *)mem_block[A_VIRTUAL_VAR].block
, INCLUDE_COUNT
, (include_t *)mem_block[A_INCLUDES].block
#ifdef USE_STRUCTS
, STRUCT_COUNT
, (struct_def_t *)mem_block[A_STRUCT_DEFS].block
#endif /* USE_STRUCTS */
);
/* Free the type information */
for (i = 0; (size_t)i < ARGTYPE_COUNT; i++)
{
free_vartype_data(&ARGUMENT_TYPE(i));
}
for (i = 0; (size_t)i < LOCAL_TYPE_COUNT; i++)
{
free_fulltype_data(&LOCAL_TYPE(i));
}
compiled_prog = NULL;
for (i = 0; i < NUMAREAS; i++)
{
xfree(mem_block[i].block);
}
type_of_locals = NULL;
#ifdef USE_NEW_INLINES
type_of_context = NULL;
#endif /* USE_NEW_INLINES */
return;
}
/* NOTREACHED */
} /* epilog() */
/*-------------------------------------------------------------------------*/
void
compile_file (int fd, const char * fname, Bool isMasterObj)
/* Compile an LPC file. See the head comment for instructions.
*/
{
prolog(fname, isMasterObj);
start_new_file(fd, fname);
yyparse();
/* If the parse failed, either num_parse_error != 0
* or inherit_file != NULL here.
*/
epilog();
end_new_file();
} /* compile_file() */
/*-------------------------------------------------------------------------*/
Bool
is_undef_function (fun_hdr_p fun)
/* Return TRUE if <fun> points to a referenced but undefined function.
*/
{
return GET_CODE(FUNCTION_CODE(fun)) == F_UNDEF;
} /* is_undef_function() */
/*-------------------------------------------------------------------------*/
#if defined( DEBUG ) && defined ( TRACE_CODE )
static int code_window_offset = -1;
void
set_code_window (void)
/* #pragma set_code_window: Remember the current program position.
*/
{
code_window_offset = CURRENT_PROGRAM_SIZE;
}
void
show_code_window (void)
/* #pragma show_code_window: Print 32 bytes following the last
* position remembered with set_code_window to stdout.
*/
{
int i;
bytecode_p p;
if (code_window_offset < 0)
return;
p = (bytecode_p)mem_block[A_PROGRAM].block + code_window_offset;
for (i = 0; i < 32; i++) {
printf("%3d ", p[i]);
}
printf("\n");
fflush(stdout);
} /* show_code_window() */
#endif
/*-------------------------------------------------------------------------*/
#ifdef GC_SUPPORT
void
count_compiler_refs (void)
/* GC support: mark the memory held by the compiler environment.
*/
{
if (type_of_arguments.block)
{
note_malloced_block_ref(type_of_arguments.block);
}
}
#endif
#if defined(__MWERKS__) && !defined(WARN_ALL)
# pragma warn_possunwant off
# pragma warn_implicitconv off
#endif
/*-------------------------------------------------------------------------*/
/***************************************************************************/
/* vim: filetype=c
*/
Reference in New Issue View Git Blame Copy Permalink