/**************************************************************************** ** ** This file is part of GAP, a system for computational discrete algebra. ** ** Copyright of GAP belongs to its developers, whose names are too numerous ** to list here. Please refer to the COPYRIGHT file for details. ** ** SPDX-License-Identifier: GPL-2.0-or-later ** ** This file contains the GAP to C compiler.
*/
/**************************************************************************** ** *V CompFastIntArith . . option to emit code that handles small ints. faster
*/ staticInt CompFastIntArith;
/**************************************************************************** ** *V CompFastPlainLists . option to emit code that handles plain lists faster
*/ staticInt CompFastPlainLists;
/**************************************************************************** ** *V CompFastListFuncs . . option to emit code that inlines calls to functions
*/ staticInt CompFastListFuncs;
/**************************************************************************** ** *V CompCheckTypes . . . . option to emit code that assumes all types are ok.
*/ staticInt CompCheckTypes;
/**************************************************************************** ** *V CompCheckListElements . option to emit code that assumes list elms exist
*/ staticInt CompCheckListElements;
/**************************************************************************** ** *V CompPass . . . . . . . . . . . . . . . . . . . . . . . . . compiler pass ** ** 'CompPass' holds the number of the current pass. ** ** The compiler does two passes over the source. ** ** In the first pass it only collects information but emits no code. ** ** It finds out which global variables and record names are used, so that ** the compiler can output code to define and initialize global variables ** 'G_<name>' resp. 'R_<name>' to hold their identifiers. ** ** It finds out which arguments and local variables are used as higher ** variables from inside local functions, so that the compiler can output ** code to allocate and manage a stack frame for them. ** ** It finds out how many temporary variables are used, so that the compiler ** can output code to define corresponding local variables. ** ** In the second pass it emits code. ** ** The only difference between the first pass and the second pass is that ** 'Emit' emits no code during the first pass. While this causes many ** unnecessary computations during the first pass, the advantage is that ** the two passes are guaranteed to do exactly the same computations.
*/ staticInt CompPass;
/**************************************************************************** ** *T CVar . . . . . . . . . . . . . . . . . . . . . . . type for C variables ** ** A C variable represents the result of compiling an expression. There are ** three cases (distinguished by the least significant two bits). ** ** If the expression is an immediate integer expression, the C variable ** contains the value of the immediate integer expression. ** ** If the expression is an immediate reference to a local variable, the C ** variable contains the index of the local variable. ** ** Otherwise the expression compiler emits code that puts the value of the ** expression into a temporary variable, and the C variable contains the ** index of that temporary variable.
*/ typedef UInt CVar;
/**************************************************************************** ** *F SetInfoCVar( <cvar>, <type> ) . . . . . . . set the type of a C variable *F GetInfoCVar( <cvar> ) . . . . . . . . . . . get the type of a C variable *F HasInfoCVar( <cvar>, <type> ) . . . . . . . test the type of a C variable ** *F NewInfoCVars() . . . . . . . . . allocate a new info bag for C variables *F CopyInfoCVars( <dst>, <src> ) . . copy between info bags for C variables *F MergeInfoCVars( <dst>, <src> ) . . . merge two info bags for C variables *F IsEqInfoCVars( <dst>, <src> ) . . . compare two info bags for C variables ** ** With each function we associate a C variables information bag. In this ** bag we store the number of the function, the number of local variables, ** the number of local variables that are used as higher variables, the ** number of temporaries used, the current number of used temporaries. ** ** Furthermore for each local variable and temporary we store what we know ** about this local variable or temporary, i.e., whether the variable has an ** assigned value, whether that value is an integer, a boolean, etc. ** ** 'SetInfoCVar' sets the information for the C variable <cvar>. ** 'GetInfoCVar' gets the information for the C variable <cvar>. ** 'HasInfoCVar' returns true if the C variable <cvar> has the type <type>. ** ** 'NewInfoCVars' creates a new C variables information bag. ** 'CopyInfoCVars' copies the C variables information from <src> to <dst>. ** 'MergeInfoCVars' merges the C variables information from <src> to <dst>, ** i.e., if there are two paths to a certain place in the source and <dst> ** is the information gathered along one path and <src> is the information ** gathered along the other path, then 'MergeInfoCVars' stores in <dst> the ** information for that point (independent of the path travelled). ** 'IsEqInfoCVars' returns true if <src> and <dst> contain the same ** information. ** ** Note that the numeric values for the types are defined such that if ** <type1> implies <type2>, then <type1> is a bitwise superset of <type2>.
*/ typedef UInt4 LVar;
staticvoid SetInfoCVar(CVar cvar, UInt type)
{
Bag info; // its info bag
// get the information bag
info = INFO_FEXP( CURR_FUNC() );
// set the type of a temporary if ( IS_TEMP_CVAR(cvar) ) {
TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) ) = type;
}
// set the type of a lvar (but do not change if it is a higher variable) elseif ( IS_LVAR_CVAR(cvar)
&& TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) != W_HIGHER ) {
TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) = type;
}
}
staticInt GetInfoCVar(CVar cvar)
{
Bag info; // its info bag
// get the information bag
info = INFO_FEXP( CURR_FUNC() );
// get the type of an integer if ( IS_INTG_CVAR(cvar) ) { return ((0 < INTG_CVAR(cvar)) ? W_INT_SMALL_POS : W_INT_SMALL);
}
// get the type of a temporary elseif ( IS_TEMP_CVAR(cvar) ) { return TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) );
}
// get the type of a lvar elseif ( IS_LVAR_CVAR(cvar) ) { return TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) );
}
static Bag NewInfoCVars(void)
{
Bag old;
Bag new;
old = INFO_FEXP( CURR_FUNC() ); new = NewBag( TNUM_BAG(old), SIZE_BAG(old) ); returnnew;
}
staticvoid CopyInfoCVars(Bag dst, Bag src)
{ Int i; if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) ); if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );
NR_INFO(dst) = NR_INFO(src);
NLVAR_INFO(dst) = NLVAR_INFO(src);
NHVAR_INFO(dst) = NHVAR_INFO(src);
NTEMP_INFO(dst) = NTEMP_INFO(src);
CTEMP_INFO(dst) = CTEMP_INFO(src); for ( i = 1; i <= NLVAR_INFO(src); i++ ) {
TNUM_LVAR_INFO(dst,i) = TNUM_LVAR_INFO(src,i);
} for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {
TNUM_TEMP_INFO(dst,i) = TNUM_TEMP_INFO(src,i);
}
}
staticvoid MergeInfoCVars(Bag dst, Bag src)
{ Int i; if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) ); if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) ); if ( NTEMP_INFO(dst)<NTEMP_INFO(src) ) NTEMP_INFO(dst)=NTEMP_INFO(src); for ( i = 1; i <= NLVAR_INFO(src); i++ ) {
TNUM_LVAR_INFO(dst,i) &= TNUM_LVAR_INFO(src,i);
} for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {
TNUM_TEMP_INFO(dst,i) &= TNUM_TEMP_INFO(src,i);
}
}
staticBOOL IsEqInfoCVars(Bag dst, Bag src)
{ Int i; if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) ); if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) ); for ( i = 1; i <= NLVAR_INFO(src); i++ ) { if ( TNUM_LVAR_INFO(dst,i) != TNUM_LVAR_INFO(src,i) ) { returnFALSE;
}
} for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) { if ( TNUM_TEMP_INFO(dst,i) != TNUM_TEMP_INFO(src,i) ) { returnFALSE;
}
} returnTRUE;
}
/**************************************************************************** ** *F NewTemp( <name> ) . . . . . . . . . . . . . . . allocate a new temporary *F FreeTemp( <temp> ) . . . . . . . . . . . . . . . . . . free a temporary ** ** 'NewTemp' allocates a new temporary variable (<name> is currently ** ignored). ** ** 'FreeTemp' frees the temporary <temp>. ** ** Currently allocations and deallocations of temporaries are done in a ** strict nested (laff -- last allocated, first freed) order. This means we ** do not have to search for unused temporaries.
*/ typedef UInt4 Temp;
static Temp NewTemp(constChar * name)
{
Temp temp; // new temporary, result
Bag info; // information bag
// get the information bag
info = INFO_FEXP( CURR_FUNC() );
// take the next available temporary
CTEMP_INFO( info )++;
temp = CTEMP_INFO( info );
// maybe make room for more temporaries if ( NTEMP_INFO( info ) < temp ) { if ( SIZE_BAG(info) < SIZE_INFO( NLVAR_INFO(info), temp ) ) {
ResizeBag( info, SIZE_INFO( NLVAR_INFO(info), temp+7 ) );
}
NTEMP_INFO( info ) = temp;
}
TNUM_TEMP_INFO( info, temp ) = W_UNKNOWN;
// return the temporary return temp;
}
staticvoid FreeTemp(Temp temp)
{
Bag info; // information bag
// get the information bag
info = INFO_FEXP( CURR_FUNC() );
// check that deallocations happens in the correct order if ( temp != CTEMP_INFO( info ) && CompPass == 2 ) {
Pr("PROBLEM: freeing t_%d, should be t_%d\n",(Int)temp,CTEMP_INFO(info));
}
// free the temporary
TNUM_TEMP_INFO( info, temp ) = W_UNUSED;
CTEMP_INFO( info )--;
}
/**************************************************************************** ** *F CompSetUseHVar( <hvar> ) . . . . . . . . register use of higher variable *F CompGetUseHVar( <hvar> ) . . . . . . . . get use mode of higher variable *F GetLevlHVar( <hvar> ) . . . . . . . . . . . get level of higher variable *F GetIndxHVar( <hvar> ) . . . . . . . . . . . get index of higher variable ** ** 'CompSetUseHVar' register (during pass 1) that the variable <hvar> is ** used as higher variable, i.e., is referenced from inside a local ** function. Such variables must be allocated in a stack frame bag (and ** cannot be mapped to C variables). ** ** 'CompGetUseHVar' returns nonzero if the variable <hvar> is used as higher ** variable. ** ** 'GetLevlHVar' returns the level of the higher variable <hvar>, i.e., the ** number of frames that must be walked upwards for the one containing ** <hvar>. This may be properly smaller than 'LEVEL_HVAR(<hvar>)', because ** only those compiled functions that have local variables that are used as ** higher variables allocate a stack frame. ** ** 'GetIndxHVar' returns the index of the higher variable <hvar>, i.e., the ** position of <hvar> in the stack frame. This may be properly smaller than ** 'INDEX_HVAR(<hvar>)', because only those local variable that are used as ** higher variables are allocated in a stack frame.
*/ typedef UInt4 HVar;
staticvoid CompSetUseHVar(HVar hvar)
{
Bag info; // its info bag Int i; // loop variable
// only mark in pass 1 if ( CompPass != 1 ) return;
// walk up
info = INFO_FEXP( CURR_FUNC() ); for ( i = 1; i <= (hvar >> 16); i++ ) {
info = NEXT_INFO( info );
}
// set mark if ( TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) != W_HIGHER ) {
TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) = W_HIGHER;
NHVAR_INFO(info) = NHVAR_INFO(info) + 1;
}
}
staticInt CompGetUseHVar(HVar hvar)
{
Bag info; // its info bag Int i; // loop variable
// walk up
info = INFO_FEXP( CURR_FUNC() ); for ( i = 1; i <= (hvar >> 16); i++ ) {
info = NEXT_INFO( info );
}
// get mark return (TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) == W_HIGHER);
}
static UInt GetLevlHVar(HVar hvar)
{
UInt levl; // level of higher variable
Bag info; // its info bag Int i; // loop variable
// walk up
levl = 0;
info = INFO_FEXP( CURR_FUNC() );
levl++; for ( i = 1; i <= (hvar >> 16); i++ ) {
info = NEXT_INFO( info );
levl++;
}
// return level (the number steps to go up) return levl - 1;
}
static UInt GetIndxHVar(HVar hvar)
{
UInt indx; // index of higher variable
Bag info; // its info bag Int i; // loop variable
// walk up
info = INFO_FEXP( CURR_FUNC() ); for ( i = 1; i <= (hvar >> 16); i++ ) {
info = NEXT_INFO( info );
}
// walk right
indx = 0; for ( i = 1; i <= (hvar & 0xFFFF); i++ ) { if ( TNUM_LVAR_INFO( info, i ) == W_HIGHER ) indx++;
}
// return the index return indx;
}
/**************************************************************************** ** *F CompSetUseGVar( <gvar>, <mode> ) . . . . register use of global variable *F CompGetUseGVar( <gvar> ) . . . . . . . . get use mode of global variable ** ** 'CompSetUseGVar' registers (during pass 1) the use of the global variable ** with identifier <gvar>. ** ** 'CompGetUseGVar' returns the bitwise OR of all the <mode> arguments for ** the global variable with identifier <gvar>. ** ** Currently the interpretation of the <mode> argument is as follows ** ** If '<mode> & COMP_USE_GVAR_ID' is nonzero, then the produced code shall ** define and initialize 'G_<name>' with the identifier of the global ** variable (which may be different from <gvar> by the time the compiled ** code is actually run). ** ** If '<mode> & COMP_USE_GVAR_COPY' is nonzero, then the produced code shall ** define and initialize 'GC_<name>' as a copy of the global variable ** (see 'InitCopyGVar' in 'gvars.h'). ** ** If '<mode> & COMP_USE_GVAR_FOPY' is nonzero, then the produced code shall ** define and initialize 'GF_<name>' as a function copy of the global ** variable (see 'InitFopyGVar' in 'gvars.h').
*/ typedef UInt GVar;
/**************************************************************************** ** *F CompSetUseRNam( <rnam>, <mode> ) . . . . . . register use of record name *F CompGetUseRNam( <rnam> ) . . . . . . . . . . get use mode of record name ** ** 'CompSetUseRNam' registers (during pass 1) the use of the record name ** with identifier <rnam>. 'CompGetUseRNam' returns the bitwise OR of all ** the <mode> arguments for the global variable with identifier <rnam>. ** ** Currently the interpretation of the <mode> argument is as follows ** ** If '<mode> & COMP_USE_RNAM_ID' is nonzero, then the produced code shall ** define and initialize 'R_<name>' with the identifier of the record name ** (which may be different from <rnam> when the time the compiled code is ** actually run).
*/ typedef UInt RNam;
#define COMP_USE_RNAM_ID (1 << 0)
static Bag CompInfoRNam;
staticvoid CompSetUseRNam(RNam rnam, UInt mode)
{ // only mark in pass 1 if ( CompPass != 1 ) return;
// resize if necessary if ( SIZE_OBJ(CompInfoRNam)/sizeof(UInt) <= rnam ) {
ResizeBag( CompInfoRNam, sizeof(UInt)*(rnam+1) );
}
// or with <mode>
((UInt*)PTR_BAG(CompInfoRNam))[rnam] |= mode;
}
/**************************************************************************** ** *F Emit( <fmt>, ... ) . . . . . . . . . . . . . . . . . . . . . . emit code ** ** 'Emit' outputs the string <fmt> and the other arguments, which must ** correspond to the '%' format elements in <fmt>. Nothing is actually ** outputted if 'CompPass' is not 2. ** ** 'Emit' supports the following '%' format elements: ** - '%d' formats an integer, ** - '%g' formats a GAP string, ** - '%C' does the same but uses only valid C escapes, ** - '%n' formats a name ('_' is converted to '__', special characters are ** converted to '_<hex1><hex2>') ** - '%c' formats a C variable ('INTOBJ_INT(<int>)' for integers, 'a_<name>' ** for arguments, 'l_<name>' for locals, 't_<nr>' for temporaries), ** - '%i' formats a C variable as an integer ('<int>' for integers, and for ** everything else the same as INT_INTOBJ(%c) would produce ** - '%%' outputs a single '%'.
*/ staticInt EmitIndent;
staticInt EmitIndent2;
staticvoid Emit(constchar * fmt, ...)
{ Int narg; // number of arguments
va_list ap; // argument list pointer Int dint; // integer argument
CVar cvar; // C variable argument constChar * p; // loop variable constChar * hex = "0123456789ABCDEF";
// are we in pass 2? if ( CompPass != 2 ) return;
// get the information bag
narg = NARG_FUNC( CURR_FUNC() ); if (narg < 0) {
narg = -narg;
}
// loop over the format string
va_start( ap, fmt ); for ( p = fmt; *p != '\0'; p++ ) {
// print an indent, except for preprocessor commands if ( *fmt != '#' ) { if ( 0 < EmitIndent2 && *p == '}' ) EmitIndent2--; while ( 0 < EmitIndent2-- ) Pr(" ", 0, 0);
}
// format an argument if ( *p == '%' ) {
p++;
// emit an integer if ( *p == 'd' ) {
dint = va_arg( ap, Int );
Pr("%d", dint, 0);
}
static CVar CompFunccall0to6Args(Expr expr)
{
CVar result; // result, result
CVar func; // function
CVar args [8]; // arguments Int narg; // number of arguments Int i; // loop variable
// we know that the result is a function
SetInfoCVar( func, W_FUNC );
// return the number of the C variable that will hold the function return func;
}
/**************************************************************************** ** *F CompOr( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . EXPR_OR
*/ static CVar CompOr(Expr expr)
{
CVar val; // or, result
CVar left; // left operand
CVar right; // right operand
Bag only_left; // info after evaluating only left
// allocate a new temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the left expression
left = CompBoolExpr(READ_EXPR(expr, 0));
Emit( "%c = (%c ? True : False);\n", val, left );
Emit( "if ( %c == False ) {\n", val );
only_left = NewInfoCVars();
CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
// compile the right expression
right = CompBoolExpr(READ_EXPR(expr, 1));
Emit( "%c = (%c ? True : False);\n", val, right );
Emit( "}\n" );
// we know that the result is boolean
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
SetInfoCVar( val, W_BOOL );
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
return val;
}
/**************************************************************************** ** *F CompOrBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . EXPR_OR
*/ static CVar CompOrBool(Expr expr)
{
CVar val; // or, result
CVar left; // left operand
CVar right; // right operand
Bag only_left; // info after evaluating only left
// allocate a new temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the left expression
left = CompBoolExpr(READ_EXPR(expr, 0));
Emit( "%c = %c;\n", val, left );
Emit( "if ( ! %c ) {\n", val );
only_left = NewInfoCVars();
CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
// compile the right expression
right = CompBoolExpr(READ_EXPR(expr, 1));
Emit( "%c = %c;\n", val, right );
Emit( "}\n" );
// we know that the result is boolean (should be 'W_CBOOL')
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
SetInfoCVar( val, W_BOOL );
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
return val;
}
/**************************************************************************** ** *F CompAnd( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_AND
*/ static CVar CompAnd(Expr expr)
{
CVar val; // result
CVar left; // left operand
CVar right1; // right operand 1
CVar right2; // right operand 2
Bag only_left; // info after evaluating only left
// allocate a temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the left expression
left = CompExpr(READ_EXPR(expr, 0));
only_left = NewInfoCVars();
CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
// emit the code for the case that the left value is 'false'
Emit( "if ( %c == False ) {\n", left );
Emit( "%c = %c;\n", val, left );
Emit( "}\n" );
// emit the code for the case that the left value is 'true'
Emit( "else if ( %c == True ) {\n", left );
right1 = CompExpr(READ_EXPR(expr, 1));
CompCheckBool( right1 );
Emit( "%c = %c;\n", val, right1 );
Emit( "}\n" );
// emit the code for the case that the left value is a filter
Emit( "else if (IS_FILTER( %c ) ) {\n", left );
right2 = CompExpr(READ_EXPR(expr, 1));
Emit( "%c = NewAndFilter( %c, %c );\n", val, left, right2 );
Emit( "}\n" );
// signal an error
Emit( "else {\n" );
Emit( "RequireArgumentEx(0, %c, \"<expr>\",\n" "\"must be 'true'or'false'or a filter\" );\n", left );
Emit( "}\n" );
// we know precious little about the result
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
SetInfoCVar( val, W_BOUND );
// free the temporaries if ( IS_TEMP_CVAR( right2 ) ) FreeTemp( TEMP_CVAR( right2 ) ); if ( IS_TEMP_CVAR( right1 ) ) FreeTemp( TEMP_CVAR( right1 ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
return val;
}
/**************************************************************************** ** *F CompAndBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . EXPR_AND
*/ static CVar CompAndBool(Expr expr)
{
CVar val; // or, result
CVar left; // left operand
CVar right; // right operand
Bag only_left; // info after evaluating only left
// allocate a new temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the left expression
left = CompBoolExpr(READ_EXPR(expr, 0));
Emit( "%c = %c;\n", val, left );
Emit( "if ( %c ) {\n", val );
only_left = NewInfoCVars();
CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
// compile the right expression
right = CompBoolExpr(READ_EXPR(expr, 1));
Emit( "%c = %c;\n", val, right );
Emit( "}\n" );
// we know that the result is boolean (should be 'W_CBOOL')
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
SetInfoCVar( val, W_BOOL );
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
// set the information for the result if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
SetInfoCVar( val, W_INT );
} else {
SetInfoCVar( val, W_BOUND );
}
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
// set the information for the result if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
SetInfoCVar( val, W_INT );
} else {
SetInfoCVar( val, W_BOUND );
}
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
// set the information for the result if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
SetInfoCVar( val, W_INT );
} else {
SetInfoCVar( val, W_BOUND );
}
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
// allocate a new temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the two operands
left = CompExpr( READ_EXPR(expr, 0) );
right = CompExpr( READ_EXPR(expr, 1) );
// emit the code
Emit( "%c = MOD( %c, %c );\n", val, left, right );
// set the information for the result if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
SetInfoCVar( val, W_INT );
} else {
SetInfoCVar( val, W_BOUND );
}
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
// allocate a new temporary for the result
val = CVAR_TEMP( NewTemp( "val" ) );
// compile the two operands
left = CompExpr( READ_EXPR(expr, 0) );
right = CompExpr( READ_EXPR(expr, 1) );
// emit the code
Emit( "%c = POW( %c, %c );\n", val, left, right );
// set the information for the result if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
SetInfoCVar( val, W_INT );
} else {
SetInfoCVar( val, W_BOUND );
}
// free the temporaries if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) ); if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
return val;
}
/**************************************************************************** ** *F CompIntExpr( <expr> ) . . . . . . . . . . . . . . . EXPR_INT/EXPR_INTPOS ** ** This is complicated by the need to produce code that will compile ** correctly in 32 or 64 bit and with or without GMP. ** ** The problem is that when we compile the code, we know the integer ** representation of the stored literal in the compiling process but NOT the ** representation which will apply to the compiled code or the endianness ** ** The solution to this is macros: C_SET_LIMB4(bag, limbnumber, value) ** C_SET_LIMB8(bag, limbnumber, value) ** ** we compile using the one appropriate for the compiling system, but their ** definition depends on the limb size of the target system. **
*/ void C_SET_LIMB4(Obj bag, UInt limbnumber, UInt4 value)
{ #ifdef SYS_IS_64_BIT
UInt8 * p; if (limbnumber % 2) {
p = ((UInt8 *)ADDR_OBJ(bag)) + (limbnumber - 1) / 2;
*p = (*p & 0xFFFFFFFFUL) | ((UInt8)value << 32);
} else {
p = ((UInt8 *)ADDR_OBJ(bag)) + limbnumber / 2;
*p = (*p & 0xFFFFFFFF00000000UL) | (UInt8)value;
} #else
((UInt4 *)ADDR_OBJ(bag))[limbnumber] = value; #endif
}
// we know that we have a value
SetInfoCVar( val, W_BOUND );
// return the value return val;
}
/**************************************************************************** ** *F CompPermExpr( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_PERM
*/ static CVar CompPermExpr(Expr expr)
{
CVar perm; // result
CVar lcyc; // one cycle as list
CVar lprm; // perm as list of list cycles
CVar val; // one point Int i; Int j; Int n; Int csize;
Expr cycle;
static CVar CompListExpr(Expr expr)
{
CVar list; // list, result
// compile the list expression
list = CompListExpr1( expr );
CompListExpr2( list, expr );
return list;
}
/**************************************************************************** ** *F CompListTildeExpr( <expr> ) . . . . . . . . . . . . . . EXPR_LIST_TILDE
*/ static CVar CompListTildeExpr(Expr expr)
{
CVar list; // list value, result
CVar tilde; // old value of tilde
// remember the old value of '~'
tilde = CVAR_TEMP( NewTemp( "tilde" ) );
Emit( "%c = STATE(Tilde);\n", tilde );
// create the list value
list = CompListExpr1( expr );
// assign the list to '~'
Emit( "STATE(Tilde) = %c;\n", list );
// evaluate the subexpressions into the list value
CompListExpr2( list, expr );
// restore old value of '~'
Emit( "STATE(Tilde) = %c;\n", tilde ); if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );
// return the list value return list;
}
/**************************************************************************** ** *F CompListExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local
*/ static CVar CompListExpr1(Expr expr)
{
CVar list; // list, result Int len; // logical length of the list
// get the length of the list
len = SIZE_EXPR( expr ) / sizeof(Expr);
// allocate a temporary for the list
list = CVAR_TEMP( NewTemp( "list" ) );
// emit the code to make the list
Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", list, len );
Emit( "SET_LEN_PLIST( %c, %d );\n", list, len );
// we know that <list> is a list
SetInfoCVar( list, W_LIST );
// return the list return list;
}
/**************************************************************************** ** *F CompListExpr2( <list>, <expr> ) . . . . . . . . . . . . . . . . . . local
*/ staticvoid CompListExpr2(CVar list, Expr expr)
{
CVar sub; // subexpression Int len; // logical length of the list Int i; // loop variable
// get the length of the list
len = SIZE_EXPR( expr ) / sizeof(Expr);
// emit the code to fill the list for ( i = 1; i <= len; i++ ) {
// if the subexpression is empty if (READ_EXPR(expr, i - 1) == 0) { continue;
}
// special case if subexpression is a list expression elseif (TNUM_EXPR(READ_EXPR(expr, i - 1)) == EXPR_LIST) {
sub = CompListExpr1(READ_EXPR(expr, i - 1));
Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );
Emit( "CHANGED_BAG( %c );\n", list );
CompListExpr2(sub, READ_EXPR(expr, i - 1)); if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
// special case if subexpression is a record expression elseif (TNUM_EXPR(READ_EXPR(expr, i - 1)) == EXPR_REC) {
sub = CompRecExpr1(READ_EXPR(expr, i - 1));
Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );
Emit( "CHANGED_BAG( %c );\n", list );
CompRecExpr2(sub, READ_EXPR(expr, i - 1)); if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
// general case else {
sub = CompExpr(READ_EXPR(expr, i - 1));
Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub ); if ( ! HasInfoCVar( sub, W_INT_SMALL ) ) {
Emit( "CHANGED_BAG( %c );\n", list );
} if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
}
}
/**************************************************************************** ** *F CompRangeExpr( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_RANGE
*/ static CVar CompRangeExpr(Expr expr)
{
CVar range; // range, result
CVar first; // first element
CVar second; // second element
CVar last; // last element
// allocate a new temporary for the range
range = CVAR_TEMP( NewTemp( "range" ) );
// evaluate the expressions if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {
first = CompExpr( READ_EXPR(expr, 0) );
second = 0;
last = CompExpr( READ_EXPR(expr, 1) );
} else {
first = CompExpr( READ_EXPR(expr, 0) );
second = CompExpr( READ_EXPR(expr, 1) );
last = CompExpr( READ_EXPR(expr, 2) );
}
// we know that the result is a list
SetInfoCVar( range, W_LIST );
// free the temporaries if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) { if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) ); if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );
} else { if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) ); if ( IS_TEMP_CVAR( second ) ) FreeTemp( TEMP_CVAR( second ) ); if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );
}
// return the range return range;
}
/**************************************************************************** ** *F CompStringExpr( <expr> ) . . . . . . . . . . compile a string expression
*/ static CVar CompStringExpr(Expr expr)
{
CVar string; // string value, result
Obj str; // the actual string object
// allocate a new temporary for the string
string = CVAR_TEMP( NewTemp( "string" ) );
// get the string of this expression
str = EVAL_EXPR(expr);
// create the string and copy the stuff
Emit( "%c = MakeString( \"%C\" );\n", string, str);
// we know that the result is a list
SetInfoCVar( string, W_LIST );
// compile the record expression
rec = CompRecExpr1( expr );
CompRecExpr2( rec, expr );
return rec;
}
/**************************************************************************** ** *F CompRecTildeExpr( <expr> ) . . . . . . . . . . . . . . EXPR_REC_TILDE
*/ static CVar CompRecTildeExpr(Expr expr)
{
CVar rec; // record value, result
CVar tilde; // old value of tilde
// remember the old value of '~'
tilde = CVAR_TEMP( NewTemp( "tilde" ) );
Emit( "%c = STATE(Tilde);\n", tilde );
// create the record value
rec = CompRecExpr1( expr );
// assign the record value to the variable '~'
Emit( "STATE(Tilde) = %c;\n", rec );
// evaluate the subexpressions into the record value
CompRecExpr2( rec, expr );
// restore the old value of '~'
Emit( "STATE(Tilde) = %c;\n", tilde ); if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );
// return the record value return rec;
}
/**************************************************************************** ** *F CompRecExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local
*/ static CVar CompRecExpr1(Expr expr)
{
CVar rec; // record value, result Int len; // number of components
// get the number of components
len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
// allocate a new temporary for the record
rec = CVAR_TEMP( NewTemp( "rec" ) );
// emit the code to allocate the new record object
Emit( "%c = NEW_PREC( %d );\n", rec, len );
// we know that we have a value
SetInfoCVar( rec, W_BOUND );
// return the record return rec;
}
/**************************************************************************** ** *F CompRecExpr2( <rec>, <expr> ) . . . . . . . . . . . . . . . . . . . local
*/ staticvoid CompRecExpr2(CVar rec, Expr expr)
{
CVar rnam; // name of component
CVar sub; // value of subexpression Int len; // number of components
Expr tmp; // temporary variable Int i; // loop variable
// get the number of components
len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
// handle the subexpressions for ( i = 1; i <= len; i++ ) {
// handle the name
tmp = READ_EXPR(expr, 2 * i - 2);
rnam = CVAR_TEMP( NewTemp( "rnam" ) ); if ( IS_INTEXPR(tmp) ) {
CompSetUseRNam( (UInt)INT_INTEXPR(tmp), COMP_USE_RNAM_ID );
Emit( "%c = (Obj)R_%n;\n",
rnam, NAME_RNAM((UInt)INT_INTEXPR(tmp)) );
} else {
sub = CompExpr( tmp );
Emit( "%c = (Obj)RNamObj( %c );\n", rnam, sub );
}
// if the subexpression is empty (cannot happen for records)
tmp = READ_EXPR(expr, 2 * i - 1); if ( tmp == 0 ) { if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) ); continue;
}
// special case if subexpression is a list expression elseif ( TNUM_EXPR( tmp ) == EXPR_LIST ) {
sub = CompListExpr1( tmp );
Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );
CompListExpr2( sub, tmp ); if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
// special case if subexpression is a record expression elseif ( TNUM_EXPR( tmp ) == EXPR_REC ) {
sub = CompRecExpr1( tmp );
Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );
CompRecExpr2( sub, tmp ); if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
// general case else {
sub = CompExpr( tmp );
Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub ); if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
}
// emit the code to get the value if ( CompGetUseHVar( lvar ) ) {
val = CVAR_TEMP( NewTemp( "val" ) );
Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );
} else {
val = CVAR_LVAR(lvar);
}
// emit code to check that the variable has a value
CompCheckBound( val, NAME_LVAR(lvar) );
// get the local variable
lvar = (LVar)(READ_EXPR(expr, 0));
// allocate a new temporary for the result
isb = CVAR_TEMP( NewTemp( "isb" ) );
// emit the code to get the value if ( CompGetUseHVar( lvar ) ) {
val = CVAR_TEMP( NewTemp( "val" ) );
Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );
} else {
val = CVAR_LVAR(lvar);
}
// emit the code to check that the variable has a value
Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );
// we know that the result is boolean
SetInfoCVar( isb, W_BOOL );
// free the temporaries if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );
// get the number of statements
nr = SIZE_STAT( stat ) / sizeof(Stat);
// compile the statements for ( i = 1; i <= nr; i++ ) {
CompStat(READ_STAT(stat, i - 1));
}
}
/**************************************************************************** ** *F CompIf( <stat> ) . . . . . . . . STAT_IF/STAT_IF_ELSE/STAT_IF_ELIF/STAT_IF_ELIF_ELSE
*/ staticvoid CompIf(Stat stat)
{
CVar cond; // condition
UInt nr; // number of branches
Bag info_in; // information at branch begin
Bag info_out; // information at branch end
UInt i; // loop variable
// get the number of branches
nr = SIZE_STAT( stat ) / (2*sizeof(Stat));
// print a comment if ( CompPass == 2 ) {
Emit( "\n/* if " );
PrintExpr(READ_EXPR(stat, 0));
Emit( " then */\n" );
}
// compile the expression
cond = CompBoolExpr(READ_STAT(stat, 0));
// emit the code to test the condition
Emit( "if ( %c ) {\n", cond ); if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
// remember what we know after evaluating the first condition
info_in = NewInfoCVars();
CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC()) );
// compile the body
CompStat(READ_STAT(stat, 1));
// remember what we know after executing the first body
info_out = NewInfoCVars();
CopyInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
// emit the rest code
Emit( "\n}\n" );
// loop over the 'elif' branches for ( i = 2; i <= nr; i++ ) {
// do not handle 'else' branch here if (i == nr && TNUM_EXPR(READ_STAT(stat, 2 * (i - 1))) == EXPR_TRUE) break;
// print a comment if ( CompPass == 2 ) {
Emit( "\n/* elif " );
PrintExpr(READ_EXPR(stat, 2 * (i - 1)));
Emit( " then */\n" );
}
// emit the 'else' to connect this branch to the 'if' branch
Emit( "else {\n" );
// this is what we know if we enter this branch
CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
// compile the expression
cond = CompBoolExpr(READ_STAT(stat, 2 * (i - 1)));
// emit the code to test the condition
Emit( "if ( %c ) {\n", cond ); if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
// remember what we know after evaluating all previous conditions
CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC()) );
// compile the body
CompStat(READ_STAT(stat, 2 * (i - 1) + 1));
// remember what we know after executing one of the previous bodies
MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
// emit the rest code
Emit( "\n}\n" );
}
// handle 'else' branch if ( i == nr ) {
// print a comment if ( CompPass == 2 ) {
Emit( "\n/* else */\n" );
}
// emit the 'else' to connect this branch to the 'if' branch
Emit( "else {\n" );
// this is what we know if we enter this branch
CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
// compile the body
CompStat(READ_STAT(stat, 2 * (i - 1) + 1));
// remember what we know after executing one of the previous bodies
MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
// emit the rest code
Emit( "\n}\n" );
}
// fake empty 'else' branch else {
// this is what we know if we enter this branch
CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
// remember what we know after executing one of the previous bodies
MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
}
// close all unbalanced parenthesis for ( i = 2; i <= nr; i++ ) { if (i == nr && TNUM_EXPR(READ_STAT(stat, 2 * (i - 1))) == EXPR_TRUE) break;
Emit( "}\n" );
}
Emit( "/* fi */\n" );
// put what we know into the current info
CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_out );
}
/**************************************************************************** ** *F CompFor( <stat> ) . . . . . . . STAT_FOR...STAT_FOR3/STAT_FOR_RANGE...STAT_FOR_RANGE3
*/ staticvoid CompFor(Stat stat)
{
UInt var; // loop variable Char vart; // variable type
CVar list; // list to loop over
CVar islist; // is the list a proper list
CVar first; // first loop index
CVar last; // last loop index
CVar lidx; // loop index variable
CVar elm; // element of list Int pass; // current pass
Bag prev; // previous temp-info Int i; // loop variable
// print a comment if ( CompPass == 2 ) {
Emit( "\n/* for " );
PrintExpr(READ_EXPR(stat, 0));
Emit( " in " );
PrintExpr(READ_EXPR(stat, 1));
Emit( " do */\n" );
}
// get the local variable
var = LVAR_REF_LVAR(READ_STAT(stat, 0));
// allocate a new temporary for the loop variable
lidx = CVAR_TEMP( NewTemp( "lidx" ) );
// compile and check the first and last value
first = CompExpr(READ_EXPR(READ_STAT(stat, 1), 0));
CompCheckIntSmall( first );
// compile and check the last value // if the last value is in a local variable, // we must copy it into a temporary, // because the local variable may change its value in the body
last = CompExpr(READ_EXPR(READ_STAT(stat, 1), 1));
CompCheckIntSmall( last ); if ( IS_LVAR_CVAR(last) ) {
elm = CVAR_TEMP( NewTemp( "last" ) );
Emit( "%c = %c;\n", elm, last );
last = elm;
}
// find the invariant temp-info
pass = CompPass;
CompPass = 99;
prev = NewInfoCVars(); do {
CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) ); if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {
SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );
} else {
SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );
} for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
CompStat(READ_STAT(stat, i));
}
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
CompPass = pass;
// emit the code for the loop
Emit( "for ( %c = %c;\n", lidx, first );
Emit( " ((Int)%c) <= ((Int)%c);\n", lidx, last );
Emit( " %c = (Obj)(((UInt)%c)+4) ", lidx, lidx );
Emit( ") {\n" );
// emit the code to copy the loop index into the loop variable
Emit( "%c = %c;\n", CVAR_LVAR(var), lidx );
// set what we know about the loop variable if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {
SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );
} else {
SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );
}
// compile the body for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
CompStat(READ_STAT(stat, i));
}
// emit the end code
Emit( "\n}\n" );
Emit( "/* od */\n" );
// free the temporaries if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) ); if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) ); if ( IS_TEMP_CVAR( lidx ) ) FreeTemp( TEMP_CVAR( lidx ) );
}
// handle other loops else {
// print a comment if ( CompPass == 2 ) {
Emit( "\n/* for " );
PrintExpr(READ_EXPR(stat, 0));
Emit( " in " );
PrintExpr(READ_EXPR(stat, 1));
Emit( " do */\n" );
}
// get the variable (initialize them first to please 'lint') if ( IS_REF_LVAR( READ_STAT(stat, 0) )
&& ! CompGetUseHVar( LVAR_REF_LVAR( READ_STAT(stat, 0) ) ) ) {
var = LVAR_REF_LVAR( READ_STAT(stat, 0) );
vart = 'l';
} elseif (IS_REF_LVAR(READ_STAT(stat, 0))) {
var = LVAR_REF_LVAR(READ_STAT(stat, 0));
vart = 'm';
} elseif (TNUM_EXPR(READ_STAT(stat, 0)) == EXPR_REF_HVAR) {
var = READ_EXPR(READ_STAT(stat, 0), 0);
vart = 'h';
} else/* if ( TNUM_EXPR( READ_STAT(stat, 0) ) == EXPR_REF_GVAR ) */ {
var = READ_EXPR(READ_STAT(stat, 0), 0);
CompSetUseGVar( var, COMP_USE_GVAR_ID );
vart = 'g';
}
// allocate a new temporary for the loop variable
lidx = CVAR_TEMP( NewTemp( "lidx" ) );
elm = CVAR_TEMP( NewTemp( "elm" ) );
islist = CVAR_TEMP( NewTemp( "islist" ) );
// compile and check the first and last value
list = CompExpr(READ_STAT(stat, 1));
// SL Patch added to try and avoid a bug if (IS_LVAR_CVAR(list))
{
CVar copylist;
copylist = CVAR_TEMP( NewTemp( "copylist" ) );
Emit("%c = %c;\n",copylist, list);
list = copylist;
} // end of SL patch
// find the invariant temp-info
pass = CompPass;
CompPass = 99;
prev = NewInfoCVars(); do {
CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) ); if ( vart == 'l' ) {
SetInfoCVar( CVAR_LVAR(var), W_BOUND );
} for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
CompStat(READ_STAT(stat, i));
}
MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
} while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
CompPass = pass;
// free the temporaries if ( IS_TEMP_CVAR( lst ) ) FreeTemp( TEMP_CVAR( lst ) ); if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) ); if ( IS_TEMP_CVAR( sel ) ) FreeTemp( TEMP_CVAR( sel ) );
}
/**************************************************************************** ** *F CompFunc( <func> ) . . . . . . . . . . . . . . . . . compile a function ** ** 'CompFunc' compiles the function <func>, i.e., it emits the code for the ** handler of the function <func> and the handlers of all its subfunctions.
*/ static Obj CompFunctions;
staticvoid CompFunc(Obj func)
{
Bag info; // info bag for this function Int narg; // number of arguments Int nloc; // number of locals
Bag oldFrame; // old frame Int i; // loop variable Int prevarargs; // we have varargs with a prefix
// get the number of arguments and locals
narg = NARG_FUNC(func);
prevarargs = 0; if(narg < -1) prevarargs = 1; if (narg < 0) {
narg = -narg;
}
nloc = NLOC_FUNC(func);
// in the first pass allocate the info bag if ( CompPass == 1 ) {
// switch to this function (so that 'CONST_ADDR_STAT' and 'CONST_ADDR_EXPR' work)
oldFrame = SWITCH_TO_NEW_LVARS(func, narg, nloc);
// get the info bag
info = INFO_FEXP( CURR_FUNC() );
// compile the inner functions
Obj values = VALUES_BODY(BODY_FUNC(func)); if (values) {
UInt len = LEN_PLIST(values); for (i = 1; i <= len; i++) {
Obj val = ELM_PLIST(values, i); if (IS_FUNC(val))
CompFunc(val);
}
}
// emit the code for the function header and the arguments
Emit( "\n/* handler for function %d */\n", NR_INFO(info)); if ( narg == 0 ) {
Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
Emit( " Obj self )\n" );
Emit( "{\n" );
} elseif ( narg <= 6 && !prevarargs ) {
Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
Emit( " Obj self,\n" ); for ( i = 1; i < narg; i++ ) {
Emit( " Obj %c,\n", CVAR_LVAR(i) );
}
Emit( " Obj %c )\n", CVAR_LVAR(narg) );
Emit( "{\n" );
} else {
Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
Emit( " Obj self,\n" );
Emit( " Obj args )\n" );
Emit( "{\n" ); for ( i = 1; i <= narg; i++ ) {
Emit( "Obj %c;\n", CVAR_LVAR(i) );
}
}
// emit the code for the local variables for ( i = 1; i <= nloc; i++ ) { if ( ! CompGetUseHVar( i+narg ) ) {
Emit( "Obj %c = 0;\n", CVAR_LVAR(i+narg) );
}
}
// emit the code for the temporaries for ( i = 1; i <= NTEMP_INFO(info); i++ ) {
Emit( "Obj %c = 0;\n", CVAR_TEMP(i) );
}
for ( i = 1; i <= nloc; i++ ) { if ( ! CompGetUseHVar( i+narg ) ) {
Emit( "(void)%c;\n", CVAR_LVAR(i+narg) );
}
}
// emit the code for the higher variables
Emit( "Bag oldFrame;\n" );
// emit the code to get the arguments for xarg functions if ( 6 < narg ) {
Emit( "CHECK_NR_ARGS( %d, args )\n", narg ); for ( i = 1; i <= narg; i++ ) {
Emit( "%c = ELM_PLIST( args, %d );\n", CVAR_LVAR(i), i );
}
}
if ( prevarargs ) {
Emit( "CHECK_NR_AT_LEAST_ARGS( %d, args )\n", narg ); for ( i = 1; i < narg; i++ ) {
Emit( "%c = ELM_PLIST( args, %d );\n", CVAR_LVAR(i), i );
}
Emit( "Obj x_temp_range = Range2Check(INTOBJ_INT(%d), INTOBJ_INT(LEN_PLIST(args)));\n", narg);
Emit( "%c = ELMS_LIST(args , x_temp_range);\n", CVAR_LVAR(narg));
}
// emit the code to switch to a new frame for outer functions
Emit( "\n/* allocate new stack frame */\n" );
Emit( "SWITCH_TO_NEW_FRAME(self,%d,0,oldFrame);\n",NHVAR_INFO(info)); if (NHVAR_INFO(info) > 0) {
Emit("MakeHighVars(STATE(CurrLVars));\n");
} for ( i = 1; i <= narg; i++ ) { if ( CompGetUseHVar( i ) ) {
Emit( "ASS_LVAR( %d, %c );\n",GetIndxHVar(i),CVAR_LVAR(i));
}
}
// we know all the arguments have values for ( i = 1; i <= narg; i++ ) {
SetInfoCVar( CVAR_LVAR(i), W_BOUND );
} for ( i = narg+1; i <= narg+nloc; i++ ) {
SetInfoCVar( CVAR_LVAR(i), W_UNBOUND );
}
// compile the body
CompStat( OFFSET_FIRST_STAT );
Emit( "}\n" );
// switch back to old frame
SWITCH_TO_OLD_LVARS( oldFrame );
}
/**************************************************************************** ** *F CompileFunc( <filename>, <func>, <name>, <crc>, <magic2> ) . . compile ** ** The meaning of the arguments is as follows: ** - 'filename': the file the generated C code should be written to. ** - 'func': a function generated by parsing the input GAP file via ** 'READ_AS_FUNC' resp. 'ReadEvalFile'. ** - 'name' is the designated name for the entry function of the kernel ** extension generated by the compiler, e.g. `Init__type1`. ** - 'crc' is a checksum of the content of the input file. ** - 'magic2' is a string used as name for the module. Typically this is the ** name of GAP source file being compiled; but for compiled GAP code ** that is statically linked into the kernel, the placeholder GAPROOT is ** used in there, e.g. in `GAPROOT/lib/oper1.g`.
*/ Int CompileFunc(Obj filename, Obj func, Obj name, Int crc, Obj magic2)
{ Int i; // loop variable
UInt col;
UInt compFunctionsNr;
// open the output file
TypOutputFile output = { 0 }; if (!OpenOutput(&output, CONST_CSTR_STRING(filename), FALSE)) { return 0;
}
col = SyNrCols;
SyNrCols = 255;
// create the list to collection the function expressions
CompFunctions = NEW_PLIST( T_PLIST, 8 );
// first collect information about variables
CompPass = 1;
CompFunc( func );
// ok, lets emit some code now
CompPass = 2;
compFunctionsNr = LEN_PLIST( CompFunctions );
// emit code to include the interface files
Emit( "/* C file produced by GAC */\n" );
Emit( "#include \"compiled.h\"\n" );
Emit( "#define FILE_CRC \"%d\"\n", crc );
// emit code for global variables
Emit( "\n/* global variables used in handlers */\n" ); for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) { if ( CompGetUseGVar( i ) ) {
Emit( "static GVar G_%n;\n", NameGVar(i) );
} if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {
Emit( "static Obj GC_%n;\n", NameGVar(i) );
} if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {
Emit( "static Obj GF_%n;\n", NameGVar(i) );
}
}
// emit code for record names
Emit( "\n/* record names used in handlers */\n" ); for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) { if ( CompGetUseRNam( i ) ) {
Emit( "static RNam R_%n;\n", NAME_RNAM(i) );
}
}
// emit code for the functions
Emit( "\n/* information for the functions */\n" );
Emit( "static Obj NameFunc[%d];\n", compFunctionsNr+1 );
Emit( "static Obj FileName;\n" );
// now compile the handlers
CompFunc( func );
// emit the code for PostRestore
Emit( "\n/* 'PostRestore' restore gvars, rnams, functions */\n" );
Emit( "static Int PostRestore ( StructInitInfo * module )\n" );
Emit( "{\n" );
Emit( "\n/* global variables used in handlers */\n" ); for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) { if ( CompGetUseGVar( i ) ) {
Emit( "G_%n = GVarName( \"%g\" );\n",
NameGVar(i), NameGVar(i) );
}
}
Emit( "\n/* record names used in handlers */\n" ); for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) { if ( CompGetUseRNam( i ) ) {
Emit( "R_%n = RNamName( \"%g\" );\n",
NAME_RNAM(i), NAME_RNAM(i) );
}
}
Emit( "\n/* information for the functions */\n" ); for ( i = 1; i <= compFunctionsNr; i++ ) {
Obj n = NAME_FUNC(ELM_PLIST(CompFunctions,i)); if ( n != 0 && IsStringConv(n) ) {
Emit( "NameFunc[%d] = MakeImmString(\"%C\");\n", i, n );
} else {
Emit( "NameFunc[%d] = 0;\n", i );
}
}
Emit( "\n" );
Emit( "return 0;\n" );
Emit( "\n}\n" );
Emit( "\n" );
// emit the code for InitKernel
Emit( "\n/* 'InitKernel' sets up data structures, fopies, copies, handlers */\n" );
Emit( "static Int InitKernel ( StructInitInfo * module )\n" );
Emit( "{\n" );
Emit( "\n/* global variables used in handlers */\n" ); for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) { if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {
Emit( "InitCopyGVar( \"%g\", &GC_%n );\n",
NameGVar(i), NameGVar(i) );
} if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {
Emit( "InitFopyGVar( \"%g\", &GF_%n );\n",
NameGVar(i), NameGVar(i) );
}
}
Emit( "\n/* information for the functions */\n" );
Emit( "InitGlobalBag( &FileName, \"%g:FileName(\"FILE_CRC\")\" );\n",
magic2 ); for ( i = 1; i <= compFunctionsNr; i++ ) {
Emit( "InitHandlerFunc( HdlrFunc%d, \"%g:HdlrFunc%d(\"FILE_CRC\")\" );\n",
i, magic2, i );
Emit( "InitGlobalBag( &(NameFunc[%d]), \"%g:NameFunc[%d](\"FILE_CRC\")\" );\n",
i, magic2, i );
}
Emit( "\n" );
Emit( "return 0;\n" );
Emit( "\n}\n" );
¤ Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.0.106Bemerkung:
(vorverarbeitet am 2026-04-28)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.