void FieldOp( TYPE typ1, TYPE typ2, OPTR op ) {
//================================================
// Generate code for a field selection operator.
typ1 = typ1; op = op;
PushOpn( CITNode->link );
PushOpn( CITNode );
if( CITNode->opn.us & USOPN_FLD ) {
// sub-field reference
EmitOp( FC_ADD );
DumpTypes( FT_INTEGER, TypeSize( FT_INTEGER ),
FT_INTEGER, TypeSize( FT_INTEGER ) );
} else {
EmitOp( FC_FIELD_OP );
OutPtr( CITNode->sym_ptr );
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
if( typ2 == FT_CHAR ) {
if( ( CITNode->link->opn.us & USOPN_WHAT ) != USOPN_ARR ) {
if( ( ( CITNode->link->opn.us & USOPN_WHAT ) != USOPN_NWL ) &&
( ( CITNode->link->opn.us & USOPN_WHAT ) != USOPN_ASS ) ) {
GFieldSCB( CITNode->link->size );
}
EmitOp( FC_MAKE_SCB );
OutPtr( GTempString( 0 ) );
}
}
} else {
OutPtr( CITNode->link->sym_ptr );
}
}
}
void GEndSubScr( itnode *arr ) {
//=================================
// Finish off a subscripting operation.
itnode *arg;
int dim_cnt;
if( arr->opn.us & USOPN_FLD ) {
PushOpn( arr );
EmitOp( FC_FIELD_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.fd.dim_ext->dim_flags );
} else {
EmitOp( FC_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
}
arg = arr->list;
while( dim_cnt-- > 0 ) {
GenType( arg );
arg = arg->link;
}
if( ( arr->opn.us & USOPN_FLD ) == 0 ) {
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
if( arr->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) {
OutPtr( GTempString( 0 ) );
}
}
}
SetOpn( arr, USOPN_SAFE );
}
void GArg( void ) {
//==============
// Generate an argument for subprogram, subscript, or substring.
if( (CITNode->opn.us & USOPN_WHERE) == USOPN_SAFE ) {
if( (CITNode->opn.us & USOPN_FLD) &&
((CITNode->opn.us & USOPN_WHAT) == USOPN_ARR) &&
(CITNode->typ == FT_CHAR) ) {
EmitOp( FC_PASS_FIELD_CHAR_ARRAY );
OutPtr( CITNode->value.st.field_id );
OutPtr( GTempString( 0 ) );
}
return;
}
if( (CITNode->opn.us & USOPN_WHAT) == USOPN_SSR ) {
EmitOp( FC_PUSH_SCB_LEN );
} else if( (CITNode->opn.us & USOPN_WHAT) == USOPN_CON ) {
PushOpn( CITNode );
} else if( (CITNode->opn.us & USOPN_WHAT) == USOPN_ARR ) {
PushOpn( CITNode );
if( CITNode->typ == FT_CHAR ) {
EmitOp( FC_PASS_CHAR_ARRAY );
SymRef( CITNode );
OutPtr( GTempString( 0 ) );
}
} else {
PushOpn( CITNode );
}
}
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 GArrIntlSet( void ) {
//=====================
// Set internal file pointer to array.
EmitOp( FC_ARR_SET_INTL );
OutPtr( CITNode->sym_ptr );
OutPtr( GTempString( 0 ) );
}
void GenChar1Op( itnode *op ) {
//================================
if( ( ( op->opn.us & USOPN_WHAT ) == USOPN_CON ) ) {
OutPtr( op->sym_ptr );
SetOpn( op, USOPN_SAFE );
} else {
OutPtr( NULL );
}
op->opn.us &= ~USOPN_SS1;
}
void GBegCall( itnode *itptr ) {
//=================================
// Initialize for subprogram invocation.
sym_id sp;
obj_ptr curr_obj;
int num_args;
sp = itptr->sym_ptr;
#if _CPU == 386
{
aux_info *aux;
aux = AuxLookupName( sp->u.ns.name, sp->u.ns.u2.name_len );
if( aux != NULL ) {
if( aux->cclass & FAR16_CALL ) {
if( (SubProgId->u.ns.flags & SY_SUBPROG_TYPE) == SY_PROGRAM ) {
ProgramInfo.cclass |= THUNK_PROLOG;
} else {
aux = AuxLookupAdd( SubProgId->u.ns.name, SubProgId->u.ns.u2.name_len );
aux->cclass |= THUNK_PROLOG;
}
}
}
}
#endif
EmitOp( FC_CALL );
OutPtr( itptr->sym_ptr );
curr_obj = ObjTell();
OutU16( 0 );
if( (Options & OPT_DESCRIPTOR) == 0 ) {
if( (sp->u.ns.flags & SY_SUBPROG_TYPE) == SY_FUNCTION ) {
if( (sp->u.ns.flags & SY_INTRINSIC) == 0 ) {
if( sp->u.ns.u1.s.typ == FT_CHAR ) {
OutPtr( GTempString( sp->u.ns.xt.size ) );
}
}
}
}
num_args = DumpArgInfo( itptr->list );
curr_obj = ObjSeek( curr_obj );
OutU16( num_args );
ObjSeek( curr_obj );
if( (sp->u.ns.flags & SY_SUBPROG_TYPE) == SY_FUNCTION ) {
if( sp->u.ns.u1.s.typ == FT_CHAR ) {
if( (Options & OPT_DESCRIPTOR) || (sp->u.ns.flags & SY_INTRINSIC) ) {
OutPtr( GTempString( sp->u.ns.xt.size ) );
}
}
}
}
void SymRef( itnode *itptr ) {
//=======================================
// Generate symbol table address for given symbol.
OutPtr( itptr->sym_ptr );
}
void GForceHiBound( int ss, sym_id sym ) {
//=======================================================
// Generate code to fill in ADV subscript element (hi bound).
// The hi bound is constant and the low bound is not.
// We have to force the filling in of the high bound so that the number of
// of elements gets computed.
//
// Scenario: SUBROUTINE SAM( A, J )
// DIMENSION A(J:3)
//
// GInitADV() fills in the lo bound and # of elements in the dimension at
// compile-time. The lo bound is unknown so the ADV does not contain the
// correct information. The lo bound gets filled in at run-time but
// since the hi bound is not dumped into the ADV at compile time we
// must fill it in at run-time and compute the correct number of elements
// in the dimension.
AddConst( CITNode );
PushOpn( CITNode );
EmitOp( FC_ADV_FILL_HI );
OutPtr( sym );
OutU16( (uint_16)ss );
GenType( CITNode );
}
void GEndDSet( void ) {
//==================
// Terminate set of constants (i.e. Data i,j,k/1,2,3/,m/3/ - 1,2,3 is a set
// and 3 is a set).
OutPtr( NULL );
}
void GSetNameList( FCODE routine ) {
//=====================================
// Pass the address of NAMELIST data for run-time routine.
EmitOp( routine );
OutPtr( CITNode->sym_ptr );
}
void GIOArray( void ) {
//==================
// Generate code to do array i/o.
if( StmtProc == PR_READ ) {
EmitOp( FC_INP_ARRAY );
} else {
EmitOp( FC_PRT_ARRAY );
}
OutPtr( CITNode->sym_ptr );
if( CITNode->opn.us & USOPN_FLD ) {
OutPtr( CITNode->value.st.field_id );
} else {
OutPtr( NULL );
}
}
void GEndBlockData( void ) {
//=======================
// Terminate a block data subprogram.
EmitOp( FC_EPILOGUE );
OutPtr( SubProgId );
}
void GWarp( sym_id sym ) {
//===================================
// Generate warp to code to fill in ADV.
EmitOp( FC_WARP );
OutPtr( sym );
}
void PushConst( intstar4 val ) {
//=================================
// Push an integer constant.
EmitOp( FC_PUSH_CONST );
OutPtr( STConst( &val, FT_INTEGER, TypeSize( FT_INTEGER ) ) );
}
static void DoLoopEnd( void ) {
//===========================
// Generate code for end of DO-loops or implied-DO.
do_entry *doptr;
doptr = CSHead->cs_info.do_parms;
EmitOp( FC_DO_END );
OutPtr( doptr->do_parm );
OutPtr( doptr->increment );
if( doptr->increment == NULL ) {
OutConst32( doptr->incr_value );
} else {
OutPtr( doptr->iteration );
}
OutU16( CSHead->branch );
}
static void SetArgAddrs( void ) {
//=============================
// Assign addresses to dummy argument arguments.
parameter *d_arg;
EmitOp( FC_DARG_INIT );
OutPtr( ArgList->id );
d_arg = ArgList->parms;
while( d_arg != NULL ) {
if( (d_arg->flags & ARG_STMTNO) == 0 ) {
OutPtr( d_arg->id );
}
d_arg = d_arg->link;
}
OutPtr( NULL );
}
void GFmtArrSet( void ) {
//====================
// Called when using
// PRINT <character array>, ...
EmitOp( FC_FMT_ARR_SCAN );
OutPtr( CITNode->sym_ptr );
ChkExtendFmt();
}
void GSFCall( itnode *sfunc ) {
//================================
// Generate a statement function call.
sf_parm *arg;
EmitOp( FC_SF_CALL );
OutPtr( sfunc->sym_ptr );
arg = sfunc->sym_ptr->ns.si.sf.header->parm_list;
while( arg != NULL ) {
OutPtr( arg->shadow );
arg = arg->link;
}
OutPtr( NULL );
if( sfunc->typ == FT_CHAR ) {
OutPtr( GTempString( sfunc->size ) );
}
SetOpn( sfunc, USOPN_SAFE );
}
void GSLoBound( int ss, sym_id sym ) {
//===================================================
// Generate code to fill in ADV subscript element (lo bound).
PushOpn( CITNode );
EmitOp( FC_ADV_FILL_LO );
OutPtr( sym );
OutU16( (uint_16)ss );
GenType( CITNode );
}
void GFmtVarSet( void ) {
//====================
// Called when using
// ASSIGN 10 TO I
// PRINT I, ...
// 10 FORMAT( ... )
EmitOp( FC_FMT_ASSIGN );
OutPtr( CITNode->sym_ptr );
}
void GIOStructArray( void ) {
//========================
// Generate code to do structured array i/o.
if( StmtProc == PR_READ ) {
EmitOp( FC_STRUCT_INP_ARRAY );
} else {
EmitOp( FC_STRUCT_PRT_ARRAY );
}
OutPtr( CITNode->sym_ptr );
}
void GIOStruct( sym_id sd ) {
//==============================
// Generate code to do structure i/o.
PushOpn( CITNode );
if( StmtProc == PR_READ ) {
EmitOp( FC_INPUT_STRUCT );
} else {
EmitOp( FC_OUTPUT_STRUCT );
}
OutPtr( sd ); // structure definition
}
void GDataItem( itnode *rpt ) {
//================================
// Generate a data item.
sym_id data;
intstar4 one;
if( rpt == NULL ) {
one = 1;
data = STConst( &one, FT_INTEGER, TypeSize( FT_INTEGER ) );
} else {
data = rpt->sym_ptr;
}
OutPtr( data );
if( CITNode->typ == FT_HEX ) {
OutU16( PT_NOTYPE );
} else {
GenType( CITNode );
}
OutPtr( CITNode->sym_ptr );
}
void GSHiBoundLo1( int ss, sym_id sym ) {
//======================================================
// Generate code to fill in ADV subscript element (hi bound).
// Set the low bound to 1.
// push high bound value
PushOpn( CITNode );
EmitOp( FC_ADV_FILL_HI_LO_1 );
// general information
OutPtr( sym );
OutU16( (uint_16)ss );
GenType( CITNode );
}
void GEpilog( void ) {
//=================
// Generate a subprogram epilogue.
if( (SubProgId->u.ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE ) {
GNullRetIdx();
}
if( EpilogLabel != 0 ) {
GLabel( EpilogLabel );
FreeLabel( EpilogLabel );
}
EmitOp( FC_EPILOGUE );
OutPtr( SubProgId );
}
static void DataDo( TYPE do_type ) {
//=====================================
// Process an implied-DO for DATA statements.
sym_id do_var;
do_type = do_type;
do_var = CITNode->sym_ptr;
AdvanceITPtr();
DoExpr(); // process e1
if( ReqComma() ) {
DoExpr(); // process e2
if( RecComma() ) {
DoExpr(); // process e3
} else {
PushConst( 1 ); // indicate unit incrementation
}
}
EmitOp( FC_DATA_DO_LOOP );
OutPtr( do_var );
}
OutPtr OutNew(SymbolPtr msg, AtomCount argc, AtomPtr argv)
{
OutPtr self;
TTValue sr(sys_getsr());
long attrstart = attr_args_offset(argc, argv); // support normal arguments
//short i;
TTValue v;
TTErr err;
self = OutPtr(object_alloc(sOutClass));
if (self) {
self->maxNumChannels = 2; // An initial argument to this object will set the maximum number of channels
if(attrstart && argv)
self->maxNumChannels = atom_getlong(argv);
ttEnvironment->setAttributeValue(kTTSym_sampleRate, sr);
// setup the output_buffer according to channnel number
self->output_buffer = (t_atom *)malloc(self->maxNumChannels * sizeof(t_atom));
v.setSize(2);
v.set(0, TT("thru"));
v.set(1, 1); // arg is the number of inlets
err = TTObjectBaseInstantiate(TT("audio.object"), (TTObjectBasePtr*)&self->audioGraphObject, v);
//self->audioGraphObject->getUnitGenerator()->setAttributeValue(TT("linearGain"), 1.0);
attr_args_process(self, argc, argv);
object_obex_store((void*)self, _sym_dumpout, (object*)outlet_new(self, NULL)); // dumpout
self->s_out = listout((t_pxobject *)self); // the list outlet
dsp_setup((t_pxobject*)self, 1);
self->clock = clock_new(self, (method)OutTick);
self->qelem = qelem_new(self, (method)OutQFn);
self->obj.z_misc = Z_NO_INPLACE | Z_PUT_LAST;
}
return self;
}
void PushSym( sym_id sym ) {
//=============================
EmitOp( FC_PUSH );
OutPtr( sym );
}
static void DoLoop( TYPE do_type ) {
//=====================================
// Generate code for DO statement or implied-DO.
do_entry *doptr;
uint do_size;
intstar4 incr;
intstar4 limit;
sym_id loop_ctrl;
TYPE e1_type;
uint e1_size;
itnode *e2_node;
itnode *e3_node;
bool e2_const;
doptr = CSHead->cs_info.do_parms;
do_size = CITNode->sym_ptr->u.ns.xt.size;
doptr->do_parm = CITNode->sym_ptr; // save ptr to do variable
AdvanceITPtr(); // bump past the '='
EatDoParm(); // process e1
PushOpn( CITNode );
e1_type = CITNode->typ;
e1_size = CITNode->size;
AdvanceITPtr();
if( ReqComma() ) {
EatDoParm(); // process e2
e2_const = CITNode->opn.us == USOPN_CON;
PushOpn( CITNode );
e2_node = CITNode;
AdvanceITPtr();
e3_node = NULL;
if( RecComma() ) {
EatDoParm(); // process e3
e3_node = CITNode;
if( !AError ) {
if( (CITNode->opn.us == USOPN_CON) && _IsTypeInteger( do_type ) ) {
incr = GetIntValue( CITNode );
doptr->incr_value = incr;
doptr->increment = NULL;
if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
if( e2_const ) {
limit = GetIntValue( e2_node );
if( NeedIncrement( limit, incr, do_type ) ) {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
} else {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
} else {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
AdvanceITPtr();
}
} else {
if( _IsTypeInteger( do_type ) ) {
doptr->increment = NULL;
doptr->incr_value = 1;
if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
if( e2_const ) {
limit = GetIntValue( e2_node );
if( NeedIncrement( limit, 1, do_type ) ) {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
} else {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
} else {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
EmitOp( FC_DO_BEGIN );
OutPtr( doptr->do_parm );
OutPtr( doptr->increment );
if( doptr->increment == NULL ) { // INTEGER do-loop with constant incr
loop_ctrl = StaticAlloc( do_size, do_type );
OutConst32( doptr->incr_value );
OutPtr( loop_ctrl );
} else {
if( _IsTypeInteger( do_type ) ) {
loop_ctrl = StaticAlloc( do_size, do_type );
} else {
loop_ctrl = StaticAlloc( sizeof( intstar4 ), FT_INTEGER );
}
doptr->iteration = loop_ctrl;
OutPtr( loop_ctrl );
if( e3_node == NULL ) {
DumpType( FT_INTEGER, TypeSize( FT_INTEGER ) );
} else {
GenType( e3_node );
}
}
GenType( e2_node );
DumpType( e1_type, e1_size );
OutU16( CSHead->branch );
OutU16( CSHead->bottom );
}
}
