Example #1
0
static  void    RTCopy( char *ptr, string PGM *str ) {
//====================================================

    uint        len;
    uint        scb_len;

    len = strlen( ptr );
    scb_len = str->len;
    if( len <= scb_len ) {
        pgm_memput( str->strptr, ptr, len );
        pgm_memset( str->strptr + len, ' ', scb_len - len );
    } else {
        pgm_memput( str->strptr, ptr, scb_len );
    }
}
Example #2
0
intstar4        fortran FGETENV( string PGM *env_var, string PGM *value ) {
//=========================================================================

    char        *buff;
    char        *ptr;
    int         len;

    len = 0;
    for(;;) {
        if( len == env_var->len ) break;
        if( env_var->strptr[ len ] == ' ' ) break;
        ++len;
    }
    if( len == 0 ) return( 0 );
    buff = alloca( len + sizeof( char ) );
    if( buff != NULL ) {
        pgm_memget( buff, env_var->strptr, len );
        buff[ len ] = NULLCHAR;
        ptr = getenv( buff );
        if( ptr != NULL ) {
            len = strlen( ptr );
            if( len > value->len ) {
                len = value->len;
            }
            pgm_memput( value->strptr, ptr, len );
            pgm_memset( value->strptr + len, ' ', value->len - len );
            return( len );
        }
    }
    return( 0 );
}
Example #3
0
static  void    IUnBytes( char HPGM *dst, unsigned long len ) {
//=============================================================

    uint        amt;
    ftnfile     *fcb;
    char        *src;

    fcb = IOCB->fileinfo;
    if( IsFixed() && ( fcb->col + len > fcb->len ) ) {
        IOErr( IO_UNFMT_RECL );
    }
    src = fcb->buffer + fcb->col;
    for(;;) {
        amt = fcb->len - fcb->col;
        if( amt > len ) {
            amt = len;
        }
        pgm_memput( dst, src, amt );
        fcb->col += amt;
        len -= amt;
        if( len == 0 ) break;
        dst += amt;
        src = fcb->buffer;
        NextUnFmtRec();
    }
}
Example #4
0
void    R_FIStr( void ) {
//=================

    uint        width;
    byte        blanks;
    uint        length;
    ftnfile     *fcb;
    char        *src;
    char        PGM *ptr;

    fcb   = IOCB->fileinfo;
    width = IOCB->fmtptr->fmt4.fld1;
    if( IOCB->typ != PT_CHAR ) {
        ptr = IORslt.pgm_ptr;
        length = GetLen();
    } else {
        ptr = IORslt.string.strptr;
        length = IORslt.string.len;
    }
    if( width == 0 ) {
        width = length;
    }
    if( width >= length ) {
        fcb->col += width - length;
        width = length;
    }
    ChkBuffLen( width );
    blanks = length - width;
    src = &fcb->buffer[ fcb->col ];
    pgm_memput( ptr, src, width );
    pgm_memset( ptr + width, ' ', blanks );
    fcb->col += width;
}
Example #5
0
static  void    IUnStream( char HPGM *dst, unsigned long len ) {
//==============================================================

    uint        amt;
    ftnfile     *fcb;

    fcb = IOCB->fileinfo;
    for(;;) {
        amt = fcb->bufflen;
        if( amt > len ) {
            amt = len;
        }
        fcb->len = amt;
        NextRec();
        pgm_memput( dst, fcb->buffer, fcb->len );
        len -= amt;
        if( len == 0 ) break;
        dst += amt;
    }
}
Example #6
0
void    SendIFBuff( char *buffer, int len, unsigned_32 recnum,
                    string PGM *ifile ) {
//============================================================

    pgm_memput( _Normalize( ifile->strptr, (recnum-1)*len ), buffer, len );
}