Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
| Download
GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: 418346/****************************************************************************1**2*W compiler.c GAP source Frank Celler3*W & Ferenc Rà kòczi4*W & Martin Schönert5**6**7*Y Copyright (C) 1997, Lehrstuhl D für Mathematik, RWTH Aachen, Germany8*Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland9*Y Copyright (C) 2002 The GAP Group10**11** This file contains the GAP to C compiler.12*/13#include <stdarg.h> /* variable argument list macros */14#include "system.h" /* Ints, UInts */151617#include "gasman.h" /* garbage collector */18#include "objects.h" /* objects */19#include "scanner.h" /* scanner */2021#include "gvars.h" /* global variables */2223#include "ariths.h" /* basic arithmetic */24#include "integer.h"2526#include "bool.h" /* booleans */2728#include "gap.h" /* error handling, initialisation */2930#include "calls.h" /* generic call mechanism */31/*N 1996/06/16 mschoene func expressions should be different from funcs */3233#include "lists.h" /* generic lists */3435#include "records.h" /* generic records */36#include "precord.h" /* plain records */3738#include "plist.h" /* plain lists */3940#include "string.h" /* strings */4142#include "code.h" /* coder */4344#include "exprs.h" /* expressions */45#include "stats.h" /* statements */4647#include "compiler.h" /* compiler */4849#include "tls.h" /* thread-local storage */5051#include "vars.h" /* variables */525354/****************************************************************************55**5657*F * * * * * * * * * * * * * compilation flags * * * * * * * * * * * * * * *58*/596061/****************************************************************************62**636465*V CompFastIntArith . . option to emit code that handles small ints. faster66*/67Int CompFastIntArith;686970/****************************************************************************71**72*V CompFastPlainLists . option to emit code that handles plain lists faster73*/74Int CompFastPlainLists ;757677/****************************************************************************78**79*V CompFastListFuncs . . option to emit code that inlines calls to functions80*/81Int CompFastListFuncs;828384/****************************************************************************85**86*V CompCheckTypes . . . . option to emit code that assumes all types are ok.87*/88Int CompCheckTypes ;899091/****************************************************************************92**93*V CompCheckListElements . option to emit code that assumes list elms exist94*/95Int CompCheckListElements;9697/****************************************************************************98**99*V CompOptNames . . names for all the compiler options passed by gac100**101*/102103struct CompOptStruc { const Char *extname;104Int *variable;105Int val;};106107struct CompOptStruc CompOptNames[] = {108{ "FAST_INT_ARITH", &CompFastIntArith, 1 },109{ "FAST_PLAIN_LISTS", &CompFastPlainLists, 1 },110{ "FAST_LIST_FUNCS", &CompFastListFuncs, 1 },111{ "NO_CHECK_TYPES", &CompCheckTypes, 0 },112{ "NO_CHECK_LIST_ELMS", &CompCheckListElements, 0 }};113114#define N_CompOpts (sizeof(CompOptNames)/sizeof(struct CompOptStruc))115116117/****************************************************************************118**119*F SetCompileOpts( <string> ) . . parse the compiler options from <string>120** and set the appropriate variables121** unrecognised options are ignored for now122*/123#include <ctype.h>124125void SetCompileOpts( Char *opts )126{127Char *s = opts;128Int i;129while (*s)130{131while (IsSpace(*s))132s++;133for (i = 0; i < N_CompOpts; i++)134{135if (0 == strncmp(CompOptNames[i].extname,136s,137strlen(CompOptNames[i].extname)))138{139*(CompOptNames[i].variable) = CompOptNames[i].val;140break;141}142}143while (*s && *s != ',')144s++;145if (*s == ',')146s++;147}148return;149}150151/****************************************************************************152**153*V CompCheckPosObjElements . option to emit code that assumes pos elm exist154*/155Int CompCheckPosObjElements;156157158/****************************************************************************159**160*V CompPass . . . . . . . . . . . . . . . . . . . . . . . . . compiler pass161**162** 'CompPass' holds the number of the current pass.163**164** The compiler does two passes over the source.165**166** In the first pass it only collects information but emits no code.167**168** It finds out which global variables and record names are used, so that169** the compiler can output code to define and initialize global variables170** 'G_<name>' resp. 'R_<name>' to hold their identifiers.171**172** It finds out which arguments and local variables are used as higher173** variables from inside local functions, so that the compiler can output174** code to allocate and manage a stack frame for them.175**176** It finds out how many temporary variables are used, so that the compiler177** can output code to define corresponding local variables.178**179** In the second pass it emits code.180**181** The only difference between the first pass and the second pass is that182** 'Emit' emits no code during the first pass. While this causes many183** unneccessary computations during the first pass, the advantage is that184** the two passes are guaranteed to do exactly the same computations.185*/186Int CompPass;187188189/****************************************************************************190**191192*F * * * * * * * * * * * * temp, C, local functions * * * * * * * * * * * * *193*/194195196/****************************************************************************197**198199*V compilerMagic1 . . . . . . . . . . . . . . . . . . . . . current magic1200*/201static Int compilerMagic1;202203204/****************************************************************************205**206*V compilerMagic2 . . . . . . . . . . . . . . . . . . . . . current magic2207*/208static Char * compilerMagic2;209210211/****************************************************************************212**213*T CVar . . . . . . . . . . . . . . . . . . . . . . . type for C variables214**215** A C variable represents the result of compiling an expression. There are216** three cases (distinguished by the least significant two bits).217**218** If the expression is an immediate integer expression, the C variable219** contains the value of the immediate integer expression.220**221** If the expression is an immediate reference to a local variable, the C222** variable contains the index of the local variable.223**224** Otherwise the expression compiler emits code that puts the value of the225** expression into a temporary variable, and the C variable contains the226** index of that temporary variable.227*/228typedef UInt CVar;229230#define IS_INTG_CVAR(c) ((((UInt)(c)) & 0x03) == 0x01)231#define INTG_CVAR(c) (((Int)(c)) >> 2)232#define CVAR_INTG(i) ((((UInt)(i)) << 2) + 0x01)233234#define IS_TEMP_CVAR(c) ((((UInt)(c)) & 0x03) == 0x02)235#define TEMP_CVAR(c) (((UInt)(c)) >> 2)236#define CVAR_TEMP(l) ((((UInt)(l)) << 2) + 0x02)237238#define IS_LVAR_CVAR(c) ((((UInt)(c)) & 0x03) == 0x03)239#define LVAR_CVAR(c) (((UInt)(c)) >> 2)240#define CVAR_LVAR(l) ((((UInt)(l)) << 2) + 0x03)241242243/****************************************************************************244**245*F SetInfoCVar( <cvar>, <type> ) . . . . . . . set the type of a C variable246*F GetInfoCVar( <cvar> ) . . . . . . . . . . . get the type of a C variable247*F HasInfoCVar( <cvar>, <type> ) . . . . . . . test the type of a C variable248**249*F NewInfoCVars() . . . . . . . . . allocate a new info bag for C variables250*F CopyInfoCVars( <dst>, <src> ) . . copy between info bags for C variables251*F MergeInfoCVars( <dst>, <src> ) . . . merge two info bags for C variables252*F IsEqInfoCVars( <dst>, <src> ) . . . compare two info bags for C variables253**254** With each function we associate a C variables information bag. In this255** bag we store the number of the function, the number of local variables,256** the number of local variables that are used as higher variables, the257** number of temporaries used, the number of loop variables needed, the258** current number of used temporaries.259**260** Furthermore for each local variable and temporary we store what we know261** about this local variable or temporary, i.e., whether the variable has an262** assigned value, whether that value is an integer, a boolean, etc.263**264** 'SetInfoCVar' sets the information for the C variable <cvar>.265** 'GetInfoCVar' gets the information for the C variable <cvar>.266** 'HasInfoCVar' returns true if the C variable <cvar> has the type <type>.267**268** 'NewInfoCVars' creates a new C variables information bag.269** 'CopyInfoCVars' copies the C variables information from <src> to <dst>.270** 'MergeInfoCVars' merges the C variables information from <src> to <dst>,271** i.e., if there are two paths to a certain place in the source and <dst>272** is the information gathered along one path and <src> is the information273** gathered along the other path, then 'MergeInfoCVars' stores in <dst> the274** information for that point (independent of the path travelled).275** 'IsEqInfoCVars' returns true if <src> and <dst> contain the same276** information.277**278** Note that the numeric values for the types are defined such that if279** <type1> implies <type2>, then <type1> is a bitwise superset of <type2>.280*/281typedef UInt4 LVar;282283#define INFO_FEXP(fexp) PROF_FUNC(fexp)284#define NEXT_INFO(info) PTR_BAG(info)[0]285#define NR_INFO(info) (*((Int*)(PTR_BAG(info)+1)))286#define NLVAR_INFO(info) (*((Int*)(PTR_BAG(info)+2)))287#define NHVAR_INFO(info) (*((Int*)(PTR_BAG(info)+3)))288#define NTEMP_INFO(info) (*((Int*)(PTR_BAG(info)+4)))289#define NLOOP_INFO(info) (*((Int*)(PTR_BAG(info)+5)))290#define CTEMP_INFO(info) (*((Int*)(PTR_BAG(info)+6)))291#define TNUM_LVAR_INFO(info,i) (*((Int*)(PTR_BAG(info)+7+(i))))292293#define TNUM_TEMP_INFO(info,i) \294(*((Int*)(PTR_BAG(info)+7+NLVAR_INFO(info)+(i))))295296#define SIZE_INFO(nlvar,ntemp) (sizeof(Int) * (8 + (nlvar) + (ntemp)))297298#define W_UNUSED 0 /* TEMP is currently unused */299#define W_HIGHER (1L<<0) /* LVAR is used as higher variable */300#define W_UNKNOWN ((1L<<1) | W_HIGHER)301#define W_UNBOUND ((1L<<2) | W_UNKNOWN)302#define W_BOUND ((1L<<3) | W_UNKNOWN)303#define W_INT ((1L<<4) | W_BOUND)304#define W_INT_SMALL ((1L<<5) | W_INT)305#define W_INT_POS ((1L<<6) | W_INT)306#define W_BOOL ((1L<<7) | W_BOUND)307#define W_FUNC ((1L<<8) | W_BOUND)308#define W_LIST ((1L<<9) | W_BOUND)309310#define W_INT_SMALL_POS (W_INT_SMALL | W_INT_POS)311312void SetInfoCVar (313CVar cvar,314UInt type )315{316Bag info; /* its info bag */317318/* get the information bag */319info = INFO_FEXP( CURR_FUNC );320321/* set the type of a temporary */322if ( IS_TEMP_CVAR(cvar) ) {323TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) ) = type;324}325326/* set the type of a lvar (but do not change if its a higher variable) */327else if ( IS_LVAR_CVAR(cvar)328&& TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) != W_HIGHER ) {329TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) = type;330}331}332333Int GetInfoCVar (334CVar cvar )335{336Bag info; /* its info bag */337338/* get the information bag */339info = INFO_FEXP( CURR_FUNC );340341/* get the type of an integer */342if ( IS_INTG_CVAR(cvar) ) {343return ((0 < INTG_CVAR(cvar)) ? W_INT_SMALL_POS : W_INT_SMALL);344}345346/* get the type of a temporary */347else if ( IS_TEMP_CVAR(cvar) ) {348return TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) );349}350351/* get the type of a lvar */352else if ( IS_LVAR_CVAR(cvar) ) {353return TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) );354}355356/* hmm, avoid warning by compiler */357else {358return 0;359}360}361362Int HasInfoCVar (363CVar cvar,364Int type )365{366return ((GetInfoCVar( cvar ) & type) == type);367}368369370Bag NewInfoCVars ( void )371{372Bag old;373Bag new;374old = INFO_FEXP( CURR_FUNC );375new = NewBag( TNUM_BAG(old), SIZE_BAG(old) );376return new;377}378379void CopyInfoCVars (380Bag dst,381Bag src )382{383Int i;384if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );385if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );386NR_INFO(dst) = NR_INFO(src);387NLVAR_INFO(dst) = NLVAR_INFO(src);388NHVAR_INFO(dst) = NHVAR_INFO(src);389NTEMP_INFO(dst) = NTEMP_INFO(src);390NLOOP_INFO(dst) = NLOOP_INFO(src);391CTEMP_INFO(dst) = CTEMP_INFO(src);392for ( i = 1; i <= NLVAR_INFO(src); i++ ) {393TNUM_LVAR_INFO(dst,i) = TNUM_LVAR_INFO(src,i);394}395for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {396TNUM_TEMP_INFO(dst,i) = TNUM_TEMP_INFO(src,i);397}398}399400void MergeInfoCVars (401Bag dst,402Bag src )403{404Int i;405if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );406if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );407if ( NTEMP_INFO(dst)<NTEMP_INFO(src) ) NTEMP_INFO(dst)=NTEMP_INFO(src);408for ( i = 1; i <= NLVAR_INFO(src); i++ ) {409TNUM_LVAR_INFO(dst,i) &= TNUM_LVAR_INFO(src,i);410}411for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {412TNUM_TEMP_INFO(dst,i) &= TNUM_TEMP_INFO(src,i);413}414}415416Int IsEqInfoCVars (417Bag dst,418Bag src )419{420Int i;421if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );422if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );423for ( i = 1; i <= NLVAR_INFO(src); i++ ) {424if ( TNUM_LVAR_INFO(dst,i) != TNUM_LVAR_INFO(src,i) ) {425return 0;426}427}428for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {429if ( TNUM_TEMP_INFO(dst,i) != TNUM_TEMP_INFO(src,i) ) {430return 0;431}432}433return 1;434}435436437/****************************************************************************438**439*F NewTemp( <name> ) . . . . . . . . . . . . . . . allocate a new temporary440*F FreeTemp( <temp> ) . . . . . . . . . . . . . . . . . . free a temporary441**442** 'NewTemp' allocates a new temporary variable (<name> is currently443** ignored).444**445** 'FreeTemp' frees the temporary <temp>.446**447** Currently allocations and deallocations of temporaries are done in a448** strict nested (laff -- last allocated, first freed) order. This means we449** do not have to search for unused temporaries.450*/451typedef UInt4 Temp;452453Temp NewTemp (454const Char * name )455{456Temp temp; /* new temporary, result */457Bag info; /* information bag */458459/* get the information bag */460info = INFO_FEXP( CURR_FUNC );461462/* take the next available temporary */463CTEMP_INFO( info )++;464temp = CTEMP_INFO( info );465466/* maybe make room for more temporaries */467if ( NTEMP_INFO( info ) < temp ) {468if ( SIZE_BAG(info) < SIZE_INFO( NLVAR_INFO(info), temp ) ) {469ResizeBag( info, SIZE_INFO( NLVAR_INFO(info), temp+7 ) );470}471NTEMP_INFO( info ) = temp;472}473TNUM_TEMP_INFO( info, temp ) = W_UNKNOWN;474475/* return the temporary */476return temp;477}478479void FreeTemp (480Temp temp )481{482Bag info; /* information bag */483484/* get the information bag */485info = INFO_FEXP( CURR_FUNC );486487/* check that deallocations happens in the correct order */488if ( temp != CTEMP_INFO( info ) && CompPass == 2 ) {489Pr("PROBLEM: freeing t_%d, should be t_%d\n",(Int)temp,CTEMP_INFO(info));490}491492/* free the temporary */493TNUM_TEMP_INFO( info, temp ) = W_UNUSED;494CTEMP_INFO( info )--;495}496497498/****************************************************************************499**500*F CompSetUseHVar( <hvar> ) . . . . . . . . register use of higher variable501*F CompGetUseHVar( <hvar> ) . . . . . . . . get use mode of higher variable502*F GetLevlHVar( <hvar> ) . . . . . . . . . . . get level of higher variable503*F GetIndxHVar( <hvar> ) . . . . . . . . . . . get index of higher variable504**505** 'CompSetUseHVar' register (during pass 1) that the variable <hvar> is506** used as higher variable, i.e., is referenced from inside a local507** function. Such variables must be allocated in a stack frame bag (and508** cannot be mapped to C variables).509**510** 'CompGetUseHVar' returns nonzero if the variable <hvar> is used as higher511** variable.512**513** 'GetLevlHVar' returns the level of the higher variable <hvar>, i.e., the514** number of frames that must be walked upwards for the one containing515** <hvar>. This may be properly smaller than 'LEVEL_HVAR(<hvar>)', because516** only those compiled functions that have local variables that are used as517** higher variables allocate a stack frame.518**519** 'GetIndxHVar' returns the index of the higher variable <hvar>, i.e., the520** position of <hvar> in the stack frame. This may be properly smaller than521** 'INDEX_HVAR(<hvar>)', because only those local variable that are used as522** higher variables are allocated in a stack frame.523*/524typedef UInt4 HVar;525526void CompSetUseHVar (527HVar hvar )528{529Bag info; /* its info bag */530Int i; /* loop variable */531532/* only mark in pass 1 */533if ( CompPass != 1 ) return;534535/* walk up */536info = INFO_FEXP( CURR_FUNC );537for ( i = 1; i <= (hvar >> 16); i++ ) {538info = NEXT_INFO( info );539}540541/* set mark */542if ( TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) != W_HIGHER ) {543TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) = W_HIGHER;544NHVAR_INFO(info) = NHVAR_INFO(info) + 1;545}546547}548549Int CompGetUseHVar (550HVar hvar )551{552Bag info; /* its info bag */553Int i; /* loop variable */554555/* walk up */556info = INFO_FEXP( CURR_FUNC );557for ( i = 1; i <= (hvar >> 16); i++ ) {558info = NEXT_INFO( info );559}560561/* get mark */562return (TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) == W_HIGHER);563}564565UInt GetLevlHVar (566HVar hvar )567{568UInt levl; /* level of higher variable */569Bag info; /* its info bag */570Int i; /* loop variable */571572/* walk up */573levl = 0;574info = INFO_FEXP( CURR_FUNC );575#if 0576if ( NHVAR_INFO(info) != 0 )577#endif578levl++;579for ( i = 1; i <= (hvar >> 16); i++ ) {580info = NEXT_INFO( info );581#if 0582if ( NHVAR_INFO(info) != 0 )583#endif584levl++;585}586587/* return level (the number steps to go up) */588return levl - 1;589}590591UInt GetIndxHVar (592HVar hvar )593{594UInt indx; /* index of higher variable */595Bag info; /* its info bag */596Int i; /* loop variable */597598/* walk up */599info = INFO_FEXP( CURR_FUNC );600for ( i = 1; i <= (hvar >> 16); i++ ) {601info = NEXT_INFO( info );602}603604/* walk right */605indx = 0;606for ( i = 1; i <= (hvar & 0xFFFF); i++ ) {607if ( TNUM_LVAR_INFO( info, i ) == W_HIGHER ) indx++;608}609610/* return the index */611return indx;612}613614615/****************************************************************************616**617*F CompSetUseGVar( <gvar>, <mode> ) . . . . register use of global variable618*F CompGetUseGVar( <gvar> ) . . . . . . . . get use mode of global variable619**620** 'CompSetUseGVar' registers (during pass 1) the use of the global variable621** with identifier <gvar>.622**623** 'CompGetUseGVar' returns the bitwise OR of all the <mode> arguments for624** the global variable with identifier <gvar>.625**626** Currently the interpretation of the <mode> argument is as follows627**628** If '<mode> & COMP_USE_GVAR_ID' is nonzero, then the produced code shall629** define and initialize 'G_<name>' with the identifier of the global630** variable (which may be different from <gvar> by the time the compiled631** code is actually run).632**633** If '<mode> & COMP_USE_GVAR_COPY' is nonzero, then the produced code shall634** define and initialize 'GC_<name>' as a copy of the global variable635** (see 'InitCopyGVar' in 'gvars.h').636**637** If '<mode> & COMP_USE_GVAR_FOPY' is nonzero, then the produced code shall638** define and initialize 'GF_<name>' as a function copy of the global639** variable (see 'InitFopyGVar' in 'gvars.h').640*/641typedef UInt GVar;642643#define COMP_USE_GVAR_ID (1L << 0)644#define COMP_USE_GVAR_COPY (1L << 1)645#define COMP_USE_GVAR_FOPY (1L << 2)646647Bag CompInfoGVar;648649void CompSetUseGVar (650GVar gvar,651UInt mode )652{653/* only mark in pass 1 */654if ( CompPass != 1 ) return;655656/* resize if neccessary */657if ( SIZE_OBJ(CompInfoGVar)/sizeof(UInt) <= gvar ) {658ResizeBag( CompInfoGVar, sizeof(UInt)*(gvar+1) );659}660661/* or with <mode> */662((UInt*)PTR_BAG(CompInfoGVar))[gvar] |= mode;663}664665UInt CompGetUseGVar (666GVar gvar )667{668return ((UInt*)PTR_BAG(CompInfoGVar))[gvar];669}670671672/****************************************************************************673**674*F CompSetUseRNam( <rnam>, <mode> ) . . . . . . register use of record name675*F CompGetUseRNam( <rnam> ) . . . . . . . . . . get use mode of record name676**677** 'CompSetUseRNam' registers (during pass 1) the use of the record name678** with identifier <rnam>. 'CompGetUseRNam' returns the bitwise OR of all679** the <mode> arguments for the global variable with identifier <rnam>.680**681** Currently the interpretation of the <mode> argument is as follows682**683** If '<mode> & COMP_USE_RNAM_ID' is nonzero, then the produced code shall684** define and initialize 'R_<name>' with the identifier of the record name685** (which may be different from <rnam> when the time the compiled code is686** actually run).687*/688typedef UInt RNam;689690#define COMP_USE_RNAM_ID (1L << 0)691692Bag CompInfoRNam;693694void CompSetUseRNam (695RNam rnam,696UInt mode )697{698/* only mark in pass 1 */699if ( CompPass != 1 ) return;700701/* resize if neccessary */702if ( SIZE_OBJ(CompInfoRNam)/sizeof(UInt) <= rnam ) {703ResizeBag( CompInfoRNam, sizeof(UInt)*(rnam+1) );704}705706/* or with <mode> */707((UInt*)PTR_BAG(CompInfoRNam))[rnam] |= mode;708}709710UInt CompGetUseRNam (711RNam rnam )712{713return ((UInt*)PTR_BAG(CompInfoRNam))[rnam];714}715716717/****************************************************************************718**719*F Emit( <fmt>, ... ) . . . . . . . . . . . . . . . . . . . . . . emit code720**721** 'Emit' outputs the string <fmt> and the other arguments, which must722** correspond to the '%' format elements in <fmt>. Nothing is actually723** outputted if 'CompPass' is not 2.724**725** 'Emit' supports the following '%' format elements: '%d' formats an726** integer, '%s' formats a string, '%S' formats a string with all the727** necessary escapes, %C does the same but uses only valid C escapes, '%n'728** formats a name ('_' is converted to '__', special characters are729** converted to '_<hex1><hex2>'), '%c' formats a C variable730** ('INTOBJ_INT(<int>)' for integers, 'a_<name>' for arguments, 'l_<name>'731** for locals, 't_<nr>' for temporaries), and '%%' outputs a single '%'.732*/733Int EmitIndent;734735Int EmitIndent2;736737void Emit (738const char * fmt,739... )740{741Int narg; /* number of arguments */742va_list ap; /* argument list pointer */743Int dint; /* integer argument */744CVar cvar; /* C variable argument */745Char * string; /* string argument */746const Char * p; /* loop variable */747Char * q; /* loop variable */748const Char * hex = "0123456789ABCDEF";749750/* are we in pass 2? */751if ( CompPass != 2 ) return;752753/* get the information bag */754narg = (NARG_FUNC( CURR_FUNC ) != -1 ? NARG_FUNC( CURR_FUNC ) : 1);755756/* loop over the format string */757va_start( ap, fmt );758for ( p = fmt; *p != '\0'; p++ ) {759760/* print an indent */761if ( 0 < EmitIndent2 && *p == '}' ) EmitIndent2--;762while ( 0 < EmitIndent2-- ) Pr( " ", 0L, 0L );763764/* format an argument */765if ( *p == '%' ) {766p++;767768/* emit an integer */769if ( *p == 'd' ) {770dint = va_arg( ap, Int );771Pr( "%d", dint, 0L );772}773774/* emit a string */775else if ( *p == 's' ) {776string = va_arg( ap, Char* );777Pr( "%s", (Int)string, 0L );778}779780/* emit a string */781else if ( *p == 'S' ) {782string = va_arg( ap, Char* );783Pr( "%S", (Int)string, 0L );784}785786/* emit a string */787else if ( *p == 'C' ) {788string = va_arg( ap, Char* );789Pr( "%C", (Int)string, 0L );790}791792/* emit a name */793else if ( *p == 'n' ) {794string = va_arg( ap, Char* );795for ( q = string; *q != '\0'; q++ ) {796if ( IsAlpha(*q) || IsDigit(*q) ) {797Pr( "%c", (Int)(*q), 0L );798}799else if ( *q == '_' ) {800Pr( "__", 0L, 0L );801}802else {803Pr("_%c%c",hex[((UInt)*q)/16],hex[((UInt)*q)%16]);804}805}806}807808/* emit a C variable */809else if ( *p == 'c' ) {810cvar = va_arg( ap, CVar );811if ( IS_INTG_CVAR(cvar) ) {812Int x = INTG_CVAR(cvar);813if (x >= -(1L <<28) && x < (1L << 28))814Pr( "INTOBJ_INT(%d)", x, 0L );815else816Pr( "C_MAKE_MED_INT(%d)", x, 0L );817}818else if ( IS_TEMP_CVAR(cvar) ) {819Pr( "t_%d", TEMP_CVAR(cvar), 0L );820}821else if ( LVAR_CVAR(cvar) <= narg ) {822Emit( "a_%n", NAME_LVAR( LVAR_CVAR(cvar) ) );823}824else {825Emit( "l_%n", NAME_LVAR( LVAR_CVAR(cvar) ) );826}827}828829/* emit a C variable */830else if ( *p == 'i' ) {831cvar = va_arg( ap, CVar );832if ( IS_INTG_CVAR(cvar) ) {833Pr( "%d", INTG_CVAR(cvar), 0L );834}835else if ( IS_TEMP_CVAR(cvar) ) {836Pr( "INT_INTOBJ(t_%d)", TEMP_CVAR(cvar), 0L );837}838else if ( LVAR_CVAR(cvar) <= narg ) {839Emit( "INT_INTOBJ(a_%n)", NAME_LVAR( LVAR_CVAR(cvar) ) );840}841else {842Emit( "INT_INTOBJ(l_%n)", NAME_LVAR( LVAR_CVAR(cvar) ) );843}844}845846/* emit a '%' */847else if ( *p == '%' ) {848Pr( "%%", 0L, 0L );849}850851/* what */852else {853Pr( "%%illegal format statement", 0L, 0L );854}855856}857858else if ( *p == '{' ) {859Pr( "{", 0L, 0L );860EmitIndent++;861}862else if ( *p == '}' ) {863Pr( "}", 0L, 0L );864EmitIndent--;865}866else if ( *p == '\n' ) {867Pr( "\n", 0L, 0L );868EmitIndent2 = EmitIndent;869}870871else {872Pr( "%c", (Int)(*p), 0L );873}874875}876va_end( ap );877878}879880881/****************************************************************************882**883884*F * * * * * * * * * * * * * * compile checks * * * * * * * * * * * * * * * *885*/886887888/****************************************************************************889**890891892*F CompCheckBound( <obj>, <name> ) emit code to check that <obj> has a value893*/894void CompCheckBound (895CVar obj,896Char * name )897{898if ( ! HasInfoCVar( obj, W_BOUND ) ) {899if ( CompCheckTypes ) {900Emit( "CHECK_BOUND( %c, \"%s\" )\n", obj, name );901}902SetInfoCVar( obj, W_BOUND );903}904}905906907/****************************************************************************908**909*F CompCheckFuncResult( <obj> ) . emit code to check that <obj> has a value910*/911void CompCheckFuncResult (912CVar obj )913{914if ( ! HasInfoCVar( obj, W_BOUND ) ) {915if ( CompCheckTypes ) {916Emit( "CHECK_FUNC_RESULT( %c )\n", obj );917}918SetInfoCVar( obj, W_BOUND );919}920}921922923/****************************************************************************924**925*F CompCheckIntSmall( <obj> ) emit code to check that <obj> is a small int926*/927void CompCheckIntSmall (928CVar obj )929{930if ( ! HasInfoCVar( obj, W_INT_SMALL ) ) {931if ( CompCheckTypes ) {932Emit( "CHECK_INT_SMALL( %c )\n", obj );933}934SetInfoCVar( obj, W_INT_SMALL );935}936}937938939940/****************************************************************************941**942*F CompCheckIntSmallPos( <obj> ) emit code to check that <obj> is a position943*/944void CompCheckIntSmallPos (945CVar obj )946{947if ( ! HasInfoCVar( obj, W_INT_SMALL_POS ) ) {948if ( CompCheckTypes ) {949Emit( "CHECK_INT_SMALL_POS( %c )\n", obj );950}951SetInfoCVar( obj, W_INT_SMALL_POS );952}953}954955/****************************************************************************956**957*F CompCheckIntPos( <obj> ) emit code to check that <obj> is a position958*/959void CompCheckIntPos (960CVar obj )961{962if ( ! HasInfoCVar( obj, W_INT_POS ) ) {963if ( CompCheckTypes ) {964Emit( "CHECK_INT_POS( %c )\n", obj );965}966SetInfoCVar( obj, W_INT_POS );967}968}969970971/****************************************************************************972**973*F CompCheckBool( <obj> ) . . . emit code to check that <obj> is a boolean974*/975void CompCheckBool (976CVar obj )977{978if ( ! HasInfoCVar( obj, W_BOOL ) ) {979if ( CompCheckTypes ) {980Emit( "CHECK_BOOL( %c )\n", obj );981}982SetInfoCVar( obj, W_BOOL );983}984}985986987988/****************************************************************************989**990*F CompCheckFunc( <obj> ) . . . emit code to check that <obj> is a function991*/992void CompCheckFunc (993CVar obj )994{995if ( ! HasInfoCVar( obj, W_FUNC ) ) {996if ( CompCheckTypes ) {997Emit( "CHECK_FUNC( %c )\n", obj );998}999SetInfoCVar( obj, W_FUNC );1000}1001}100210031004/****************************************************************************1005**10061007*F * * * * * * * * * * * * compile expressions * * * * * * * * * * * * * * *1008*/100910101011/****************************************************************************1012**10131014*F CompExpr( <expr> ) . . . . . . . . . . . . . . . . compile an expression1015**1016** 'CompExpr' compiles the expression <expr> and returns the C variable that1017** will contain the result.1018*/1019CVar (* CompExprFuncs[256]) ( Expr expr );102010211022CVar CompExpr (1023Expr expr )1024{1025return (* CompExprFuncs[ TNUM_EXPR(expr) ])( expr );1026}102710281029/****************************************************************************1030**1031*F CompUnknownExpr( <expr> ) . . . . . . . . . . . . log unknown expression1032*/1033CVar CompUnknownExpr (1034Expr expr )1035{1036Emit( "CANNOT COMPILE EXPRESSION OF TNUM %d;\n", TNUM_EXPR(expr) );1037return 0;1038}1039104010411042/****************************************************************************1043**1044*F CompBoolExpr( <expr> ) . . . . . . . compile bool expr and return C bool1045*/1046CVar (* CompBoolExprFuncs[256]) ( Expr expr );10471048CVar CompBoolExpr (1049Expr expr )1050{1051return (* CompBoolExprFuncs[ TNUM_EXPR(expr) ])( expr );1052}105310541055/****************************************************************************1056**1057*F CompUnknownBool( <expr> ) . . . . . . . . . . use 'CompExpr' and convert1058*/1059CVar CompUnknownBool (1060Expr expr )1061{1062CVar res; /* result */1063CVar val; /* value of expression */10641065/* allocate a new temporary for the result */1066res = CVAR_TEMP( NewTemp( "res" ) );10671068/* compile the expression and check that the value is boolean */1069val = CompExpr( expr );1070CompCheckBool( val );10711072/* emit code to store the C boolean value in the result */1073Emit( "%c = (Obj)(UInt)(%c != False);\n", res, val );10741075/* we know that the result is boolean (should be 'W_CBOOL') */1076SetInfoCVar( res, W_BOOL );10771078/* free the temporary */1079if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );10801081/* return the result */1082return res;1083}10841085/****************************************************************************1086**1087*V G_Length . . . . . . . . . . . . . . . . . . . . . . . function 'Length'1088*/1089GVar G_Length;1090109110921093/****************************************************************************1094**1095*F CompFunccall0to6Args( <expr> ) . . . T_FUNCCALL_0ARGS...T_FUNCCALL_6ARGS1096*/1097extern CVar CompRefGVarFopy (1098Expr expr );109911001101CVar CompFunccall0to6Args (1102Expr expr )1103{1104CVar result; /* result, result */1105CVar func; /* function */1106CVar args [8]; /* arguments */1107Int narg; /* number of arguments */1108Int i; /* loop variable */11091110/* special case to inline 'Length' */1111if ( CompFastListFuncs1112&& TNUM_EXPR( FUNC_CALL(expr) ) == T_REF_GVAR1113&& ADDR_EXPR( FUNC_CALL(expr) )[0] == G_Length1114&& NARG_SIZE_CALL(SIZE_EXPR(expr)) == 1 ) {1115result = CVAR_TEMP( NewTemp( "result" ) );1116args[1] = CompExpr( ARGI_CALL(expr,1) );1117if ( CompFastPlainLists ) {1118Emit( "C_LEN_LIST_FPL( %c, %c )\n", result, args[1] );1119}1120else {1121Emit( "C_LEN_LIST( %c, %c )\n", result, args[1] );1122}1123SetInfoCVar( result, W_INT_SMALL );1124if ( IS_TEMP_CVAR( args[1] ) ) FreeTemp( TEMP_CVAR( args[1] ) );1125return result;1126}11271128/* allocate a temporary for the result */1129result = CVAR_TEMP( NewTemp( "result" ) );11301131/* compile the reference to the function */1132if ( TNUM_EXPR( FUNC_CALL(expr) ) == T_REF_GVAR ) {1133func = CompRefGVarFopy( FUNC_CALL(expr) );1134}1135else {1136func = CompExpr( FUNC_CALL(expr) );1137CompCheckFunc( func );1138}11391140/* compile the argument expressions */1141narg = NARG_SIZE_CALL(SIZE_EXPR(expr));1142for ( i = 1; i <= narg; i++ ) {1143args[i] = CompExpr( ARGI_CALL(expr,i) );1144}11451146/* emit the code for the procedure call */1147Emit( "%c = CALL_%dARGS( %c", result, narg, func );1148for ( i = 1; i <= narg; i++ ) {1149Emit( ", %c", args[i] );1150}1151Emit( " );\n" );11521153/* emit code for the check (sets the information for the result) */1154CompCheckFuncResult( result );11551156/* free the temporaries */1157for ( i = narg; 1 <= i; i-- ) {1158if ( IS_TEMP_CVAR( args[i] ) ) FreeTemp( TEMP_CVAR( args[i] ) );1159}1160if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );11611162/* return the result */1163return result;1164}116511661167/****************************************************************************1168**1169*F CompFunccallXArgs( <expr> ) . . . . . . . . . . . . . . T_FUNCCALL_XARGS1170*/1171CVar CompFunccallXArgs (1172Expr expr )1173{1174CVar result; /* result, result */1175CVar func; /* function */1176CVar argl; /* argument list */1177CVar argi; /* <i>-th argument */1178UInt narg; /* number of arguments */1179UInt i; /* loop variable */11801181/* allocate a temporary for the result */1182result = CVAR_TEMP( NewTemp( "result" ) );11831184/* compile the reference to the function */1185if ( TNUM_EXPR( FUNC_CALL(expr) ) == T_REF_GVAR ) {1186func = CompRefGVarFopy( FUNC_CALL(expr) );1187}1188else {1189func = CompExpr( FUNC_CALL(expr) );1190CompCheckFunc( func );1191}11921193/* compile the argument expressions */1194narg = NARG_SIZE_CALL(SIZE_EXPR(expr));1195argl = CVAR_TEMP( NewTemp( "argl" ) );1196Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", argl, narg );1197Emit( "SET_LEN_PLIST( %c, %d );\n", argl, narg );1198for ( i = 1; i <= narg; i++ ) {1199argi = CompExpr( ARGI_CALL( expr, i ) );1200Emit( "SET_ELM_PLIST( %c, %d, %c );\n", argl, i, argi );1201if ( ! HasInfoCVar( argi, W_INT_SMALL ) ) {1202Emit( "CHANGED_BAG( %c );\n", argl );1203}1204if ( IS_TEMP_CVAR( argi ) ) FreeTemp( TEMP_CVAR( argi ) );1205}12061207/* emit the code for the procedure call */1208Emit( "%c = CALL_XARGS( %c, %c );\n", result, func, argl );12091210/* emit code for the check (sets the information for the result) */1211CompCheckFuncResult( result );12121213/* free the temporaries */1214if ( IS_TEMP_CVAR( argl ) ) FreeTemp( TEMP_CVAR( argl ) );1215if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );12161217/* return the result */1218return result;1219}12201221/****************************************************************************1222**1223*F CompFunccallXArgs( <expr> ) . . . . . . . . . . . . . . T_FUNCCALL_OPTS1224*/1225CVar CompFunccallOpts(1226Expr expr)1227{1228CVar opts = CompExpr(ADDR_STAT(expr)[0]);1229GVar pushOptions;1230GVar popOptions;1231CVar result;1232pushOptions = GVarName("PushOptions");1233popOptions = GVarName("PopOptions");1234CompSetUseGVar(pushOptions, COMP_USE_GVAR_FOPY);1235CompSetUseGVar(popOptions, COMP_USE_GVAR_FOPY);1236Emit("CALL_1ARGS( GF_PushOptions, %c );\n", opts);1237if (IS_TEMP_CVAR( opts) ) FreeTemp( TEMP_CVAR( opts ));1238result = CompExpr(ADDR_STAT(expr)[1]);1239Emit("CALL_0ARGS( GF_PopOptions );\n");1240return result;1241}124212431244/****************************************************************************1245**1246*F CompFuncExpr( <expr> ) . . . . . . . . . . . . . . . . . . . T_FUNC_EXPR1247*/1248CVar CompFuncExpr (1249Expr expr )1250{1251CVar func; /* function, result */1252CVar tmp; /* dummy body */12531254Obj fexs; /* function expressions list */1255Obj fexp; /* function expression */1256Int nr; /* number of the function */12571258/* get the number of the function */1259fexs = FEXS_FUNC( CURR_FUNC );1260fexp = ELM_PLIST( fexs, ((Int*)ADDR_EXPR(expr))[0] );1261nr = NR_INFO( INFO_FEXP( fexp ) );12621263/* allocate a new temporary for the function */1264func = CVAR_TEMP( NewTemp( "func" ) );12651266/* make the function (all the pieces are in global variables) */1267Emit( "%c = NewFunction( NameFunc[%d], NargFunc[%d], NamsFunc[%d]",1268func, nr, nr, nr );1269Emit( ", HdlrFunc%d );\n", nr );12701271/* this should probably be done by 'NewFunction' */1272Emit( "ENVI_FUNC( %c ) = TLS(CurrLVars);\n", func );1273tmp = CVAR_TEMP( NewTemp( "body" ) );1274Emit( "%c = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );\n", tmp );1275Emit( "STARTLINE_BODY(%c) = INTOBJ_INT(%d);\n", tmp, INT_INTOBJ(STARTLINE_BODY(BODY_FUNC(fexp))));1276Emit( "ENDLINE_BODY(%c) = INTOBJ_INT(%d);\n", tmp, INT_INTOBJ(ENDLINE_BODY(BODY_FUNC(fexp))));1277Emit( "FILENAME_BODY(%c) = FileName;\n",tmp);1278Emit( "BODY_FUNC(%c) = %c;\n", func, tmp );1279FreeTemp( TEMP_CVAR( tmp ) );12801281Emit( "CHANGED_BAG( TLS(CurrLVars) );\n" );12821283/* we know that the result is a function */1284SetInfoCVar( func, W_FUNC );12851286/* return the number of the C variable that will hold the function */1287return func;1288}128912901291/****************************************************************************1292**1293*F CompOr( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_OR1294*/1295CVar CompOr (1296Expr expr )1297{1298CVar val; /* or, result */1299CVar left; /* left operand */1300CVar right; /* right operand */1301Bag only_left; /* info after evaluating only left */13021303/* allocate a new temporary for the result */1304val = CVAR_TEMP( NewTemp( "val" ) );13051306/* compile the left expression */1307left = CompBoolExpr( ADDR_EXPR(expr)[0] );1308Emit( "%c = (%c ? True : False);\n", val, left );1309Emit( "if ( %c == False ) {\n", val );1310only_left = NewInfoCVars();1311CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC) );13121313/* compile the right expression */1314right = CompBoolExpr( ADDR_EXPR(expr)[1] );1315Emit( "%c = (%c ? True : False);\n", val, right );1316Emit( "}\n" );13171318/* we know that the result is boolean */1319MergeInfoCVars( INFO_FEXP(CURR_FUNC), only_left );1320SetInfoCVar( val, W_BOOL );13211322/* free the temporaries */1323if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1324if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );13251326/* return the result */1327return val;1328}132913301331/****************************************************************************1332**1333*F CompOrBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_OR1334*/1335CVar CompOrBool (1336Expr expr )1337{1338CVar val; /* or, result */1339CVar left; /* left operand */1340CVar right; /* right operand */1341Bag only_left; /* info after evaluating only left */13421343/* allocate a new temporary for the result */1344val = CVAR_TEMP( NewTemp( "val" ) );13451346/* compile the left expression */1347left = CompBoolExpr( ADDR_EXPR(expr)[0] );1348Emit( "%c = %c;\n", val, left );1349Emit( "if ( ! %c ) {\n", val );1350only_left = NewInfoCVars();1351CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC) );13521353/* compile the right expression */1354right = CompBoolExpr( ADDR_EXPR(expr)[1] );1355Emit( "%c = %c;\n", val, right );1356Emit( "}\n" );13571358/* we know that the result is boolean (should be 'W_CBOOL') */1359MergeInfoCVars( INFO_FEXP(CURR_FUNC), only_left );1360SetInfoCVar( val, W_BOOL );13611362/* free the temporaries */1363if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1364if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );13651366/* return the result */1367return val;1368}136913701371/****************************************************************************1372**1373*F CompAnd( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_AND1374*/1375CVar CompAnd (1376Expr expr )1377{1378CVar val; /* result */1379CVar left; /* left operand */1380CVar right1; /* right operand 1 */1381CVar right2; /* right operand 2 */1382Bag only_left; /* info after evaluating only left */13831384/* allocate a temporary for the result */1385val = CVAR_TEMP( NewTemp( "val" ) );13861387/* compile the left expression */1388left = CompExpr( ADDR_EXPR(expr)[0] );1389only_left = NewInfoCVars();1390CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC) );13911392/* emit the code for the case that the left value is 'false' */1393Emit( "if ( %c == False ) {\n", left );1394Emit( "%c = %c;\n", val, left );1395Emit( "}\n" );13961397/* emit the code for the case that the left value is 'true' */1398Emit( "else if ( %c == True ) {\n", left );1399right1 = CompExpr( ADDR_EXPR(expr)[1] );1400CompCheckBool( right1 );1401Emit( "%c = %c;\n", val, right1 );1402Emit( "}\n" );14031404/* emit the code for the case that the left value is a filter */1405Emit( "else {\n" );1406CompCheckFunc( left );1407right2 = CompExpr( ADDR_EXPR(expr)[1] );1408CompCheckFunc( right2 );1409Emit( "%c = NewAndFilter( %c, %c );\n", val, left, right2 );1410Emit( "}\n" );14111412/* we know precious little about the result */1413MergeInfoCVars( INFO_FEXP(CURR_FUNC), only_left );1414SetInfoCVar( val, W_BOUND );14151416/* free the temporaries */1417if ( IS_TEMP_CVAR( right2 ) ) FreeTemp( TEMP_CVAR( right2 ) );1418if ( IS_TEMP_CVAR( right1 ) ) FreeTemp( TEMP_CVAR( right1 ) );1419if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );14201421/* return the result */1422return val;1423}142414251426/****************************************************************************1427**1428*F CompAndBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_AND1429*/1430CVar CompAndBool (1431Expr expr )1432{1433CVar val; /* or, result */1434CVar left; /* left operand */1435CVar right; /* right operand */1436Bag only_left; /* info after evaluating only left */14371438/* allocate a new temporary for the result */1439val = CVAR_TEMP( NewTemp( "val" ) );14401441/* compile the left expression */1442left = CompBoolExpr( ADDR_EXPR(expr)[0] );1443Emit( "%c = %c;\n", val, left );1444Emit( "if ( %c ) {\n", val );1445only_left = NewInfoCVars();1446CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC) );14471448/* compile the right expression */1449right = CompBoolExpr( ADDR_EXPR(expr)[1] );1450Emit( "%c = %c;\n", val, right );1451Emit( "}\n" );14521453/* we know that the result is boolean (should be 'W_CBOOL') */1454MergeInfoCVars( INFO_FEXP(CURR_FUNC), only_left );1455SetInfoCVar( val, W_BOOL );14561457/* free the temporaries */1458if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1459if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );14601461/* return the result */1462return val;1463}146414651466/****************************************************************************1467**1468*F CompNot( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_NOT1469*/1470CVar CompNot (1471Expr expr )1472{1473CVar val; /* result */1474CVar left; /* operand */14751476/* allocate a new temporary for the result */1477val = CVAR_TEMP( NewTemp( "val" ) );14781479/* compile the operand */1480left = CompBoolExpr( ADDR_EXPR(expr)[0] );14811482/* invert the operand */1483Emit( "%c = (%c ? False : True);\n", val, left );14841485/* we know that the result is boolean */1486SetInfoCVar( val, W_BOOL );14871488/* free the temporaries */1489if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );14901491/* return the result */1492return val;1493}149414951496/****************************************************************************1497**1498*F CompNotBoot( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_NOT1499*/1500CVar CompNotBool (1501Expr expr )1502{1503CVar val; /* result */1504CVar left; /* operand */15051506/* allocate a new temporary for the result */1507val = CVAR_TEMP( NewTemp( "val" ) );15081509/* compile the operand */1510left = CompBoolExpr( ADDR_EXPR(expr)[0] );15111512/* invert the operand */1513Emit( "%c = (Obj)(UInt)( ! ((Int)%c) );\n", val, left );15141515/* we know that the result is boolean */1516SetInfoCVar( val, W_BOOL );15171518/* free the temporaries */1519if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );15201521/* return the result */1522return val;1523}152415251526/****************************************************************************1527**1528*F CompEq( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_EQ1529*/1530CVar CompEq (1531Expr expr )1532{1533CVar val; /* result */1534CVar left; /* left operand */1535CVar right; /* right operand */15361537/* allocate a new temporary for the result */1538val = CVAR_TEMP( NewTemp( "val" ) );15391540/* compile the two operands */1541left = CompExpr( ADDR_EXPR(expr)[0] );1542right = CompExpr( ADDR_EXPR(expr)[1] );15431544/* emit the code */1545if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1546Emit("%c = ((((Int)%c) == ((Int)%c)) ? True : False);\n", val, left, right);1547}1548else {1549Emit( "%c = (EQ( %c, %c ) ? True : False);\n", val, left, right );1550}15511552/* we know that the result is boolean */1553SetInfoCVar( val, W_BOOL );15541555/* free the temporaries */1556if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1557if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );15581559/* return the result */1560return val;1561}156215631564/****************************************************************************1565**1566*F CompEqBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_EQ1567*/1568CVar CompEqBool (1569Expr expr )1570{1571CVar val; /* result */1572CVar left; /* left operand */1573CVar right; /* right operand */15741575/* allocate a new temporary for the result */1576val = CVAR_TEMP( NewTemp( "val" ) );15771578/* compile the two operands */1579left = CompExpr( ADDR_EXPR(expr)[0] );1580right = CompExpr( ADDR_EXPR(expr)[1] );15811582/* emit the code */1583if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1584Emit( "%c = (Obj)(UInt)(((Int)%c) == ((Int)%c));\n", val, left, right);1585}1586else {1587Emit( "%c = (Obj)(UInt)(EQ( %c, %c ));\n", val, left, right );1588}15891590/* we know that the result is boolean (should be 'W_CBOOL') */1591SetInfoCVar( val, W_BOOL );15921593/* free the temporaries */1594if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1595if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );15961597/* return the result */1598return val;1599}160016011602/****************************************************************************1603**1604*F CompNe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_NE1605*/1606CVar CompNe (1607Expr expr )1608{1609CVar val; /* result */1610CVar left; /* left operand */1611CVar right; /* right operand */16121613/* allocate a new temporary for the result */1614val = CVAR_TEMP( NewTemp( "val" ) );16151616/* compile the two operands */1617left = CompExpr( ADDR_EXPR(expr)[0] );1618right = CompExpr( ADDR_EXPR(expr)[1] );16191620/* emit the code */1621if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1622Emit("%c = ((((Int)%c) == ((Int)%c)) ? False : True);\n", val, left, right);1623}1624else {1625Emit( "%c = (EQ( %c, %c ) ? False : True);\n", val, left, right );1626}16271628/* we know that the result is boolean */1629SetInfoCVar( val, W_BOOL );16301631/* free the temporaries */1632if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1633if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );16341635/* return the result */1636return val;1637}163816391640/****************************************************************************1641**1642*F CompNeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_NE1643*/1644CVar CompNeBool (1645Expr expr )1646{1647CVar val; /* result */1648CVar left; /* left operand */1649CVar right; /* right operand */16501651/* allocate a new temporary for the result */1652val = CVAR_TEMP( NewTemp( "val" ) );16531654/* compile the two operands */1655left = CompExpr( ADDR_EXPR(expr)[0] );1656right = CompExpr( ADDR_EXPR(expr)[1] );16571658/* emit the code */1659if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1660Emit( "%c = (Obj)(UInt)(((Int)%c) != ((Int)%c));\n", val, left, right );1661}1662else {1663Emit( "%c = (Obj)(UInt)( ! EQ( %c, %c ));\n", val, left, right );1664}16651666/* we know that the result is boolean (should be 'W_CBOOL') */1667SetInfoCVar( val, W_BOOL );16681669/* free the temporaries */1670if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1671if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );16721673/* return the result */1674return val;1675}167616771678/****************************************************************************1679**1680*F CompLt( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_LT1681*/1682CVar CompLt (1683Expr expr )1684{1685CVar val; /* result */1686CVar left; /* left operand */1687CVar right; /* right operand */16881689/* allocate a new temporary for the result */1690val = CVAR_TEMP( NewTemp( "val" ) );16911692/* compile the two operands */1693left = CompExpr( ADDR_EXPR(expr)[0] );1694right = CompExpr( ADDR_EXPR(expr)[1] );16951696/* emit the code */1697if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1698Emit( "%c = ((((Int)%c) < ((Int)%c)) ? True : False);\n", val, left, right );1699}1700else {1701Emit( "%c = (LT( %c, %c ) ? True : False);\n", val, left, right );1702}17031704/* we know that the result is boolean */1705SetInfoCVar( val, W_BOOL );17061707/* free the temporaries */1708if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1709if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );17101711/* return the result */1712return val;1713}171417151716/****************************************************************************1717**1718*F CompLtBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_LT1719*/1720CVar CompLtBool (1721Expr expr )1722{1723CVar val; /* result */1724CVar left; /* left operand */1725CVar right; /* right operand */17261727/* allocate a new temporary for the result */1728val = CVAR_TEMP( NewTemp( "val" ) );17291730/* compile the two operands */1731left = CompExpr( ADDR_EXPR(expr)[0] );1732right = CompExpr( ADDR_EXPR(expr)[1] );17331734/* emit the code */1735if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1736Emit( "%c = (Obj)(UInt)(((Int)%c) < ((Int)%c));\n", val, left, right );1737}1738else {1739Emit( "%c = (Obj)(UInt)(LT( %c, %c ));\n", val, left, right );1740}17411742/* we know that the result is boolean (should be 'W_CBOOL') */1743SetInfoCVar( val, W_BOOL );17441745/* free the temporaries */1746if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1747if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );17481749/* return the result */1750return val;1751}175217531754/****************************************************************************1755**1756*F CompGe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_GE1757*/1758CVar CompGe (1759Expr expr )1760{1761CVar val; /* result */1762CVar left; /* left operand */1763CVar right; /* right operand */17641765/* allocate a new temporary for the result */1766val = CVAR_TEMP( NewTemp( "val" ) );17671768/* compile the two operands */1769left = CompExpr( ADDR_EXPR(expr)[0] );1770right = CompExpr( ADDR_EXPR(expr)[1] );17711772/* emit the code */1773if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1774Emit("%c = ((((Int)%c) < ((Int)%c)) ? False : True);\n", val, left, right);1775}1776else {1777Emit( "%c = (LT( %c, %c ) ? False : True);\n", val, left, right );1778}17791780/* we know that the result is boolean */1781SetInfoCVar( val, W_BOOL );17821783/* free the temporaries */1784if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1785if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );17861787/* return the result */1788return val;1789}179017911792/****************************************************************************1793**1794*F CompGeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_GE1795*/1796CVar CompGeBool (1797Expr expr )1798{1799CVar val; /* result */1800CVar left; /* left operand */1801CVar right; /* right operand */18021803/* allocate a new temporary for the result */1804val = CVAR_TEMP( NewTemp( "val" ) );18051806/* compile the two operands */1807left = CompExpr( ADDR_EXPR(expr)[0] );1808right = CompExpr( ADDR_EXPR(expr)[1] );18091810/* emit the code */1811if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1812Emit( "%c = (Obj)(UInt)(((Int)%c) >= ((Int)%c));\n", val, left, right );1813}1814else {1815Emit( "%c = (Obj)(UInt)(! LT( %c, %c ));\n", val, left, right );1816}18171818/* we know that the result is boolean (should be 'W_CBOOL') */1819SetInfoCVar( val, W_BOOL );18201821/* free the temporaries */1822if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1823if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );18241825/* return the result */1826return val;1827}182818291830/****************************************************************************1831**1832*F CompGt( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_GT1833*/1834CVar CompGt (1835Expr expr )1836{1837CVar val; /* result */1838CVar left; /* left operand */1839CVar right; /* right operand */18401841/* allocate a new temporary for the result */1842val = CVAR_TEMP( NewTemp( "val" ) );18431844/* compile the two operands */1845left = CompExpr( ADDR_EXPR(expr)[0] );1846right = CompExpr( ADDR_EXPR(expr)[1] );18471848/* emit the code */1849if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1850Emit("%c = ((((Int)%c) < ((Int)%c)) ? True : False);\n", val, right, left);1851}1852else {1853Emit( "%c = (LT( %c, %c ) ? True : False);\n", val, right, left );1854}18551856/* we know that the result is boolean */1857SetInfoCVar( val, W_BOOL );18581859/* free the temporaries */1860if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1861if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );18621863/* return the result */1864return val;1865}186618671868/****************************************************************************1869**1870*F CompGtBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_GT1871*/1872CVar CompGtBool (1873Expr expr )1874{1875CVar val; /* result */1876CVar left; /* left operand */1877CVar right; /* right operand */18781879/* allocate a new temporary for the result */1880val = CVAR_TEMP( NewTemp( "val" ) );18811882/* compile the two operands */1883left = CompExpr( ADDR_EXPR(expr)[0] );1884right = CompExpr( ADDR_EXPR(expr)[1] );18851886/* emit the code */1887if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1888Emit( "%c = (Obj)(UInt)(((Int)%c) < ((Int)%c));\n", val, right, left );1889}1890else {1891Emit( "%c = (Obj)(UInt)(LT( %c, %c ));\n", val, right, left );1892}18931894/* we know that the result is boolean (should be 'W_CBOOL') */1895SetInfoCVar( val, W_BOOL );18961897/* free the temporaries */1898if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1899if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );19001901/* return the result */1902return val;1903}190419051906/****************************************************************************1907**1908*F CompLe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_LE1909*/1910CVar CompLe (1911Expr expr )1912{1913CVar val; /* result */1914CVar left; /* left operand */1915CVar right; /* right operand */19161917/* allocate a new temporary for the result */1918val = CVAR_TEMP( NewTemp( "val" ) );19191920/* compile the two operands */1921left = CompExpr( ADDR_EXPR(expr)[0] );1922right = CompExpr( ADDR_EXPR(expr)[1] );19231924/* emit the code */1925if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1926Emit("%c = ((((Int)%c) < ((Int)%c)) ? False : True);\n", val, right, left);1927}1928else {1929Emit( "%c = (LT( %c, %c ) ? False : True);\n", val, right, left );1930}19311932/* we know that the result is boolean */1933SetInfoCVar( val, W_BOOL );19341935/* free the temporaries */1936if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1937if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );19381939/* return the result */1940return val;1941}194219431944/****************************************************************************1945**1946*F CompLeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_LE1947*/1948CVar CompLeBool (1949Expr expr )1950{1951CVar val; /* result */1952CVar left; /* left operand */1953CVar right; /* right operand */19541955/* allocate a new temporary for the result */1956val = CVAR_TEMP( NewTemp( "val" ) );19571958/* compile the two operands */1959left = CompExpr( ADDR_EXPR(expr)[0] );1960right = CompExpr( ADDR_EXPR(expr)[1] );19611962/* emit the code */1963if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {1964Emit( "%c = (Obj)(UInt)(((Int)%c) >= ((Int)%c));\n", val, right, left );1965}1966else {1967Emit( "%c = (Obj)(UInt)(! LT( %c, %c ));\n", val, right, left );1968}19691970/* we know that the result is boolean (should be 'W_CBOOL') */1971SetInfoCVar( val, W_BOOL );19721973/* free the temporaries */1974if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );1975if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );19761977/* return the result */1978return val;1979}198019811982/****************************************************************************1983**1984*F CompIn( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_IN1985*/1986CVar CompIn (1987Expr expr )1988{1989CVar val; /* result */1990CVar left; /* left operand */1991CVar right; /* right operand */19921993/* allocate a new temporary for the result */1994val = CVAR_TEMP( NewTemp( "val" ) );19951996/* compile the two operands */1997left = CompExpr( ADDR_EXPR(expr)[0] );1998right = CompExpr( ADDR_EXPR(expr)[1] );19992000/* emit the code */2001Emit( "%c = (IN( %c, %c ) ? True : False);\n", val, left, right );20022003/* we know that the result is boolean */2004SetInfoCVar( val, W_BOOL );20052006/* free the temporaries */2007if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2008if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );20092010/* return the result */2011return val;2012}201320142015/****************************************************************************2016**2017*F CompInBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_IN2018*/2019CVar CompInBool (2020Expr expr )2021{2022CVar val; /* result */2023CVar left; /* left operand */2024CVar right; /* right operand */20252026/* allocate a new temporary for the result */2027val = CVAR_TEMP( NewTemp( "val" ) );20282029/* compile the two operands */2030left = CompExpr( ADDR_EXPR(expr)[0] );2031right = CompExpr( ADDR_EXPR(expr)[1] );20322033/* emit the code */2034Emit( "%c = (Obj)(UInt)(IN( %c, %c ));\n", val, left, right );20352036/* we know that the result is boolean (should be 'W_CBOOL') */2037SetInfoCVar( val, W_BOOL );20382039/* free the temporaries */2040if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2041if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );20422043/* return the result */2044return val;2045}204620472048/****************************************************************************2049**2050*F CompSum( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_SUM2051*/2052CVar CompSum (2053Expr expr )2054{2055CVar val; /* result */2056CVar left; /* left operand */2057CVar right; /* right operand */20582059/* allocate a new temporary for the result */2060val = CVAR_TEMP( NewTemp( "val" ) );20612062/* compile the two operands */2063left = CompExpr( ADDR_EXPR(expr)[0] );2064right = CompExpr( ADDR_EXPR(expr)[1] );20652066/* emit the code */2067if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {2068Emit( "C_SUM_INTOBJS( %c, %c, %c )\n", val, left, right );2069}2070else if ( CompFastIntArith ) {2071Emit( "C_SUM_FIA( %c, %c, %c )\n", val, left, right );2072}2073else {2074Emit( "C_SUM( %c, %c, %c )\n", val, left, right );2075}20762077/* set the information for the result */2078if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {2079SetInfoCVar( val, W_INT );2080}2081else {2082SetInfoCVar( val, W_BOUND );2083}20842085/* free the temporaries */2086if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2087if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );20882089/* return the result */2090return val;2091}209220932094/****************************************************************************2095**2096*F CompAInv( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_AINV2097*/2098CVar CompAInv (2099Expr expr )2100{2101CVar val; /* result */2102CVar left; /* left operand */21032104/* allocate a new temporary for the result */2105val = CVAR_TEMP( NewTemp( "val" ) );21062107/* compile the operands */2108left = CompExpr( ADDR_EXPR(expr)[0] );21092110/* emit the code */2111if ( HasInfoCVar(left,W_INT_SMALL) ) {2112Emit( "C_AINV_INTOBJS( %c, %c )\n", val, left );2113}2114else if ( CompFastIntArith ) {2115Emit( "C_AINV_FIA( %c, %c )\n", val, left );2116}2117else {2118Emit( "C_AINV( %c, %c )\n", val, left );2119}21202121/* set the information for the result */2122if ( HasInfoCVar(left,W_INT) ) {2123SetInfoCVar( val, W_INT );2124}2125else {2126SetInfoCVar( val, W_BOUND );2127}21282129/* free the temporaries */2130if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );21312132/* return the result */2133return val;2134}213521362137/****************************************************************************2138**2139*F CompDiff( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_DIFF2140*/2141CVar CompDiff (2142Expr expr )2143{2144CVar val; /* result */2145CVar left; /* left operand */2146CVar right; /* right operand */21472148/* allocate a new temporary for the result */2149val = CVAR_TEMP( NewTemp( "val" ) );21502151/* compile the two operands */2152left = CompExpr( ADDR_EXPR(expr)[0] );2153right = CompExpr( ADDR_EXPR(expr)[1] );21542155/* emit the code */2156if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {2157Emit( "C_DIFF_INTOBJS( %c, %c, %c )\n", val, left, right );2158}2159else if ( CompFastIntArith ) {2160Emit( "C_DIFF_FIA( %c, %c, %c )\n", val, left, right );2161}2162else {2163Emit( "C_DIFF( %c, %c, %c )\n", val, left, right );2164}21652166/* set the information for the result */2167if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {2168SetInfoCVar( val, W_INT );2169}2170else {2171SetInfoCVar( val, W_BOUND );2172}21732174/* free the temporaries */2175if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2176if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );21772178/* return the result */2179return val;2180}218121822183/****************************************************************************2184**2185*F CompProd( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . T_PROD2186*/2187CVar CompProd (2188Expr expr )2189{2190CVar val; /* result */2191CVar left; /* left operand */2192CVar right; /* right operand */21932194/* allocate a new temporary for the result */2195val = CVAR_TEMP( NewTemp( "val" ) );21962197/* compile the two operands */2198left = CompExpr( ADDR_EXPR(expr)[0] );2199right = CompExpr( ADDR_EXPR(expr)[1] );22002201/* emit the code */2202if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {2203Emit( "C_PROD_INTOBJS( %c, %c, %c )\n", val, left, right );2204}2205else if ( CompFastIntArith ) {2206Emit( "C_PROD_FIA( %c, %c, %c )\n", val, left, right );2207}2208else {2209Emit( "C_PROD( %c, %c, %c )\n", val, left, right );2210}22112212/* set the information for the result */2213if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {2214SetInfoCVar( val, W_INT );2215}2216else {2217SetInfoCVar( val, W_BOUND );2218}22192220/* free the temporaries */2221if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2222if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );22232224/* return the result */2225return val;2226}222722282229/****************************************************************************2230**2231*F CompInv( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_INV2232**2233** C_INV is not defined, so I guess this never gets called SL2234**2235*/2236CVar CompInv (2237Expr expr )2238{2239CVar val; /* result */2240CVar left; /* left operand */22412242/* allocate a new temporary for the result */2243val = CVAR_TEMP( NewTemp( "val" ) );22442245/* compile the operands */2246left = CompExpr( ADDR_EXPR(expr)[0] );22472248/* emit the code */2249Emit( "C_INV( %c, %c )\n", val, left );22502251/* set the information for the result */2252SetInfoCVar( val, W_BOUND );22532254/* free the temporaries */2255if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );22562257/* return the result */2258return val;2259}226022612262/****************************************************************************2263**2264*F CompQuo( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_QUO2265*/2266CVar CompQuo (2267Expr expr )2268{2269CVar val; /* result */2270CVar left; /* left operand */2271CVar right; /* right operand */22722273/* allocate a new temporary for the result */2274val = CVAR_TEMP( NewTemp( "val" ) );22752276/* compile the two operands */2277left = CompExpr( ADDR_EXPR(expr)[0] );2278right = CompExpr( ADDR_EXPR(expr)[1] );22792280/* emit the code */2281Emit( "%c = QUO( %c, %c );\n", val, left, right );22822283/* set the information for the result */2284SetInfoCVar( val, W_BOUND );22852286/* free the temporaries */2287if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2288if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );22892290/* return the result */2291return val;2292}229322942295/****************************************************************************2296**2297*F CompMod( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_MOD2298*/2299CVar CompMod (2300Expr expr )2301{2302CVar val; /* result */2303CVar left; /* left operand */2304CVar right; /* right operand */23052306/* allocate a new temporary for the result */2307val = CVAR_TEMP( NewTemp( "val" ) );23082309/* compile the two operands */2310left = CompExpr( ADDR_EXPR(expr)[0] );2311right = CompExpr( ADDR_EXPR(expr)[1] );23122313/* emit the code */2314Emit( "%c = MOD( %c, %c );\n", val, left, right );23152316/* set the information for the result */2317if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {2318SetInfoCVar( val, W_INT );2319}2320else {2321SetInfoCVar( val, W_BOUND );2322}23232324/* free the temporaries */2325if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2326if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );23272328/* return the result */2329return val;2330}233123322333/****************************************************************************2334**2335*F CompPow( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . T_POW2336*/2337CVar CompPow (2338Expr expr )2339{2340CVar val; /* result */2341CVar left; /* left operand */2342CVar right; /* right operand */23432344/* allocate a new temporary for the result */2345val = CVAR_TEMP( NewTemp( "val" ) );23462347/* compile the two operands */2348left = CompExpr( ADDR_EXPR(expr)[0] );2349right = CompExpr( ADDR_EXPR(expr)[1] );23502351/* emit the code */2352Emit( "%c = POW( %c, %c );\n", val, left, right );23532354/* set the information for the result */2355if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {2356SetInfoCVar( val, W_INT );2357}2358else {2359SetInfoCVar( val, W_BOUND );2360}23612362/* free the temporaries */2363if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );2364if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );23652366/* return the result */2367return val;2368}236923702371/****************************************************************************2372**2373*F CompIntExpr( <expr> ) . . . . . . . . . . . . . . . T_INTEXPR/T_INT_EXPR2374*2375* This is complicated by the need to produce code that will compile correctly2376* in 32 or 64 bit and with or without GMP.2377*2378* The problem is that when we compile the code, we know the integer representation2379* of the stored literal in the compiling process2380* but NOT the representation which will apply to the compiled code or the endianness2381*2382* The solution to this is macros: C_MAKE_INTEGER_BAG( size, type)2383* C_SET_LIMB2(bag, limbnumber, value)2384* C_SET_LIMB4(bag, limbnumber, value)2385* C_SET_LIMB8(bag, limbnumber, value)2386*2387* we compile using the one appropriate for the compiling system, but their2388* definition depends on the limb size of the target system.2389*2390*/23912392CVar CompIntExpr (2393Expr expr )2394{2395CVar val;2396Int siz;2397Int i;2398UInt typ;23992400if ( IS_INTEXPR(expr) ) {2401return CVAR_INTG( INT_INTEXPR(expr) );2402}2403else {2404val = CVAR_TEMP( NewTemp( "val" ) );2405siz = SIZE_EXPR(expr) - sizeof(UInt);2406typ = *(UInt *)ADDR_EXPR(expr);2407Emit( "%c = C_MAKE_INTEGER_BAG(%d, %d);\n",val, siz, typ);2408if ( typ == T_INTPOS ) {2409SetInfoCVar(val, W_INT_POS);2410}2411else {2412SetInfoCVar(val, W_INT);2413}24142415for ( i = 0; i < siz/INTEGER_UNIT_SIZE; i++ ) {2416#if INTEGER_UNIT_SIZE == 22417Emit( "C_SET_LIMB2( %c, %d, %d);\n",val, i, ((UInt2 *)((UInt *)ADDR_EXPR(expr) + 1))[i]);2418#else2419#if INTEGER_UNIT_SIZE == 42420Emit( "C_SET_LIMB4( %c, %d, %dL);\n",val, i, ((UInt4 *)((UInt *)ADDR_EXPR(expr) + 1))[i]);2421#else2422Emit( "C_SET_LIMB8( %c, %d, %dLL);\n",val, i, ((UInt8*)((UInt *)ADDR_EXPR(expr) + 1))[i]);2423#endif2424#endif2425}2426if (siz <= 8)2427Emit("%c = C_NORMALIZE_64BIT(%c);\n", val,val);2428return val;2429}2430}243124322433/****************************************************************************2434**2435*F CompTrueExpr( <expr> ) . . . . . . . . . . . . . . . . . . . T_TRUE_EXPR2436*/2437CVar CompTrueExpr (2438Expr expr )2439{2440CVar val; /* value, result */24412442/* allocate a new temporary for the 'true' value */2443val = CVAR_TEMP( NewTemp( "val" ) );24442445/* emit the code */2446Emit( "%c = True;\n", val );24472448/* we know that the result is boolean ;-) */2449SetInfoCVar( val, W_BOOL );24502451/* return 'true' */2452return val;2453}245424552456/****************************************************************************2457**2458*F CompFalseExpr( <expr> ) . . . . . . . . . . . . . . . . . . T_FALSE_EXPR2459*/2460CVar CompFalseExpr (2461Expr expr )2462{2463CVar val; /* value, result */24642465/* allocate a new temporary for the 'false' value */2466val = CVAR_TEMP( NewTemp( "val" ) );24672468/* emit the code */2469Emit( "%c = False;\n", val );24702471/* we know that the result is boolean ;-) */2472SetInfoCVar( val, W_BOOL );24732474/* return 'false' */2475return val;2476}247724782479/****************************************************************************2480**2481*F CompCharExpr( <expr> ) . . . . . . . . . . . . . . . . . . . T_CHAR_EXPR2482*/2483CVar CompCharExpr (2484Expr expr )2485{2486CVar val; /* result */24872488/* allocate a new temporary for the char value */2489val = CVAR_TEMP( NewTemp( "val" ) );24902491/* emit the code */2492Emit( "%c = ObjsChar[%d];\n", val, (Int)(((UChar*)ADDR_EXPR(expr))[0]));24932494/* we know that we have a value */2495SetInfoCVar( val, W_BOUND );24962497/* return the value */2498return val;2499}250025012502/****************************************************************************2503**2504*F CompPermExpr( <expr> ) . . . . . . . . . . . . . . . . . . . T_PERM_EXPR2505*/2506CVar CompPermExpr (2507Expr expr )2508{2509CVar perm; /* result */2510CVar lcyc; /* one cycle as list */2511CVar lprm; /* perm as list of list cycles */2512CVar val; /* one point */2513Int i;2514Int j;2515Int n;2516Int csize;2517Expr cycle;25182519/* check for the identity */2520if ( SIZE_EXPR(expr) == 0 ) {2521perm = CVAR_TEMP( NewTemp( "idperm" ) );2522Emit( "%c = IdentityPerm;\n", perm );2523SetInfoCVar( perm, W_BOUND );2524return perm;2525}25262527/* for each cycle create a list */2528perm = CVAR_TEMP( NewTemp( "perm" ) );2529lcyc = CVAR_TEMP( NewTemp( "lcyc" ) );2530lprm = CVAR_TEMP( NewTemp( "lprm" ) );25312532/* start with the identity permutation */2533Emit( "%c = IdentityPerm;\n", perm );25342535/* loop over the cycles */2536n = SIZE_EXPR(expr)/sizeof(Expr);2537Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lprm, n );2538Emit( "SET_LEN_PLIST( %c, %d );\n", lprm, n );25392540for ( i = 1; i <= n; i++ ) {2541cycle = ADDR_EXPR(expr)[i-1];2542csize = SIZE_EXPR(cycle)/sizeof(Expr);2543Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lcyc, csize );2544Emit( "SET_LEN_PLIST( %c, %d );\n", lcyc, csize );2545Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lprm, i, lcyc );2546Emit( "CHANGED_BAG( %c );\n", lprm );25472548/* loop over the entries of the cycle */2549for ( j = 1; j <= csize; j++ ) {2550val = CompExpr( ADDR_EXPR(cycle)[j-1] );2551Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lcyc, j, val );2552Emit( "CHANGED_BAG( %c );\n", lcyc );2553if ( IS_TEMP_CVAR(val) ) FreeTemp( TEMP_CVAR(val) );2554}2555}2556Emit( "%c = Array2Perm( %c );\n", perm, lprm );25572558/* free the termporaries */2559FreeTemp( TEMP_CVAR(lprm) );2560FreeTemp( TEMP_CVAR(lcyc) );25612562return perm;2563}256425652566/****************************************************************************2567**2568*F CompListExpr( <expr> ) . . . . . . . . . . . . . . . . . . . T_LIST_EXPR2569*/2570extern CVar CompListExpr1 ( Expr expr );2571extern void CompListExpr2 ( CVar list, Expr expr );2572extern CVar CompRecExpr1 ( Expr expr );2573extern void CompRecExpr2 ( CVar rec, Expr expr );25742575CVar CompListExpr (2576Expr expr )2577{2578CVar list; /* list, result */25792580/* compile the list expression */2581list = CompListExpr1( expr );2582CompListExpr2( list, expr );25832584/* return the result */2585return list;2586}258725882589/****************************************************************************2590**2591*F CompListTildeExpr( <expr> ) . . . . . . . . . . . . . . T_LIST_TILD_EXPR2592*/2593CVar CompListTildeExpr (2594Expr expr )2595{2596CVar list; /* list value, result */2597CVar tilde; /* old value of tilde */25982599/* remember the old value of '~' */2600tilde = CVAR_TEMP( NewTemp( "tilde" ) );2601Emit( "%c = VAL_GVAR( Tilde );\n", tilde );26022603/* create the list value */2604list = CompListExpr1( expr );26052606/* assign the list to '~' */2607Emit( "AssGVar( Tilde, %c );\n", list );26082609/* evaluate the subexpressions into the list value */2610CompListExpr2( list, expr );26112612/* restore old value of '~' */2613Emit( "AssGVar( Tilde, %c );\n", tilde );2614if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );26152616/* return the list value */2617return list;2618}261926202621/****************************************************************************2622**2623*F CompListExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local2624*/2625CVar CompListExpr1 (2626Expr expr )2627{2628CVar list; /* list, result */2629Int len; /* logical length of the list */26302631/* get the length of the list */2632len = SIZE_EXPR( expr ) / sizeof(Expr);26332634/* allocate a temporary for the list */2635list = CVAR_TEMP( NewTemp( "list" ) );26362637/* emit the code to make the list */2638Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", list, len );2639Emit( "SET_LEN_PLIST( %c, %d );\n", list, len );26402641/* we know that <list> is a list */2642SetInfoCVar( list, W_LIST );26432644/* return the list */2645return list;2646}264726482649/****************************************************************************2650**2651*F CompListExpr2( <list>, <expr> ) . . . . . . . . . . . . . . . . . . local2652*/2653void CompListExpr2 (2654CVar list,2655Expr expr )2656{2657CVar sub; /* subexpression */2658Int len; /* logical length of the list */2659Int i; /* loop variable */26602661/* get the length of the list */2662len = SIZE_EXPR( expr ) / sizeof(Expr);26632664/* emit the code to fill the list */2665for ( i = 1; i <= len; i++ ) {26662667/* if the subexpression is empty */2668if ( ADDR_EXPR(expr)[i-1] == 0 ) {2669continue;2670}26712672/* special case if subexpression is a list expression */2673else if ( TNUM_EXPR( ADDR_EXPR(expr)[i-1] ) == T_LIST_EXPR ) {2674sub = CompListExpr1( ADDR_EXPR(expr)[i-1] );2675Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );2676Emit( "CHANGED_BAG( %c );\n", list );2677CompListExpr2( sub, ADDR_EXPR(expr)[i-1] );2678if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2679}26802681/* special case if subexpression is a record expression */2682else if ( TNUM_EXPR( ADDR_EXPR(expr)[i-1] ) == T_REC_EXPR ) {2683sub = CompRecExpr1( ADDR_EXPR(expr)[i-1] );2684Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );2685Emit( "CHANGED_BAG( %c );\n", list );2686CompRecExpr2( sub, ADDR_EXPR(expr)[i-1] );2687if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2688}26892690/* general case */2691else {2692sub = CompExpr( ADDR_EXPR(expr)[i-1] );2693Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );2694if ( ! HasInfoCVar( sub, W_INT_SMALL ) ) {2695Emit( "CHANGED_BAG( %c );\n", list );2696}2697if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2698}26992700}27012702}270327042705/****************************************************************************2706**2707*F CompRangeExpr( <expr> ) . . . . . . . . . . . . . . . . . . T_RANGE_EXPR2708*/2709CVar CompRangeExpr (2710Expr expr )2711{2712CVar range; /* range, result */2713CVar first; /* first element */2714CVar second; /* second element */2715CVar last; /* last element */27162717/* allocate a new temporary for the range */2718range = CVAR_TEMP( NewTemp( "range" ) );27192720/* evaluate the expressions */2721if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {2722first = CompExpr( ADDR_EXPR(expr)[0] );2723second = 0;2724last = CompExpr( ADDR_EXPR(expr)[1] );2725}2726else {2727first = CompExpr( ADDR_EXPR(expr)[0] );2728second = CompExpr( ADDR_EXPR(expr)[1] );2729last = CompExpr( ADDR_EXPR(expr)[2] );2730}27312732/* emit the code */2733if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {2734Emit( "%c = Range2Check( %c, %c );\n",2735range, first, last );2736}2737else {2738Emit( "%c = Range3Check( %c, %c, %c );\n",2739range, first, second, last );2740}27412742/* we know that the result is a list */2743SetInfoCVar( range, W_LIST );27442745/* free the temporaries */2746if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {2747if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );2748if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );2749}2750else {2751if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );2752if ( IS_TEMP_CVAR( second ) ) FreeTemp( TEMP_CVAR( second ) );2753if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );2754}27552756/* return the range */2757return range;2758}275927602761/****************************************************************************2762**2763*F CompStringExpr( <expr> ) . . . . . . . . . . compile a string expression2764*/2765CVar CompStringExpr (2766Expr expr )2767{2768CVar string; /* string value, result */27692770/* allocate a new temporary for the string */2771string = CVAR_TEMP( NewTemp( "string" ) );27722773/* create the string and copy the stuff */2774Emit( "C_NEW_STRING( %c, %d, \"%C\" );\n",27752776/* the sizeof(UInt) offset is to get past the length of the string2777which is now stored in the front of the literal */2778string, SIZE_EXPR(expr)-1-sizeof(UInt),2779sizeof(UInt)+ (Char*)ADDR_EXPR(expr) );27802781/* we know that the result is a list */2782SetInfoCVar( string, W_LIST );27832784/* return the string */2785return string;2786}278727882789/****************************************************************************2790**2791*F CompRecExpr( <expr> ) . . . . . . . . . . . . . . . . . . . . T_REC_EXPR2792*/2793CVar CompRecExpr (2794Expr expr )2795{2796CVar rec; /* record value, result */27972798/* compile the record expression */2799rec = CompRecExpr1( expr );2800CompRecExpr2( rec, expr );28012802/* return the result */2803return rec;2804}280528062807/****************************************************************************2808**2809*F CompRecTildeExpr( <expr> ) . . . . . . . . . . . . . . . T_REC_TILD_EXPR2810*/2811CVar CompRecTildeExpr (2812Expr expr )2813{2814CVar rec; /* record value, result */2815CVar tilde; /* old value of tilde */28162817/* remember the old value of '~' */2818tilde = CVAR_TEMP( NewTemp( "tilde" ) );2819Emit( "%c = VAL_GVAR( Tilde );\n", tilde );28202821/* create the record value */2822rec = CompRecExpr1( expr );28232824/* assign the record value to the variable '~' */2825Emit( "AssGVar( Tilde, %c );\n", rec );28262827/* evaluate the subexpressions into the record value */2828CompRecExpr2( rec, expr );28292830/* restore the old value of '~' */2831Emit( "AssGVar( Tilde, %c );\n", tilde );2832if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );28332834/* return the record value */2835return rec;2836}283728382839/****************************************************************************2840**2841*F CompRecExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local2842*/2843CVar CompRecExpr1 (2844Expr expr )2845{2846CVar rec; /* record value, result */2847Int len; /* number of components */28482849/* get the number of components */2850len = SIZE_EXPR( expr ) / (2*sizeof(Expr));28512852/* allocate a new temporary for the record */2853rec = CVAR_TEMP( NewTemp( "rec" ) );28542855/* emit the code to allocate the new record object */2856Emit( "%c = NEW_PREC( %d );\n", rec, len );28572858/* we know that we have a value */2859SetInfoCVar( rec, W_BOUND );28602861/* return the record */2862return rec;2863}286428652866/****************************************************************************2867**2868*F CompRecExpr2( <rec>, <expr> ) . . . . . . . . . . . . . . . . . . . local2869*/2870void CompRecExpr2 (2871CVar rec,2872Expr expr )2873{2874CVar rnam; /* name of component */2875CVar sub; /* value of subexpression */2876Int len; /* number of components */2877Expr tmp; /* temporary variable */2878Int i; /* loop variable */28792880/* get the number of components */2881len = SIZE_EXPR( expr ) / (2*sizeof(Expr));28822883/* handle the subexpressions */2884for ( i = 1; i <= len; i++ ) {28852886/* handle the name */2887tmp = ADDR_EXPR(expr)[2*i-2];2888rnam = CVAR_TEMP( NewTemp( "rnam" ) );2889if ( IS_INTEXPR(tmp) ) {2890CompSetUseRNam( (UInt)INT_INTEXPR(tmp), COMP_USE_RNAM_ID );2891Emit( "%c = (Obj)R_%n;\n",2892rnam, NAME_RNAM((UInt)INT_INTEXPR(tmp)) );2893}2894else {2895sub = CompExpr( tmp );2896Emit( "%c = (Obj)RNamObj( %c );\n", rnam, sub );2897}28982899/* if the subexpression is empty (cannot happen for records) */2900tmp = ADDR_EXPR(expr)[2*i-1];2901if ( tmp == 0 ) {2902if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );2903continue;2904}29052906/* special case if subexpression is a list expression */2907else if ( TNUM_EXPR( tmp ) == T_LIST_EXPR ) {2908sub = CompListExpr1( tmp );2909Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );2910CompListExpr2( sub, tmp );2911if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2912}29132914/* special case if subexpression is a record expression */2915else if ( TNUM_EXPR( tmp ) == T_REC_EXPR ) {2916sub = CompRecExpr1( tmp );2917Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );2918CompRecExpr2( sub, tmp );2919if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2920}29212922/* general case */2923else {2924sub = CompExpr( tmp );2925Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );2926if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );2927}29282929if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );2930}2931Emit( "SortPRecRNam( %c, 0 );\n", rec );29322933}293429352936/****************************************************************************2937**2938*F CompRefLVar( <expr> ) . . . . . . . T_REFLVAR/T_REF_LVAR...T_REF_LVAR_162939*/2940CVar CompRefLVar (2941Expr expr )2942{2943CVar val; /* value, result */2944LVar lvar; /* local variable */29452946/* get the local variable */2947if ( IS_REFLVAR(expr) ) {2948lvar = LVAR_REFLVAR(expr);2949}2950else {2951lvar = (LVar)(ADDR_EXPR(expr)[0]);2952}29532954/* emit the code to get the value */2955if ( CompGetUseHVar( lvar ) ) {2956val = CVAR_TEMP( NewTemp( "val" ) );2957Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );2958}2959else {2960val = CVAR_LVAR(lvar);2961}29622963/* emit code to check that the variable has a value */2964CompCheckBound( val, NAME_LVAR(lvar) );29652966/* return the value */2967return val;2968}296929702971/****************************************************************************2972**2973*F CompIsbLVar( <expr> ) . . . . . . . . . . . . . . . . . . . . T_ISB_LVAR2974*/2975CVar CompIsbLVar (2976Expr expr )2977{2978CVar isb; /* isbound, result */2979CVar val; /* value */2980LVar lvar; /* local variable */29812982/* get the local variable */2983lvar = (LVar)(ADDR_EXPR(expr)[0]);29842985/* allocate a new temporary for the result */2986isb = CVAR_TEMP( NewTemp( "isb" ) );29872988/* emit the code to get the value */2989if ( CompGetUseHVar( lvar ) ) {2990val = CVAR_TEMP( NewTemp( "val" ) );2991Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );2992}2993else {2994val = CVAR_LVAR(lvar);2995}29962997/* emit the code to check that the variable has a value */2998Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );29993000/* we know that the result is boolean */3001SetInfoCVar( isb, W_BOOL );30023003/* free the temporaries */3004if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );30053006/* return the result */3007return isb;3008}300930103011/****************************************************************************3012**3013*F CompRefHVar( <expr> ) . . . . . . . . . . . . . . . . . . . . T_REF_HVAR3014*/3015CVar CompRefHVar (3016Expr expr )3017{3018CVar val; /* value, result */3019HVar hvar; /* higher variable */30203021/* get the higher variable */3022hvar = (HVar)(ADDR_EXPR(expr)[0]);3023CompSetUseHVar( hvar );30243025/* allocate a new temporary for the value */3026val = CVAR_TEMP( NewTemp( "val" ) );30273028/* emit the code to get the value */3029Emit( "%c = OBJ_LVAR_%dUP( %d );\n",3030val, GetLevlHVar(hvar), GetIndxHVar(hvar) );30313032/* emit the code to check that the variable has a value */3033CompCheckBound( val, NAME_HVAR(hvar) );30343035/* return the value */3036return val;3037}303830393040/****************************************************************************3041**3042*F CompIsbHVar( <expr> ) . . . . . . . . . . . . . . . . . . . . T_ISB_HVAR3043*/3044CVar CompIsbHVar (3045Expr expr )3046{3047CVar isb; /* isbound, result */3048CVar val; /* value */3049HVar hvar; /* higher variable */30503051/* get the higher variable */3052hvar = (HVar)(ADDR_EXPR(expr)[0]);3053CompSetUseHVar( hvar );30543055/* allocate new temporaries for the value and the result */3056val = CVAR_TEMP( NewTemp( "val" ) );3057isb = CVAR_TEMP( NewTemp( "isb" ) );30583059/* emit the code to get the value */3060Emit( "%c = OBJ_LVAR_%dUP( %d );\n",3061val, GetLevlHVar(hvar), GetIndxHVar(hvar) );30623063/* emit the code to check that the variable has a value */3064Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );30653066/* we know that the result is boolean */3067SetInfoCVar( isb, W_BOOL );30683069/* free the temporaries */3070if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );30713072/* return the result */3073return isb;3074}307530763077/****************************************************************************3078**3079*F CompRefGVar( <expr> ) . . . . . . . . . . . . . . . . . . . . T_REF_GVAR3080*/3081CVar CompRefGVar (3082Expr expr )3083{3084CVar val; /* value, result */3085GVar gvar; /* higher variable */30863087/* get the global variable */3088gvar = (GVar)(ADDR_EXPR(expr)[0]);3089CompSetUseGVar( gvar, COMP_USE_GVAR_COPY );30903091/* allocate a new global variable for the value */3092val = CVAR_TEMP( NewTemp( "val" ) );30933094/* emit the code to get the value */3095Emit( "%c = GC_%n;\n", val, NameGVar(gvar) );30963097/* emit the code to check that the variable has a value */3098CompCheckBound( val, NameGVar(gvar) );30993100/* return the value */3101return val;3102}310331043105/****************************************************************************3106**3107*F CompRefGVarFopy( <expr> ) . . . . . . . . . . . . . . . . . . . . . local3108*/3109CVar CompRefGVarFopy (3110Expr expr )3111{3112CVar val; /* value, result */3113GVar gvar; /* higher variable */31143115/* get the global variable */3116gvar = (GVar)(ADDR_EXPR(expr)[0]);3117CompSetUseGVar( gvar, COMP_USE_GVAR_FOPY );31183119/* allocate a new temporary for the value */3120val = CVAR_TEMP( NewTemp( "val" ) );31213122/* emit the code to get the value */3123Emit( "%c = GF_%n;\n", val, NameGVar(gvar) );31243125/* we know that the object in a function copy is a function */3126SetInfoCVar( val, W_FUNC );31273128/* return the value */3129return val;3130}313131323133/****************************************************************************3134**3135*F CompIsbGVar( <expr> ) . . . . . . . . . . . . . . . . . . . . T_ISB_GVAR3136*/3137CVar CompIsbGVar (3138Expr expr )3139{3140CVar isb; /* isbound, result */3141CVar val; /* value, result */3142GVar gvar; /* higher variable */31433144/* get the global variable */3145gvar = (GVar)(ADDR_EXPR(expr)[0]);3146CompSetUseGVar( gvar, COMP_USE_GVAR_COPY );31473148/* allocate new temporaries for the value and the result */3149isb = CVAR_TEMP( NewTemp( "isb" ) );3150val = CVAR_TEMP( NewTemp( "val" ) );31513152/* emit the code to get the value */3153Emit( "%c = GC_%n;\n", val, NameGVar(gvar) );31543155/* emit the code to check that the variable has a value */3156Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );31573158/* we know that the result is boolean */3159SetInfoCVar( isb, W_BOOL );31603161/* free the temporaries */3162if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );31633164/* return the result */3165return isb;3166}316731683169/****************************************************************************3170**3171*F CompElmList( <expr> ) . . . . . . . . . . . . . . . . . . . . T_ELM_LIST3172*/3173CVar CompElmList (3174Expr expr )3175{3176CVar elm; /* element, result */3177CVar list; /* list */3178CVar pos; /* position */31793180/* allocate a new temporary for the element */3181elm = CVAR_TEMP( NewTemp( "elm" ) );31823183/* compile the list expression (checking is done by 'ELM_LIST') */3184list = CompExpr( ADDR_EXPR(expr)[0] );31853186/* compile and check the position expression */3187pos = CompExpr( ADDR_EXPR(expr)[1] );3188CompCheckIntPos( pos );31893190/* emit the code to get the element */3191if ( CompCheckListElements && CompFastPlainLists ) {3192Emit( "C_ELM_LIST_FPL( %c, %c, %c )\n", elm, list, pos );3193}3194else if ( CompCheckListElements && ! CompFastPlainLists ) {3195Emit( "C_ELM_LIST( %c, %c, %c );\n", elm, list, pos );3196}3197else if ( ! CompCheckListElements && CompFastPlainLists ) {3198Emit( "C_ELM_LIST_NLE_FPL( %c, %c, %c );\n", elm, list, pos );3199}3200else {3201Emit( "C_ELM_LIST_NLE( %c, %c, %c );\n", elm, list, pos );3202}32033204/* we know that we have a value */3205SetInfoCVar( elm, W_BOUND );32063207/* free the temporaries */3208if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );3209if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );32103211/* return the element */3212return elm;3213}321432153216/****************************************************************************3217**3218*F CompElmsList( <expr> ) . . . . . . . . . . . . . . . . . . . T_ELMS_LIST3219*/3220CVar CompElmsList (3221Expr expr )3222{3223CVar elms; /* elements, result */3224CVar list; /* list */3225CVar poss; /* positions */32263227/* allocate a new temporary for the elements */3228elms = CVAR_TEMP( NewTemp( "elms" ) );32293230/* compile the list expression (checking is done by 'ElmsListCheck') */3231list = CompExpr( ADDR_EXPR(expr)[0] );32323233/* compile the position expression (checking done by 'ElmsListCheck') */3234poss = CompExpr( ADDR_EXPR(expr)[1] );32353236/* emit the code to get the element */3237Emit( "%c = ElmsListCheck( %c, %c );\n", elms, list, poss );32383239/* we know that the elements are a list */3240SetInfoCVar( elms, W_LIST );32413242/* free the temporaries */3243if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );3244if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );32453246/* return the elements */3247return elms;3248}324932503251/****************************************************************************3252**3253*F CompElmListLev( <expr> ) . . . . . . . . . . . . . . . . T_ELM_LIST_LEV3254*/3255CVar CompElmListLev (3256Expr expr )3257{3258CVar lists; /* lists */3259CVar pos; /* position */3260Int level; /* level */32613262/* compile the lists expression */3263lists = CompExpr( ADDR_EXPR(expr)[0] );32643265/* compile and check the position expression */3266pos = CompExpr( ADDR_EXPR(expr)[1] );3267CompCheckIntSmallPos( pos );32683269/* get the level */3270level = (Int)(ADDR_EXPR(expr)[2]);32713272/* emit the code to select the elements from several lists (to <lists>)*/3273Emit( "ElmListLevel( %c, %c, %d );\n", lists, pos, level );32743275/* free the temporaries */3276if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );32773278/* return the lists */3279return lists;3280}328132823283/****************************************************************************3284**3285*F CompElmsListLev( <expr> ) . . . . . . . . . . . . . . . . T_ELMS_LIST_LEV3286*/3287CVar CompElmsListLev (3288Expr expr )3289{3290CVar lists; /* lists */3291CVar poss; /* positions */3292Int level; /* level */32933294/* compile the lists expression */3295lists = CompExpr( ADDR_EXPR(expr)[0] );32963297/* compile the position expression (checking done by 'ElmsListLevel') */3298poss = CompExpr( ADDR_EXPR(expr)[1] );32993300/* get the level */3301level = (Int)(ADDR_EXPR(expr)[2]);33023303/* emit the code to select the elements from several lists (to <lists>)*/3304Emit( "ElmsListLevelCheck( %c, %c, %d );\n", lists, poss, level );33053306/* free the temporaries */3307if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );33083309/* return the lists */3310return lists;3311}331233133314/****************************************************************************3315**3316*F CompIsbList( <expr> ) . . . . . . . . . . . . . . . . . . . . T_ISB_LIST3317*/3318CVar CompIsbList (3319Expr expr )3320{3321CVar isb; /* isbound, result */3322CVar list; /* list */3323CVar pos; /* position */33243325/* allocate a new temporary for the result */3326isb = CVAR_TEMP( NewTemp( "isb" ) );33273328/* compile the list expression (checking is done by 'ISB_LIST') */3329list = CompExpr( ADDR_EXPR(expr)[0] );33303331/* compile and check the position expression */3332pos = CompExpr( ADDR_EXPR(expr)[1] );3333CompCheckIntPos( pos );33343335/* emit the code to test the element */3336Emit( "%c = C_ISB_LIST( %c, %c );\n", isb, list, pos );33373338/* we know that the result is boolean */3339SetInfoCVar( isb, W_BOOL );33403341/* free the temporaries */3342if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );3343if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );33443345/* return the element */3346return isb;3347}334833493350/****************************************************************************3351**3352*F CompElmRecName( <expr> ) . . . . . . . . . . . . . . . . T_ELM_REC_NAME3353*/3354CVar CompElmRecName (3355Expr expr )3356{3357CVar elm; /* element, result */3358CVar record; /* the record, left operand */3359UInt rnam; /* the name, right operand */33603361/* allocate a new temporary for the element */3362elm = CVAR_TEMP( NewTemp( "elm" ) );33633364/* compile the record expression (checking is done by 'ELM_REC') */3365record = CompExpr( ADDR_EXPR(expr)[0] );33663367/* get the name (stored immediately in the expression) */3368rnam = (UInt)(ADDR_EXPR(expr)[1]);3369CompSetUseRNam( rnam, COMP_USE_RNAM_ID );33703371/* emit the code to select the element of the record */3372Emit( "%c = ELM_REC( %c, R_%n );\n", elm, record, NAME_RNAM(rnam) );33733374/* we know that we have a value */3375SetInfoCVar( elm, W_BOUND );33763377/* free the temporaries */3378if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );33793380/* return the element */3381return elm;3382}338333843385/****************************************************************************3386**3387*F CompElmRecExpr( <expr> ) . . . . . . . . . . . . . . . . T_ELM_REC_EXPR3388*/3389CVar CompElmRecExpr (3390Expr expr )3391{3392CVar elm; /* element, result */3393CVar record; /* the record, left operand */3394CVar rnam; /* the name, right operand */33953396/* allocate a new temporary for the element */3397elm = CVAR_TEMP( NewTemp( "elm" ) );33983399/* compile the record expression (checking is done by 'ELM_REC') */3400record = CompExpr( ADDR_EXPR(expr)[0] );34013402/* compile the record name expression */3403rnam = CompExpr( ADDR_EXPR(expr)[1] );34043405/* emit the code to select the element of the record */3406Emit( "%c = ELM_REC( %c, RNamObj(%c) );\n", elm, record, rnam );34073408/* we know that we have a value */3409SetInfoCVar( elm, W_BOUND );34103411/* free the temporaries */3412if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );3413if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );34143415/* return the element */3416return elm;3417}341834193420/****************************************************************************3421**3422*F CompIsbRecName( <expr> ) . . . . . . . . . . . . . . . . T_ISB_REC_NAME3423*/3424CVar CompIsbRecName (3425Expr expr )3426{3427CVar isb; /* isbound, result */3428CVar record; /* the record, left operand */3429UInt rnam; /* the name, right operand */34303431/* allocate a new temporary for the result */3432isb = CVAR_TEMP( NewTemp( "isb" ) );34333434/* compile the record expression (checking is done by 'ISB_REC') */3435record = CompExpr( ADDR_EXPR(expr)[0] );34363437/* get the name (stored immediately in the expression) */3438rnam = (UInt)(ADDR_EXPR(expr)[1]);3439CompSetUseRNam( rnam, COMP_USE_RNAM_ID );34403441/* emit the code to test the element */3442Emit( "%c = (ISB_REC( %c, R_%n ) ? True : False);\n",3443isb, record, NAME_RNAM(rnam) );34443445/* we know that the result is boolean */3446SetInfoCVar( isb, W_BOOL );34473448/* free the temporaries */3449if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );34503451/* return the result */3452return isb;3453}345434553456/****************************************************************************3457**3458*F CompIsbRecExpr( <expr> ) . . . . . . . . . . . . . . . . T_ISB_REC_EXPR3459*/3460CVar CompIsbRecExpr (3461Expr expr )3462{3463CVar isb; /* isbound, result */3464CVar record; /* the record, left operand */3465CVar rnam; /* the name, right operand */34663467/* allocate a new temporary for the result */3468isb = CVAR_TEMP( NewTemp( "isb" ) );34693470/* compile the record expression (checking is done by 'ISB_REC') */3471record = CompExpr( ADDR_EXPR(expr)[0] );34723473/* compile the record name expression */3474rnam = CompExpr( ADDR_EXPR(expr)[1] );34753476/* emit the code to test the element */3477Emit( "%c = (ISB_REC( %c, RNamObj(%c) ) ? True : False);\n",3478isb, record, rnam );34793480/* we know that the result is boolean */3481SetInfoCVar( isb, W_BOOL );34823483/* free the temporaries */3484if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );3485if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );34863487/* return the result */3488return isb;3489}349034913492/****************************************************************************3493**3494*F CompElmPosObj( <expr> ) . . . . . . . . . . . . . . . . . . T_ELM_POSOBJ3495*/3496CVar CompElmPosObj (3497Expr expr )3498{3499CVar elm; /* element, result */3500CVar list; /* list */3501CVar pos; /* position */35023503/* allocate a new temporary for the element */3504elm = CVAR_TEMP( NewTemp( "elm" ) );35053506/* compile the list expression (checking is done by 'ELM_LIST') */3507list = CompExpr( ADDR_EXPR(expr)[0] );35083509/* compile and check the position expression */3510pos = CompExpr( ADDR_EXPR(expr)[1] );3511CompCheckIntSmallPos( pos );35123513/* emit the code to get the element */3514if ( CompCheckPosObjElements ) {3515Emit( "C_ELM_POSOBJ( %c, %c, %i )\n", elm, list, pos );3516}3517else if ( ! CompCheckPosObjElements ) {3518Emit( "C_ELM_POSOBJ_NLE( %c, %c, %i );\n", elm, list, pos );3519}35203521/* we know that we have a value */3522SetInfoCVar( elm, W_BOUND );35233524/* free the temporaries */3525if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );3526if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );35273528/* return the element */3529return elm;3530}353135323533/****************************************************************************3534**3535*F CompElmsPosObj( <expr> ) . . . . . . . . . . . . . . . . . T_ELMS_POSOBJ3536*/3537CVar CompElmsPosObj (3538Expr expr )3539{3540Emit( "CANNOT COMPILE EXPRESSION OF TNUM %d;\n", TNUM_EXPR(expr) );3541return 0;3542}354335443545/****************************************************************************3546**3547*F CompElmPosObjLev( <expr> ) . . . . . . . . . . . . . . T_ELM_POSOBJ_LEV3548*/3549CVar CompElmPosObjLev (3550Expr expr )3551{3552Emit( "CANNOT COMPILE EXPRESSION OF TNUM %d;\n", TNUM_EXPR(expr) );3553return 0;3554}355535563557/****************************************************************************3558**3559*F CompElmsPosObjLev( <expr> ) . . . . . . . . . . . . . . . . T_ELMS_POSOBJ3560*/3561CVar CompElmsPosObjLev (3562Expr expr )3563{3564Emit( "CANNOT COMPILE EXPRESSION OF TNUM %d;\n", TNUM_EXPR(expr) );3565return 0;3566}356735683569/****************************************************************************3570**3571*F CompIsbPosObj( <expr> ) . . . . . . . . . . . . . . . . . . T_ISB_POSOBJ3572*/3573CVar CompIsbPosObj (3574Expr expr )3575{3576CVar isb; /* isbound, result */3577CVar list; /* list */3578CVar pos; /* position */35793580/* allocate a new temporary for the result */3581isb = CVAR_TEMP( NewTemp( "isb" ) );35823583/* compile the list expression (checking is done by 'ISB_LIST') */3584list = CompExpr( ADDR_EXPR(expr)[0] );35853586/* compile and check the position expression */3587pos = CompExpr( ADDR_EXPR(expr)[1] );3588CompCheckIntSmallPos( pos );35893590/* emit the code to test the element */3591Emit( "if ( TNUM_OBJ(%c) == T_POSOBJ ) {\n", list );3592Emit( "%c = (%i <= SIZE_OBJ(%c)/sizeof(Obj)-1\n", isb, pos, list );3593Emit( " && ELM_PLIST(%c,%i) != 0 ? True : False);\n", list, pos );3594Emit( "}\nelse {\n" );3595Emit( "%c = (ISB_LIST( %c, %i ) ? True : False);\n", isb, list, pos );3596Emit( "}\n" );35973598/* we know that the result is boolean */3599SetInfoCVar( isb, W_BOOL );36003601/* free the temporaries */3602if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );3603if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );36043605/* return the element */3606return isb;3607}360836093610/****************************************************************************3611**3612*F CompElmObjName( <expr> ) . . . . . . . . . . . . . . . T_ELM_COMOBJ_NAME3613*/3614CVar CompElmComObjName (3615Expr expr )3616{3617CVar elm; /* element, result */3618CVar record; /* the record, left operand */3619UInt rnam; /* the name, right operand */36203621/* allocate a new temporary for the element */3622elm = CVAR_TEMP( NewTemp( "elm" ) );36233624/* compile the record expression (checking is done by 'ELM_REC') */3625record = CompExpr( ADDR_EXPR(expr)[0] );36263627/* get the name (stored immediately in the expression) */3628rnam = (UInt)(ADDR_EXPR(expr)[1]);3629CompSetUseRNam( rnam, COMP_USE_RNAM_ID );36303631/* emit the code to select the element of the record */3632Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );3633Emit( "%c = ElmPRec( %c, R_%n );\n", elm, record, NAME_RNAM(rnam) );3634Emit( "}\nelse {\n" );3635Emit( "%c = ELM_REC( %c, R_%n );\n", elm, record, NAME_RNAM(rnam) );3636Emit( "}\n" );36373638/* we know that we have a value */3639SetInfoCVar( elm, W_BOUND );36403641/* free the temporaries */3642if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );36433644/* return the element */3645return elm;3646}3647364836493650/****************************************************************************3651**3652*F CompElmComObjExpr( <expr> ) . . . . . . . . . . . . . . T_ELM_COMOBJ_EXPR3653*/3654CVar CompElmComObjExpr (3655Expr expr )3656{3657CVar elm; /* element, result */3658CVar record; /* the record, left operand */3659CVar rnam; /* the name, right operand */36603661/* allocate a new temporary for the element */3662elm = CVAR_TEMP( NewTemp( "elm" ) );36633664/* compile the record expression (checking is done by 'ELM_REC') */3665record = CompExpr( ADDR_EXPR(expr)[0] );36663667/* get the name (stored immediately in the expression) */3668rnam = CompExpr( ADDR_EXPR(expr)[1] );36693670/* emit the code to select the element of the record */3671Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );3672Emit( "%c = ElmPRec( %c, RNamObj(%c) );\n", elm, record, rnam );3673Emit( "}\nelse {\n" );3674Emit( "%c = ELM_REC( %c, RNamObj(%c) );\n", elm, record, rnam );3675Emit( "}\n" );36763677/* we know that we have a value */3678SetInfoCVar( elm, W_BOUND );36793680/* free the temporaries */3681if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );3682if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );36833684/* return the element */3685return elm;3686}368736883689/****************************************************************************3690**3691*F CompIsbComObjName( <expr> ) . . . . . . . . . . . . . . T_ISB_COMOBJ_NAME3692*/3693CVar CompIsbComObjName (3694Expr expr )3695{3696CVar isb; /* isbound, result */3697CVar record; /* the record, left operand */3698UInt rnam; /* the name, right operand */36993700/* allocate a new temporary for the result */3701isb = CVAR_TEMP( NewTemp( "isb" ) );37023703/* compile the record expression (checking is done by 'ISB_REC') */3704record = CompExpr( ADDR_EXPR(expr)[0] );37053706/* get the name (stored immediately in the expression) */3707rnam = (UInt)(ADDR_EXPR(expr)[1]);3708CompSetUseRNam( rnam, COMP_USE_RNAM_ID );37093710/* emit the code to test the element */3711Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );3712Emit( "%c = (IsbPRec( %c, R_%n ) ? True : False);\n",3713isb, record, NAME_RNAM(rnam) );3714Emit( "}\nelse {\n" );3715Emit( "%c = (ISB_REC( %c, R_%n ) ? True : False);\n",3716isb, record, NAME_RNAM(rnam) );3717Emit( "}\n" );37183719/* we know that the result is boolean */3720SetInfoCVar( isb, W_BOOL );37213722/* free the temporaries */3723if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );37243725/* return the result */3726return isb;3727}372837293730/****************************************************************************3731**3732*F CompIsbComObjExpr( <expr> ) . . . . . . . . . . . . . . T_ISB_COMOBJ_EXPR3733*/3734CVar CompIsbComObjExpr (3735Expr expr )3736{3737CVar isb; /* isbound, result */3738CVar record; /* the record, left operand */3739UInt rnam; /* the name, right operand */37403741/* allocate a new temporary for the result */3742isb = CVAR_TEMP( NewTemp( "isb" ) );37433744/* compile the record expression (checking is done by 'ISB_REC') */3745record = CompExpr( ADDR_EXPR(expr)[0] );37463747/* get the name (stored immediately in the expression) */3748rnam = CompExpr( ADDR_EXPR(expr)[1] );37493750/* emit the code to test the element */3751Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );3752Emit( "%c = (IsbPRec( %c, RNamObj(%c) ) ? True : False);\n",3753isb, record, rnam );3754Emit( "}\nelse {\n" );3755Emit( "%c = (ISB_REC( %c, RNamObj(%c) ) ? True : False);\n",3756isb, record, rnam );3757Emit( "}\n" );37583759/* we know that the result is boolean */3760SetInfoCVar( isb, W_BOOL );37613762/* free the temporaries */3763if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );3764if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );37653766/* return the result */3767return isb;3768}376937703771/****************************************************************************3772**37733774*F * * * * * * * * * * * * * compile statements * * * * * * * * * * * * * * *3775*/377637773778/****************************************************************************3779**37803781*F CompStat( <stat> ) . . . . . . . . . . . . . . . . . compile a statement3782**3783** 'CompStat' compiles the statement <stat>.3784*/3785void (* CompStatFuncs[256]) ( Stat stat );37863787void CompStat (3788Stat stat )3789{3790(* CompStatFuncs[ TNUM_STAT(stat) ])( stat );3791}379237933794/****************************************************************************3795**3796*F CompUnknownStat( <stat> ) . . . . . . . . . . . . . . . . signal an error3797*/3798void CompUnknownStat (3799Stat stat )3800{3801Emit( "CANNOT COMPILE STATEMENT OF TNUM %d;\n", TNUM_STAT(stat) );3802}380338043805/****************************************************************************3806**3807*V G_Add . . . . . . . . . . . . . . . . . . . . . . . . . . function 'Add'3808*/3809GVar G_Add;381038113812/****************************************************************************3813**3814*F CompProccall0to6Args( <stat> ) . . . T_PROCCALL_0ARGS...T_PROCCALL_6ARGS3815*/3816void CompProccall0to6Args (3817Stat stat )3818{3819CVar func; /* function */3820CVar args[8]; /* arguments */3821UInt narg; /* number of arguments */3822UInt i; /* loop variable */38233824/* print a comment */3825if ( CompPass == 2 ) {3826Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );3827}38283829/* special case to inline 'Add' */3830if ( CompFastListFuncs3831&& TNUM_EXPR( FUNC_CALL(stat) ) == T_REF_GVAR3832&& ADDR_EXPR( FUNC_CALL(stat) )[0] == G_Add3833&& NARG_SIZE_CALL(SIZE_EXPR(stat)) == 2 ) {3834args[1] = CompExpr( ARGI_CALL(stat,1) );3835args[2] = CompExpr( ARGI_CALL(stat,2) );3836if ( CompFastPlainLists ) {3837Emit( "C_ADD_LIST_FPL( %c, %c )\n", args[1], args[2] );3838}3839else {3840Emit( "C_ADD_LIST( %c, %c )\n", args[1], args[2] );3841}3842if ( IS_TEMP_CVAR( args[2] ) ) FreeTemp( TEMP_CVAR( args[2] ) );3843if ( IS_TEMP_CVAR( args[1] ) ) FreeTemp( TEMP_CVAR( args[1] ) );3844return;3845}38463847/* compile the reference to the function */3848if ( TNUM_EXPR( FUNC_CALL(stat) ) == T_REF_GVAR ) {3849func = CompRefGVarFopy( FUNC_CALL(stat) );3850}3851else {3852func = CompExpr( FUNC_CALL(stat) );3853CompCheckFunc( func );3854}38553856/* compile the argument expressions */3857narg = NARG_SIZE_CALL(SIZE_STAT(stat));3858for ( i = 1; i <= narg; i++ ) {3859args[i] = CompExpr( ARGI_CALL(stat,i) );3860}38613862/* emit the code for the procedure call */3863Emit( "CALL_%dARGS( %c", narg, func );3864for ( i = 1; i <= narg; i++ ) {3865Emit( ", %c", args[i] );3866}3867Emit( " );\n" );38683869/* free the temporaries */3870for ( i = narg; 1 <= i; i-- ) {3871if ( IS_TEMP_CVAR( args[i] ) ) FreeTemp( TEMP_CVAR( args[i] ) );3872}3873if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );3874}387538763877/****************************************************************************3878**3879*F CompProccallXArgs . . . . . . . . . . . . . . . . . . . T_PROCCALL_XARGS3880*/3881void CompProccallXArgs (3882Stat stat )3883{3884CVar func; /* function */3885CVar argl; /* argument list */3886CVar argi; /* <i>-th argument */3887UInt narg; /* number of arguments */3888UInt i; /* loop variable */38893890/* print a comment */3891if ( CompPass == 2 ) {3892Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );3893}38943895/* compile the reference to the function */3896if ( TNUM_EXPR( FUNC_CALL(stat) ) == T_REF_GVAR ) {3897func = CompRefGVarFopy( FUNC_CALL(stat) );3898}3899else {3900func = CompExpr( FUNC_CALL(stat) );3901CompCheckFunc( func );3902}39033904/* compile the argument expressions */3905narg = NARG_SIZE_CALL(SIZE_STAT(stat));3906argl = CVAR_TEMP( NewTemp( "argl" ) );3907Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", argl, narg );3908Emit( "SET_LEN_PLIST( %c, %d );\n", argl, narg );3909for ( i = 1; i <= narg; i++ ) {3910argi = CompExpr( ARGI_CALL( stat, i ) );3911Emit( "SET_ELM_PLIST( %c, %d, %c );\n", argl, i, argi );3912if ( ! HasInfoCVar( argi, W_INT_SMALL ) ) {3913Emit( "CHANGED_BAG( %c );\n", argl );3914}3915if ( IS_TEMP_CVAR( argi ) ) FreeTemp( TEMP_CVAR( argi ) );3916}39173918/* emit the code for the procedure call */3919Emit( "CALL_XARGS( %c, %c );\n", func, argl );39203921/* free the temporaries */3922if ( IS_TEMP_CVAR( argl ) ) FreeTemp( TEMP_CVAR( argl ) );3923if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );3924}39253926/****************************************************************************3927**3928*F CompProccallXArgs( <expr> ) . . . . . . . . . . . . . . T_PROCCALL_OPTS3929*/3930void CompProccallOpts(3931Stat stat)3932{3933CVar opts = CompExpr(ADDR_STAT(stat)[0]);3934GVar pushOptions;3935GVar popOptions;3936pushOptions = GVarName("PushOptions");3937popOptions = GVarName("PopOptions");3938CompSetUseGVar(pushOptions, COMP_USE_GVAR_FOPY);3939CompSetUseGVar(popOptions, COMP_USE_GVAR_FOPY);3940Emit("CALL_1ARGS( GF_PushOptions, %c );\n", opts);3941if (IS_TEMP_CVAR( opts) ) FreeTemp( TEMP_CVAR( opts ));3942CompStat(ADDR_STAT(stat)[1]);3943Emit("CALL_0ARGS( GF_PopOptions );\n");3944}394539463947/****************************************************************************3948**3949*F CompSeqStat( <stat> ) . . . . . . . . . . . . . T_SEQ_STAT...T_SEQ_STAT73950*/3951void CompSeqStat (3952Stat stat )3953{3954UInt nr; /* number of statements */3955UInt i; /* loop variable */39563957/* get the number of statements */3958nr = SIZE_STAT( stat ) / sizeof(Stat);39593960/* compile the statements */3961for ( i = 1; i <= nr; i++ ) {3962CompStat( ADDR_STAT( stat )[i-1] );3963}3964}396539663967/****************************************************************************3968**3969*F CompIf( <stat> ) . . . . . . . . T_IF/T_IF_ELSE/T_IF_ELIF/T_IF_ELIF_ELSE3970*/3971void CompIf (3972Stat stat )3973{3974CVar cond; /* condition */3975UInt nr; /* number of branches */3976Bag info_in; /* information at branch begin */3977Bag info_out; /* information at branch end */3978UInt i; /* loop variable */39793980/* get the number of branches */3981nr = SIZE_STAT( stat ) / (2*sizeof(Stat));39823983/* print a comment */3984if ( CompPass == 2 ) {3985Emit( "\n/* if " );3986PrintExpr( ADDR_STAT(stat)[0] );3987Emit( " then */\n" );3988}39893990/* compile the expression */3991cond = CompBoolExpr( ADDR_STAT( stat )[0] );39923993/* emit the code to test the condition */3994Emit( "if ( %c ) {\n", cond );3995if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );39963997/* remember what we know after evaluating the first condition */3998info_in = NewInfoCVars();3999CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC) );40004001/* compile the body */4002CompStat( ADDR_STAT( stat )[1] );40034004/* remember what we know after executing the first body */4005info_out = NewInfoCVars();4006CopyInfoCVars( info_out, INFO_FEXP(CURR_FUNC) );40074008/* emit the rest code */4009Emit( "\n}\n" );40104011/* loop over the 'elif' branches */4012for ( i = 2; i <= nr; i++ ) {40134014/* do not handle 'else' branch here */4015if ( i == nr && TNUM_EXPR(ADDR_STAT(stat)[2*(i-1)]) == T_TRUE_EXPR )4016break;40174018/* print a comment */4019if ( CompPass == 2 ) {4020Emit( "\n/* elif " );4021PrintExpr( ADDR_STAT(stat)[2*(i-1)] );4022Emit( " then */\n" );4023}40244025/* emit the 'else' to connect this branch to the 'if' branch */4026Emit( "else {\n" );40274028/* this is what we know if we enter this branch */4029CopyInfoCVars( INFO_FEXP(CURR_FUNC), info_in );40304031/* compile the expression */4032cond = CompBoolExpr( ADDR_STAT( stat )[2*(i-1)] );40334034/* emit the code to test the condition */4035Emit( "if ( %c ) {\n", cond );4036if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );40374038/* remember what we know after evaluating all previous conditions */4039CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC) );40404041/* compile the body */4042CompStat( ADDR_STAT( stat )[2*(i-1)+1] );40434044/* remember what we know after executing one of the previous bodies*/4045MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC) );40464047/* emit the rest code */4048Emit( "\n}\n" );40494050}40514052/* handle 'else' branch */4053if ( i == nr ) {40544055/* print a comment */4056if ( CompPass == 2 ) {4057Emit( "\n/* else */\n" );4058}40594060/* emit the 'else' to connect this branch to the 'if' branch */4061Emit( "else {\n" );40624063/* this is what we know if we enter this branch */4064CopyInfoCVars( INFO_FEXP(CURR_FUNC), info_in );40654066/* compile the body */4067CompStat( ADDR_STAT( stat )[2*(i-1)+1] );40684069/* remember what we know after executing one of the previous bodies*/4070MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC) );40714072/* emit the rest code */4073Emit( "\n}\n" );40744075}40764077/* fake empty 'else' branch */4078else {40794080/* this is what we know if we enter this branch */4081CopyInfoCVars( INFO_FEXP(CURR_FUNC), info_in );40824083/* remember what we know after executing one of the previous bodies*/4084MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC) );40854086}40874088/* close all unbalanced parenthesis */4089for ( i = 2; i <= nr; i++ ) {4090if ( i == nr && TNUM_EXPR(ADDR_STAT(stat)[2*(i-1)]) == T_TRUE_EXPR )4091break;4092Emit( "}\n" );4093}4094Emit( "/* fi */\n" );40954096/* put what we know into the current info */4097CopyInfoCVars( INFO_FEXP(CURR_FUNC), info_out );40984099}410041014102/****************************************************************************4103**4104*F CompFor( <stat> ) . . . . . . . T_FOR...T_FOR3/T_FOR_RANGE...T_FOR_RANGE34105*/4106void CompFor (4107Stat stat )4108{4109UInt var; /* loop variable */4110Char vart; /* variable type */4111CVar list; /* list to loop over */4112CVar islist; /* is the list a proper list */4113CVar first; /* first loop index */4114CVar last; /* last loop index */4115CVar lidx; /* loop index variable */4116CVar elm; /* element of list */4117Int pass; /* current pass */4118Bag prev; /* previous temp-info */4119Int i; /* loop variable */41204121/* handle 'for <lvar> in [<first>..<last>] do' */4122if ( IS_REFLVAR( ADDR_STAT(stat)[0] )4123&& ! CompGetUseHVar( LVAR_REFLVAR( ADDR_STAT(stat)[0] ) )4124&& TNUM_EXPR( ADDR_STAT(stat)[1] ) == T_RANGE_EXPR4125&& SIZE_EXPR( ADDR_STAT(stat)[1] ) == 2*sizeof(Expr) ) {41264127/* print a comment */4128if ( CompPass == 2 ) {4129Emit( "\n/* for " );4130PrintExpr( ADDR_STAT(stat)[0] );4131Emit( " in " );4132PrintExpr( ADDR_STAT(stat)[1] );4133Emit( " do */\n" );4134}41354136/* get the local variable */4137var = LVAR_REFLVAR( ADDR_STAT(stat)[0] );41384139/* allocate a new temporary for the loop variable */4140lidx = CVAR_TEMP( NewTemp( "lidx" ) );41414142/* compile and check the first and last value */4143first = CompExpr( ADDR_EXPR( ADDR_STAT(stat)[1] )[0] );4144CompCheckIntSmall( first );41454146/* compile and check the last value */4147/* if the last value is in a local variable, */4148/* we must copy it into a temporary, */4149/* because the local variable may change its value in the body */4150last = CompExpr( ADDR_EXPR( ADDR_STAT(stat)[1] )[1] );4151CompCheckIntSmall( last );4152if ( IS_LVAR_CVAR(last) ) {4153elm = CVAR_TEMP( NewTemp( "last" ) );4154Emit( "%c = %c;\n", elm, last );4155last = elm;4156}41574158/* find the invariant temp-info */4159pass = CompPass;4160CompPass = 99;4161prev = NewInfoCVars();4162do {4163CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC) );4164if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {4165SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );4166}4167else {4168SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );4169}4170for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4171CompStat( ADDR_STAT(stat)[i] );4172}4173MergeInfoCVars( INFO_FEXP(CURR_FUNC), prev );4174} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC), prev ) );4175CompPass = pass;41764177/* emit the code for the loop */4178Emit( "for ( %c = %c;\n", lidx, first );4179Emit( " ((Int)%c) <= ((Int)%c);\n", lidx, last );4180Emit( " %c = (Obj)(((UInt)%c)+4) ", lidx, lidx );4181Emit( ") {\n" );41824183/* emit the code to copy the loop index into the loop variable */4184Emit( "%c = %c;\n", CVAR_LVAR(var), lidx );41854186/* set what we know about the loop variable */4187if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {4188SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );4189}4190else {4191SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );4192}41934194/* compile the body */4195for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4196CompStat( ADDR_STAT(stat)[i] );4197}41984199/* emit the end code */4200Emit( "\n}\n" );4201Emit( "/* od */\n" );42024203/* free the temporaries */4204if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );4205if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );4206if ( IS_TEMP_CVAR( lidx ) ) FreeTemp( TEMP_CVAR( lidx ) );42074208}42094210/* handle other loops */4211else {42124213/* print a comment */4214if ( CompPass == 2 ) {4215Emit( "\n/* for " );4216PrintExpr( ADDR_STAT(stat)[0] );4217Emit( " in " );4218PrintExpr( ADDR_STAT(stat)[1] );4219Emit( " do */\n" );4220}42214222/* get the variable (initialize them first to please 'lint') */4223if ( IS_REFLVAR( ADDR_STAT(stat)[0] )4224&& ! CompGetUseHVar( LVAR_REFLVAR( ADDR_STAT(stat)[0] ) ) ) {4225var = LVAR_REFLVAR( ADDR_STAT(stat)[0] );4226vart = 'l';4227}4228else if ( IS_REFLVAR( ADDR_STAT(stat)[0] ) ) {4229var = LVAR_REFLVAR( ADDR_STAT(stat)[0] );4230vart = 'm';4231}4232else if ( T_REF_LVAR <= TNUM_EXPR( ADDR_STAT(stat)[0] )4233&& TNUM_EXPR( ADDR_STAT(stat)[0] ) <= T_REF_LVAR_164234&& ! CompGetUseHVar( ADDR_EXPR( ADDR_STAT(stat)[0] )[0] ) ) {4235var = (UInt)(ADDR_EXPR( ADDR_STAT(stat)[0] )[0]);4236vart = 'l';4237}4238else if ( T_REF_LVAR <= TNUM_EXPR( ADDR_STAT(stat)[0] )4239&& TNUM_EXPR( ADDR_STAT(stat)[0] ) <= T_REF_LVAR_16 ) {4240var = (UInt)(ADDR_EXPR( ADDR_STAT(stat)[0] )[0]);4241vart = 'm';4242}4243else if ( TNUM_EXPR( ADDR_STAT(stat)[0] ) == T_REF_HVAR ) {4244var = (UInt)(ADDR_EXPR( ADDR_STAT(stat)[0] )[0]);4245vart = 'h';4246}4247else /* if ( TNUM_EXPR( ADDR_STAT(stat)[0] ) == T_REF_GVAR ) */ {4248var = (UInt)(ADDR_EXPR( ADDR_STAT(stat)[0] )[0]);4249CompSetUseGVar( var, COMP_USE_GVAR_ID );4250vart = 'g';4251}42524253/* allocate a new temporary for the loop variable */4254lidx = CVAR_TEMP( NewTemp( "lidx" ) );4255elm = CVAR_TEMP( NewTemp( "elm" ) );4256islist = CVAR_TEMP( NewTemp( "islist" ) );42574258/* compile and check the first and last value */4259list = CompExpr( ADDR_STAT(stat)[1] );42604261/* SL Patch added to try and avoid a bug */4262if (IS_LVAR_CVAR(list))4263{4264CVar copylist;4265copylist = CVAR_TEMP( NewTemp( "copylist" ) );4266Emit("%c = %c;\n",copylist, list);4267list = copylist;4268}4269/* end of SL patch */42704271/* find the invariant temp-info */4272pass = CompPass;4273CompPass = 99;4274prev = NewInfoCVars();4275do {4276CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC) );4277if ( vart == 'l' ) {4278SetInfoCVar( CVAR_LVAR(var), W_BOUND );4279}4280for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4281CompStat( ADDR_STAT(stat)[i] );4282}4283MergeInfoCVars( INFO_FEXP(CURR_FUNC), prev );4284} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC), prev ) );4285CompPass = pass;42864287/* emit the code for the loop */4288/* (plenty ugly because of iterator handling) */4289Emit( "if ( IS_SMALL_LIST(%c) ) {\n", list );4290Emit( "%c = (Obj)(UInt)1;\n", islist );4291Emit( "%c = INTOBJ_INT(1);\n", lidx );4292Emit( "}\n" );4293Emit( "else {\n" );4294Emit( "%c = (Obj)(UInt)0;\n", islist );4295Emit( "%c = CALL_1ARGS( GF_ITERATOR, %c );\n", lidx, list );4296Emit( "}\n" );4297Emit( "while ( 1 ) {\n" );4298Emit( "if ( %c ) {\n", islist );4299Emit( "if ( LEN_LIST(%c) < %i ) break;\n", list, lidx );4300Emit( "%c = ELMV0_LIST( %c, %i );\n", elm, list, lidx );4301Emit( "%c = (Obj)(((UInt)%c)+4);\n", lidx, lidx );4302Emit( "if ( %c == 0 ) continue;\n", elm );4303Emit( "}\n" );4304Emit( "else {\n" );4305Emit( "if ( CALL_1ARGS( GF_IS_DONE_ITER, %c ) != False ) break;\n",4306lidx );4307Emit( "%c = CALL_1ARGS( GF_NEXT_ITER, %c );\n", elm, lidx );4308Emit( "}\n" );43094310/* emit the code to copy the loop index into the loop variable */4311if ( vart == 'l' ) {4312Emit( "%c = %c;\n",4313CVAR_LVAR(var), elm );4314}4315else if ( vart == 'm' ) {4316Emit( "ASS_LVAR( %d, %c );\n",4317GetIndxHVar(var), elm );4318}4319else if ( vart == 'h' ) {4320Emit( "ASS_LVAR_%dUP( %d, %c );\n",4321GetLevlHVar(var), GetIndxHVar(var), elm );4322}4323else if ( vart == 'g' ) {4324Emit( "AssGVar( G_%n, %c );\n",4325NameGVar(var), elm );4326}43274328/* set what we know about the loop variable */4329if ( vart == 'l' ) {4330SetInfoCVar( CVAR_LVAR(var), W_BOUND );4331}43324333/* compile the body */4334for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4335CompStat( ADDR_STAT(stat)[i] );4336}43374338/* emit the end code */4339Emit( "\n}\n" );4340Emit( "/* od */\n" );43414342/* free the temporaries */4343if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );4344if ( IS_TEMP_CVAR( islist ) ) FreeTemp( TEMP_CVAR( islist ) );4345if ( IS_TEMP_CVAR( elm ) ) FreeTemp( TEMP_CVAR( elm ) );4346if ( IS_TEMP_CVAR( lidx ) ) FreeTemp( TEMP_CVAR( lidx ) );43474348}43494350}435143524353/****************************************************************************4354**4355*F CompWhile( <stat> ) . . . . . . . . . . . . . . . . . T_WHILE...T_WHILE34356*/4357void CompWhile (4358Stat stat )4359{4360CVar cond; /* condition */4361Int pass; /* current pass */4362Bag prev; /* previous temp-info */4363UInt i; /* loop variable */43644365/* find an invariant temp-info */4366/* the emits are probably not needed */4367pass = CompPass;4368CompPass = 99;4369Emit( "while ( 1 ) {\n" );4370prev = NewInfoCVars();4371do {4372CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC) );4373cond = CompBoolExpr( ADDR_STAT(stat)[0] );4374Emit( "if ( ! %c ) break;\n", cond );4375if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );4376for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4377CompStat( ADDR_STAT(stat)[i] );4378}4379MergeInfoCVars( INFO_FEXP(CURR_FUNC), prev );4380} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC), prev ) );4381Emit( "}\n" );4382CompPass = pass;43834384/* print a comment */4385if ( CompPass == 2 ) {4386Emit( "\n/* while " );4387PrintExpr( ADDR_STAT(stat)[0] );4388Emit( " od */\n" );4389}43904391/* emit the code for the loop */4392Emit( "while ( 1 ) {\n" );43934394/* compile the condition */4395cond = CompBoolExpr( ADDR_STAT(stat)[0] );4396Emit( "if ( ! %c ) break;\n", cond );4397if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );43984399/* compile the body */4400for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4401CompStat( ADDR_STAT(stat)[i] );4402}44034404/* thats it */4405Emit( "\n}\n" );4406Emit( "/* od */\n" );44074408}440944104411/****************************************************************************4412**4413*F CompRepeat( <stat> ) . . . . . . . . . . . . . . . T_REPEAT...T_REPEAT34414*/4415void CompRepeat (4416Stat stat )4417{4418CVar cond; /* condition */4419Int pass; /* current pass */4420Bag prev; /* previous temp-info */4421UInt i; /* loop variable */44224423/* find an invariant temp-info */4424/* the emits are probably not needed */4425pass = CompPass;4426CompPass = 99;4427Emit( "do {\n" );4428prev = NewInfoCVars();4429do {4430CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC) );4431for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4432CompStat( ADDR_STAT(stat)[i] );4433}4434cond = CompBoolExpr( ADDR_STAT(stat)[0] );4435Emit( "if ( %c ) break;\n", cond );4436if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );4437MergeInfoCVars( INFO_FEXP(CURR_FUNC), prev );4438} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC), prev ) );4439Emit( "} while ( 1 );\n" );4440CompPass = pass;44414442/* print a comment */4443if ( CompPass == 2 ) {4444Emit( "\n/* repeat */\n" );4445}44464447/* emit the code for the loop */4448Emit( "do {\n" );44494450/* compile the body */4451for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {4452CompStat( ADDR_STAT(stat)[i] );4453}44544455/* print a comment */4456if ( CompPass == 2 ) {4457Emit( "\n/* until " );4458PrintExpr( ADDR_STAT(stat)[0] );4459Emit( " */\n" );4460}44614462/* compile the condition */4463cond = CompBoolExpr( ADDR_STAT(stat)[0] );4464Emit( "if ( %c ) break;\n", cond );4465if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );44664467/* thats it */4468Emit( "} while ( 1 );\n" );4469}447044714472/****************************************************************************4473**4474*F CompBreak( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . T_BREAK4475*/4476void CompBreak (4477Stat stat )4478{4479/* print a comment */4480if ( CompPass == 2 ) {4481Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4482}44834484Emit( "break;\n" );4485}44864487/****************************************************************************4488**4489*F CompContinue( <stat> ) . . . . . . . . . . . . . . . . . . . . T_CONTINUE4490*/4491void CompContinue (4492Stat stat )4493{4494/* print a comment */4495if ( CompPass == 2 ) {4496Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4497}44984499Emit( "continue;\n" );4500}450145024503/****************************************************************************4504**4505*F CompReturnObj( <stat> ) . . . . . . . . . . . . . . . . . . T_RETURN_OBJ4506*/4507void CompReturnObj (4508Stat stat )4509{4510CVar obj; /* returned object */45114512/* print a comment */4513if ( CompPass == 2 ) {4514Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4515}45164517/* compile the expression */4518obj = CompExpr( ADDR_STAT(stat)[0] );45194520/* emit code to remove stack frame */4521Emit( "RES_BRK_CURR_STAT();\n" );4522Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );45234524/* emit code to return from function */4525Emit( "return %c;\n", obj );45264527/* free the temporary */4528if ( IS_TEMP_CVAR( obj ) ) FreeTemp( TEMP_CVAR( obj ) );4529}453045314532/****************************************************************************4533**4534*F CompReturnVoid( <stat> ) . . . . . . . . . . . . . . . . . T_RETURN_VOID4535*/4536void CompReturnVoid (4537Stat stat )4538{4539/* print a comment */4540if ( CompPass == 2 ) {4541Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4542}45434544/* emit code to remove stack frame */4545Emit( "RES_BRK_CURR_STAT();\n");4546Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );45474548/* emit code to return from function */4549Emit( "return 0;\n" );4550}455145524553/****************************************************************************4554**4555*F CompAssLVar( <stat> ) . . . . . . . . . . . . T_ASS_LVAR...T_ASS_LVAR_164556*/4557void CompAssLVar (4558Stat stat )4559{4560LVar lvar; /* local variable */4561CVar rhs; /* right hand side */45624563/* print a comment */4564if ( CompPass == 2 ) {4565Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4566}45674568/* compile the right hand side expression */4569rhs = CompExpr( ADDR_STAT(stat)[1] );45704571/* emit the code for the assignment */4572lvar = (LVar)(ADDR_STAT(stat)[0]);4573if ( CompGetUseHVar( lvar ) ) {4574Emit( "ASS_LVAR( %d, %c );\n", GetIndxHVar(lvar), rhs );4575}4576else {4577Emit( "%c = %c;\n", CVAR_LVAR(lvar), rhs );4578SetInfoCVar( CVAR_LVAR(lvar), GetInfoCVar( rhs ) );4579}45804581/* free the temporary */4582if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4583}458445854586/****************************************************************************4587**4588*F CompUnbLVar( <stat> ) . . . . . . . . . . . . . . . . . . . . T_UNB_LVAR4589*/4590void CompUnbLVar (4591Stat stat )4592{4593LVar lvar; /* local variable */45944595/* print a comment */4596if ( CompPass == 2 ) {4597Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4598}45994600/* emit the code for the assignment */4601lvar = (LVar)(ADDR_STAT(stat)[0]);4602if ( CompGetUseHVar( lvar ) ) {4603Emit( "ASS_LVAR( %d, 0 );\n", GetIndxHVar(lvar) );4604}4605else {4606Emit( "%c = 0;\n", CVAR_LVAR( lvar ) );4607SetInfoCVar( lvar, W_UNBOUND );4608}4609}461046114612/****************************************************************************4613**4614*F CompAssHVar( <stat> ) . . . . . . . . . . . . . . . . . . . . T_ASS_HVAR4615*/4616void CompAssHVar (4617Stat stat )4618{4619HVar hvar; /* higher variable */4620CVar rhs; /* right hand side */46214622/* print a comment */4623if ( CompPass == 2 ) {4624Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4625}46264627/* compile the right hand side expression */4628rhs = CompExpr( ADDR_STAT(stat)[1] );46294630/* emit the code for the assignment */4631hvar = (HVar)(ADDR_STAT(stat)[0]);4632CompSetUseHVar( hvar );4633Emit( "ASS_LVAR_%dUP( %d, %c );\n",4634GetLevlHVar(hvar), GetIndxHVar(hvar), rhs );46354636/* free the temporary */4637if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4638}463946404641/****************************************************************************4642**4643*F CompUnbHVar( <stat> ) . . . . . . . . . . . . . . . . . . . . T_UNB_HVAR4644*/4645void CompUnbHVar (4646Stat stat )4647{4648HVar hvar; /* higher variable */46494650/* print a comment */4651if ( CompPass == 2 ) {4652Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4653}46544655/* emit the code for the assignment */4656hvar = (HVar)(ADDR_STAT(stat)[0]);4657CompSetUseHVar( hvar );4658Emit( "ASS_LVAR_%dUP( %d, 0 );\n",4659GetLevlHVar(hvar), GetIndxHVar(hvar) );4660}466146624663/****************************************************************************4664**4665*F CompAssGVar( <stat> ) . . . . . . . . . . . . . . . . . . . . T_ASS_GVAR4666*/4667void CompAssGVar (4668Stat stat )4669{4670GVar gvar; /* global variable */4671CVar rhs; /* right hand side */46724673/* print a comment */4674if ( CompPass == 2 ) {4675Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4676}46774678/* compile the right hand side expression */4679rhs = CompExpr( ADDR_STAT(stat)[1] );46804681/* emit the code for the assignment */4682gvar = (GVar)(ADDR_STAT(stat)[0]);4683CompSetUseGVar( gvar, COMP_USE_GVAR_ID );4684Emit( "AssGVar( G_%n, %c );\n", NameGVar(gvar), rhs );46854686/* free the temporary */4687if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4688}468946904691/****************************************************************************4692**4693*F CompUnbGVar( <stat> ) . . . . . . . . . . . . . . . . . . . . T_UNB_GVAR4694*/4695void CompUnbGVar (4696Stat stat )4697{4698GVar gvar; /* global variable */46994700/* print a comment */4701if ( CompPass == 2 ) {4702Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4703}47044705/* emit the code for the assignment */4706gvar = (GVar)(ADDR_STAT(stat)[0]);4707CompSetUseGVar( gvar, COMP_USE_GVAR_ID );4708Emit( "AssGVar( G_%n, 0 );\n", NameGVar(gvar) );4709}471047114712/****************************************************************************4713**4714*F CompAssList( <stat> ) . . . . . . . . . . . . . . . . . . . . T_ASS_LIST4715*/4716void CompAssList (4717Stat stat )4718{4719CVar list; /* list */4720CVar pos; /* position */4721CVar rhs; /* right hand side */47224723/* print a comment */4724if ( CompPass == 2 ) {4725Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4726}47274728/* compile the list expression */4729list = CompExpr( ADDR_STAT(stat)[0] );47304731/* compile and check the position expression */4732pos = CompExpr( ADDR_STAT(stat)[1] );4733CompCheckIntPos( pos );47344735/* compile the right hand side */4736rhs = CompExpr( ADDR_STAT(stat)[2] );47374738/* emit the code */4739if ( CompFastPlainLists ) {4740if ( HasInfoCVar( rhs, W_INT_SMALL ) ) {4741Emit( "C_ASS_LIST_FPL_INTOBJ( %c, %c, %c )\n", list, pos, rhs );4742}4743else {4744Emit( "C_ASS_LIST_FPL( %c, %c, %c )\n", list, pos, rhs );4745}4746}4747else {4748Emit( "C_ASS_LIST( %c, %c, %c );\n", list, pos, rhs );4749}47504751/* free the temporaries */4752if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4753if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );4754if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );4755}475647574758/****************************************************************************4759**4760*F CompAsssList( <stat> ) . . . . . . . . . . . . . . . . . . . T_ASSS_LIST4761*/4762void CompAsssList (4763Stat stat )4764{4765CVar list; /* list */4766CVar poss; /* positions */4767CVar rhss; /* right hand sides */47684769/* print a comment */4770if ( CompPass == 2 ) {4771Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4772}47734774/* compile the list expression */4775list = CompExpr( ADDR_STAT(stat)[0] );47764777/* compile and check the position expression */4778poss = CompExpr( ADDR_STAT(stat)[1] );47794780/* compile the right hand side */4781rhss = CompExpr( ADDR_STAT(stat)[2] );47824783/* emit the code */4784Emit( "AsssListCheck( %c, %c, %c );\n", list, poss, rhss );47854786/* free the temporaries */4787if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );4788if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );4789if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );4790}479147924793/****************************************************************************4794**4795*F CompAssListLev( <stat> ) . . . . . . . . . . . . . . . . T_ASS_LIST_LEV4796*/4797void CompAssListLev (4798Stat stat )4799{4800CVar lists; /* lists */4801CVar pos; /* position */4802CVar rhss; /* right hand sides */4803Int level; /* level */48044805/* print a comment */4806if ( CompPass == 2 ) {4807Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4808}48094810/* compile the list expressions */4811lists = CompExpr( ADDR_STAT(stat)[0] );48124813/* compile and check the position expression */4814pos = CompExpr( ADDR_STAT(stat)[1] );4815CompCheckIntSmallPos( pos );48164817/* compile the right hand sides */4818rhss = CompExpr( ADDR_STAT(stat)[2] );48194820/* get the level */4821level = (Int)(ADDR_STAT(stat)[3]);48224823/* emit the code */4824Emit( "AssListLevel( %c, %c, %c, %d );\n", lists, pos, rhss, level );48254826/* free the temporaries */4827if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );4828if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );4829if ( IS_TEMP_CVAR( lists ) ) FreeTemp( TEMP_CVAR( lists ) );4830}483148324833/****************************************************************************4834**4835*F CompAsssListLev( <stat> ) . . . . . . . . . . . . . . . . T_ASSS_LIST_LEV4836*/4837void CompAsssListLev (4838Stat stat )4839{4840CVar lists; /* list */4841CVar poss; /* positions */4842CVar rhss; /* right hand sides */4843Int level; /* level */48444845/* print a comment */4846if ( CompPass == 2 ) {4847Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4848}48494850/* compile the list expressions */4851lists = CompExpr( ADDR_STAT(stat)[0] );48524853/* compile and check the position expression */4854poss = CompExpr( ADDR_STAT(stat)[1] );48554856/* compile the right hand side */4857rhss = CompExpr( ADDR_STAT(stat)[2] );48584859/* get the level */4860level = (Int)(ADDR_STAT(stat)[3]);48614862/* emit the code */4863Emit( "AsssListLevelCheck( %c, %c, %c, %d );\n",4864lists, poss, rhss, level );48654866/* free the temporaries */4867if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );4868if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );4869if ( IS_TEMP_CVAR( lists ) ) FreeTemp( TEMP_CVAR( lists ) );4870}487148724873/****************************************************************************4874**4875*F CompUnbList( <stat> ) . . . . . . . . . . . . . . . . . . . . T_UNB_LIST4876*/4877void CompUnbList (4878Stat stat )4879{4880CVar list; /* list, left operand */4881CVar pos; /* position, left operand */48824883/* print a comment */4884if ( CompPass == 2 ) {4885Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4886}48874888/* compile the list expression */4889list = CompExpr( ADDR_STAT(stat)[0] );48904891/* compile and check the position expression */4892pos = CompExpr( ADDR_STAT(stat)[1] );4893CompCheckIntPos( pos );48944895/* emit the code */4896Emit( "C_UNB_LIST( %c, %c );\n", list, pos );48974898/* free the temporaries */4899if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );4900if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );4901}490249034904/****************************************************************************4905**4906*F CompAssRecName( <stat> ) . . . . . . . . . . . . . . . . T_ASS_REC_NAME4907*/4908void CompAssRecName (4909Stat stat )4910{4911CVar record; /* record, left operand */4912UInt rnam; /* name, left operand */4913CVar rhs; /* rhs, right operand */49144915/* print a comment */4916if ( CompPass == 2 ) {4917Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4918}49194920/* compile the record expression */4921record = CompExpr( ADDR_STAT(stat)[0] );49224923/* get the name (stored immediately in the statement) */4924rnam = (UInt)(ADDR_STAT(stat)[1]);4925CompSetUseRNam( rnam, COMP_USE_RNAM_ID );49264927/* compile the right hand side */4928rhs = CompExpr( ADDR_STAT(stat)[2] );49294930/* emit the code for the assignment */4931Emit( "ASS_REC( %c, R_%n, %c );\n", record, NAME_RNAM(rnam), rhs );49324933/* free the temporaries */4934if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4935if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );4936}493749384939/****************************************************************************4940**4941*F CompAssRecExpr( <stat> ) . . . . . . . . . . . . . . . . T_ASS_REC_EXPR4942*/4943void CompAssRecExpr (4944Stat stat )4945{4946CVar record; /* record, left operand */4947CVar rnam; /* name, left operand */4948CVar rhs; /* rhs, right operand */49494950/* print a comment */4951if ( CompPass == 2 ) {4952Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4953}49544955/* compile the record expression */4956record = CompExpr( ADDR_STAT(stat)[0] );49574958/* get the name (stored immediately in the statement) */4959rnam = CompExpr( ADDR_STAT(stat)[1] );49604961/* compile the right hand side */4962rhs = CompExpr( ADDR_STAT(stat)[2] );49634964/* emit the code for the assignment */4965Emit( "ASS_REC( %c, RNamObj(%c), %c );\n", record, rnam, rhs );49664967/* free the temporaries */4968if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );4969if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );4970if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );4971}497249734974/****************************************************************************4975**4976*F CompUnbRecName( <stat> ) . . . . . . . . . . . . . . . . T_UNB_REC_NAME4977*/4978void CompUnbRecName (4979Stat stat )4980{4981CVar record; /* record, left operand */4982UInt rnam; /* name, left operand */49834984/* print a comment */4985if ( CompPass == 2 ) {4986Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );4987}49884989/* compile the record expression */4990record = CompExpr( ADDR_STAT(stat)[0] );49914992/* get the name (stored immediately in the statement) */4993rnam = (UInt)(ADDR_STAT(stat)[1]);4994CompSetUseRNam( rnam, COMP_USE_RNAM_ID );49954996/* emit the code for the assignment */4997Emit( "UNB_REC( %c, R_%n );\n", record, NAME_RNAM(rnam) );49984999/* free the temporaries */5000if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5001}500250035004/****************************************************************************5005**5006*F CompUnbRecExpr( <stat> ) . . . . . . . . . . . . . . . . T_UNB_REC_EXPR5007*/5008void CompUnbRecExpr (5009Stat stat )5010{5011CVar record; /* record, left operand */5012CVar rnam; /* name, left operand */50135014/* print a comment */5015if ( CompPass == 2 ) {5016Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5017}50185019/* compile the record expression */5020record = CompExpr( ADDR_STAT(stat)[0] );50215022/* get the name (stored immediately in the statement) */5023rnam = CompExpr( ADDR_STAT(stat)[1] );50245025/* emit the code for the assignment */5026Emit( "UNB_REC( %c, RNamObj(%c) );\n", record, rnam );50275028/* free the temporaries */5029if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );5030if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5031}503250335034/****************************************************************************5035**5036*F CompAssPosObj( <stat> ) . . . . . . . . . . . . . . . . . . T_ASS_POSOBJ5037*/5038void CompAssPosObj (5039Stat stat )5040{5041CVar list; /* list */5042CVar pos; /* position */5043CVar rhs; /* right hand side */50445045/* print a comment */5046if ( CompPass == 2 ) {5047Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5048}50495050/* compile the list expression */5051list = CompExpr( ADDR_STAT(stat)[0] );50525053/* compile and check the position expression */5054pos = CompExpr( ADDR_STAT(stat)[1] );5055CompCheckIntSmallPos( pos );50565057/* compile the right hand side */5058rhs = CompExpr( ADDR_STAT(stat)[2] );50595060/* emit the code */5061if ( HasInfoCVar( rhs, W_INT_SMALL ) ) {5062Emit( "C_ASS_POSOBJ_INTOBJ( %c, %i, %c )\n", list, pos, rhs );5063}5064else {5065Emit( "C_ASS_POSOBJ( %c, %i, %c )\n", list, pos, rhs );5066}50675068/* free the temporaries */5069if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );5070if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );5071if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );5072}5073507450755076/****************************************************************************5077**5078*F CompAsssPosObj( <stat> ) . . . . . . . . . . . . . . . . . T_ASSS_POSOBJ5079*/5080void CompAsssPosObj (5081Stat stat )5082{5083CVar list; /* list */5084CVar poss; /* positions */5085CVar rhss; /* right hand sides */50865087/* print a comment */5088if ( CompPass == 2 ) {5089Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5090}50915092/* compile the list expression */5093list = CompExpr( ADDR_STAT(stat)[0] );50945095/* compile and check the position expression */5096poss = CompExpr( ADDR_STAT(stat)[1] );50975098/* compile the right hand side */5099rhss = CompExpr( ADDR_STAT(stat)[2] );51005101/* emit the code */5102Emit( "AsssPosObjCheck( %c, %c, %c );\n", list, poss, rhss );51035104/* free the temporaries */5105if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );5106if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );5107if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );5108}510951105111/****************************************************************************5112**5113*F CompAssPosObjLev( <stat> ) . . . . . . . . . . . . . . T_ASS_POSOBJ_LEV5114*/5115void CompAssPosObjLev (5116Stat stat )5117{5118Emit( "CANNOT COMPILE STATEMENT OF TNUM %d;\n", TNUM_STAT(stat) );5119}512051215122/****************************************************************************5123**5124*F CompAsssPosObjLev( <stat> ) . . . . . . . . . . . . . . T_ASSS_POSOBJ_LEV5125*/5126void CompAsssPosObjLev (5127Stat stat )5128{5129Emit( "CANNOT COMPILE STATEMENT OF TNUM %d;\n", TNUM_STAT(stat) );5130}513151325133/****************************************************************************5134**5135*F CompUnbPosObj( <stat> ) . . . . . . . . . . . . . . . . . . T_UNB_POSOBJ5136*/5137void CompUnbPosObj (5138Stat stat )5139{5140CVar list; /* list, left operand */5141CVar pos; /* position, left operand */51425143/* print a comment */5144if ( CompPass == 2 ) {5145Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5146}51475148/* compile the list expression */5149list = CompExpr( ADDR_STAT(stat)[0] );51505151/* compile and check the position expression */5152pos = CompExpr( ADDR_STAT(stat)[1] );5153CompCheckIntSmallPos( pos );51545155/* emit the code */5156Emit( "if ( TNUM_OBJ(%c) == T_POSOBJ ) {\n", list );5157Emit( "if ( %i <= SIZE_OBJ(%c)/sizeof(Obj)-1 ) {\n", pos, list );5158Emit( "SET_ELM_PLIST( %c, %i, 0 );\n", list, pos );5159Emit( "}\n}\n" );5160Emit( "else {\n" );5161Emit( "UNB_LIST( %c, %i );\n", list, pos );5162Emit( "}\n" );51635164/* free the temporaries */5165if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );5166if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );5167}516851695170/****************************************************************************5171**5172*F CompAssComObjName( <stat> ) . . . . . . . . . . . . . . T_ASS_COMOBJ_NAME5173*/5174void CompAssComObjName (5175Stat stat )5176{5177CVar record; /* record, left operand */5178UInt rnam; /* name, left operand */5179CVar rhs; /* rhs, right operand */51805181/* print a comment */5182if ( CompPass == 2 ) {5183Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5184}51855186/* compile the record expression */5187record = CompExpr( ADDR_STAT(stat)[0] );51885189/* get the name (stored immediately in the statement) */5190rnam = (UInt)(ADDR_STAT(stat)[1]);5191CompSetUseRNam( rnam, COMP_USE_RNAM_ID );51925193/* compile the right hand side */5194rhs = CompExpr( ADDR_STAT(stat)[2] );51955196/* emit the code for the assignment */5197Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );5198Emit( "AssPRec( %c, R_%n, %c );\n", record, NAME_RNAM(rnam), rhs );5199Emit( "}\nelse {\n" );5200Emit( "ASS_REC( %c, R_%n, %c );\n", record, NAME_RNAM(rnam), rhs );5201Emit( "}\n" );52025203/* free the temporaries */5204if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );5205if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5206}520752085209/****************************************************************************5210**5211*F CompAssComObjExpr( <stat> ) . . . . . . . . . . . . . . T_ASS_COMOBJ_EXPR5212*/5213void CompAssComObjExpr (5214Stat stat )5215{5216CVar record; /* record, left operand */5217CVar rnam; /* name, left operand */5218CVar rhs; /* rhs, right operand */52195220/* print a comment */5221if ( CompPass == 2 ) {5222Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5223}52245225/* compile the record expression */5226record = CompExpr( ADDR_STAT(stat)[0] );52275228/* get the name (stored immediately in the statement) */5229rnam = CompExpr( ADDR_STAT(stat)[1] );52305231/* compile the right hand side */5232rhs = CompExpr( ADDR_STAT(stat)[2] );52335234/* emit the code for the assignment */5235Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );5236Emit( "AssPRec( %c, RNamObj(%c), %c );\n", record, rnam, rhs );5237Emit( "}\nelse {\n" );5238Emit( "ASS_REC( %c, RNamObj(%c), %c );\n", record, rnam, rhs );5239Emit( "}\n" );52405241/* free the temporaries */5242if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );5243if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );5244if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5245}524652475248/****************************************************************************5249**5250*F CompUnbComObjName( <stat> ) . . . . . . . . . . . . . . T_UNB_COMOBJ_NAME5251*/5252void CompUnbComObjName (5253Stat stat )5254{5255CVar record; /* record, left operand */5256UInt rnam; /* name, left operand */52575258/* print a comment */5259if ( CompPass == 2 ) {5260Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5261}52625263/* compile the record expression */5264record = CompExpr( ADDR_STAT(stat)[0] );52655266/* get the name (stored immediately in the statement) */5267rnam = (UInt)(ADDR_STAT(stat)[1]);5268CompSetUseRNam( rnam, COMP_USE_RNAM_ID );52695270/* emit the code for the assignment */5271Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );5272Emit( "UnbPRec( %c, R_%n );\n", record, NAME_RNAM(rnam) );5273Emit( "}\nelse {\n" );5274Emit( "UNB_REC( %c, R_%n );\n", record, NAME_RNAM(rnam) );5275Emit( "}\n" );52765277/* free the temporaries */5278if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5279}528052815282/****************************************************************************5283**5284*F CompUnbComObjExpr( <stat> ) . . . . . . . . . . . . . . T_UNB_COMOBJ_EXPR5285*/5286void CompUnbComObjExpr (5287Stat stat )5288{5289CVar record; /* record, left operand */5290UInt rnam; /* name, left operand */52915292/* print a comment */5293if ( CompPass == 2 ) {5294Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );5295}52965297/* compile the record expression */5298record = CompExpr( ADDR_STAT(stat)[0] );52995300/* get the name (stored immediately in the statement) */5301rnam = CompExpr( ADDR_STAT(stat)[1] );5302CompSetUseRNam( rnam, COMP_USE_RNAM_ID );53035304/* emit the code for the assignment */5305Emit( "if ( TNUM_OBJ(%c) == T_COMOBJ ) {\n", record );5306Emit( "UnbPRec( %c, RNamObj(%c) );\n", record, rnam );5307Emit( "}\nelse {\n" );5308Emit( "UNB_REC( %c, RNamObj(%c) );\n", record, rnam );5309Emit( "}\n" );53105311/* free the temporaries */5312if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );5313if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );5314}53155316/****************************************************************************5317**5318*F CompEmpty( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . T_EMPY5319*/5320void CompEmpty (5321Stat stat )5322{5323Emit("\n/* ; */\n");5324Emit(";");5325}53265327/****************************************************************************5328**5329*F CompInfo( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . T_INFO5330*/5331void CompInfo (5332Stat stat )5333{5334CVar tmp;5335CVar sel;5336CVar lev;5337CVar lst;5338Int narg;5339Int i;53405341Emit( "\n/* Info( ... ); */\n" );5342sel = CompExpr( ARGI_INFO( stat, 1 ) );5343lev = CompExpr( ARGI_INFO( stat, 2 ) );5344lst = CVAR_TEMP( NewTemp( "lst" ) );5345tmp = CVAR_TEMP( NewTemp( "tmp" ) );5346Emit( "%c = CALL_2ARGS( InfoDecision, %c, %c );\n", tmp, sel, lev );5347Emit( "if ( %c == True ) {\n", tmp );5348if ( IS_TEMP_CVAR( tmp ) ) FreeTemp( TEMP_CVAR( tmp ) );5349narg = NARG_SIZE_INFO(SIZE_STAT(stat))-2;5350Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lst, narg );5351Emit( "SET_LEN_PLIST( %c, %d );\n", lst, narg );5352for ( i = 1; i <= narg; i++ ) {5353tmp = CompExpr( ARGI_INFO( stat, i+2 ) );5354Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lst, i, tmp );5355Emit( "CHANGED_BAG(%c);\n", lst );5356if ( IS_TEMP_CVAR( tmp ) ) FreeTemp( TEMP_CVAR( tmp ) );5357}5358Emit( "CALL_1ARGS( InfoDoPrint, %c );\n", lst );5359Emit( "}\n" );53605361/* free the temporaries */5362if ( IS_TEMP_CVAR( lst ) ) FreeTemp( TEMP_CVAR( lst ) );5363if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );5364if ( IS_TEMP_CVAR( sel ) ) FreeTemp( TEMP_CVAR( sel ) );5365}536653675368/****************************************************************************5369**5370*F CompAssert2( <stat> ) . . . . . . . . . . . . . . . . . . T_ASSERT_2ARGS5371*/5372void CompAssert2 (5373Stat stat )5374{5375CVar lev; /* the level */5376CVar cnd; /* the condition */53775378Emit( "\n/* Assert( ... ); */\n" );5379lev = CompExpr( ADDR_STAT(stat)[0] );5380Emit( "if ( ! LT(CurrentAssertionLevel, %c) ) {\n", lev );5381cnd = CompBoolExpr( ADDR_STAT(stat)[1] );5382Emit( "if ( ! %c ) {\n", cnd );5383Emit( "ErrorReturnVoid(\"Assertion failure\",0L,0L,\"you may 'return;'\"" );5384Emit( ");\n");5385Emit( "}\n" );5386Emit( "}\n" );53875388/* free the temporaries */5389if ( IS_TEMP_CVAR( cnd ) ) FreeTemp( TEMP_CVAR( cnd ) );5390if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );5391}539253935394/****************************************************************************5395**5396*F CompAssert3( <stat> ) . . . . . . . . . . . . . . . . . . T_ASSERT_3ARGS5397*/5398void CompAssert3 (5399Stat stat )5400{5401CVar lev; /* the level */5402CVar cnd; /* the condition */5403CVar msg; /* the message */54045405Emit( "\n/* Assert( ... ); */\n" );5406lev = CompExpr( ADDR_STAT(stat)[0] );5407Emit( "if ( ! LT(CurrentAssertionLevel, %c) ) {\n", lev );5408cnd = CompBoolExpr( ADDR_STAT(stat)[1] );5409Emit( "if ( ! %c ) {\n", cnd );5410msg = CompExpr( ADDR_STAT(stat)[2] );5411Emit( "if ( %c != (Obj)(UInt)0 )", msg );5412Emit( "{\n if ( IS_STRING_REP ( %c ) )\n", msg);5413Emit( " PrintString1( %c);\n else\n PrintObj(%c);\n}\n", msg, msg );5414Emit( "}\n" );5415Emit( "}\n" );54165417/* free the temporaries */5418if ( IS_TEMP_CVAR( msg ) ) FreeTemp( TEMP_CVAR( msg ) );5419if ( IS_TEMP_CVAR( cnd ) ) FreeTemp( TEMP_CVAR( cnd ) );5420if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );5421}5422542354245425/****************************************************************************5426**54275428*F * * * * * * * * * * * * * * start compiling * * * * * * * * * * * * * * *5429*/543054315432/****************************************************************************5433**54345435*F CompFunc( <func> ) . . . . . . . . . . . . . . . . . compile a function5436**5437** 'CompFunc' compiles the function <func>, i.e., it emits the code for the5438** handler of the function <func> and the handlers of all its subfunctions.5439*/5440Obj CompFunctions;5441Int CompFunctionsNr;54425443void CompFunc (5444Obj func )5445{5446Bag info; /* info bag for this function */5447Int narg; /* number of arguments */5448Int nloc; /* number of locals */5449Obj fexs; /* function expression list */5450Bag oldFrame; /* old frame */5451Int i; /* loop variable */54525453/* get the number of arguments and locals */5454narg = (NARG_FUNC(func) != -1 ? NARG_FUNC(func) : 1);5455nloc = NLOC_FUNC(func);54565457/* in the first pass allocate the info bag */5458if ( CompPass == 1 ) {54595460CompFunctionsNr++;5461GROW_PLIST( CompFunctions, CompFunctionsNr );5462SET_ELM_PLIST( CompFunctions, CompFunctionsNr, func );5463SET_LEN_PLIST( CompFunctions, CompFunctionsNr );5464CHANGED_BAG( CompFunctions );54655466info = NewBag( T_STRING, SIZE_INFO(narg+nloc,8) );5467NEXT_INFO(info) = INFO_FEXP( CURR_FUNC );5468NR_INFO(info) = CompFunctionsNr;5469NLVAR_INFO(info) = narg + nloc;5470NHVAR_INFO(info) = 0;5471NTEMP_INFO(info) = 0;5472NLOOP_INFO(info) = 0;54735474INFO_FEXP(func) = info;5475CHANGED_BAG(func);54765477}54785479/* switch to this function (so that 'ADDR_STAT' and 'ADDR_EXPR' work) */5480SWITCH_TO_NEW_LVARS( func, narg, nloc, oldFrame );54815482/* get the info bag */5483info = INFO_FEXP( CURR_FUNC );54845485/* compile the innner functions */5486fexs = FEXS_FUNC(func);5487for ( i = 1; i <= LEN_PLIST(fexs); i++ ) {5488CompFunc( ELM_PLIST( fexs, i ) );5489}54905491/* emit the code for the function header and the arguments */5492Emit( "\n/* handler for function %d */\n", NR_INFO(info));5493if ( narg == 0 ) {5494Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );5495Emit( " Obj self )\n" );5496Emit( "{\n" );5497}5498else if ( narg <= 6 ) {5499Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );5500Emit( " Obj self,\n" );5501for ( i = 1; i < narg; i++ ) {5502Emit( " Obj %c,\n", CVAR_LVAR(i) );5503}5504Emit( " Obj %c )\n", CVAR_LVAR(narg) );5505Emit( "{\n" );5506}5507else {5508Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );5509Emit( " Obj self,\n" );5510Emit( " Obj args )\n" );5511Emit( "{\n" );5512for ( i = 1; i <= narg; i++ ) {5513Emit( "Obj %c;\n", CVAR_LVAR(i) );5514}5515}55165517/* emit the code for the local variables */5518for ( i = 1; i <= nloc; i++ ) {5519if ( ! CompGetUseHVar( i+narg ) ) {5520Emit( "Obj %c = 0;\n", CVAR_LVAR(i+narg) );5521}5522}55235524/* emit the code for the temporaries */5525for ( i = 1; i <= NTEMP_INFO(info); i++ ) {5526Emit( "Obj %c = 0;\n", CVAR_TEMP(i) );5527}5528for ( i = 1; i <= NLOOP_INFO(info); i++ ) {5529Emit( "Int l_%d = 0;\n", i );5530}55315532/* emit the code for the higher variables */5533Emit( "Bag oldFrame;\n" );5534Emit( "OLD_BRK_CURR_STAT\n");55355536/* emit the code to get the arguments for xarg functions */5537if ( 6 < narg ) {5538Emit( "CHECK_NR_ARGS( %d, args )\n", narg );5539for ( i = 1; i <= narg; i++ ) {5540Emit( "%c = ELM_PLIST( args, %d );\n", CVAR_LVAR(i), i );5541}5542}55435544/* emit the code to switch to a new frame for outer functions */5545#if 15546/* Try and get better debugging by always doing this */5547if (1) {5548#else5549/* this was the old code */5550if ( NHVAR_INFO(info) != 0 ) {5551#endif5552Emit( "\n/* allocate new stack frame */\n" );5553Emit( "SWITCH_TO_NEW_FRAME(self,%d,0,oldFrame);\n",NHVAR_INFO(info));5554for ( i = 1; i <= narg; i++ ) {5555if ( CompGetUseHVar( i ) ) {5556Emit( "ASS_LVAR( %d, %c );\n",GetIndxHVar(i),CVAR_LVAR(i));5557}5558}5559}5560else {5561Emit( "\n/* restoring old stack frame */\n" );5562Emit( "oldFrame = TLS(CurrLVars);\n" );5563Emit( "SWITCH_TO_OLD_FRAME(ENVI_FUNC(self));\n" );5564}55655566/* emit the code to save and zero the "current statement" information5567so that the break loop behaves */5568Emit( "REM_BRK_CURR_STAT();\n");5569Emit( "SET_BRK_CURR_STAT(0);\n");55705571/* we know all the arguments have values */5572for ( i = 1; i <= narg; i++ ) {5573SetInfoCVar( CVAR_LVAR(i), W_BOUND );5574}5575for ( i = narg+1; i <= narg+nloc; i++ ) {5576SetInfoCVar( CVAR_LVAR(i), W_UNBOUND );5577}55785579/* compile the body */5580CompStat( FIRST_STAT_CURR_FUNC );55815582/* emit the code to switch back to the old frame and return */5583Emit( "\n/* return; */\n" );5584Emit( "RES_BRK_CURR_STAT();\n" );5585Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );5586Emit( "return 0;\n" );5587Emit( "}\n" );55885589/* switch back to old frame */5590SWITCH_TO_OLD_LVARS( oldFrame );5591}559255935594/****************************************************************************5595**5596*F CompileFunc( <output>, <func>, <name>, <magic1>, <magic2> ) . . . compile5597*/5598Int CompileFunc (5599Char * output,5600Obj func,5601Char * name,5602Int magic1,5603Char * magic2 )5604{5605Int i; /* loop variable */5606Obj n; /* temporary */5607UInt col;56085609/* open the output file */5610if ( ! OpenOutput( output ) ) {5611return 0;5612}5613col = SyNrCols;5614SyNrCols = 255;56155616/* store the magic values */5617compilerMagic1 = magic1;5618compilerMagic2 = magic2;56195620/* create 'CompInfoGVar' and 'CompInfoRNam' */5621CompInfoGVar = NewBag( T_STRING, sizeof(UInt) * 1024 );5622CompInfoRNam = NewBag( T_STRING, sizeof(UInt) * 1024 );56235624/* create the list to collection the function expressions */5625CompFunctionsNr = 0;5626CompFunctions = NEW_PLIST( T_PLIST, 8 );5627SET_LEN_PLIST( CompFunctions, 0 );56285629/* first collect information about variables */5630CompPass = 1;5631CompFunc( func );56325633/* ok, lets emit some code now */5634CompPass = 2;56355636/* emit code to include the interface files */5637Emit( "/* C file produced by GAC */\n" );5638Emit( "#include \"src/compiled.h\"\n" );56395640/* emit code for global variables */5641Emit( "\n/* global variables used in handlers */\n" );5642for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {5643if ( CompGetUseGVar( i ) ) {5644Emit( "static GVar G_%n;\n", NameGVar(i) );5645}5646if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {5647Emit( "static Obj GC_%n;\n", NameGVar(i) );5648}5649if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {5650Emit( "static Obj GF_%n;\n", NameGVar(i) );5651}5652}56535654/* emit code for record names */5655Emit( "\n/* record names used in handlers */\n" );5656for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) {5657if ( CompGetUseRNam( i ) ) {5658Emit( "static RNam R_%n;\n", NAME_RNAM(i) );5659}5660}56615662/* emit code for the functions */5663Emit( "\n/* information for the functions */\n" );5664Emit( "static Obj NameFunc[%d];\n", CompFunctionsNr+1 );5665Emit( "static Obj NamsFunc[%d];\n", CompFunctionsNr+1 );5666Emit( "static Int NargFunc[%d];\n", CompFunctionsNr+1 );5667Emit( "static Obj DefaultName;\n" );5668Emit( "static Obj FileName;\n" );566956705671/* now compile the handlers */5672CompFunc( func );56735674/* emit the code for the function that links this module to GAP */5675Emit( "\n/* 'InitKernel' sets up data structures, fopies, copies, handlers */\n" );5676Emit( "static Int InitKernel ( StructInitInfo * module )\n" );5677Emit( "{\n" );5678Emit( "\n/* global variables used in handlers */\n" );5679for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {5680if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {5681Emit( "InitCopyGVar( \"%s\", &GC_%n );\n",5682NameGVar(i), NameGVar(i) );5683}5684if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {5685Emit( "InitFopyGVar( \"%s\", &GF_%n );\n",5686NameGVar(i), NameGVar(i) );5687}5688}5689Emit( "\n/* information for the functions */\n" );5690Emit( "InitGlobalBag( &DefaultName, \"%s:DefaultName(%d)\" );\n",5691magic2, magic1 );5692Emit( "InitGlobalBag( &FileName, \"%s:FileName(%d)\" );\n",5693magic2, magic1 );5694for ( i = 1; i <= CompFunctionsNr; i++ ) {5695Emit( "InitHandlerFunc( HdlrFunc%d, \"%s:HdlrFunc%d(%d)\" );\n",5696i, compilerMagic2, i, compilerMagic1 );5697Emit( "InitGlobalBag( &(NameFunc[%d]), \"%s:NameFunc[%d](%d)\" );\n",5698i, magic2, i, magic1 );5699n = NAME_FUNC(ELM_PLIST(CompFunctions,i));5700if ( n != 0 && IsStringConv(n) ) {5701Emit( "InitGlobalBag( &(NamsFunc[%d]), \"%s:NamsFunc[%d](%d)\" );\n",5702i, magic2, i, magic1 );5703}5704}5705Emit( "\n/* return success */\n" );5706Emit( "return 0;\n" );5707Emit( "\n}\n" );57085709Emit( "\n/* 'InitLibrary' sets up gvars, rnams, functions */\n" );5710Emit( "static Int InitLibrary ( StructInitInfo * module )\n" );5711Emit( "{\n" );5712Emit( "Obj func1;\n" );5713Emit( "Obj body1;\n" );5714Emit( "\n/* Complete Copy/Fopy registration */\n" );5715Emit( "UpdateCopyFopyInfo();\n" );5716Emit( "\n/* global variables used in handlers */\n" );5717for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {5718if ( CompGetUseGVar( i ) ) {5719Emit( "G_%n = GVarName( \"%s\" );\n",5720NameGVar(i), NameGVar(i) );5721}5722}5723Emit( "\n/* record names used in handlers */\n" );5724for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) {5725if ( CompGetUseRNam( i ) ) {5726Emit( "R_%n = RNamName( \"%s\" );\n",5727NAME_RNAM(i), NAME_RNAM(i) );5728}5729}5730Emit( "\n/* information for the functions */\n" );5731Emit( "C_NEW_STRING( DefaultName, 14, \"local function\" );\n" );5732Emit( "C_NEW_STRING( FileName, %d, \"%s\" );\n", strlen(magic2), magic2 );5733for ( i = 1; i <= CompFunctionsNr; i++ ) {5734n = NAME_FUNC(ELM_PLIST(CompFunctions,i));5735if ( n != 0 && IsStringConv(n) ) {5736Emit( "C_NEW_STRING( NameFunc[%d], %d, \"%S\" );\n",5737i, strlen(CSTR_STRING(n)), CSTR_STRING(n) );5738}5739else {5740Emit( "NameFunc[%d] = DefaultName;\n", i );5741}5742Emit( "NamsFunc[%d] = 0;\n", i );5743Emit( "NargFunc[%d] = %d;\n", i, NARG_FUNC(ELM_PLIST(CompFunctions,i)));5744}5745Emit( "\n/* create all the functions defined in this module */\n" );5746Emit( "func1 = NewFunction(NameFunc[1],NargFunc[1],NamsFunc[1],HdlrFunc1);\n" );5747Emit( "ENVI_FUNC( func1 ) = TLS(CurrLVars);\n" );5748Emit( "CHANGED_BAG( TLS(CurrLVars) );\n" );5749Emit( "body1 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj));\n" );5750Emit( "BODY_FUNC( func1 ) = body1;\n" );5751Emit( "CHANGED_BAG( func1 );\n");5752Emit( "CALL_0ARGS( func1 );\n" );5753Emit( "\n/* return success */\n" );5754Emit( "return 0;\n" );5755Emit( "\n}\n" );57565757Emit( "\n/* 'PostRestore' restore gvars, rnams, functions */\n" );5758Emit( "static Int PostRestore ( StructInitInfo * module )\n" );5759Emit( "{\n" );5760Emit( "\n/* global variables used in handlers */\n" );5761for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {5762if ( CompGetUseGVar( i ) ) {5763Emit( "G_%n = GVarName( \"%s\" );\n",5764NameGVar(i), NameGVar(i) );5765}5766}5767Emit( "\n/* record names used in handlers */\n" );5768for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) {5769if ( CompGetUseRNam( i ) ) {5770Emit( "R_%n = RNamName( \"%s\" );\n",5771NAME_RNAM(i), NAME_RNAM(i) );5772}5773}5774Emit( "\n/* information for the functions */\n" );5775for ( i = 1; i <= CompFunctionsNr; i++ ) {5776n = NAME_FUNC(ELM_PLIST(CompFunctions,i));5777if ( n == 0 || ! IsStringConv(n) ) {5778Emit( "NameFunc[%d] = DefaultName;\n", i );5779}5780Emit( "NamsFunc[%d] = 0;\n", i );5781Emit( "NargFunc[%d] = %d;\n", i, NARG_FUNC(ELM_PLIST(CompFunctions,i)));5782}5783Emit( "\n/* return success */\n" );5784Emit( "return 0;\n" );5785Emit( "\n}\n" );5786Emit( "\n" );57875788/* emit the initialization code */5789Emit( "\n/* <name> returns the description of this module */\n" );5790Emit( "static StructInitInfo module = {\n" );5791if ( ! strcmp( "Init_Dynamic", name ) ) {5792Emit( "/* type = */ %d,\n", MODULE_DYNAMIC );5793}5794else {5795Emit( "/* type = */ %d,\n", MODULE_STATIC );5796}5797Emit( "/* name = */ \"%C\",\n", magic2 );5798Emit( "/* revision_c = */ %d,\n", 0 );5799Emit( "/* revision_h = */ %d,\n", 0 );5800Emit( "/* version = */ %d,\n", 0 );5801Emit( "/* crc = */ %d,\n", magic1 );5802Emit( "/* initKernel = */ InitKernel,\n" );5803Emit( "/* initLibrary = */ InitLibrary,\n" );5804Emit( "/* checkInit = */ 0,\n" );5805Emit( "/* preSave = */ 0,\n" );5806Emit( "/* postSave = */ 0,\n" );5807Emit( "/* postRestore = */ PostRestore\n" );5808Emit( "};\n" );5809Emit( "\n" );5810Emit( "StructInitInfo * %n ( void )\n", name );5811Emit( "{\n" );5812Emit( "return &module;\n" );5813Emit( "}\n" );5814Emit( "\n/* compiled code ends here */\n" );58155816/* close the output file */5817SyNrCols = col;5818CloseOutput();58195820/* return success */5821return CompFunctionsNr;5822}582358245825/****************************************************************************5826**5827*F FuncCOMPILE_FUNC( <self>, <output>, <func>, <name>, <magic1>, <magic2> )5828*/5829Obj FuncCOMPILE_FUNC (5830Obj self,5831Obj arg )5832{5833Obj output;5834Obj func;5835Obj name;5836Obj magic1;5837Obj magic2;5838Int nr;5839Int len;58405841/* unravel the arguments */5842len = LEN_LIST(arg);5843if ( len < 5 ) {5844ErrorQuit( "usage: COMPILE_FUNC( <output>, <func>, <name>, %s",5845(Int)"<magic1>, <magic2>, ... )", 0 );5846return 0;5847}5848output = ELM_LIST( arg, 1 );5849func = ELM_LIST( arg, 2 );5850name = ELM_LIST( arg, 3 );5851magic1 = ELM_LIST( arg, 4 );5852magic2 = ELM_LIST( arg, 5 );58535854/* check the arguments */5855if ( ! IsStringConv( output ) ) {5856ErrorQuit("CompileFunc: <output> must be a string",0L,0L);5857}5858if ( TNUM_OBJ(func) != T_FUNCTION ) {5859ErrorQuit("CompileFunc: <func> must be a function",0L,0L);5860}5861if ( ! IsStringConv( name ) ) {5862ErrorQuit("CompileFunc: <name> must be a string",0L,0L);5863}5864if ( ! IS_INTOBJ(magic1) ) {5865ErrorQuit("CompileFunc: <magic1> must be an integer",0L,0L);5866}5867if ( ! IsStringConv(magic2) ) {5868ErrorQuit("CompileFunc: <magic2> must be a string",0L,0L);5869}58705871/* possible optimiser flags */5872CompFastIntArith = 1;5873CompFastPlainLists = 1;5874CompFastListFuncs = 1;5875CompCheckTypes = 1;5876CompCheckListElements = 1;5877CompCheckPosObjElements = 0;58785879if ( 6 <= len ) {5880CompFastIntArith = EQ( ELM_LIST( arg, 6 ), True );5881}5882if ( 7 <= len ) {5883CompFastPlainLists = EQ( ELM_LIST( arg, 7 ), True );5884}5885if ( 8 <= len ) {5886CompFastListFuncs = EQ( ELM_LIST( arg, 8 ), True );5887}5888if ( 9 <= len ) {5889CompCheckTypes = EQ( ELM_LIST( arg, 9 ), True );5890}5891if ( 10 <= len ) {5892CompCheckListElements = EQ( ELM_LIST( arg, 10 ), True );5893}5894if ( 11 <= len ) {5895CompCheckPosObjElements = EQ( ELM_LIST( arg, 11 ), True );5896}58975898/* compile the function */5899nr = CompileFunc(5900CSTR_STRING(output), func, CSTR_STRING(name),5901INT_INTOBJ(magic1), CSTR_STRING(magic2) );590259035904/* return the result */5905return INTOBJ_INT(nr);5906}590759085909/****************************************************************************5910**59115912*F * * * * * * * * * * * * * initialize package * * * * * * * * * * * * * * *5913*/59145915/****************************************************************************5916**59175918*V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export5919*/5920static StructGVarFunc GVarFuncs [] = {59215922{ "COMPILE_FUNC", -1, "arg",5923FuncCOMPILE_FUNC, "src/compiler.c:COMPILE_FUNC" },59245925{ 0 }59265927};592859295930/****************************************************************************5931**59325933*F InitKernel( <module> ) . . . . . . . . initialise kernel data structures5934*/5935static Int InitKernel (5936StructInitInfo * module )5937{5938Int i; /* loop variable */59395940CompFastIntArith = 1;5941CompFastListFuncs = 1;5942CompFastPlainLists = 1;5943CompCheckTypes = 1;5944CompCheckListElements = 1;5945CompCheckPosObjElements = 0;5946CompPass = 0;59475948/* init filters and functions */5949InitHdlrFuncsFromTable( GVarFuncs );59505951/* announce the global variables */5952InitGlobalBag( &CompInfoGVar, "src/compiler.c:CompInfoGVar" );5953InitGlobalBag( &CompInfoRNam, "src/compiler.c:CompInfoRNam" );5954InitGlobalBag( &CompFunctions, "src/compiler.c:CompFunctions" );59555956/* enter the expression compilers into the table */5957for ( i = 0; i < 256; i++ ) {5958CompExprFuncs[ i ] = CompUnknownExpr;5959}59605961CompExprFuncs[ T_FUNCCALL_0ARGS ] = CompFunccall0to6Args;5962CompExprFuncs[ T_FUNCCALL_1ARGS ] = CompFunccall0to6Args;5963CompExprFuncs[ T_FUNCCALL_2ARGS ] = CompFunccall0to6Args;5964CompExprFuncs[ T_FUNCCALL_3ARGS ] = CompFunccall0to6Args;5965CompExprFuncs[ T_FUNCCALL_4ARGS ] = CompFunccall0to6Args;5966CompExprFuncs[ T_FUNCCALL_5ARGS ] = CompFunccall0to6Args;5967CompExprFuncs[ T_FUNCCALL_6ARGS ] = CompFunccall0to6Args;5968CompExprFuncs[ T_FUNCCALL_XARGS ] = CompFunccallXArgs;5969CompExprFuncs[ T_FUNC_EXPR ] = CompFuncExpr;59705971CompExprFuncs[ T_OR ] = CompOr;5972CompExprFuncs[ T_AND ] = CompAnd;5973CompExprFuncs[ T_NOT ] = CompNot;5974CompExprFuncs[ T_EQ ] = CompEq;5975CompExprFuncs[ T_NE ] = CompNe;5976CompExprFuncs[ T_LT ] = CompLt;5977CompExprFuncs[ T_GE ] = CompGe;5978CompExprFuncs[ T_GT ] = CompGt;5979CompExprFuncs[ T_LE ] = CompLe;5980CompExprFuncs[ T_IN ] = CompIn;59815982CompExprFuncs[ T_SUM ] = CompSum;5983CompExprFuncs[ T_AINV ] = CompAInv;5984CompExprFuncs[ T_DIFF ] = CompDiff;5985CompExprFuncs[ T_PROD ] = CompProd;5986CompExprFuncs[ T_INV ] = CompInv;5987CompExprFuncs[ T_QUO ] = CompQuo;5988CompExprFuncs[ T_MOD ] = CompMod;5989CompExprFuncs[ T_POW ] = CompPow;59905991CompExprFuncs[ T_INTEXPR ] = CompIntExpr;5992CompExprFuncs[ T_INT_EXPR ] = CompIntExpr;5993CompExprFuncs[ T_TRUE_EXPR ] = CompTrueExpr;5994CompExprFuncs[ T_FALSE_EXPR ] = CompFalseExpr;5995CompExprFuncs[ T_CHAR_EXPR ] = CompCharExpr;5996CompExprFuncs[ T_PERM_EXPR ] = CompPermExpr;5997CompExprFuncs[ T_PERM_CYCLE ] = CompUnknownExpr;5998CompExprFuncs[ T_LIST_EXPR ] = CompListExpr;5999CompExprFuncs[ T_LIST_TILD_EXPR ] = CompListTildeExpr;6000CompExprFuncs[ T_RANGE_EXPR ] = CompRangeExpr;6001CompExprFuncs[ T_STRING_EXPR ] = CompStringExpr;6002CompExprFuncs[ T_REC_EXPR ] = CompRecExpr;6003CompExprFuncs[ T_REC_TILD_EXPR ] = CompRecTildeExpr;60046005CompExprFuncs[ T_REFLVAR ] = CompRefLVar;6006CompExprFuncs[ T_REF_LVAR ] = CompRefLVar;6007CompExprFuncs[ T_REF_LVAR_01 ] = CompRefLVar;6008CompExprFuncs[ T_REF_LVAR_02 ] = CompRefLVar;6009CompExprFuncs[ T_REF_LVAR_03 ] = CompRefLVar;6010CompExprFuncs[ T_REF_LVAR_04 ] = CompRefLVar;6011CompExprFuncs[ T_REF_LVAR_05 ] = CompRefLVar;6012CompExprFuncs[ T_REF_LVAR_06 ] = CompRefLVar;6013CompExprFuncs[ T_REF_LVAR_07 ] = CompRefLVar;6014CompExprFuncs[ T_REF_LVAR_08 ] = CompRefLVar;6015CompExprFuncs[ T_REF_LVAR_09 ] = CompRefLVar;6016CompExprFuncs[ T_REF_LVAR_10 ] = CompRefLVar;6017CompExprFuncs[ T_REF_LVAR_11 ] = CompRefLVar;6018CompExprFuncs[ T_REF_LVAR_12 ] = CompRefLVar;6019CompExprFuncs[ T_REF_LVAR_13 ] = CompRefLVar;6020CompExprFuncs[ T_REF_LVAR_14 ] = CompRefLVar;6021CompExprFuncs[ T_REF_LVAR_15 ] = CompRefLVar;6022CompExprFuncs[ T_REF_LVAR_16 ] = CompRefLVar;6023CompExprFuncs[ T_ISB_LVAR ] = CompIsbLVar;6024CompExprFuncs[ T_REF_HVAR ] = CompRefHVar;6025CompExprFuncs[ T_ISB_HVAR ] = CompIsbHVar;6026CompExprFuncs[ T_REF_GVAR ] = CompRefGVar;6027CompExprFuncs[ T_ISB_GVAR ] = CompIsbGVar;60286029CompExprFuncs[ T_ELM_LIST ] = CompElmList;6030CompExprFuncs[ T_ELMS_LIST ] = CompElmsList;6031CompExprFuncs[ T_ELM_LIST_LEV ] = CompElmListLev;6032CompExprFuncs[ T_ELMS_LIST_LEV ] = CompElmsListLev;6033CompExprFuncs[ T_ISB_LIST ] = CompIsbList;6034CompExprFuncs[ T_ELM_REC_NAME ] = CompElmRecName;6035CompExprFuncs[ T_ELM_REC_EXPR ] = CompElmRecExpr;6036CompExprFuncs[ T_ISB_REC_NAME ] = CompIsbRecName;6037CompExprFuncs[ T_ISB_REC_EXPR ] = CompIsbRecExpr;60386039CompExprFuncs[ T_ELM_POSOBJ ] = CompElmPosObj;6040CompExprFuncs[ T_ELMS_POSOBJ ] = CompElmsPosObj;6041CompExprFuncs[ T_ELM_POSOBJ_LEV ] = CompElmPosObjLev;6042CompExprFuncs[ T_ELMS_POSOBJ_LEV ] = CompElmsPosObjLev;6043CompExprFuncs[ T_ISB_POSOBJ ] = CompIsbPosObj;6044CompExprFuncs[ T_ELM_COMOBJ_NAME ] = CompElmComObjName;6045CompExprFuncs[ T_ELM_COMOBJ_EXPR ] = CompElmComObjExpr;6046CompExprFuncs[ T_ISB_COMOBJ_NAME ] = CompIsbComObjName;6047CompExprFuncs[ T_ISB_COMOBJ_EXPR ] = CompIsbComObjExpr;60486049CompExprFuncs[ T_FUNCCALL_OPTS ] = CompFunccallOpts;60506051/* enter the boolean expression compilers into the table */6052for ( i = 0; i < 256; i++ ) {6053CompBoolExprFuncs[ i ] = CompUnknownBool;6054}60556056CompBoolExprFuncs[ T_OR ] = CompOrBool;6057CompBoolExprFuncs[ T_AND ] = CompAndBool;6058CompBoolExprFuncs[ T_NOT ] = CompNotBool;6059CompBoolExprFuncs[ T_EQ ] = CompEqBool;6060CompBoolExprFuncs[ T_NE ] = CompNeBool;6061CompBoolExprFuncs[ T_LT ] = CompLtBool;6062CompBoolExprFuncs[ T_GE ] = CompGeBool;6063CompBoolExprFuncs[ T_GT ] = CompGtBool;6064CompBoolExprFuncs[ T_LE ] = CompLeBool;6065CompBoolExprFuncs[ T_IN ] = CompInBool;60666067/* enter the statement compilers into the table */6068for ( i = 0; i < 256; i++ ) {6069CompStatFuncs[ i ] = CompUnknownStat;6070}60716072CompStatFuncs[ T_PROCCALL_0ARGS ] = CompProccall0to6Args;6073CompStatFuncs[ T_PROCCALL_1ARGS ] = CompProccall0to6Args;6074CompStatFuncs[ T_PROCCALL_2ARGS ] = CompProccall0to6Args;6075CompStatFuncs[ T_PROCCALL_3ARGS ] = CompProccall0to6Args;6076CompStatFuncs[ T_PROCCALL_4ARGS ] = CompProccall0to6Args;6077CompStatFuncs[ T_PROCCALL_5ARGS ] = CompProccall0to6Args;6078CompStatFuncs[ T_PROCCALL_6ARGS ] = CompProccall0to6Args;6079CompStatFuncs[ T_PROCCALL_XARGS ] = CompProccallXArgs;60806081CompStatFuncs[ T_SEQ_STAT ] = CompSeqStat;6082CompStatFuncs[ T_SEQ_STAT2 ] = CompSeqStat;6083CompStatFuncs[ T_SEQ_STAT3 ] = CompSeqStat;6084CompStatFuncs[ T_SEQ_STAT4 ] = CompSeqStat;6085CompStatFuncs[ T_SEQ_STAT5 ] = CompSeqStat;6086CompStatFuncs[ T_SEQ_STAT6 ] = CompSeqStat;6087CompStatFuncs[ T_SEQ_STAT7 ] = CompSeqStat;6088CompStatFuncs[ T_IF ] = CompIf;6089CompStatFuncs[ T_IF_ELSE ] = CompIf;6090CompStatFuncs[ T_IF_ELIF ] = CompIf;6091CompStatFuncs[ T_IF_ELIF_ELSE ] = CompIf;6092CompStatFuncs[ T_FOR ] = CompFor;6093CompStatFuncs[ T_FOR2 ] = CompFor;6094CompStatFuncs[ T_FOR3 ] = CompFor;6095CompStatFuncs[ T_FOR_RANGE ] = CompFor;6096CompStatFuncs[ T_FOR_RANGE2 ] = CompFor;6097CompStatFuncs[ T_FOR_RANGE3 ] = CompFor;6098CompStatFuncs[ T_WHILE ] = CompWhile;6099CompStatFuncs[ T_WHILE2 ] = CompWhile;6100CompStatFuncs[ T_WHILE3 ] = CompWhile;6101CompStatFuncs[ T_REPEAT ] = CompRepeat;6102CompStatFuncs[ T_REPEAT2 ] = CompRepeat;6103CompStatFuncs[ T_REPEAT3 ] = CompRepeat;6104CompStatFuncs[ T_BREAK ] = CompBreak;6105CompStatFuncs[ T_CONTINUE ] = CompContinue;6106CompStatFuncs[ T_RETURN_OBJ ] = CompReturnObj;6107CompStatFuncs[ T_RETURN_VOID ] = CompReturnVoid;61086109CompStatFuncs[ T_ASS_LVAR ] = CompAssLVar;6110CompStatFuncs[ T_ASS_LVAR_01 ] = CompAssLVar;6111CompStatFuncs[ T_ASS_LVAR_02 ] = CompAssLVar;6112CompStatFuncs[ T_ASS_LVAR_03 ] = CompAssLVar;6113CompStatFuncs[ T_ASS_LVAR_04 ] = CompAssLVar;6114CompStatFuncs[ T_ASS_LVAR_05 ] = CompAssLVar;6115CompStatFuncs[ T_ASS_LVAR_06 ] = CompAssLVar;6116CompStatFuncs[ T_ASS_LVAR_07 ] = CompAssLVar;6117CompStatFuncs[ T_ASS_LVAR_08 ] = CompAssLVar;6118CompStatFuncs[ T_ASS_LVAR_09 ] = CompAssLVar;6119CompStatFuncs[ T_ASS_LVAR_10 ] = CompAssLVar;6120CompStatFuncs[ T_ASS_LVAR_11 ] = CompAssLVar;6121CompStatFuncs[ T_ASS_LVAR_12 ] = CompAssLVar;6122CompStatFuncs[ T_ASS_LVAR_13 ] = CompAssLVar;6123CompStatFuncs[ T_ASS_LVAR_14 ] = CompAssLVar;6124CompStatFuncs[ T_ASS_LVAR_15 ] = CompAssLVar;6125CompStatFuncs[ T_ASS_LVAR_16 ] = CompAssLVar;6126CompStatFuncs[ T_UNB_LVAR ] = CompUnbLVar;6127CompStatFuncs[ T_ASS_HVAR ] = CompAssHVar;6128CompStatFuncs[ T_UNB_HVAR ] = CompUnbHVar;6129CompStatFuncs[ T_ASS_GVAR ] = CompAssGVar;6130CompStatFuncs[ T_UNB_GVAR ] = CompUnbGVar;61316132CompStatFuncs[ T_ASS_LIST ] = CompAssList;6133CompStatFuncs[ T_ASSS_LIST ] = CompAsssList;6134CompStatFuncs[ T_ASS_LIST_LEV ] = CompAssListLev;6135CompStatFuncs[ T_ASSS_LIST_LEV ] = CompAsssListLev;6136CompStatFuncs[ T_UNB_LIST ] = CompUnbList;6137CompStatFuncs[ T_ASS_REC_NAME ] = CompAssRecName;6138CompStatFuncs[ T_ASS_REC_EXPR ] = CompAssRecExpr;6139CompStatFuncs[ T_UNB_REC_NAME ] = CompUnbRecName;6140CompStatFuncs[ T_UNB_REC_EXPR ] = CompUnbRecExpr;61416142CompStatFuncs[ T_ASS_POSOBJ ] = CompAssPosObj;6143CompStatFuncs[ T_ASSS_POSOBJ ] = CompAsssPosObj;6144CompStatFuncs[ T_ASS_POSOBJ_LEV ] = CompAssPosObjLev;6145CompStatFuncs[ T_ASSS_POSOBJ_LEV ] = CompAsssPosObjLev;6146CompStatFuncs[ T_UNB_POSOBJ ] = CompUnbPosObj;6147CompStatFuncs[ T_ASS_COMOBJ_NAME ] = CompAssComObjName;6148CompStatFuncs[ T_ASS_COMOBJ_EXPR ] = CompAssComObjExpr;6149CompStatFuncs[ T_UNB_COMOBJ_NAME ] = CompUnbComObjName;6150CompStatFuncs[ T_UNB_COMOBJ_EXPR ] = CompUnbComObjExpr;61516152CompStatFuncs[ T_INFO ] = CompInfo;6153CompStatFuncs[ T_ASSERT_2ARGS ] = CompAssert2;6154CompStatFuncs[ T_ASSERT_3ARGS ] = CompAssert3;6155CompStatFuncs[ T_EMPTY ] = CompEmpty;61566157CompStatFuncs[ T_PROCCALL_OPTS ] = CompProccallOpts;6158/* return success */6159return 0;6160}616161626163/****************************************************************************6164**6165*F PostRestore( <module> ) . . . . . . . . . . . . . after restore workspace6166*/6167static Int PostRestore (6168StructInitInfo * module )6169{6170/* get the identifiers of 'Length' and 'Add' (for inlining) */6171G_Length = GVarName( "Length" );6172G_Add = GVarName( "Add" );61736174/* return success */6175return 0;6176}617761786179/****************************************************************************6180**6181*F InitLibrary( <module> ) . . . . . . . initialise library data structures6182*/6183static Int InitLibrary (6184StructInitInfo * module )6185{6186/* init filters and functions */6187InitGVarFuncsFromTable( GVarFuncs );61886189/* return success */6190return PostRestore( module );6191}619261936194/****************************************************************************6195**6196*F InitInfoCompiler() . . . . . . . . . . . . . . . table of init functions6197*/6198static StructInitInfo module = {6199MODULE_BUILTIN, /* type */6200"compiler", /* name */62010, /* revision entry of c file */62020, /* revision entry of h file */62030, /* version */62040, /* crc */6205InitKernel, /* initKernel */6206InitLibrary, /* initLibrary */62070, /* checkInit */62080, /* preSave */62090, /* postSave */6210PostRestore /* postRestore */6211};62126213StructInitInfo * InitInfoCompiler ( void )6214{6215return &module;6216}621762186219/****************************************************************************6220**62216222*E compiler.c . . . . . . . . . . . . . . . . . . . . . . . . . . ends here6223*/622462256226622762286229