fcio.c

来自「开放源码的编译器open watcom 1.6.0版的源代码」· C语言 代码 · 共 1,296 行 · 第 1/2 页

        &FCOutINT4,
        &FCOutREAL,
        &FCOutDBLE,
        &FCOutXTND,
        &FCOutCPLX,
        &FCOutDBCX,
        &FCOutXTCX,
        &OutString
};

static  void            (*InpRtn[])(void) = {
        NULL,
        &FCInpLOG1,
        &FCInpLOG4,
        &FCInpINT1,
        &FCInpINT2,
        &FCInpINT4,
        &FCInpREAL,
        &FCInpDBLE,
        &FCInpXTND,
        &FCInpCPLX,
        &FCInpDBCX,
        &FCInpXTCX,
        &InpString
};


void    FCOutStruct( void ) {
//=====================

// Output a structure.

    IORtnTable = OutRtn;
    TmpStructPtr = MkTmp( XPop(), T_POINTER );
    StructIO( ((sym_id)GetPtr())->sd.fl.fields );
}


static  void    DoStructArrayIO( tmp_handle num_elts, struct field *fieldz ) {
//============================================================================

// Perform structure array i/o.

    label_handle        label;

    label = BENewLabel();
    CGControl( O_LABEL, NULL, label );
    StructIO( fieldz );
    CGControl( O_IF_TRUE,
               CGCompare( O_NE,
                          CGAssign( TmpPtr( num_elts, T_INT_4 ),
                                    CGBinary( O_MINUS,
                                              TmpVal( num_elts, T_INT_4 ),
                                              CGInteger( 1, T_INTEGER ),
                                              T_INT_4 ),
                                    T_INT_4 ),
                          CGInteger( 0, T_INTEGER ), T_INT_4 ),
               label );
    BEFiniLabel( label );
}


static  void    StructIOArrayStruct( sym_id arr ) {
//=================================================

// Perform structure array i/o on a field.

    tmp_handle          num_elts;

    num_elts = MkTmp( FieldArrayNumElts( arr ), T_INT_4 );
    DoStructArrayIO( num_elts, arr->fd.xt.record->fl.fields );
}


static  void    StructIOItem( sym_id fd ) {
//=========================================

// Perform i/o of structure field.

    RTCODE      rtn;

    if( fd->fd.dim_ext == NULL ) {
        XPush( TmpVal( TmpStructPtr, T_POINTER ) );
        if( fd->fd.typ == TY_CHAR ) {
            XPush( CGInteger( fd->fd.xt.size, T_INTEGER ) );
        }
        IORtnTable[ ParmType( fd->fd.typ, fd->fd.xt.size ) ]();
        CGTrash( CGAssign( TmpPtr( TmpStructPtr, T_POINTER ),
                           CGBinary( O_PLUS,
                                     TmpVal( TmpStructPtr, T_POINTER ),
                                     CGInteger( fd->fd.xt.size, T_UINT_4 ),
                                     T_POINTER ),
                           T_POINTER ) );
    } else {
        if( IORtnTable == &OutRtn ) {
            rtn = RT_PRT_ARRAY;
        } else {
            rtn = RT_INP_ARRAY;
        }
        if( fd->fd.typ == TY_CHAR ) {
            ChrArrayIO( rtn + 1, TmpVal( TmpStructPtr, T_POINTER ),
                        CGInteger( fd->fd.dim_ext->num_elts, T_INT_4 ),
                        CGInteger( fd->fd.xt.size, T_INTEGER ) );
        } else {
            NumArrayIO( rtn, TmpVal( TmpStructPtr, T_POINTER ),
                        CGInteger( fd->fd.dim_ext->num_elts, T_INT_4 ),
                        ParmType( fd->fd.typ, fd->fd.xt.size ) );
        }
        CGTrash( CGAssign( TmpPtr( TmpStructPtr, T_POINTER ),
                           CGBinary( O_PLUS,
                                     TmpVal( TmpStructPtr, T_POINTER ),
                                     CGInteger( fd->fd.xt.size *
                                                fd->fd.dim_ext->num_elts,
                                                T_UINT_4 ),
                                     T_POINTER ),
                           T_POINTER ) );
    }
}


static  void    StructArrayIO( void ) {
//===============================

// Perform structure array i/o.

    sym_id              arr;
    tmp_handle          num_elts;

    arr = GetPtr();
    num_elts = MkTmp( ArrayNumElts( arr ), T_INT_4 );
    TmpStructPtr = MkTmp( SymAddr( arr ), T_POINTER );
    DoStructArrayIO( num_elts, arr->ns.xt.record->fl.fields );
}


void    FCPrtStructArray( void ) {
//==========================

    IORtnTable = OutRtn;
    StructArrayIO();
}


void    FCInpStructArray( void ) {
//==========================

    IORtnTable = InpRtn;
    StructArrayIO();
}


void    FCInpStruct( void ) {
//=====================

// Input a structure.

    IORtnTable = InpRtn;
    TmpStructPtr = MkTmp( XPop(), T_POINTER );
    StructIO( ((sym_id)GetPtr())->sd.fl.fields );
}


void    FCChkIOStmtLabel( void ) {
//==========================

    if( EndEqStmt != NULL ) {
        RefStmtLabel( EndEqStmt );
    }
    if( ErrEqStmt != NULL ) {
        RefStmtLabel( ErrEqStmt );
    }
}


void    FCSetNml( void ) {
//==================

// Set NAMELIST format.

    call_handle handle;
    sym_id      nl;
    grp_entry   *ge;

    NmlSpecified = TRUE;
    handle = InitCall( RT_SET_NML );
    nl = GetPtr();
    ReverseList( &nl->nl.group_list );
    ge = nl->nl.group_list;
    while( ge != NULL ) {
        CGAddParm( handle, SymAddr( ge->sym ), T_POINTER );
        ge = ge->link;
    }
    ReverseList( &nl->nl.group_list );
    CGAddParm( handle, CGBackName( nl->nl.address, T_POINTER ), T_POINTER );
    CGDone( CGCall( handle ) );
}


void    FCSetFmt( void ) {
//==================

// Set format string from FORMAT statement.

    call_handle handle;

    handle = InitCall( RT_SET_FMT );
    CGAddParm( handle, CGBackName( GetStmtLabel( GetPtr() ), T_POINTER ),
               T_POINTER );
    CGDone( CGCall( handle ) );
}


void    FCPassLabel( void ) {
//=====================

// Pass label to run-time routine.

    call_handle handle;

    handle = InitCall( GetU16() );
    CGAddParm( handle, CGBackName( GetLabel( GetU16() ), T_POINTER ),
               T_POINTER );
    CGDone( CGCall( handle ) );
}


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() ), T_POINTER ),
               T_POINTER );
    CGDone( CGCall( handle ) );
}


void    ArrayIO( RTCODE num_array, RTCODE chr_array ) {
//=====================================================

// Output an array.

    sym_id      arr;
    sym_id      field;
    cg_name     addr;
    cg_name     num_elts;
    cg_name     elt_size;

    arr = GetPtr();
    field = GetPtr();
    if( field == NULL ) {
        addr = SymAddr( arr );
        num_elts = ArrayNumElts( arr );
        if( arr->ns.typ == TY_CHAR ) {
            ChrArrayIO( chr_array, addr, num_elts, ArrayEltSize( arr ) );
        } else {
            NumArrayIO( num_array, addr, num_elts,
                        ParmType( arr->ns.typ, arr->ns.xt.size ) );
        }
    } else { // must be a array field in a structure
        addr = XPop();
        num_elts = FieldArrayNumElts( field );
        if( field->fd.typ == TY_CHAR ) {
            elt_size = CGInteger( field->fd.xt.size, T_INTEGER );
            ChrArrayIO( chr_array, addr, num_elts, elt_size );
        } else {
            NumArrayIO( num_array, addr, num_elts,
                        ParmType( field->fd.typ, field->fd.xt.size ) );
        }
    }
}


void    FCPrtArray( void ) {
//====================

// Output an array.

    ArrayIO( RT_PRT_ARRAY, RT_PRT_CHAR_ARRAY );
}


void    FCInpArray( void ) {
//====================

// Input an array.

    ArrayIO( RT_INP_ARRAY, RT_INP_CHAR_ARRAY );
}


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(), T_UNSIGNED ), T_UNSIGNED );
    CGAddParm( handle, XPop(), T_POINTER );
    CGDone( CGCall( handle ) );
}


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(), T_UNSIGNED ), T_UNSIGNED );
    CGAddParm( handle, ArrayEltSize( sym ), T_UNSIGNED );
    CGAddParm( handle, ArrayNumElts( sym ), T_INT_4 );
    CGAddParm( handle, SymAddr( sym ), T_POINTER );
    CGDone( CGCall( handle ) );
}


void    FCIntlArrSet( void ) {
//======================

// Call runtime routine to set internal file to character array.

    call_handle handle;
    sym_id      sym;
    sym_id      scb;

    sym = GetPtr();
    scb = GetPtr();
    CGTrash( CGAssign( SCBLenAddr( CGFEName( scb, T_POINTER ) ),
                       ArrayEltSize( sym ), T_INTEGER ) );
    CGTrash( CGAssign( SCBPtrAddr( CGFEName( scb, T_POINTER ) ),
                       SymAddr( sym ), T_POINTER ) );
    handle = InitCall( RT_SET_INTL );
    CGAddParm( handle, ArrayNumElts( sym ), T_INT_4 );
    CGAddParm( handle, CGFEName( scb, T_POINTER ), T_POINTER );
    CGDone( CGCall( handle ) );
}


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, T_INT_4 ), T_INT_4 );
    CGAddParm( handle, XPop(), T_POINTER );
    CGDone( CGCall( handle ) );
}


void    FCSetFile( void ) {
//===================

// Set FILE=.

    IOCall( RT_SET_FILE );
}


void    FCSetCCtrl( void ) {
//====================

// Set CARRIAGECONTROL=.

    IOCall( RT_SET_CCTRL );
}


void    FCSetShare( void ) {
//====================

// Set SHARE=.

    IOCall( RT_SET_SHARE );
}


void    FCSetRecType( void ) {
//======================

// Set RECORDTYPE=.

    IOCall( RT_SET_RECTYPE );
}


void    FCSetAction( void ) {
//=====================

// Set ACTION=.

    IOCall( RT_SET_ACTION );
}


void    FCSetErr( void ) {
//==================

// Set ERROR=.

    sym_id      sn;

    CGDone( CGCall( InitCall( RT_SET_ERR ) ) );
    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.
    ErrEqStmt = sn;
    ErrEqLabel = sn->st.address;
}


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


void    FCSetAtEnd( void ) {
//====================

// Set END= for ATEND statement.

    CGDone( CGCall( InitCall( RT_SET_END ) ) );
    EndEqLabel = GetU16();
}


void    FCSetRec( void ) {
//==================

// Set REC=.

    IOCallValue( RT_SET_REC );
}


void    FCSetIOS( void ) {
//==================

// Set IOSTAT=.

    IOCall( RT_SET_IOS );
    IOStatSpecified = TRUE;
}


void    FCSetAcc( void ) {
//==================

// Set ACCESS=.

    IOCall( RT_SET_ACC );
}


void    FCSetBlnk( void ) {
//===================

// Set BLANK=.

    IOCall( RT_SET_BLNK );
}


void    FCSetForm( void ) {
//===================

// Set FORM=.

    IOCall( RT_SET_FORM );
}


void    FCInqBlockSize( void ) {
//========================

// Set BLOCKSIZE= for INQUIRE statement.

    IOCall( RT_INQ_BLOCKSIZE );
}


void    FCSetLen( void ) {
//==================

// Set RECL= for INQUIRE statement.

    IOCall( RT_SET_LEN );
}


void    FCSetStat( void ) {
//===================

// Set STATUS=.

    IOCall( RT_SET_STAT );
}


void    FCSetDir( void ) {
//==================

// Set DIRECT=.

    IOCall( RT_SET_DIR );
}


void    FCSetFmtd( void ) {
//===================

// Set FORMATTED=.

    IOCall( RT_SET_FMTD );
}


void    FCSetName( void ) {
//===================

// Set NAME=.

    IOCall( RT_SET_NAME );
}


void    FCSetSeq( void ) {
//==================

// Set SEQUENTIAL=.

    IOCall( RT_SET_SEQ );
}


void    FCSetUFmtd( void ) {
//====================

// Set UNFORMATTED=.

    IOCall( RT_SET_UFMTD );
}


void    FCSetExst( void ) {
//===================

// Set EXIST=.

    IOCall( RT_SET_EXST );
}


void    FCSetNmd( void ) {
//==================

// Set NAMED=.

    IOCall( RT_SET_NMD );
}


void    FCSetNRec( void ) {
//===================

// Set NEXTREC=.

    IOCall( RT_SET_NREC );
}


void    FCSetNumb( void ) {
//===================

// Set NUMBER=.

    IOCall( RT_SET_NUMB );
}


void    FCSetOpen( void ) {
//===================

// Set OPENED=.

    IOCall( RT_SET_OPEN );
}


void    FCSetBlockSize( void ) {
//========================

// Set BLOCKSIZE= for OPEN statement.

    IOCallValue( RT_SET_BLOCKSIZE );
}


void    FCSetRecl( void ) {
//===================

// Set RECL= for OPEN statement.

    IOCallValue( RT_SET_RECL );
}


void    FCSetNoFmt( void ) {
//====================

// Set "not formatted i/o".

    CGDone( CGCall( InitCall( RT_SET_NOFMT ) ) );
}