Open64: osprey/libI77/dfe.c Source File

00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2.1 of the GNU Lesser General Public License 
00007   as published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU Lesser General Public 
00021   License along with this program; if not, write the Free Software 
00022   Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 
00023   USA.
00024 
00025   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00026   Mountain View, CA 94043, or:
00027 
00028   http://www.sgi.com
00029 
00030   For further information regarding this notice, see:
00031 
00032   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00033 
00034 */
00035 
00036 
00037 
00038 /* $Header: /proj/osprey/CVS/open64/osprey1.0/libI77/dfe.c,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $ */
00039 /*  3.0 SID # 1.2 */
00040 
00041 #include <cmplrs/fio.h>
00042 #include <mutex.h>
00043 #include "fmt.h"
00044 #include "iomode.h"
00045 #include "dfe.h"
00046 #include "err.h"
00047 #include "util.h"
00048 #include "rdfmt.h"
00049 #include "wrtfmt.h"
00050 #include "open.h"
00051 #include "bcompat.h"
00052 
00053 #define ASSOCV  12
00054 
00055 static int c_dfe (cilist64 *a, unit **fu);
00056 
00057 int
00058 s_rdfe (cilist *a)
00059 {
00060     return( s_rdfe_mp( a, &f77curunit ) );
00061 }
00062 
00063 
00064 #if 11
00065 int
00066 s_rdfe_mp (cilist *a, unit **fu) {
00067     cilist64 a64;
00068 
00069     get_cilist64( &a64, a );
00070     return( s_rdfe64_mp( &a64, fu ) );
00071 }
00072 
00073 int
00074 s_rdfe64 (cilist64 *a)
00075 {
00076     return( s_rdfe64_mp( a, &f77curunit ) );
00077 }
00078 
00079 int s_rdfe64_mp(cilist64 *a, unit **fu) {
00080 
00081 #else
00082 int
00083 s_rdfe_mp (cilist *a, unit **fu) {
00084 
00085 #endif
00086    int             n;
00087    unit            *ftnunit;
00088 
00089    if (!f77init)
00090       f_init ();
00091    if (n = c_dfe (a, fu)) {
00092       if (*fu) (*fu)->lock_unit = 0;
00093       return (n);
00094    }
00095    ftnunit = *fu;
00096    if (ftnunit->uwrt & WR_OP)
00097       (void) f77nowreading (ftnunit);
00098 #ifdef I90
00099    if (ftnunit->uaction == WRITEONLY )
00100   errret(ftnunit->f77errlist.cierr,180,"startread");
00101 #endif
00102    ftnunit->f77getn = y_getc;
00103    ftnunit->f77gets = y_gets;
00104    ftnunit->f77ungetn = y_ungetc;
00105    ftnunit->f77doed = rd_ed;
00106    ftnunit->f77doned = rd_ned;
00107    ftnunit->f77donewrec = yrd_SL;
00108    ftnunit->f77dorevert = ftnunit->f77doend = y_rsk;
00109    if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
00110       errret(a->cierr, 100, "startio");
00111    fmt_bg (ftnunit);
00112    return (0);
00113 }
00114 
00115 int
00116 s_wdfe (cilist *a) {
00117     return( s_wdfe_mp( a, &f77curunit ) );
00118 }
00119 
00120 #if 11
00121 
00122 int
00123 s_wdfe_mp (cilist *a, unit **fu) {
00124     cilist64 a64;
00125 
00126     get_cilist64( &a64, a );
00127     return( s_wdfe64_mp( &a64, fu ) );
00128 }
00129 
00130 int
00131 s_wdfe64 (cilist64 *a)
00132 {
00133     return( s_wdfe64_mp( a, &f77curunit ) );
00134 }
00135 
00136 int s_wdfe64_mp (cilist64 *a, unit **fu) {
00137 
00138 #else
00139 
00140 int
00141 s_wdfe_mp (cilist *a, unit **fu) {
00142 #endif
00143    int             n;
00144    unit   *ftnunit;
00145 
00146    if (!f77init)
00147       f_init ();
00148    if (n = c_dfe (a, fu)) {
00149       if (*fu) (*fu)->lock_unit = 0;
00150       return (n);
00151    }
00152    ftnunit = *fu;
00153    if (ftnunit->uwrt != WR_READY && f77nowwriting (ftnunit))
00154       errret(a->cierr, 160, "startwrt");
00155    ftnunit->f77putn = y_putc;
00156    ftnunit->f77ungetn = y_ungetc;
00157    ftnunit->f77doed = w_ed;
00158    ftnunit->f77doned = w_ned;
00159    ftnunit->f77donewrec = y_wSL;
00160    ftnunit->f77dorevert = y_rev;
00161    ftnunit->f77doend = y_end;
00162    ftnunit->uirec = a->cirec;
00163    if (ftnunit->umaxrec && (a->cirec > ftnunit->umaxrec))
00164       errret(a->cierr, 159, "startwrt");
00165    if (pars_f (ftnunit, ftnunit->f77fmtbuf) < 0)
00166       errret(a->cierr, 100, "startwrt");
00167    fmt_bg (ftnunit);
00168    return (0);
00169 }
00170 
00171 
00172 int
00173 e_rdfe ()
00174 {
00175     return( e_rdfe_mp( &f77curunit ) );
00176 }
00177 
00178 
00179 
00180 int
00181 e_rdfe_mp (unit **fu)
00182 {
00183    unit *ftnunit = *fu;
00184    (void) en_fio (fu);
00185    if (ftnunit->ufd && ferror (ftnunit->ufd))
00186       errret(ftnunit->f77errlist.cierr, errno, "dfe");
00187    ftnunit->lock_unit = 0;
00188    return (0);
00189 }
00190 
00191 
00192 int
00193 e_wdfe ()
00194 {
00195    return( e_wdfe_mp( &f77curunit ) );
00196 }
00197 
00198 
00199 int
00200 e_wdfe_mp (unit **fu)
00201 {
00202    unit *ftnunit = *fu;
00203    (void) en_fio (fu);
00204    if (ftnunit->ufd && ferror (ftnunit->ufd))
00205       errret(ftnunit->f77errlist.cierr, errno, "dfe");
00206    if (ftnunit->ushared)
00207       fflush (ftnunit->ufd);
00208    ftnunit->lock_unit = 0;
00209    return (0);
00210 }
00211 
00212 static int
00213 c_dfe (cilist64 *a, unit **fu) 
00214 {
00215    unit   *ftnunit;
00216 extern FILE *debugfile;
00217 
00218    if ((ftnunit = *fu = find_luno (a->ciunit)) == NULL)
00219       if (fk_open (DIR, FMT, a->ciunit))
00220    err(a->cierr, 104, "dfe");
00221    while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L ))
00222        ;
00223    ftnunit->f77errlist.cierr = a->cierr;
00224    ftnunit->f77errlist.ciend = a->ciend;
00225    ftnunit->f77errlist.cieor = a->cieor;
00226    ftnunit->f77errlist.cisize = a->cisize;
00227    ftnunit->f77errlist.iciunit = 0;
00228    ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
00229    ftnunit->f77scale = 0;
00230    ftnunit->ufd = ftnunit->ufd;
00231 
00232    if (!ftnunit->ufmt)
00233       err(a->cierr, 102, "dfe")
00234    if (!ftnunit->useek)
00235    err(a->cierr, 104, "dfe")
00236       if (a->cirec < 1)
00237       err(a->cierr, 168, "dfe");
00238    ftnunit->f77fmtbuf = a->cifmt;
00239 
00240    /* fprintf( debugfile, "At position %d for thread %d, oldrec = %d, newrec = %d\n", ftell( ftnunit->ufd ), mp_my_threadnum_(), ftnunit->uirec, a->cirec ); */
00241    if (FSEEK (ftnunit->ufd,  (ftnll)ftnunit->url * (a->cirec - 1), 0))
00242       err( a->cierr, errno, "Direct formatted");
00243    if (ftnunit->uassocv)
00244       set_var ((ftnintu *)ftnunit->uassocv,
00245          ftnunit->umask, ASSOCV, a->cirec);
00246    ftnunit->uend = 0;
00247    return (0);
00248 }
00249 
00250 int
00251 y_rsk (unit *ftnunit)
00252 {
00253    yrd_SL (ftnunit);
00254    return (0);
00255 }
00256 
00257 int
00258 yrd_SL (unit *ftnunit)
00259 {
00260    inc_var ((ftnintu *)ftnunit->uassocv, ftnunit->umask, ASSOCV);
00261    if (ftnunit->uend || ftnunit->url <= ftnunit->f77recpos
00262        || ftnunit->url == 1) {
00263       if (ftnunit->url > 1)
00264    ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
00265       return(0);
00266    }
00267    do {
00268       getc (ftnunit->ufd);
00269    } while (++ftnunit->f77recpos < ftnunit->url);
00270    ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
00271    return (0);
00272 }
00273 
00274 int
00275 y_ungetc (unit *ftnunit, int ch)
00276 {
00277    if (!ftnunit->useek)
00278       return (-1);
00279    (void) fseek (ftnunit->ufd, -1L, 1);
00280    ftnunit->f77recpos--;
00281    return (ch);
00282 }
00283 
00284 int
00285 y_getc (unit *ftnunit)
00286 {
00287    int             ch;
00288 
00289    if (ftnunit->uend)
00290       return (-1);
00291    if ((ch = getc (ftnunit->ufd)) != EOF) {
00292       ftnunit->f77recpos++;
00293       if (ftnunit->url >= ftnunit->f77recpos ||
00294     ftnunit->url == 1)
00295    return (ch);
00296       else
00297    return (' ');
00298    }
00299    if (feof (ftnunit->ufd)) {
00300       ftnunit->uend = 1;
00301       errno = 0;
00302       return (-1);
00303    }
00304    err(ftnunit->f77errlist.cierr, errno, "readingd");
00305 }
00306 
00307 int
00308 y_gets (unit *ftnunit, char *s, int w, char unused_c) {
00309    register int    ch, n;
00310 
00311    if (ftnunit->uend)
00312       return (-1);
00313    if (ftnunit->url > 1) {
00314       n = ftnunit->url - ftnunit->f77recpos;
00315       w = n < w ? n : w;
00316    }
00317    for (n = 0; n < w; n++) {
00318       if ((ch = getc (ftnunit->ufd)) == EOF)
00319    break;
00320       *(s++) = (char) ch;
00321    }
00322    ftnunit->f77recpos += n;
00323    if (n == w)
00324       return (n);
00325    if (feof (ftnunit->ufd)) {
00326       ftnunit->uend = 1;
00327       errno = 0;
00328       return (EOF);
00329    }
00330    err(ftnunit->f77errlist.cierr, errno, "readingd");
00331 }
00332 
00333 int
00334 y_putc (unit *ftnunit, register XINT count, register char con, register char *buf) {
00335    register XINT    new_size;
00336    register int    i;
00337 
00338    new_size = ftnunit->f77recpos + count;
00339    if (new_size > ftnunit->url && ftnunit->url > 1)
00340       err(ftnunit->f77errlist.cierr, 110, "dout");
00341 
00342    if (buf)
00343       while (count--)
00344    putc (*buf++, ftnunit->ufd);
00345 
00346    else {
00347       if (con)
00348    while (count--)
00349       putc (con, ftnunit->ufd);
00350       else if ((ftnunit->f77recpos + count) > ftnunit->f77recend) {
00351    i = ftnunit->f77recend - ftnunit->f77recpos;
00352    if (!ftnunit->useek)
00353       return (-1);
00354    (void) fseek (ftnunit->ufd, (long) i, 1);
00355    i = count - i;
00356    while (i--)
00357       putc (' ', ftnunit->ufd);
00358       } else {
00359    if (!ftnunit->useek)
00360       return (-1);
00361    (void) fseek (ftnunit->ufd, (long) count, 1);
00362       }
00363    }
00364 
00365 
00366    ftnunit->f77recpos = new_size;
00367 
00368    if (ftnunit->f77recpos > ftnunit->f77recend)
00369       ftnunit->f77recend = ftnunit->f77recpos;
00370    return (0);
00371 
00372 }
00373 
00374 int
00375 y_rev (unit *ftnunit)
00376 {       /* what about work done? */
00377    if (ftnunit->url != 1 && ftnunit->f77recpos < ftnunit->url)
00378       y_wSL (ftnunit);
00379    else {
00380       ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
00381       inc_var ((ftnintu *)ftnunit->uassocv, ftnunit->umask, ASSOCV);
00382    }
00383    return (0);
00384 }
00385 
00386 int
00387 y_end (unit *ftnunit)
00388 {
00389    y_wSL (ftnunit);
00390    return (0);
00391 }
00392 
00393 int
00394 y_wSL (unit *ftnunit)
00395 {
00396    if (ftnunit->f77recpos < ftnunit->url)
00397       (*ftnunit->f77putn) (ftnunit, ftnunit->url - ftnunit->f77recpos, ' ', NULL);
00398    inc_var ((ftnintu *)ftnunit->uassocv, ftnunit->umask, ASSOCV);
00399    ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
00400    return (0);
00401 }
00402 
00403 #if 11
00404 #pragma weak e_rdfe64 = e_rdfe
00405 #pragma weak e_rdfe64_mp = e_rdfe_mp
00406 #pragma weak e_wdfe64 = e_wdfe
00407 #pragma weak e_wdfe64_mp = e_wdfe_mp
00408 #endif
00409