void FCCmplxFlip( void ) {
//=====================
// Flip 2 complex operands.
cg_name rp_1;
cg_name ip_1 = NULL;
cg_name rp_2;
cg_name ip_2 = NULL;
rp_1 = XPop();
if( !TypePointer( CGType( rp_1 ) ) ) {
ip_1 = XPop();
}
rp_2 = XPop();
if( !TypePointer( CGType( rp_2 ) ) ) {
ip_2 = XPop();
}
if( !TypePointer( CGType( rp_1 ) ) ) {
XPush( ip_1 );
}
XPush( rp_1 );
if( !TypePointer( CGType( rp_2 ) ) ) {
XPush( ip_2 );
}
XPush( rp_2 );
}
static void UpdateRestriction(
void *buf,
long obji)
{
BSAVE_RESTRICTION *brp;
brp = (BSAVE_RESTRICTION *) buf;
restrictionArray[obji].tcnt = brp->tcnt;
restrictionArray[obji].types = TypePointer(brp->types);
restrictionArray[obji].query = ExpressionPointer(brp->query);
}
void FCXCFlip( void ) {
//==================
// Flip scalar and complex operands.
cg_name rp;
cg_name ip = NULL;
cg_name scalar;
scalar = XPop();
rp = XPop();
if( !TypePointer( CGType( rp ) ) ) {
ip = XPop();
}
XPush( scalar );
if( !TypePointer( CGType( rp ) ) ) {
XPush( ip );
}
XPush( rp );
}
void FCCXFlip( void ) {
//==================
// Flip complex and scalar operands.
cg_name rp;
cg_name ip = NULL;
cg_name scalar;
rp = XPop();
if( !TypePointer( CGType( rp ) ) ) {
ip = XPop();
}
scalar = XPop();
if( !TypePointer( CGType( rp ) ) ) {
XPush( ip );
}
XPush( rp );
XPush( scalar );
}
static void UpdateRestriction(
void *theEnv,
void *buf,
long obji)
{
BSAVE_RESTRICTION *brp;
brp = (BSAVE_RESTRICTION *) buf;
DefgenericBinaryData(theEnv)->RestrictionArray[obji].tcnt = brp->tcnt;
DefgenericBinaryData(theEnv)->RestrictionArray[obji].types = TypePointer(brp->types);
DefgenericBinaryData(theEnv)->RestrictionArray[obji].query = ExpressionPointer(brp->query);
}
void Cmplx2Scalar( void ) {
//==============================
// Convert complex to scalar.
cg_name opn;
opn = XPop();
if( !TypePointer( CGType( opn ) ) ) {
CGTrash( XPop() );
}
XPush( opn );
}
cg_name XPopValue( cg_type typ ) {
//================================
// Pop a CG-name from the stack (its value).
cg_name opn;
opn = XPop();
if( TypePointer( CGType( opn ) ) ) {
opn = CGUnary( O_POINTS, opn, typ );
}
return( opn );
}
void FCImag( void ) {
//================
cg_name opn;
cg_type typ;
typ = CmplxBaseType( GetType( GetU16() ) );
opn = XPop();
if( TypePointer( CGType( opn ) ) ) {
XPush( CGUnary( O_POINTS, ImagPtr( opn, typ ), typ ) );
} else {
CGTrash( opn );
}
}
cg_name GetTypedValue( void ) {
//=======================
// Pop a CG-name from the stack (its value).
cg_name opn;
cg_type typ;
opn = XPop();
typ = GetType( GetU16() );
if( TypePointer( CGType( opn ) ) ) {
opn = CGUnary( O_POINTS, opn, typ );
}
return( opn );
}
void XPopCmplx( cg_cmplx *z, cg_type typ ) {
//=====================================================
// Get complex value.
cg_name opn;
opn = XPop();
if( TypePointer( CGType( opn ) ) ) {
SplitCmplx( opn, typ );
z->realpart = XPop();
} else {
z->realpart = opn;
}
z->imagpart = XPop();
}
void DoAddr( void )
{
mad_type_info mti;
LValue( ExprSP );
if( (ExprSP->flags & SF_LOCATION)
&& ExprSP->v.loc.num == 1
&& ExprSP->v.loc.e[0].type == LT_ADDR ) {
ExprSP->v.addr = ExprSP->v.loc.e[0].u.addr;
ExprSetAddrInfo( ExprSP, FALSE );
if( ExprSP->th != NULL ) {
GetMADTypeDefaultAt( ExprSP->v.addr, MTK_ADDRESS, &mti );
TypePointer(ExprSP->th, TM_FAR, mti.b.bits / BITS_PER_BYTE, ExprSP->th);
ExprSP->info.kind = TK_POINTER;
} else {
ExprSP->info.kind = TK_ADDRESS;
}
ExprSP->flags &= ~SF_FORM_MASK;
} else {
Error( ERR_NONE, LIT( ERR_NEED_ADDRESS ) );
}
}
static unsigned MechDo( unsigned select, unsigned parm )
{
unsigned long size;
unsigned result = 0;
DIPHDL( type, th );
dip_type_info info;
mad_type_info mti;
switch( select ) {
case 0:
DoAssign();
break;
case 1:
DoMul();
break;
case 2:
DoDiv();
break;
case 3:
DoMod();
break;
case 4:
DoMinus();
break;
case 5:
DoShift();
break;
case 6:
DoAnd();
break;
case 7:
DoXor();
break;
case 8:
DoOr();
break;
case 9:
DoAddr();
break;
case 10:
ClassToTypeInfo( parm, &info );
DoPoints( info.kind );
break;
case 11:
DoField();
break;
case 12:
DoCall( Num, parm );
break;
case 13:
DoConvert();
break;
case 14:
DoPlus();
break;
case 15:
MakeAddr();
break;
case 16:
result = TstEQ( parm );
break;
case 17:
result = TstLT( parm );
break;
case 18:
result = TstTrue( parm );
break;
case 19:
result = TstExist( parm );
break;
case 20:
size = ExprSP->info.size;
PopEntry();
PushNum( size );
break;
case 21:
TypeBase( ExprSP->th, th, NULL, NULL );
PopEntry();
PushType( th );
break;
case 22:
GetMADTypeDefault( MTK_ADDRESS, &mti );
size = (mti.b.bits - mti.a.seg.bits) / BITS_PER_BYTE;
if( parm ) {
size += sizeof( addr_seg );
TypePointer( ExprSP->th, TM_FAR, size, th );
} else {
TypePointer( ExprSP->th, TM_NEAR, size, th );
}
PopEntry();
PushType( th );
break;
case 23:
result = UserType( th );
if( result ) {
PopEntry();
PushType( th );
}
break;
case 24:
DoMakeComplex();
break;
case 25:
DoStringConcat();
break;
case 26:
DoLConvert();
break;
case 27:
DoPlusScaled();
break;
case 28:
DoMinusScaled();
break;
case 29:
DoPoints( TI_KIND_EXTRACT( parm ) );
break;
case 30:
info.kind = TK_POINTER;
info.size = TI_SIZE_EXTRACT( parm );
info.modifier = TI_MOD_EXTRACT( parm );
FillInDefaults( &info );
TypePointer( ExprSP->th, info.modifier, info.size, th );
PopEntry();
PushType( th );
break;
case 31:
if( parm ) {
/* file scope */
if( ExprSP->flags & SF_NAME ) {
ExprSP->v.li.file_scope = TRUE;
} else {
Error( ERR_LOC, LIT( ERR_WANT_NAME ) );
}
} else {
/* in a namespace */
DoScope();
}
break;
}
return( result );
}
void LRValue( stack_entry *entry )
{
location_list ll;
item_mach tmp;
bool extend;
mad_type_info mti;
DIPHDL( type, th );
ExprResolve( entry );
if( entry->flags & SF_LOCATION ) {
if( entry->info.kind == TK_FUNCTION || entry->info.kind == TK_CODE ) {
/* rvalue of procedure is its address */
entry->v.addr = entry->v.loc.e[0].u.addr;
ExprSetAddrInfo( entry, FALSE );
entry->info.kind = TK_ADDRESS;
} else if( !AddressExpression( entry ) ) {
extend = FALSE;
switch( entry->info.kind ) {
case TK_ARRAY:
/* rvalue of array is its address */
entry->v.addr = entry->v.loc.e[0].u.addr;
if( entry->th != NULL ) {
/* change typing from "array of..." to "pointer to..." */
GetMADTypeDefaultAt( entry->v.addr, MTK_ADDRESS, &mti );
TypeBase( entry->th, th, NULL, NULL );
TypePointer( th, TM_FAR, mti.b.bits / BITS_PER_BYTE, entry->th );
TypeInfo( entry->th, entry->lc, &entry->info );
} else {
ExprSetAddrInfo( entry, FALSE );
}
break;
case TK_STRING:
_ChkAlloc( entry->v.string.allocated, entry->info.size,
LIT( ERR_NO_MEMORY_FOR_EXPR ) );
LocationCreate( &ll, LT_INTERNAL, entry->v.string.allocated );
if( LocationAssign( &ll, &entry->v.loc, entry->info.size, FALSE ) != DS_OK ) {
_Free( entry->v.string.allocated );
Error( ERR_NONE, LIT( ERR_NO_ACCESS ) );
}
entry->v.string.loc = ll;
break;
case TK_BOOL:
case TK_CHAR:
case TK_ENUM:
case TK_INTEGER:
if( (entry->info.modifier & TM_MOD_MASK) == TM_SIGNED ) extend = TRUE;
/* fall through */
default:
LocationCreate( &ll, LT_INTERNAL, &tmp );
if( LocationAssign( &ll, &entry->v.loc, entry->info.size, extend ) != DS_OK ) {
Error( ERR_NONE, LIT( ERR_NO_ACCESS ) );
}
FromItem( &tmp, entry );
break;
}
}
entry->flags &= ~(SF_LOCATION | SF_IMP_ADDR);
}
if( entry->info.kind == TK_POINTER
&& (entry->info.modifier & TM_MOD_MASK) == TM_NEAR ) {
NearToFar( entry );
}
}