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 ); } }