nmlio.c

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

            case PT_LOG_4:
                IORslt.logstar4 = **(logstar4 PGM * PGM *)nml;
                break;
            case PT_INT_1:
                IORslt.intstar4 = **(intstar1 PGM * PGM *)nml;
                break;
            case PT_INT_2:
                IORslt.intstar4 = **(intstar2 PGM * PGM *)nml;
                break;
            case PT_INT_4:
                IORslt.intstar4 = **(intstar4 PGM * PGM *)nml;
                break;
            case PT_REAL_4:
                IORslt.single = **(single PGM * PGM *)nml;
                break;
            case PT_REAL_8:
                IORslt.dble = **(double PGM * PGM *)nml;
                break;
            case PT_REAL_16:
                IORslt.extended = **(extended PGM * PGM *)nml;
                break;
            case PT_CPLX_8:
                IORslt.complex = **(complex PGM * PGM *)nml;
                break;
            case PT_CPLX_16:
                IORslt.dcomplex = **(dcomplex PGM * PGM *)nml;
                break;
            case PT_CPLX_32:
                IORslt.xcomplex = **(xcomplex PGM * PGM *)nml;
                break;
            case PT_CHAR:
                IORslt.string = **(string PGM * PGM *)nml;
                break;
            }
            OutRtn[ typ ]();
        }
        nml += sizeof( void PGM * );
        SendEOR();
    }
    SendWSLStr( " &END" );
    SendEOR();
}


static  byte PGM *FindNmlEntry( char *name, uint len ) {
//======================================================

// Scan NAMELIST information for given NAMELIST entry.

    uint        nml_len;
    byte PGM    *nml;
    byte        info;

    nml = (char PGM *)(IOCB->fmtptr);
    nml_len = *nml;
    nml += sizeof( byte ) + nml_len;
    for(;;) {
        nml_len = *nml;
        if( nml_len == 0 ) return( NULL );
        ++nml;
        if( nml_len == len ) {
            if( pgm_memicmp( nml, name, len ) == 0 ) {
                return( nml + len );
            }
        }
        nml += nml_len;
        info = *nml;
        ++nml;
        if( _GetNMLSubScrs( info ) && ( info & NML_LG_ADV ) == 0 ) {
            nml += sizeof( unsigned_32 ) + _GetNMLSubScrs( info ) *
                                    ( sizeof( unsigned_32 ) + sizeof( int ) );
            if( _GetNMLType( info ) == PT_CHAR ) {
                nml += sizeof( int );
            }
        }
        nml += sizeof( byte PGM * );
    }
}


static  io_type_rtn     NmlIOType;

static PTYPE    NmlIOType( void ) {
//===========================

// Get the type of an input item.

    uint        save_col;
    uint        len;
    char        *ptr;

    // when collecting constants, make sure we haven't encountered the
    // next name in the NAMELIST as in the following case
    //     LOGICAL A(3)
    //     INTEGER T
    //     NAMELIST /NML/ A, T
    //     READ( 1, NML )
    // Unit 1:
    //     &NML
    //     A = T F
    //     T = 4
    //     &END
    // when we are scanning "T = 4", we have to make sure that the T is
    // not interpreted as the value "true" for the 3rd element of A

    if( IOCB->rptnum <= 1 ) {
        Blanks();
        CheckEor();
        BumpComma();    // skip the "," if present
        CheckEor();
        Blanks();
        save_col = IOCB->fileinfo->col;
        ptr = ScanName( &len );
        // Make sure we have seen a name so that we don't confuse the opening
        // parenthesis of a complex number as an array element indicator
        //     COMPLEX A(2)
        //     NAMELIST /NML/ A
        //     READ( 1, NML )
        // Unit 1:
        //     &NML
        //     A = (1,2) (3,4)
        //     &END
        if( len != 0 ) {
            Blanks();
            if( ScanChar( '=' ) ) NmlInCount = 0;
            if( ScanChar( '(' ) ) NmlInCount = 0; // may be an array element
        }
        IOCB->fileinfo->col = save_col;
    }

    if( NmlInCount == 0 ) return( PT_NOTYPE );
    --NmlInCount;
    if( NmlInType == PT_CHAR ) {
        IORslt.string.len = ((string PGM *)NmlInAddr)->len;
        IORslt.string.strptr = ((string PGM *)NmlInAddr)->strptr;
        ((string PGM *)NmlInAddr)->strptr =
            ((char HPGM *)((string PGM *)NmlInAddr)->strptr) +
                                            ((string PGM *)NmlInAddr)->len;
    } else { // numeric or logical
        IORslt.pgm_ptr = NmlInAddr;
        NmlInAddr = (char HPGM *)NmlInAddr + SizeVars[ NmlInType ];
    }
    return( NmlInType );
}


static  void    NmlIn( void ) {
//=======================

    char PGM    *nml;
    uint        nml_len;
    char        *ptr;
    uint        len;
    char PGM    *nml_entry;
    byte        info;
    string      scb;
    char        e_chr;
    lg_adv PGM  *adv_ptr;
    char PGM    *adv_ss_ptr;
    uint        size;

    IOTypeRtn = &NmlIOType;
    IOCB->rptnum = -1;  // initialize for first call to NmlIOType()
    nml = (char PGM *)(IOCB->fmtptr);
    nml_len = *nml; // get length of NAMELIST name
    ++nml;
    e_chr = '&'; // assume '&' used
    for(;;) { // find the start of the NAMELIST information
        NextRec();
        Blanks();
        if( !ScanChar( '&' ) ) {
            if( !ScanChar( '$' ) ) continue;
            e_chr = '$'; // a '$' was used instead
        }
        ptr = ScanName( &len );
        if( nml_len != len ) continue;
        if( pgm_memicmp( ptr, nml, len ) != 0 ) continue;
        if( ScanEOL() || ScanChar( ' ' ) || ScanChar( '\t' ) ) break;
    }
    for(;;) {
        Blanks();
        CheckEor();
        Blanks();
        ptr = Scanner();
        if( *ptr == e_chr ) {
            ++ptr;
            if( ( toupper( ptr[0] ) == 'E' ) &&
                ( toupper( ptr[1] ) == 'N' ) &&
                ( toupper( ptr[2] ) == 'D' ) ) ptr += 3;
            if( *JmpBlanks( ptr ) == NULLCHAR ) break;
        }
        ptr = ScanName( &len );
        nml_entry = FindNmlEntry( ptr, len );
        if( nml_entry == NULL ) {
            ptr[len] = NULLCHAR;
            IOErr( IO_NML_NO_SUCH_NAME, ptr );
        }
        info = *nml_entry;
        ++nml_entry;
        NmlInType = _GetNMLType( info );
        if( _GetNMLSubScrs( info ) ) {  // array
            if( info & NML_LG_ADV ) {
                adv_ptr = *(lg_adv PGM * PGM *)nml_entry;
                NmlInAddr = (byte PGM *)adv_ptr->origin;
                if( NmlInType == PT_CHAR ) {
                    scb.len = adv_ptr->elt_size;
                }
                NmlInCount = adv_ptr->num_elts;
                adv_ss_ptr = ((char PGM *)adv_ptr + ADV_BASE_SIZE);
            } else {
                NmlInCount = *(unsigned_32 PGM *)nml_entry;
                nml_entry += sizeof( unsigned_32 );
                adv_ss_ptr = nml_entry;
                nml_entry += _GetNMLSubScrs( info ) *
                             ( sizeof( unsigned_32 ) + sizeof( int ) );
                if( NmlInType == PT_CHAR ) {
                    scb.len = *(uint PGM *)nml_entry;
                    nml_entry += sizeof( uint );
                }
                NmlInAddr = *(byte PGM * PGM *)nml_entry;
            }
            if( ScanChar( '(' ) ) {
                if( NmlInType == PT_CHAR ) {
                    size = scb.len;
                } else {
                    size = SizeVars[ NmlInType ];
                }
                if( !SubScr( info, adv_ss_ptr, size ) ) {
                    IOErr( IO_NML_BAD_SUBSCRIPT );
                }
            }
            if( NmlInType == PT_CHAR ) {
                scb.strptr = NmlInAddr;
                if( ScanChar( '(' ) ) {
                    if( !SubStr( &scb ) ) {
                        IOErr( IO_NML_BAD_SUBSTRING );
                    }
                }
                NmlInAddr = &scb;
            }
        } else { // variable
            NmlInCount = 1;
            NmlInAddr = *(byte PGM * PGM *)nml_entry;
            if( NmlInType == PT_CHAR ) {
                scb = *(string PGM *)NmlInAddr;
                if( ScanChar( '(' ) ) {
                    if( !SubStr( &scb ) ) {
                        IOErr( IO_NML_BAD_SUBSTRING );
                    }
                }
                NmlInAddr = &scb;
            }
        }
        IOCB->typ = NmlInType;
        Blanks();
        if( !ScanChar( '=' ) ) {
            IOErr( IO_NML_BAD_SYNTAX );
            break;
        }
        Blanks();
        if( Spawn( &DoFreeIn ) != 0 ) {
            // Suicide() was called - make sure it really was an error
            if( IOCB->flags & NML_CONTINUE ) {
                IOCB->flags &= ~NML_CONTINUE;
                continue;
            }
            // we got an error during NAMELIST input
            Suicide();
        }
    }
    IOTypeRtn = &IOType;
}


void    NmlAddrs( va_list args ) {
//================================

// Get addresses of NAMELIST symbols.

    byte PGM    *nml;
    byte        len;
    byte        info;

    nml = (byte PGM *)(IOCB->fmtptr);
    len = *nml;
    nml += sizeof( char ) + len;
    for(;;) {
        len = *nml;
        if( len == 0 ) break;
        nml += sizeof( char ) + len;
        info = *nml;
        ++nml;
        if( _GetNMLSubScrs( info ) && ( info & NML_LG_ADV ) == 0 ) {
            nml += sizeof( unsigned_32 ) + _GetNMLSubScrs( info ) *
                                   ( sizeof( unsigned_32 ) + sizeof( int ) );
            if( _GetNMLType( info ) == PT_CHAR ) {
                nml += sizeof( int );
            }
        }
        *(byte PGM * PGM *)nml = va_arg( args, byte PGM * );
        nml += sizeof( byte PGM * );
    }
}