void GFiniSS( itnode *sym_node, itnode *ss_node ) {
//====================================================
// Finish a substring operation.
if( sym_node->opn.us & USOPN_FLD ) {
PushOpn( sym_node );
EmitOp( FC_FIELD_SUBSTRING );
OutPtr( sym_node->sym_ptr );
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutInt( sym_node->value.st.ss_size );
} else {
OutInt( 0 ); // we don't know the length
}
} else {
EmitOp( FC_SUBSTRING );
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutPtr( NULL );
} else {
SymRef( sym_node ); // in case we need the length of SCB if
} // character*(*) and no upper bound specified
}
GenTypes( ss_node, ss_node->link );
if( (sym_node->opn.us & USOPN_FLD) == 0 ) {
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutInt( sym_node->value.st.ss_size );
}
if( (StmtSw & SS_DATA_INIT) == 0 ) {
sym_node->value.st.ss_id = sym_node->sym_ptr;
sym_node->sym_ptr = GTempString( 0 );
OutPtr( sym_node->sym_ptr );
sym_node->opn.us |= USOPN_ASY;
}
}
}
void LogOp( TYPE typ1, TYPE typ2, OPTR op ) {
//==============================================
// Generate code for a relational operator.
bool flip;
op -= OPTR_FIRST_LOGOP;
flip = FALSE;
if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
flip = TRUE;
}
PushOpn( CITNode->link );
if( typ1 == TY_NO_TYPE ) { // unary
if( _IsTypeInteger( typ2 ) ) {
EmitOp( FC_BIT_NOT );
} else {
EmitOp( FC_NOT );
}
GenType( CITNode->link );
SetOpn( CITNode, USOPN_SAFE );
} else {
PushOpn( CITNode );
if( _IsTypeInteger( typ2 ) ) {
EmitOp( FC_BITOPS + op );
} else {
EmitOp( FC_LOGOPS + op );
}
if( flip ) {
GenTypes( CITNode->link, CITNode );
} else {
GenTypes( CITNode, CITNode->link );
}
}
}
// -------------------------------------------------------------------------
// ----- Main module
void LLVMGenerator::GenModule() {
Generator::GetModuleInfo();
_mod = new llvm::Module(moduleName, llvm::getGlobalContext());
#ifdef __linux__ && _LP64
_mod->setDataLayout("e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64-S128");
_mod->setTargetTriple("x86_64-pc-linux-gnu");
#elif defined _WIN64
_mod->setDataLayout("e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32-S32");
_mod->setTargetTriple("i686-w64-mingw32");
#else
cout << "LLVMCodegen Error: Unsupported OS\n";
return;
#endif
// Генерация констант
GenConstants();
// Генерация типов
GenTypes();
// Генерация переменных
GenVariables();
// Генерация команд
GenInstructions(module->GetBeginInstructions());
_mod->dump();
GenInstructions(module->GetFinalizeInstructions());
cout << "-------DUMMY SECTION-----" << endl;
//CodegenIf();
//CodegenWhile();
//CodegenCase();
//CodegenRepeat();
cout << "--END OF DUMMY SECTION---" << endl;
SaveGeneration("test.bc");
cout << "AFTER SAVE\n";
} // GenModule
static void Binary( TYPE typ1, TYPE typ2, OPTR opr ) {
//====================================================
// Generate code for binary operations.
bool flip;
bool associative;
FCODE op_code;
associative = FALSE;
if( ( opr == OPTR_ADD ) || ( opr == OPTR_MUL ) ) {
associative = TRUE;
}
flip = FALSE;
if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
flip = TRUE;
}
op_code = opr - OPTR_FIRST_ARITHOP;
PushOpn( CITNode->link );
PushOpn( CITNode );
if( TypeCmplx( typ1 ) && TypeCmplx( typ2 ) ) {
op_code += FC_CC_BINOPS;
if( flip && !associative ) {
EmitOp( FC_CMPLX_FLIP );
}
} else if( TypeCmplx( typ1 ) ) {
if( flip ) {
if( associative ) {
op_code += FC_XC_BINOPS;
} else {
EmitOp( FC_XC_FLIP );
op_code += FC_CX_BINOPS;
}
} else {
op_code += FC_CX_BINOPS;
}
} else if( TypeCmplx( typ2 ) ) {
if( flip ) {
if( associative ) {
op_code += FC_CX_BINOPS;
} else {
EmitOp( FC_CX_FLIP );
op_code += FC_XC_BINOPS;
}
} else {
op_code += FC_XC_BINOPS;
}
} else {
op_code += FC_BINOPS;
if( flip && !associative ) {
EmitOp( FC_FLIP );
}
}
EmitOp( op_code );
if( flip && associative ) {
GenTypes( CITNode->link, CITNode );
} else {
GenTypes( CITNode, CITNode->link );
}
}
void RelOp( TYPE typ1, TYPE typ2, OPTR optr ) {
//================================================
// Generate code for a relational operator.
bool flip;
bool associative;
bool char_1_cmp;
uint i;
uint j;
OPR opr_code;
FCODE op_code;
optr = optr;
// must check for "flip" before we call "CharLength" since they may
// call "PushOpn"
flip = FALSE;
if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
flip = TRUE;
}
// must do "CITNode->link" first to get operands in the right order
i = CharLength( CITNode->link );
j = CharLength( CITNode );
opr_code = CITNode->link->opr;
if( ( opr_code == OPR_EQ ) || ( opr_code == OPR_NE ) ) {
char_1_cmp = OptimalChSize( i ) && OptimalChSize( j ) && ( i == j );
associative = TRUE;
} else {
char_1_cmp = (i == 1 ) && ( j == 1 );
associative = FALSE;
}
PushOpn( CITNode->link );
PushOpn( CITNode );
op_code = opr_code - OPR_FIRST_RELOP;
if( TypeCmplx( typ1 ) && TypeCmplx( typ2 ) ) {
op_code += FC_CC_RELOPS;
} else if( TypeCmplx( typ1 ) ) {
if( flip ) {
op_code += FC_XC_RELOPS;
} else {
op_code += FC_CX_RELOPS;
}
} else if( TypeCmplx( typ2 ) ) {
if( flip ) {
op_code += FC_CX_RELOPS;
} else {
op_code += FC_XC_RELOPS;
}
} else {
if( flip && !associative ) {
EmitOp( FC_FLIP );
}
if( typ1 == TY_CHAR ) {
if( char_1_cmp ) {
op_code += FC_CHAR_1_RELOPS;
} else {
op_code += FC_CHAR_RELOPS;
}
} else {
op_code += FC_RELOPS;
}
}
EmitOp( op_code );
if( char_1_cmp ) {
if( associative ) {
DumpType( MapTypes( TY_INTEGER, i ), i );
} else {
// Assert: comparing CHARACTER*1 with LT, LE, GT, or GE
// Consider: CHARACTER A/'a'/
// IF( A .lt. CHAR(159) ) PRINT *, 'OK'
// we must generate an unsigned comparison
DumpType( MapTypes( TY_LOGICAL, i ), i );
}
if( flip && associative ) {
GenChar1Op( CITNode->link );
GenChar1Op( CITNode );
} else {
GenChar1Op( CITNode );
GenChar1Op( CITNode->link );
}
} else if( typ1 != TY_CHAR ) {
if( flip && associative ) {
GenTypes( CITNode->link, CITNode );
} else {
GenTypes( CITNode, CITNode->link );
}
}
}