inspect_type WndGetExprSPInspectType( address *paddr )
{
sym_info info;
DIPHDL( sym, sh );
LValue( ExprSP );
*paddr = NilAddr;
if( ExprSP->info.kind == TK_FUNCTION ) {
ExprValue( ExprSP );
*paddr = ExprSP->v.addr;
PopEntry();
return( INSP_CODE );
} else if( (ExprSP->flags & SF_LOCATION) && ExprSP->th != NULL && !IsInternalMod( TypeMod( ExprSP->th ) ) ) {
if( ExprSP->v.loc.num == 1 && ExprSP->v.loc.e[0].type == LT_ADDR ) {
*paddr = ExprSP->v.loc.e[0].u.addr;
}
PopEntry();
return( INSP_DATA );
} else {
if( (ExprSP->flags & SF_LOCATION) && ExprSP->v.loc.e[0].type == LT_ADDR ) {
*paddr = ExprSP->v.loc.e[0].u.addr;
} else if( ExprSP->info.kind == TK_ADDRESS
|| ExprSP->info.kind == TK_POINTER ) {
*paddr = ExprSP->v.addr;
}
if( !IS_NIL_ADDR( (*paddr) ) ) {
AddrFloat( paddr );
if( DeAliasAddrSym( NO_MOD, *paddr, sh ) != SR_NONE ) {
SymInfo( sh, ExprSP->lc, &info );
PopEntry();
switch( info.kind ) {
case SK_CODE:
case SK_PROCEDURE:
return( INSP_CODE );
break;
default:
return( INSP_RAW_DATA );
break;
}
}
}
}
ExprValue( ExprSP );
MakeMemoryAddr( TRUE, EXPR_DATA, paddr );
return( INSP_RAW_DATA );
}
static void GlobalOptInt( char *name, int *value )
{
EXPR *expr ;
expr = Label( name ) ;
expr = ExprGetDefinition( expr ) ;
if( !expr )
return ;
*value = (int) ExprValue( expr ) ;
}
static void GlobalOptReal( char *name, double *value )
{
EXPR *expr ;
expr = Label( name ) ;
expr = ExprGetDefinition( expr ) ;
if( !expr )
return ;
*value = ExprValue( expr ) ;
}
// The following routine is cut & pasted verbatim from dbgwvar.c
// (which we really don't want to drag in here)
var_node *VarGetDisplayPiece( var_info *i, int row, int piece, int *pdepth, int *pinherit )
{
var_node *row_v;
var_node *v;
if( piece >= VAR_PIECE_LAST ) return( NULL );
if( VarFirstNode( i ) == NULL ) return( NULL );
if( row >= VarRowTotal( i ) ) return( NULL );
row_v = VarFindRowNode( i, row );
if( !row_v->value_valid ) {
VarSetValue( row_v, LIT_ENG( Quest_Marks ) );
row_v->value_valid = false;
}
if( !row_v->gadget_valid ) {
VarSetGadget( row_v, VARGADGET_NONE );
row_v->gadget_valid = false;
}
v = row_v;
if( piece == VAR_PIECE_NAME ||
( piece == VAR_PIECE_GADGET && row_v->gadget_valid ) ||
( piece == VAR_PIECE_VALUE && row_v->value_valid ) ) {
VarError = false;
} else if( _IsOff( SW_TASK_RUNNING ) ) {
if( row == i->exprsp_cacherow && i->exprsp_cache != NULL ) {
VarError = false;
v = i->exprsp_cache;
} else if( row == i->exprsp_cacherow && i->exprsp_cache_is_error ) {
VarError = true;
v = NULL;
} else {
VarErrState();
v = VarFindRow( i, row );
VarOldErrState();
i->exprsp_cacherow = row;
i->exprsp_cache = v;
i->exprsp_cache_is_error = VarError;
}
if( v == NULL ) {
if( !VarError ) return( NULL );
v = row_v;
}
VarNodeInvalid( v );
VarErrState();
ExprValue( ExprSP );
VarSetGadget( v, VarGetGadget( v ) );
VarSetOnTop( v, VarGetOnTop( v ) );
VarSetValue( v, VarGetValue( i, v ) );
VarOldErrState();
VarDoneRow( i );
}
VarGetDepths( i, v, pdepth, pinherit );
return( v );
}
double MatCTECat( EXPR *name, EXPR *nothing )
{
char *string ;
string = ExprValueString( name ) ;
if( !string )
{
IOerror( MatBomb, "MatCTECat", "cannot evaluate name" ) ;
return nan("") ;
}
return ExprValue( DbaseGetExpr( string, "CTE" ) ) ;
}
double SystemGetNumber( char *string )
{
EXPR *expr ;
expr = Label( string ) ;
expr = ExprGetDefinition( expr ) ;
if( !expr )
{
IOerror( IO_WARN, "SystemGetNumber",
"no value set for `%s'", string ) ;
return 0.0 ;
}
return ExprValue( expr ) ;
}
static FUNC *ConvertTransform( FUNC *func, EDAT xform[16] )
{
int d, which ;
FUNC *loop ;
static EDAT gnew[16] = ZERO_EDAT_16 ;
EXPR *arg, *expr ;
MatrixMultiInit(4) ;
for( loop = func ; loop ; loop = OpticForward( FuncNext(loop) ) )
{
which = (int) ( ExprValue( FuncArg( loop, 0 ) ) + 0.49 ) ;
if( which > 5 ) /* surface */
break ;
arg = Copy( FuncArg( loop, 1 ) ) ;
if( FuncIsReversed( loop ) )
arg = Ecc( arg, "u-", Garbage() ) ;
MatrixIdentity( 4, gnew ) ;
if( which < 3 )
gnew[ RC( which, 3 ) ].E = ECc( arg, "u-", Garbage() ) ;
else
{
d = which - 3 ;
expr = ECc( arg, "cos", Garbage() ) ;
gnew[ RC( (d+1)%3, (d+1)%3 ) ].E = Copy( expr ) ;
gnew[ RC( (d+2)%3, (d+2)%3 ) ].E = expr ;
expr = ECc( arg, "sin", Garbage() ) ;
gnew[ RC( (d+1)%3, (d+2)%3 ) ].E = Copy( expr ) ;
expr = Ecc( expr, "u-", Garbage() ) ;
gnew[ RC( (d+2)%3, (d+1)%3 ) ].E = expr ;
}
Free( arg ) ;
MatrixMultiNew( 4, gnew ) ;
MatrixZero( 4, gnew ) ; /* free it up */
}
MatrixMultiResult( 4, xform ) ;
MatrixMultiInit(4) ;
return loop ;
}
static FUNC *OpticForward( FUNC *func )
{
int which ;
func = FuncForward( func ) ;
if( func )
{
which = (int) ( ExprValue( FuncArg( func, 0 ) ) + 0.49 ) ;
if( (which == 13) || (which == 19) || (which == 21) )
/* print, bound, or merit */
{
OpticRegister( func ) ;
return OpticForward( FuncNext( func ) ) ;
}
}
return func ;
}
void ArrayAdapter::llvmThrowOutOfRangeException(
BasicBlockBuilder &basicBlockBuilder,
llvm::Value *itemDescRValue,
llvm::Value *indexRValue,
llvm::Value *sizeRValue,
llvm::Value *errorDescRValue
) const
{
RC::Handle<Context> context = basicBlockBuilder.getContext();
RC::ConstHandle<SizeAdapter> sizeAdapter = basicBlockBuilder.getManager()->getSizeAdapter();
RC::ConstHandle<StringAdapter> stringAdapter = basicBlockBuilder.getManager()->getStringAdapter();
RC::ConstHandle<ConstStringAdapter> constStringAdapter = basicBlockBuilder.getManager()->getConstStringAdapter();
std::vector<llvm::Type const *> argTypes;
argTypes.push_back( constStringAdapter->llvmRType( context ) );
argTypes.push_back( sizeAdapter->llvmRType( context ) );
argTypes.push_back( sizeAdapter->llvmRType( context ) );
argTypes.push_back( constStringAdapter->llvmRType( context ) );
llvm::FunctionType const *funcType = llvm::FunctionType::get( basicBlockBuilder->getVoidTy(), argTypes, false );
llvm::AttributeWithIndex AWI[1];
AWI[0] = llvm::AttributeWithIndex::get( ~0u, 0 /*llvm::Attribute::InlineHint | llvm::Attribute::NoUnwind*/ );
llvm::AttrListPtr attrListPtr = llvm::AttrListPtr::get( AWI, 1 );
std::string name = "__ThrowOutOfRangeException";
llvm::Function *func = llvm::cast<llvm::Function>( basicBlockBuilder.getModuleBuilder()->getFunction( name ) );
if ( !func )
{
ModuleBuilder &mb = basicBlockBuilder.getModuleBuilder();
func = llvm::cast<llvm::Function>( mb->getOrInsertFunction( name, funcType, attrListPtr ) );
func->setLinkage( llvm::GlobalValue::PrivateLinkage );
FunctionBuilder fb( mb, funcType, func );
llvm::Argument *itemRValue = fb[0];
itemRValue->setName( "itemRValue" );
itemRValue->addAttr( llvm::Attribute::NoCapture );
llvm::Argument *indexRValue = fb[1];
indexRValue->setName( "indexRValue" );
llvm::Argument *sizeRValue = fb[2];
sizeRValue->setName( "sizeRValue" );
llvm::Argument *errorDescRValue = fb[3];
errorDescRValue->setName( "errorDescRValue" );
errorDescRValue->addAttr( llvm::Attribute::NoCapture );
BasicBlockBuilder bbb( fb );
llvm::BasicBlock *entryBB = fb.createBasicBlock( "entry" );
bbb->SetInsertPoint( entryBB );
llvm::Value *errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3LValue;
{
Scope subScope( bbb.getScope() );
BasicBlockBuilder subBasicBlockBuilder( bbb, subScope );
llvm::BasicBlock *haveErrorDescBB = fb.createBasicBlock( "haveErrorDescBB" );
llvm::BasicBlock *noErrorDescBB = fb.createBasicBlock( "noErrorDescBB" );
llvm::BasicBlock *goBB = fb.createBasicBlock( "goBB" );
subBasicBlockBuilder->CreateCondBr(
subBasicBlockBuilder->CreateIsNotNull( errorDescRValue ),
haveErrorDescBB,
noErrorDescBB
);
subBasicBlockBuilder->SetInsertPoint( haveErrorDescBB );
llvm::Value *haveErrorDescConstStringRValue = errorDescRValue;
subBasicBlockBuilder->CreateBr( goBB );
subBasicBlockBuilder->SetInsertPoint( noErrorDescBB );
llvm::Value *noErrorDescConstStringRValue = constStringAdapter->llvmConst( subBasicBlockBuilder, "KL" );
subBasicBlockBuilder->CreateBr( goBB );
subBasicBlockBuilder->SetInsertPoint( goBB );
llvm::PHINode *errorDescConstStringRValue = subBasicBlockBuilder->CreatePHI( haveErrorDescConstStringRValue->getType(), "errorDescConstStringRValue" );
errorDescConstStringRValue->addIncoming( haveErrorDescConstStringRValue, haveErrorDescBB );
errorDescConstStringRValue->addIncoming( noErrorDescConstStringRValue, noErrorDescBB );
llvm::Value *errorMsg0RValue = stringAdapter->llvmCast(
subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, errorDescConstStringRValue )
);
llvm::Value *errorMsgARValue = stringAdapter->llvmCast( subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, constStringAdapter->llvmConst( subBasicBlockBuilder, ": " ) )
);
llvm::Value *errorMsgALValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsgA" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsgALValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
errorMsg0RValue,
errorMsgARValue,
errorMsgALValue
);
llvm::Value *errorMsgBRValue = stringAdapter->llvmCast( subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, itemRValue )
);
llvm::Value *errorMsgBLValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsgB" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsgBLValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsgALValue ),
errorMsgBRValue,
errorMsgBLValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsgALValue );
llvm::Value *errorMsgCRValue = stringAdapter->llvmCast( subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, constStringAdapter->llvmConst( subBasicBlockBuilder, " (" ) )
);
llvm::Value *errorMsgCLValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsgC" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsgCLValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsgBLValue ),
errorMsgCRValue,
errorMsgCLValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsgBLValue );
llvm::Value *indexStringRValue = stringAdapter->llvmCast(
subBasicBlockBuilder,
ExprValue( sizeAdapter, USAGE_RVALUE, context, indexRValue )
);
llvm::Value *errorMsg1PlusIndexLValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsg1PlusIndex" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsg1PlusIndexLValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsgCLValue ),
indexStringRValue,
errorMsg1PlusIndexLValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsgCLValue );
llvm::Value *errorMsg2RValue = stringAdapter->llvmCast(
subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, constStringAdapter->llvmConst( subBasicBlockBuilder, ") out of range (" ) )
);
llvm::Value *errorMsg1PlusIndexPlusErrorMsg2LValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsg1PlusIndexPlusErrorMsg2" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2LValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsg1PlusIndexLValue ),
errorMsg2RValue,
errorMsg1PlusIndexPlusErrorMsg2LValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsg1PlusIndexLValue );
llvm::Value *sizeStringRValue = stringAdapter->llvmCast(
subBasicBlockBuilder,
ExprValue( sizeAdapter, USAGE_RVALUE, context, sizeRValue )
);
llvm::Value *errorMsg1PlusIndexPlusErrorMsg2PlusSizeLValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsg1PlusIndexPlusErrorMsg2PlusSize" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2PlusSizeLValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2LValue ),
sizeStringRValue,
errorMsg1PlusIndexPlusErrorMsg2PlusSizeLValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2LValue );
llvm::Value *errorMsg3RValue = stringAdapter->llvmCast(
subBasicBlockBuilder,
ExprValue( constStringAdapter, USAGE_RVALUE, context, constStringAdapter->llvmConst( subBasicBlockBuilder, ")" ) )
);
errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3LValue = stringAdapter->llvmAlloca( subBasicBlockBuilder, "errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3" );
stringAdapter->llvmInit( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3LValue );
stringAdapter->llvmCallConcat(
subBasicBlockBuilder,
stringAdapter->llvmLValueToRValue( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2PlusSizeLValue ),
errorMsg3RValue,
errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3LValue
);
stringAdapter->llvmDispose( subBasicBlockBuilder, errorMsg1PlusIndexPlusErrorMsg2PlusSizeLValue );
subScope.llvmUnwind( subBasicBlockBuilder );
}
llvmThrowException( bbb, errorMsg1PlusIndexPlusErrorMsg2PlusSizePlusErrorMsg3LValue );
bbb->CreateRetVoid();
}
std::vector<llvm::Value *> args;
args.push_back( itemDescRValue );
args.push_back( indexRValue );
args.push_back( sizeRValue );
args.push_back( errorDescRValue );
basicBlockBuilder->CreateCall( func, args.begin(), args.end() );
}
ExprValue Function::llvmCreateCall( BasicBlockBuilder &basicBlockBuilder, std::vector<ExprValue> &args ) const
{
RC::Handle<Context> context = basicBlockBuilder.getContext();
if ( m_params.size() != args.size() )
throw Exception( "incorrect number of arguments (expected %u, actual %u)", (unsigned)m_params.size(), (unsigned)args.size() );
for ( size_t i=0; i<args.size(); ++i )
{
FunctionParam const ¶m = m_params[i];
ExprValue &arg = args[i];
if( !arg.isValid() )
throw Exception( "expression is invalid" );
try
{
arg.castTo( basicBlockBuilder, param.getExprType() );
}
catch ( Exception e )
{
throw Exception( "argument %u ('%s'): %s", (unsigned)(i + 1), param.getName().c_str(), (const char*)e.getDesc() );
}
}
llvm::Value *returnValue = 0;
if ( m_returnInfo.usesReturnLValue() )
{
RC::ConstHandle<Adapter> returnAdapter = m_returnInfo.getAdapter();
returnValue = returnAdapter->llvmAlloca( basicBlockBuilder, "resultLValue" );
returnAdapter->llvmInit( basicBlockBuilder, returnValue );
args.resize( args.size() + 1, ExprValue(context) );
for ( size_t i=1; i<args.size(); ++i )
args[args.size()-i] = args[args.size()-i-1];
args[0] = ExprValue( returnAdapter, USAGE_LVALUE, context, returnValue );
basicBlockBuilder.getScope().put( CG::VariableSymbol::Create( args[0] ) );
}
std::vector<llvm::Value *> argValues;
for ( size_t i=0; i<args.size(); ++i )
argValues.push_back( args[i].getValue() );
/*
llvm::BasicBlock *lpbb = basicBlockBuilder.getFunctionBuilder()->createBasicBlock( "lpbb" );
llvm::BasicBlock *normalbb = basicBlockBuilder.getFunctionBuilder()->createBasicBlock( "normalbb" );
llvm::Value *resultValue = basicBlockBuilder->CreateInvoke( m_llvmFunction, normalbb, lpbb, argValues );
if( !m_returnInfo.usesReturnLValue() )
returnValue = resultValue;
basicBlockBuilder->SetInsertPoint( lpbb );
basicBlockBuilder->CreateLandingPad();
basicBlockBuilder->CreateBr( normalbb );
basicBlockBuilder->SetInsertPoint( normalbb );
*/
llvm::Value *resultValue = basicBlockBuilder->CreateCall( m_llvmFunction, argValues );
if( !m_returnInfo.usesReturnLValue() )
returnValue = resultValue;
return CG::ExprValue( m_returnInfo.getExprType(), context, returnValue );
}
static int FuncCompileIfElse( FUNC *func )
{
FUNC *table[100], *loop, *temp ;
int i, j, count, unknown ;
ifelsedir direction ;
for( loop = func ; loop ; loop = loop->next )
loop->unknown = 0 ;
/*
* First find an if/else tree
*
*/
count = 0 ;
direction = DIR_UNKNOWN ;
for( loop = func ; loop ; loop = loop->next )
{
if( !loop->ignore && ExprLabelEqual(loop->label, iif) )
{
if( count && (direction == DIR_FORWARD) )
break ;
if( !count )
direction = DIR_FORWARD ;
table[count] = loop ;
loop = SetSkip( loop ) ;
count++ ;
if( direction == DIR_REVERSE )
break ; /* final $if */
}
else
if( !loop->ignore &&
( ExprLabelEqual( loop->label, ielse ) || ExprLabelEqual( loop->label, ielseif ) ) )
{
if( !count )
direction = DIR_REVERSE ;
table[count] = loop ;
loop = SetSkip( loop ) ;
count++ ;
if( (direction == DIR_FORWARD) && ExprLabelEqual(loop->label, ielse) )
break ; /* final $else */
}
else
if( count && !ExprLabelEqual(loop->label, imacro) )
break ;
}
if( !count )
return 0 ;
if( count >= 100 )
IOerror( FuncBomb, "FuncCompileIfElse", "internal table exceeded" ) ;
if( direction == DIR_UNKNOWN )
IOerror( FuncBomb, "FuncCompileIfElse", "cannot determine direction" ) ;
/*
* Swap ends if tree is reversed
*
*/
if( direction == DIR_REVERSE )
{
for( i = 0 ; i < count / 2 ; i++ )
{
temp = table[i] ;
table[i] = table[ count - i - 1 ] ;
table[ count - i - 1 ] = temp ;
}
if( !ExprLabelEqual( table[0]->label, iif ) )
IOerror( FuncBomb, "FuncCompileIfElse", "if/else tree has no if" ) ;
}
/*
* Check some syntax
*
*/
if( FuncArgCount( table[0] ) != 1 )
{
IOerror( FuncBomb, "FuncCompileIfElse",
"wrong number of arguments to $if" ) ;
}
for( i = 1 ; i < count - 1 ; i++ )
{
if( FuncArgCount( table[i] ) != 1 )
{
IOerror( FuncBomb, "FuncCompileIfElse",
"wrong number of arguments to $elseif" ) ;
}
if( ExprLabelEqual( table[i]->label, ielse ) )
{
IOerror( FuncBomb, "FuncCompileIfElse",
"$else embedded in $if/$else tree" ) ;
}
}
if( ExprLabelEqual(table[count - 1]->label, ielse) && (FuncArgCount( table[count - 1] ) != 0) )
IOerror( FuncBomb, "FuncCompileIfElse",
"wrong number of arguments to $else" ) ;
/*
* Find the true branch
*
*/
unknown = 0 ;
for( i = 0 ; i < count ; i++ )
{
if( ExprNonDepend( FuncArg( table[i], 0 ), VAR_SET, 0 ) )
{
unknown = 1 ;
break ;
}
if( ExprLabelEqual( table[i]->label, ielse ) ) /* leftover */
break ;
if( ExprValue( FuncArg( table[i], 0 ) ) ) /* true */
break ;
}
/*
* Set the final state
*
*/
for( j = 0 ; j < count ; j++ )
{
if( unknown )
loop = SetUnknown( table[j] ) ;
else
{
if( i == j )
loop = SetTrue( table[j] ) ;
else
loop = SetFalse( table[j] ) ;
}
if( (direction == DIR_REVERSE) && (j == 0) )
func = loop ;
if( (direction == DIR_FORWARD) && (j == count - 1) )
func = loop ;
}
/*
* func is now the last FUNC of the tree
*
*/
if( func && func->next )
return !unknown + FuncCompileIfElse( func->next ) ;
else
return !unknown ;
}
static FUNC *ConvertSurface( FUNC *func, OPTIC *optic )
{
FUNC *loop ;
EXPR *EA0, *separate ;
int ea0used, which, rev ;
optic->terms[ TERM_MAT ].E = Copy( MatGet() ) ;
optic->terms[ TERM_TEMP ].E = Copy( MatGetTemp() ) ;
for( loop = func ; loop ; loop = OpticForward( FuncNext(loop) ) )
{
which = (int) ( ExprValue( FuncArg( loop, 0 ) ) + 0.49 ) ;
if( which < 6 )
break ;
EA0 = Copy( FuncArg( loop, 1 ) ) ;
ea0used = 0 ;
switch( which )
{
case 6: /* INDX */
if( FuncArgCount( loop ) == 4 )
{
MatPush( EA0, FuncArg( loop, 2 ),
FuncIsReversed( loop ) ) ;
optic->mutant = 1 ;
(optic - 1)->mutant = -1 ; /* kludge-o-rama */
optic->terms[TERM_MUTANT].E = Copy( FuncArg( loop, 3 ) ) ;
}
else
if( FuncArgCount( loop ) == 3 )
{
MatPush( EA0, FuncArg( loop, 2 ),
FuncIsReversed( loop ) ) ;
}
else
if( FuncArgCount( loop ) == 2 )
{
MatPush( EA0, Label( "MatTemperature" ),
FuncIsReversed( loop ) ) ;
}
break ;
case 7: /* PARAX */
optic->terms[TERM_FOCLEN].E = EA0 ;
optic->function |= FUNCTION_PARAX ;
ea0used = 1 ;
break ;
case 8: /* MIRROR */
optic->function |= FUNCTION_MIRROR ;
break ;
case 9: /* GRATING */
optic->function |= FUNCTION_GRATING ;
optic->terms[TERM_LINES].E = EA0 ;
optic->terms[TERM_ORDER].E = Copy( FuncArg( loop, 2 ) ) ;
ea0used = 1 ;
break ;
case 10: /* VIEW */
optic->function |= FUNCTION_VIEW ;
break ;
case 11: /* STOP */
if( FuncArgCount( loop ) == 1 ) /* EXIT */
optic->function |= FUNCTION_EXIT ;
else
if( FuncArgCount( loop ) == 7 ) /* STOP */
{
int i ;
EDAT *S ;
if( optic->StopCount == NSTOPS )
{
IOerror( IO_ERR, "ConvertSurface", "too many stops" ) ;
failed = 1 ;
break ;
}
S = &optic->terms[ TERM_STOPS + 6 * optic->StopCount ] ;
for( i = 0 ; i < 6 ; i++ )
S[i].E = Copy( FuncArg( loop, i + 1 ) ) ;
optic->StopCount++ ;
}
break ;
case 12: /* PDIST */
if( FuncIsReversed( loop ) )
optic->terms[TERM_PDIST].E = Ecc( EA0, "u-", Garbage() ) ;
else
optic->terms[TERM_PDIST].E = EA0 ;
optic->function |= FUNCTION_PDIST ;
ea0used = 1 ;
break ;
case 13: /* PRINT */
break ;
case 14: /* LABEL */
separate = String( " & " ) ;
if( optic->terms[ TERM_LABEL ].E )
{
optic->terms[ TERM_LABEL ].E = Ecc(
optic->terms[ TERM_LABEL ].E, "//", separate ) ;
optic->terms[ TERM_LABEL ].E = Ecc(
optic->terms[ TERM_LABEL ].E, "//", EA0 ) ;
}
else
optic->terms[ TERM_LABEL ].E = EA0 ;
ea0used = 1 ;
break ;
case 15: /* SURF */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
if( FuncArgCount( loop ) == 4 )
{
optic->surface |= SURFACE_SYMBOLIC ;
optic->terms[TERM_Sx].E = Copy( FuncArg( loop, 1 ) ) ;
optic->terms[TERM_Sy].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_Sf].E = Copy( FuncArg( loop, 3 ) ) ;
if( !ExprIsVariable( optic->terms[TERM_Sx].E ) )
IOerror( IO_ERR, "ConvertSurface", "X not a variable" ) ;
if( !ExprIsVariable( optic->terms[TERM_Sy].E ) )
IOerror( IO_ERR, "ConvertSurface", "Y not a variable" ) ;
break ;
}
optic->terms[TERM_CURV].E = EA0 ;
ea0used = 1 ;
if( FuncArgCount( loop ) == 1 )
optic->surface |= SURFACE_FLAT ;
else
if( FuncArgCount( loop ) == 2 )
optic->surface |= SURFACE_SPHERE ;
else
if( FuncArgCount( loop ) == 3 )
{
optic->surface |= SURFACE_CONIC ;
optic->terms[TERM_CONIC].E = Copy( FuncArg( loop, 2 ) ) ;
}
else /* count = 6 */
{
optic->surface |= SURFACE_ASPHERE ;
optic->terms[TERM_CONIC].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_A4].E = Copy( FuncArg( loop, 3 ) ) ;
optic->terms[TERM_A6].E = Copy( FuncArg( loop, 4 ) ) ;
optic->terms[TERM_A8].E = Copy( FuncArg( loop, 5 ) ) ;
optic->terms[TERM_A10].E = Copy( FuncArg( loop, 6 ) ) ;
}
break ;
case 16: /* TRIX */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
optic->terms[TERM_Ex].E = EA0 ;
optic->terms[TERM_Ey].E = Copy( FuncArg( loop, 2 ) ) ;
optic->terms[TERM_Ez].E = Copy( FuncArg( loop, 3 ) ) ;
optic->terms[TERM_Eo].E = Copy( FuncArg( loop, 4 ) ) ;
optic->surface |= SURFACE_TRIAXIAL ;
ea0used = 1 ;
break ;
case 17: /* MARK */
if( FuncArgCount( loop ) == 2 ) /* surface */
{
optic->terms[TERM_MARK].E = EA0 ;
ea0used = 1 ;
}
else
if( FuncArgCount( loop ) == 3 ) /* variable */
{
if( !ExprIsVariable( FuncArg( loop, 1 ) ) )
{
IOerror( OpticBomb, "ConvertSurface",
"EXPR not a VARIABLE" ) ;
}
ExprSetFlags( FuncArg( loop, 1 ),
(int) ExprValue( FuncArg( loop, 2 ) ) & VAR_OPTIC ) ;
}
break ;
case 18: /* COAT */
if( optic->terms[ TERM_COATING ].E )
{
IOerror( IO_ERR, "ConvertSurface",
"multiple coating declarations on surface %d",
Surface ) ;
failed = 1 ;
}
else
{
optic->terms[ TERM_COATING ].E = EA0 ;
ea0used = 1 ;
}
break ;
case 19: /* BOUND */
break ;
case 20: /* BAFFLE */
optic->function |= FUNCTION_BAFFLE ;
break ;
case 21: /* MERIT */
break ;
case 22: /* APERTURE */
optic->function |= FUNCTION_APERTURE ;
if( aperture_set )
{
IOerror( IO_ERR, "ConvertSurface", "multiple apertures" ) ;
failed = 1 ;
}
aperture_set = 1 ;
break ;
case 23: /* PINHOLE */
optic->function |= FUNCTION_PINHOLE ;
break ;
case 24: /* ORIGIN */
if( origin_set )
{
IOerror( IO_WARN, "ConvertSurface", "multiple origins" ) ;
/* EVIL HACK!!!! */
/* failed = 1 ; */
}
else
{
optic->function |= FUNCTION_ORIGIN ;
origin_set = 1 ;
}
break ;
case 25: /* FRESNEL */
rev = ( FuncIsReversed( loop ) ? -1 : 1 ) ;
if( optic->reverse != rev )
{
if( !optic->reverse )
optic->reverse = rev ;
else
{
IOerror( IO_ERR, "ConvertSurface",
"inconsistent surface reversal on surface #%d",
Surface ) ;
failed = 1 ;
}
}
optic->surface |= SURFACE_FRESNEL ;
optic->terms[TERM_FOCLEN].E = EA0 ;
ea0used = 1 ;
break ;
default:
IOerror( OpticBomb, "ConvertSurface",
"unexpected surface function on surface #%d", Surface ) ;
failed = 1 ;
}
if( !ea0used )
Free( EA0 ) ;
}
if( !Compare( optic->terms[ TERM_MAT ].E, MatGet() ) )
optic->function |= FUNCTION_SNELL ;
return loop ;
}
double MatIndexCat( char *name, double temp, double wl )
{
double low, high, S2, index2, Tcat, dndT ;
int count ;
char *type ;
if( wl <= 0.0 )
{
IOerror( MatBomb, "MatIndexCat", "invalid wavelength %g", wl ) ;
return nan("") ;
}
/*
* First get the index at the catalogue temperature
*
*/
low = ExprValue( DbaseGetExpr( name, "DispersionLow" ) ) ;
if( (wl < low) && DbaseCheck( name, "DISP_LOW" ) )
{
IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range for %s: lower bound is %g", wl, name, low ) ;
IOerror( MatBomb, "MatIndexCat", "extrapolating beyond range\n" ) ;
}
high = ExprValue( DbaseGetExpr( name, "DispersionHigh" ) ) ;
if( (wl > high) && DbaseCheck( name, "DISP_HIGH" ) )
{
IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range for %s: upper bound is %g", wl, name, high ) ;
IOerror( MatBomb, "MatIndexCat", "extrapolating beyond range\n" ) ;
}
S2 = 1.0 / ( wl * wl ) ;
type = ExprValueString( DbaseGetExpr( name, "DispersionFormula" ) ) ;
if( strcmp( type, "sellmeier" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "sellmeier" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "sellmeier data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( count % 2 )
{
IOerror( MatBomb, "MatIndexCat", "sellmeier formula has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[count] ;
for( int i = 0 ; i < count ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = 1.0 ;
for( int i = 0 ; i < count / 2 ; i++ )
index2 += table[ 2 * i ] / ( 1.0 - table[ 2 * i + 1 ] * S2 ) ;
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
}
else
if( strcmp( type, "schott" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "schott" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "schott data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( count != 6 )
{
IOerror( MatBomb, "MatIndexCat", "Schott formula has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[6] ;
for( int i = 0 ; i < 6 ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = table[0]
+ table[1] / S2
+ ( table[2]
+ ( table[3]
+ ( table[4]
+ table[5] * S2 ) * S2 ) * S2 ) * S2 ;
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
}
else
if( strcmp( type, "polyindex" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "polyindex" ) ;
if( !array )
{
IOerror( MatBomb, "MatIndexCat", "polyindex data array not found for %s", name ) ;
return nan("") ;
}
count = ExprArrayCount(array) ;
if( !count || (count % 3 != 0) )
{
IOerror( MatBomb, "MatIndexCat", "Poly Index has %d terms for %s", count, name ) ;
return nan("") ;
}
double table[count] ;
for( int i = 0 ; i < count ; i++ )
table[i] = ExprValue( ExprArrayValue( array, i ) ) ;
index2 = 0.0 ;
for( int i = 0 ; i < count / 3 ; i++ )
{
index2 += table[ 3 * i + 2 ]
* pow( S2, table[ 3 * i ] )
* pow( temp, table[ 3 * i + 1 ] ) ;
}
if( index2 < 1.0 )
{
IOerror( MatBomb, "MatIndexCat", "unphysical index of n[%s]^2 = %g at %g microns", name, index2, wl ) ;
return nan("") ;
}
return sqrt( index2 ) ; /* TEMP done already! */
}
else
{
IOerror( MatBomb, "MatIndexCat", "unknown type of dispersion formula for %s", name ) ;
return nan("") ;
}
/*
* Now adjust for temperature effects
*
*/
Tcat = ExprValue( DbaseGetExpr( name, "DispersionTemperature" ) ) ;
if( Tcat == temp )
return sqrt( index2 ) ; /* all done! */
type = ExprValueString( DbaseGetExpr( name, "dndTFormula" ) ) ;
if( strcmp( type, "table" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "dndT" ) ;
if( array )
{
dndT = ExprInterp( array, wl ) ;
if( isnan(dndT) )
{
IOerror( MatBomb, "MatIndexCat", "bad dndT data array for %s", name ) ;
return nan("") ;
}
}
else
{
IOerror( MatBomb, "MatIndexCat", "dndT data not found for %s", name ) ;
return nan("") ;
}
// if( (ret == 1) && DbaseCheck( name, "DNDT_RANGE" ) )
// IOerror( MatBomb, "MatIndexCat", "wavelength %g out of range of dndT table for %s -- extrapolating", wl, name ) ;
}
else
if( strcmp( type, "constant" ) == 0 )
dndT = ExprValue( DbaseGetExpr( name, "dndTConstant" ) ) ;
else
{
IOerror( MatBomb, "MatIndexCat", "unknown form of dndT table for %s",
name ) ;
return nan("") ;
}
return sqrt( index2 ) + dndT * ( temp - Tcat ) ;
}
double MatOpacityCat( char *name, double wl )
{
double low, high, depth, T ;
char *type ;
if( wl <= 0.0 )
{
IOerror( MatBomb, "MatOpacityCat", "invalid wavelength %g", wl ) ;
return nan("") ;
}
low = ExprValue( DbaseGetExpr( name, "TransmissionLow" ) ) ;
if( (wl < low) && DbaseCheck( name, "OPACITY_LOW" ) )
{
IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s: lower bound is %g", wl, name, low ) ;
IOerror( MatBomb, "MatOpacityCat", "extrapolating beyond range\n" ) ;
wl = low ;
}
high = ExprValue( DbaseGetExpr( name, "TransmissionHigh" ) ) ;
if( (wl > high) && DbaseCheck( name, "OPACITY_HIGH" ) )
{
IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s: upper bound is %g", wl, name, high ) ;
IOerror( MatBomb, "MatOpacityCat", "extrapolating beyond range\n" ) ;
wl = high ;
}
type = ExprValueString( DbaseGetExpr( name, "TransmissionFormula" ) ) ;
if( strcmp( type, "table" ) == 0 )
{
EXPR* array = DbaseGetExpr( name, "transmission" ) ;
if( array )
{
T = ExprInterp( array, wl ) ;
if( isnan(T) )
{
IOerror( MatBomb, "MatOpacityCat", "bad transmission data array for %s", name ) ;
return nan("") ;
}
}
else
{
IOerror( MatBomb, "MatOpacityCat", "transmission data not found for %s", name ) ;
return nan("") ;
// old stuff here that we should incorporate...
// if( (ret == 1) && DbaseCheck( name, "OPACITY_RANGE" ) )
// IOerror( MatBomb, "MatOpacityCat", "wavelength %g out of range for %s -- extrapolating", wl, name ) ;
}
depth = ExprValue( DbaseGetExpr( name, "TransmissionDepth" ) ) ;
if( T == 1.0 )
return 0.0 ;
else
if( T <= 0.0 )
return HUGE ;
else
return -( depth / 25.4 ) / log(T) ;
}
else
if( strcmp( type, "clear" ) == 0 )
return 0.0 ;
else
{
IOerror( MatBomb, "MatOpacityCat", "unknown type of transmission formula for %s", name ) ;
return nan("") ;
}
}
void EvalExpr( unsigned addr_depth )
{
EvalLValExpr( addr_depth );
ExprValue( ExprSP );
}
static unsigned MechStack( unsigned select, unsigned parm )
{
unsigned result = 0;
stack_entry *entry;
sym_info info;
switch( select ) {
case 0:
SwapStack( parm );
break;
case 1:
MoveSP( parm );
break;
case 2:
entry = StkEntry( parm );
LValue( entry );
result = TypeInfoToClass( &entry->info ) & (BASE_TYPE | STK_UNSIGNED);
break;
case 3:
ExprValue( StkEntry( parm ) );
break;
case 4:
LValue( StkEntry( parm ) );
break;
case 5:
RValue( StkEntry( parm ) );
break;
case 6:
LRValue( StkEntry( parm ) );
break;
case 7:
entry = StkEntry( parm );
LValue( entry );
result = TI_CREATE( entry->info.kind, TM_NONE, 0 );
break;
case 8:
entry = StkEntry( parm );
NameResolve( entry, FALSE );
if( entry->flags & SF_SYM ) {
SymInfo( entry->v.sh, entry->lc, &info );
result = info.kind;
} else {
result = SK_NONE;
}
break;
case 9:
entry = StkEntry( parm );
result = NameResolve( entry, FALSE );
break;
case 10:
entry = StkEntry( parm );
if( entry->flags & SF_NAME ) {
result = 0;
} else if( entry->flags & SF_SYM ) {
result = 1;
} else if( entry->flags & SF_LOCATION ) {
result = 2;
} else {
result = 3;
}
break;
}
return( result );
}
static void VarModify( a_window *wnd, int row, int piece )
{
var_node *v;
type_kind class;
var_window *var = WndVar( wnd );
bool ok;
bool followable;
unsigned old;
if( row < 0 ) {
if( var->vtype == VAR_WATCH || var->vtype == VAR_VARIABLE ) {
VarMenuItem( wnd, MENU_VAR_NEW_EXPRESSION, row, piece );
}
return;
}
VarErrState();
VarKillExprSPCache( &var->i );
v = VarFindRow( &var->i, row );
if( v == NULL ) {
v = VarFindRowNode( &var->i, row );
if( v == NULL ) return;
if( piece != VAR_PIECE_GADGET && piece != VAR_PIECE_NAME ) return;
if( v->expand != NULL || v->node_type == NODE_INHERIT ) {
VarExpandRow( &var->i, v, row );
WndNewCurrent( wnd, row, VAR_PIECE_NAME );
VarRepaint( wnd );
}
return;
}
followable = VarGetStackClass( &class );
switch( piece ) {
case VAR_PIECE_GADGET:
case VAR_PIECE_NAME:
if( VarExpandable( class ) || followable || v->expand != NULL ) {
VarExpandRow( &var->i, v, row );
WndNewCurrent( wnd, row, VAR_PIECE_NAME );
VarRepaint( wnd );
}
break;
case VAR_PIECE_VALUE:
if( !VarExpandable( class ) ) {
char *value = DbgAlloc( TXT_LEN );
char *name = DbgAlloc( TXT_LEN );
old = VarNewCurrRadix( v );
ExprValue( ExprSP );
VarBuildName( &var->i, v, FALSE );
StrCopy( TxtBuff, name );
VarPrintText( &var->i, value, PrintValue, TXT_LEN );
VarKillExprSPCache( &var->i );
v = VarFindRow( &var->i, row );
FreezeStack();
ok = DlgAnyExpr( name, value, TXT_LEN );
UnFreezeStack( FALSE );
if( ok ) VarDoAssign( &var->i, v, value );
NewCurrRadix( old );
WndRowDirty( wnd, row );
DbgFree( value );
DbgFree( name );
}
break;
}
VarDoneRow( &var->i );
VarOldErrState();
}
static int FuncCompileSet0( FUNC *func )
{
FUNC *loop ;
EXPR *var, *value, *arg ;
int work, flags ;
work = 0 ;
for( loop = func ; loop ; loop = loop->next )
{
if( loop->ignore || loop->unknown )
continue ;
if( !ExprLabelEqual(loop->label, iset) && !ExprLabelEqual(loop->label, iinit) )
continue ;
var = FuncArg( loop, 0 ) ;
if( !ExprIsVariable( var ) )
{
IOerror( FuncBomb, "FuncCompileSet0", "argument not a variable" ) ;
continue ;
}
flags = ExprGetFlags( var, VAR_TYPE ) ;
if( flags == (VAR_INITIAL | VAR_HARD) )
continue ;
if( flags == (VAR_DEPEND | VAR_HARD) )
continue ;
if( ExprLabelEqual( loop->label, iinit ) )
{
if( flags && ( flags != (VAR_INITIAL | VAR_HARD) ) )
{
IOerror( FuncBomb, "FuncCompileSet0",
"`%s' is multiply defined", ExprName( var ) ) ;
loop->ignore = 1 ;
work++ ;
continue ;
}
FuncTypeSet( var, VAR_INITIAL | VAR_HARD ) ;
work++ ;
continue ;
}
if( flags )
{
IOerror( FuncBomb, "FuncCompileSet0",
"`%s' is multiply defined", ExprName( var ) ) ;
loop->ignore = 1 ;
work++ ;
continue ;
}
arg = FuncArg( loop, 1 ) ;
if( ExprDepend( arg, (VAR_INITIAL | VAR_HARD), 0 ) )
{
FuncTypeSet( var, VAR_DEPEND | VAR_HARD ) ;
work++ ;
continue ;
}
if( ExprDepend( arg, (VAR_DEPEND | VAR_HARD), 0 ) )
{
FuncTypeSet( var, VAR_DEPEND | VAR_HARD ) ;
work++ ;
continue ;
}
/* is this variable dependent on any others? */
if( ExprNonDepend( arg, VAR_NEVER, 0 ) )
continue ;
/*
* Oops! What about compound string expressions?
*
*/
if( ExprIsString( arg ) )
value = arg ;
else
value = Real( ExprValue( arg ), 0 ) ;
ExprSetDefinition( var, value ) ;
FuncTypeSet( var, VAR_CONSTANT | VAR_HARD ) ;
(void) FuncVariableSubstitute( func, var, value, 1 ) ;
loop->ignore = 1 ;
work++ ;
}
return work ;
}
