Пример #1
0
void CgExprDtored(              // DTOR CG EXPRESSION
    cg_name expr,               // - expression
    cg_type type,               // - expression type
    DGRP_FLAGS pop_type,        // - type of popping destruction
    FN_CTL* fctl )              // - function control
{
#if 0
    cg_type type;               // - expression type

    switch( CgExprStackSize() ) {
      case 0 :
        break;
      case 1 :
      { boolean temp_dtoring = fctl->temp_dtoring;
        SYMBOL temp = getExprTempSym( &type, fctl, pop_type );
        if( temp_dtoring ) {
            if( fctl->ctor_test ) {
                pop_type |= DGRP_CTOR;
            }
            CgDestructExprTemps( pop_type, fctl );
            if( NULL != temp ) {
                CgExprPush( CgFetchSym( temp ), type );
            }
        }
      } break;
      DbgDefault( "CgExprDtored -- too many temps" );
    }
#else
    SYMBOL temp;                // - NULL or copied temp

    DbgVerify( 0 == CgExprStackSize(), "CgExprDtored -- more than one expr" );
    if( expr != NULL ) {
        if( pop_type & DGRP_DONE ) {
            CGDone( expr );
            temp = NULL;
        } else if( pop_type & DGRP_TRASH ) {
            CGTrash( expr );
            temp = NULL;
        } else if( fctl->temp_dtoring ) {
            temp = CgVarTempTyped( type );
            CGDone( CGLVAssign( CgSymbol( temp ), expr, type ) );
        } else {
            CgExprPush( expr, type );
            temp = NULL;
        }
        if( fctl->temp_dtoring ) {
            fctl->temp_dtoring = FALSE;
            if( fctl->ctor_test ) {
                pop_type |= DGRP_CTOR;
            }
            CgDestructExprTemps( pop_type, fctl );
            if( NULL != temp ) {
                CgExprPush( CgFetchSym( temp ), type );
            }
        }
    }
#endif
}
Пример #2
0
void    FCAdvFillHi( void ) {
//=====================

// Fill hi bound of a dimension (actually computes # of elements in dimension).

    sym_id              arr;
    act_dim_list        *dim_ptr;
    uint                lo_size;
    uint                hi_size;
    int                 hi_offset;
    int                 ss;
    cg_name             num_elts;
    cg_name             hi;
    cg_name             adv;
    call_handle         call;

    arr = GetPtr();
    dim_ptr = arr->u.ns.si.va.u.dim_ext;
    adv = GetAdv( arr );
    hi_size = BETypeLength( TY_ADV_HI );
    lo_size = BETypeLength( TY_ADV_LO );
    ss = GetU16();
    hi = GetTypedValue();
    if( CGOpts & CGOPT_DI_CV ) {
        hi_offset = _DimCount( dim_ptr->dim_flags ) * BETypeLength( TY_ADV_ENTRY );
        if( Options & OPT_BOUNDS ) {
            hi_offset += BETypeLength( TY_POINTER );
        }
        hi_offset += (ss - 1) * (lo_size + BETypeLength( TY_ADV_HI_CV )) + lo_size;
        hi = CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI_CV );
        adv = GetAdv( arr );
    }
    if( Options & OPT_BOUNDS ) {
        call = InitCall( RT_ADV_FILL_HI );
        CGAddParm( call, hi, TY_INT_4 );
        CGAddParm( call, CGInteger( ss, TY_UNSIGNED ), TY_UNSIGNED );
        CGAddParm( call, adv, TY_LOCAL_POINTER );
        CGDone( CGUnary( O_POINTS, CGCall( call ), TY_INT_4 ) );
    } else {
        hi_offset = (ss - 1) * ( lo_size + hi_size ) + lo_size;
        num_elts = CGBinary( O_PLUS, hi,
                             CGBinary( O_MINUS, CGInteger( 1, TY_INTEGER ),
                                       LoBound( arr, ss - 1 ),
                                       TY_ADV_HI ),
                             TY_ADV_HI );
        CGDone( CGAssign( StructRef( adv, hi_offset ), num_elts, TY_ADV_HI ) );
    }
}
Пример #3
0
void            FCDeAllocate( void ) {
//==============================

    call_handle         handle;
    sym_id              arr;
    uint                num;

    num = 0;
    handle = InitCall( RT_DEALLOCATE );
    for(;;) {
        arr = GetPtr();
        if( arr == NULL ) break;
        CGAddParm( handle, CGFEName( arr, T_POINTER ), T_POINTER );
        CGAddParm( handle, getFlags( arr ), FLAG_PARM_TYPE );
        ++num;
    }
    CGAddParm( handle, CGInteger( num, T_INTEGER ), T_INTEGER );
    if( GetU16() & ALLOC_STAT ) {
        FCodeSequence();
        CGAddParm( handle, XPop(), T_POINTER );
    } else {
        CGAddParm( handle, CGInteger( 0, T_POINTER ), T_POINTER );
    }
    CGDone( CGCall( handle ) );
}
Пример #4
0
void    FCDone( void ) {
//======================

// Process end of an expression.

    CGDone( XPop() );
}
Пример #5
0
void    FCCmplxDone( void ) {
//===========================

// Process end of a complex expression.

    CGDone( CGBinary( O_COMMA, XPop(), XPop(), TY_DEFAULT ) );
}
Пример #6
0
void    FCSetNoFmt( void ) {
//====================

// Set "not formatted i/o".

    CGDone( CGCall( InitCall( RT_SET_NOFMT ) ) );
}
Пример #7
0
static  void    ChkIOErr( cg_name io_stat ) {
//===========================================

// Check for i/o errors.

    label_handle        eq_label;

    io_stat = CGUnary( O_POINTS, io_stat, TY_INTEGER );
    if( ( EndEqLabel != 0 ) && ( ErrEqLabel != 0 ) ) {
        eq_label = BENewLabel();
        CG3WayControl( io_stat, GetLabel( EndEqLabel ), eq_label,
                       GetLabel( ErrEqLabel ) );
        CGControl( O_LABEL, NULL, eq_label );
        BEFiniLabel( eq_label );
    } else if( EndEqLabel != 0 ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_LT, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   GetLabel( EndEqLabel ) );
    } else if( ErrEqLabel != 0 ) {
        CGControl( O_IF_TRUE,
                   CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   GetLabel( ErrEqLabel ) );
    } else if( IOStatSpecified ) {
        IOSLabel = BENewLabel();
        CGControl( O_IF_TRUE,
                   CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
                              TY_INTEGER ),
                   IOSLabel );
    } else {
        CGDone( io_stat );
    }
}
Пример #8
0
void    FCSetAtEnd( void ) {
//====================

// Set END= for ATEND statement.

    CGDone( CGCall( InitCall( RT_SET_END ) ) );
    EndEqLabel = GetU16();
}
Пример #9
0
static  void    IOString( RTCODE rtn ) {
//======================================

    call_handle handle;

    handle = InitCall( rtn );
    CGAddParm( handle, XPop(), TY_INTEGER );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #10
0
void    FCSetFmt( void ) {
//==================

// Set format string from FORMAT statement.

    call_handle handle;

    handle = InitCall( RT_SET_FMT );
    CGAddParm( handle, CGBackName( (back_handle)GetStmtLabel( GetPtr() ), TY_POINTER ), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #11
0
void    FCAssign( void ) {
//==================

// Process ASSIGN statement.

    sym_id      stmt;

    stmt = GetPtr();
    if( stmt->u.st.flags & SN_FORMAT ) {
        CGDone( CGAssign( SymAddr( GetPtr() ),
                          CGBackName( GetFmtLabel( stmt->u.st.address ),
                                      TY_LOCAL_POINTER ),
                          TY_LOCAL_POINTER ) );
    } else {
        CGDone( CGAssign( SymAddr( GetPtr() ),
                          CGInteger( stmt->u.st.address, TY_INTEGER ),
                          TY_INTEGER ) );
        RefStmtLabel( stmt );
    }
}
Пример #12
0
static  void    IOCallValue( RTCODE rtn ) {
//=========================================

// Call i/o run-time routine with one argument.

    call_handle handle;

    handle = InitCall( rtn );
    CGAddParm( handle, GetTypedValue(), TY_INT_4 );
    CGDone( CGCall( handle ) );
}
Пример #13
0
static  void    IOCall( RTCODE rtn ) {
//====================================

// Call i/o run-time routine with one argument.

    call_handle handle;

    handle = InitCall( rtn );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #14
0
void    FCOutCHAR( void ) {
//===================

// Call runtime routine to output CHARACTER*n value.

    call_handle handle;

    handle = InitCall( RT_OUT_CHAR );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #15
0
void    FCPassLabel( void ) {
//=====================

// Pass label to run-time routine.

    call_handle handle;

    handle = InitCall( GetU16() );
    CGAddParm( handle, CGBackName( (back_handle)GetLabel( GetU16() ), TY_POINTER ), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #16
0
static  void    Input( RTCODE rtn ) {
//===================================

// Common input routine.

    call_handle handle;

    handle = InitCall( rtn );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #17
0
static  void    Output( RTCODE rtn, cg_type arg_type ) {
//======================================================

// Call runtime routine to output elemental types value.

    call_handle handle;

    handle = InitCall( rtn );
    CGAddParm( handle, XPopValue( arg_type ), PromoteToBaseType( arg_type ) );
    CGDone( CGCall( handle ) );
}
Пример #18
0
void    FCAdvFillHiLo1( void ) {
//========================

// Fill hi and lo=1 bound of a dimension.

    sym_id              arr;
    cg_name             lo;
    cg_name             hi;
    cg_name             adv;
    unsigned            ss;
    uint                lo_size;
    uint                hi_size;
    int                 lo_offset;
    int                 hi_offset;
    call_handle         call;

    // Get general information
    arr = GetPtr();
    ss = GetU16();

    adv = GetAdv( arr );
    hi_size = BETypeLength( TY_ADV_HI );
    lo_size = BETypeLength( TY_ADV_LO );
    hi = GetTypedValue();

    if( Options & OPT_BOUNDS ) {
        call = InitCall( RT_ADV_FILL_HI_LO1 );
        CGAddParm( call, hi, TY_INT_4 );
        CGAddParm( call, CGInteger( ss, TY_UNSIGNED ), TY_UNSIGNED );
        CGAddParm( call, adv, TY_LOCAL_POINTER );
        CGDone( CGUnary( O_POINTS, CGCall( call ), TY_INT_4 ) );
    } else {
        hi_offset = (ss - 1) * ( lo_size + hi_size ) + lo_size;
        CGDone( CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI ) );
        // set lo bound of the adv
        lo = CGInteger( 1, TY_INT_4 );
        lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY );
        adv = GetAdv( arr );
        CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) );
    }
}
Пример #19
0
void    FCSetIntl( void ) {
//===================

// Call runtime routine to set internal file to character item (not array).

    call_handle handle;

    handle = InitCall( RT_SET_INTL );
    CGAddParm( handle, CGInteger( 1, TY_INT_4 ), TY_INT_4 );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #20
0
static  void    NumArrayIO( RTCODE rtn, cg_name arr, cg_name num_elts,
                            uint typ ) {
//====================================================================

    call_handle call;

    call = InitCall( rtn );
    CGAddParm( call, CGInteger( typ, TY_INTEGER ), TY_INTEGER );
    CGAddParm( call, num_elts, TY_INT_4 );
    CGAddParm( call, arr, TY_POINTER );
    CGDone( CGCall( call ) );
}
Пример #21
0
static  void    ChrArrayIO( RTCODE rtn, cg_name arr, cg_name num_elts,
                            cg_name elt_size ) {
//====================================================================

    call_handle call;

    call = InitCall( rtn );
    CGAddParm( call, elt_size, TY_INTEGER );
    CGAddParm( call, num_elts, TY_INT_4 );
    CGAddParm( call, arr, TY_POINTER );
    CGDone( CGCall( call ) );
}
Пример #22
0
void    FCEndIO( void ) {
//=================

// Call runtime routine to terminate i/o processing.

    CGDone( CGCall( InitCall( RT_ENDIO ) ) );
    FCChkIOStmtLabel();
    if( ( ErrEqLabel == 0 ) && ( EndEqLabel == 0 ) && IOStatSpecified ) {
        CGControl( O_LABEL, NULL, IOSLabel );
        BEFiniLabel( IOSLabel );
    }
}
Пример #23
0
void    FCFmtScan( void ) {
//===================

// Call runtime routine to scan a format specification from a character
// expression.

    call_handle handle;

    handle = InitCall( RT_FMT_SCAN );
    CGAddParm( handle, CGInteger( GetU16(), TY_UNSIGNED ), TY_UNSIGNED );
    CGAddParm( handle, XPop(), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #24
0
static SYMBOL getExprTempSym(   // EMIT CGDone, CGTrash, OR COPY TO TEMP
    cg_name expr,               // - expression
    cg_type type,               // - type of expression
    FN_CTL* fctl,               // - function control
    DGRP_FLAGS pop_type )       // - type of popping destruction
{
    SYMBOL temp;                // - NULL or copied temp

    if( pop_type & DGRP_DONE ) {
        CGDone( expr );
        temp = NULL;
    } else if( pop_type & DGRP_TRASH ) {
        CGTrash( expr );
        temp = NULL;
    } else if( fctl->temp_dtoring ) {
        temp = CgVarTemp( BETypeLength( type ) );
        CGDone( CGLVAssign( CgSymbol( temp ), expr, type ) );
    } else {
        temp = NULL;
    }
    fctl->temp_dtoring = FALSE;
    return temp;
}
Пример #25
0
void    FCFmtAssign( void ) {
//=====================

// Set FORMAT string for:
//       ASSIGN 10 TO I
//       PRINT I, ...
// 10    FORMAT( ... )

    call_handle handle;

    handle = InitCall( RT_SET_FMT );
    CGAddParm( handle, CGUnary( O_POINTS, SymAddr( GetPtr() ), TY_POINTER ), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #26
0
void    FCSetLine( void ) {
//===================

// Generate run-time call to ISN routine.

    call_handle handle;
    unsigned_16 line_num;

    line_num = GetU16();
    if( ( SubProgId->ns.flags & SY_SUBPROG_TYPE ) == SY_BLOCK_DATA ) return;
    handle = InitCall( RT_SET_LINE );
    CGAddParm( handle, CGInteger( line_num, TY_INTEGER ), TY_INTEGER );
    CGDone( CGCall( handle ) );
}
Пример #27
0
static  void    OutCplx( RTCODE rtn, cg_type typ ) {
//===============================================

// Call runtime routine to input COMPLEX value.

    call_handle handle;
    cg_cmplx    z;

    handle = InitCall( rtn );
    XPopCmplx( &z, typ );
    typ = CmplxBaseType( typ );
    CGAddParm( handle, z.imagpart, typ );
    CGAddParm( handle, z.realpart, typ );
    CGDone( CGCall( handle ) );
}
Пример #28
0
void    FCSetEnd( void ) {
//==================

// Set END=.

    sym_id      sn;

    CGDone( CGCall( InitCall( RT_SET_END ) ) );
    sn = GetPtr();
    // Don't call RefStmtLabel() for 'sn' yet since we will be referencing
    // the label for error checking after an i/o operation. RefStmtLabel()
    // may call DoneLabel() if this is the last reference to the statement
    // label.
    EndEqStmt = sn;
    EndEqLabel = sn->st.address;
}
Пример #29
0
void    FCFmtArrScan( void ) {
//======================

// Call runtime routine to scan a format specification from a character
// array.

    call_handle handle;
    sym_id      sym;

    sym = GetPtr();
    handle = InitCall( RT_FMT_ARR_SCAN );
    CGAddParm( handle, CGInteger( GetU16(), TY_UNSIGNED ), TY_UNSIGNED );
    CGAddParm( handle, ArrayEltSize( sym ), TY_UNSIGNED );
    CGAddParm( handle, ArrayNumElts( sym ), TY_INT_4 );
    CGAddParm( handle, SymAddr( sym ), TY_POINTER );
    CGDone( CGCall( handle ) );
}
Пример #30
0
void    FCAdvFillLo( void ) {
//=====================

// Fill lo bound of a dimension.

    sym_id              arr;
    int                 lo_offset;
    cg_name             adv;
    cg_name             lo;
    unsigned            ss;

    arr = GetPtr();
    adv = GetAdv( arr );
    ss = GetU16();
    lo = GetTypedValue();
    lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY );
    CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) );
}