nmlio.c

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

/****************************************************************************
*
*                            Open Watcom Project
*
*    Portions Copyright (c) 1983-2002 Sybase, Inc. All Rights Reserved.
*
*  ========================================================================
*
*    This file contains Original Code and/or Modifications of Original
*    Code as defined in and that are subject to the Sybase Open Watcom
*    Public License version 1.0 (the 'License'). You may not use this file
*    except in compliance with the License. BY USING THIS FILE YOU AGREE TO
*    ALL TERMS AND CONDITIONS OF THE LICENSE. A copy of the License is
*    provided with the Original Code and Modifications, and is also
*    available at www.sybase.com/developer/opensource.
*
*    The Original Code and all software distributed under the License are
*    distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
*    EXPRESS OR IMPLIED, AND SYBASE AND ALL CONTRIBUTORS HEREBY DISCLAIM
*    ALL SUCH WARRANTIES, INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF
*    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR
*    NON-INFRINGEMENT. Please see the License for the specific language
*    governing rights and limitations under the License.
*
*  ========================================================================
*
* Description:  WHEN YOU FIGURE OUT WHAT THIS FILE DOES, PLEASE
*               DESCRIBE IT HERE!
*
****************************************************************************/


//
// NMLIO        : run-time NAMELIST i/o processing
//

#include "ftnstd.h"
#include "rundat.h"
#include "pgmacc.h"
#include "errcod.h"
#include "symdefs.h"
#include "iotype.h"
#include "lgadv.h"
#include "nmlinfo.h"

#include <stdarg.h>
#include <string.h>
#include <ctype.h>

extern  void            Drop(char);
extern  void            SendStr(char PGM *,uint);
extern  void            SendWSLStr(char *);
extern  void            SendEOR(void);
extern  void            NextRec(void);
extern  void            DoFreeIn(void);
extern  void            CheckEor(void);
extern  void            Blanks(void);
extern  void            BumpComma(void);
extern  void            IOErr(uint,...);
extern  int             Spawn(void (*)( void ));
extern  void            Suicide(void);
extern  bool            DoSubscript(act_dim_list *,intstar4 *,intstar4 *);
extern  bool            DoSubstring(intstar4,intstar4,uint);
extern  intstar4        GetNum(void);
extern  char            *JmpBlanks(char *);

extern  void            (* const __FAR OutRtn[])( void );
extern  const byte __FAR        SizeVars[];

static  unsigned_32     NmlInCount;
static  PTYPE           NmlInType;
static  void            PGM *NmlInAddr;


char            *Scanner( void ) {
//==========================

// Point to where we are currently scanning.

    ftnfile     *fcb;

    fcb = IOCB->fileinfo;
    return( &fcb->buffer[ fcb->col ] );
}


bool            ScanChar( char chr ) {
//====================================

// Scan a character.

    if( *Scanner() == chr ) {
        IOCB->fileinfo->col++;
        return( TRUE );
    }
    return( FALSE );
}


bool            ScanEOL( void ) {
//=========================

// Check for end-of-line.

    return( *Scanner() == NULLCHAR );
}


char            *ScanName( uint *len ) {
//======================================

// Scan a name.

    char        *name;
    char        *ptr;
    char        chr;

    name = Scanner();
    for( ptr = name; ; ++ptr ) {
        chr = *ptr;
        if( isalnum( chr ) ) continue;
        if( chr == '_' ) continue;
        if( chr == '$' ) continue;
        break;
    }
    *len = ptr - name;
    IOCB->fileinfo->col += *len;
    return( name );
}


bool            ScanSNum( signed_32 PGM *num ) {
//==============================================

// Scan a signed number.

    char        *ptr;

    Blanks();
    ptr = Scanner();
    if( ( *ptr == '+' ) || ( *ptr == '-' ) ) {
        ++ptr;
    }
    if( isdigit( *ptr ) ) {
        *num = GetNum();
        Blanks();
        return( TRUE );
    } else {
        Blanks();
        return( FALSE );
    }
}


static  intstar4        SubScr( int info, char PGM *adv_ss_ptr, int size ) {
//==========================================================================

// Get a subscript list.

    signed_32           ss[MAX_DIM];
    act_dim_list        dim_list;
    intstar4 PGM        *dim_ptr;
    signed_32 PGM       *ss_ptr;
    intstar4            lo;
    intstar4            offset;
    int                 num_ss;

    dim_list.dim_flags = 0;
    _SetDimCount( dim_list.dim_flags, _GetNMLSubScrs( info ) );
    dim_list.num_elts = 1;
    dim_ptr = &dim_list.subs_1_lo;
    num_ss = _GetNMLSubScrs( info );
    ss_ptr = ss;
    for(;;) {
        if( !ScanSNum( ss_ptr ) ) return( FALSE );
        ++ss_ptr;
        lo = *(intstar4 PGM *)adv_ss_ptr;
        adv_ss_ptr += sizeof( intstar4 );
        dim_list.num_elts *= *(uint PGM *)adv_ss_ptr;
        *dim_ptr = lo;
        ++dim_ptr;
        *dim_ptr = lo + *(uint PGM *)adv_ss_ptr - 1;
        ++dim_ptr;
        adv_ss_ptr += sizeof( uint );
        --num_ss;
        if( num_ss == 0 ) break;
        if( !ScanChar( ',' ) ) break;
    }
    if( !ScanChar( ')' ) ) return( FALSE );
    if( !DoSubscript( &dim_list, ss, &offset ) ) return( FALSE );
    NmlInAddr = (char HPGM *)NmlInAddr + offset * size;
    return( TRUE );
}


static  bool    SubStr( string *scb ) {
//=====================================

// Get a substring list.

    intstar4    ss1;
    intstar4    ss2;

    ss1 = 1;
    ss2 = scb->len;
    if( !ScanChar( ':' ) ) {
        if( !ScanSNum( &ss1 ) ) return( FALSE );
        if( !ScanChar( ':' ) ) return( FALSE );
    }
    if( !ScanChar( ')' ) ) {
        if( !ScanSNum( &ss2 ) ) return( FALSE );
        if( !ScanChar( ')' ) ) return( FALSE );
    }
    if( !DoSubstring( ss1, ss2, scb->len ) ) return( FALSE );
    scb->len = ss2 - ss1 + 1;
    scb->strptr = scb->strptr + ss1 - 1;
    return( TRUE );
}


void    NmlExec( void ) {
//=================

    if( IOCB->flags & IOF_OUTPT ) {
        NmlOut();
    } else {
        NmlIn();
    }
    IOCB->typ = PT_NOTYPE;
}


static  void    NmlOut( void ) {
//========================

    byte        PGM *nml;
    byte        len;
    byte        info;
    PTYPE       typ;
    unsigned_32 num_elts;
    byte        PGM *data;
    string      scb;
    lg_adv      PGM *adv_ptr;

    nml = (char PGM *)(IOCB->fmtptr);
    len = *nml; // get length of NAMELIST name
    ++nml;
    Drop( ' ' );
    Drop( '&' );
    SendStr( nml, len );
    nml += len;
    SendEOR();
    for(;;) {
        len = *nml;
        if( len == 0 ) break;
        ++nml;
        Drop( ' ' );
        SendStr( nml, len );
        nml += len;
        SendWSLStr( " = " );
        info = *nml;
        ++nml;
        typ = _GetNMLType( info );
        IOCB->typ = typ;
        if( _GetNMLSubScrs( info ) ) {
            if( info & NML_LG_ADV ) {
                adv_ptr = *(lg_adv PGM * PGM *)nml;
                num_elts = adv_ptr->num_elts;
                if( typ == PT_CHAR ) {
                    scb.len = adv_ptr->elt_size;
                    scb.strptr = (char PGM *)adv_ptr->origin;
                } else {
                    data = (byte PGM *)adv_ptr->origin;
                }
            } else {
                num_elts = *(unsigned_32 PGM *)nml;
                nml += sizeof( unsigned_32 ) + _GetNMLSubScrs( info ) *
                                   ( sizeof( unsigned_32 ) + sizeof( int ) );
                if( typ == PT_CHAR ) {
                    scb.len = *(uint PGM *)nml;
                    nml += sizeof( uint );
                    scb.strptr = *(byte PGM * PGM *)nml;
                } else {
                    data = *(byte PGM * PGM *)nml;
                }
            }
            while( num_elts != 0 ) {
                if( typ == PT_CHAR ) {
                    IORslt.string = scb;
                    OutRtn[ typ ]();
                    Drop( ' ' );
                    scb.strptr += scb.len;
                } else {
                    pgm_memget( (byte *)(&IORslt), data, SizeVars[typ] );
                    OutRtn[ typ ]();
                    data += SizeVars[ typ ];
                }
                --num_elts;
            }
        } else {
            switch( typ ) {
            case PT_LOG_1:
                IORslt.logstar4 = **(logstar1 PGM * PGM *)nml;
                break;