2.9BSD - /usr/src/lib/libI77/ioprim.c

   1: /*
   2: char id_ioprim[] = "@(#)ioprim.c	1.1";
   3:  *
   4:  * FORTRAN i/o interface.
   5:  * For use with UNIX version 7 f77 compiler.
   6:  */
   7: #include <stdio.h>
   8: #include <ctype.h>
   9: #include "ioprim.h"
  10: 
  11: static FILE *fd[MAXUNIT] = {
  12:         stdin, stdout, stderr,
  13:         NULL,  NULL,   NULL,
  14:         NULL,  NULL,   NULL,
  15:         NULL,  NULL,   NULL,
  16:         NULL,  NULL,   NULL,
  17:         NULL,  NULL,   NULL,
  18:         NULL,  NULL,   NULL,
  19:         NULL,  NULL};
  20: 
  21: /* Read a character from the standard input */
  22: getc_(result, lr, c, lc)
  23: FORTCHAR *result;
  24: STRLARG lr;
  25: register FORTCHAR *c;
  26: STRLARG lc;
  27: {
  28:     *c = (FORTCHAR)getchar();
  29:     *result = *c;
  30: }
  31: 
  32: /* Read a character from a file */
  33: getch_(result, lr, c, f, lc)
  34: FORTCHAR *result;
  35: STRLARG lr;
  36: register FORTCHAR *c;
  37: register FILEID *f;
  38: STRLARG lc;
  39: {
  40:     *c = (FORTCHAR)getc(fd[*f]);
  41:     *result = *c;
  42: }
  43: 
  44: /* Push a character back into input file */
  45: putbak_(result, lr, c, f, lc)
  46: char *result;
  47: STRLARG lr;
  48: char *c;
  49: FILEID *f;
  50: STRLARG lc;
  51: {
  52:     *result = ungetc(*c, fd[*f]);
  53:     *c = *result;
  54: }
  55: 
  56: /* Binary read from a file */
  57: FORTINT readb_(ptr, size, nitems, f)
  58: char *ptr;
  59: FORTINT *size, *nitems;
  60: FILEID *f;
  61: {
  62:     return((FORTINT)fread(ptr, (int)*size,
  63:         (int)*nitems, fd[*f]));
  64: }
  65: 
  66: /* Write a character to the standard output */
  67: putc_(c, lc)
  68: register FORTCHAR *c;
  69: STRLARG lc;
  70: {
  71:     putchar(*c);
  72: }
  73: 
  74: /* Write a character to a file */
  75: putch_(c, f, lc)
  76: register FORTCHAR *c;
  77: register FILEID *f;
  78: STRLARG lc;
  79: {
  80:     putc(*c, fd[*f]);
  81: }
  82: 
  83: /* Binary write to a file */
  84: FORTINT writeb_(ptr, size, nitems, f)
  85: char *ptr;
  86: FORTINT *size, *nitems;
  87: FILEID *f;
  88: {
  89:     return((FORTINT)fwrite(ptr, (int)*size,
  90:         (int)*nitems, fd[*f]));
  91: }
  92: 
  93: /* Open a file, return its fileid */
  94: FILEID open_(name, mode, ln, lm)
  95: FORTCHAR *name;
  96: FORTCHAR *mode;
  97: STRLARG ln, lm;
  98: {
  99:     register int i;
 100:     char c;
 101:     int ic;
 102:     FILE *fopen();
 103: 
 104:     for (i=ln-1; i>0; i--)
 105:         if (!isspace(c=name[i]) && c!=NULL)
 106:             break;
 107:     c = name[ic=i+1];
 108:     name[ic] = NULL;
 109:     for (i=0; i<MAXUNIT; i++)   /* Find a free fileid */
 110:         if (fd[i] == NULL)
 111:             break;
 112:     if (i >= MAXUNIT)       /* All are in use */
 113:         i = FORTERR;
 114:     else if ((fd[i] = fopen(name, mode)) == NULL)
 115:         i = FORTERR;
 116:     name[ic] = c;
 117:     return((FILEID)i);
 118: }
 119: 
 120: /* Create a new file, deleting old one, if any */
 121: FILEID create_(name, mode, ln, lm)
 122: FORTCHAR *name;
 123: FORTCHAR *mode;
 124: STRLARG ln, lm;
 125: {
 126:     unlink(name);
 127:     return(open_(name, mode, ln, lm));
 128: }
 129: 
 130: /* Close an open file */
 131: close_(f)
 132: register FILEID *f;
 133: {
 134:     if (fd[*f] != NULL)
 135:         fclose(fd[*f]);
 136:     fd[*f] = NULL;
 137: }
 138: 
 139: /* Flush output to a file */
 140: flush(f)
 141: register FILEID *f;
 142: {
 143:     if (fd[*f] != NULL)
 144:         fflush(fd[*f]);
 145: }
 146: 
 147: /* Position a file for next i/o operation */
 148: seek_(f, offset, whence)
 149: FILEID *f;
 150: OFFSET *offset;
 151: FORTINT *whence;
 152: {
 153:     fseek(fd[*f], (OFFSET)*offset, (int)*whence);
 154: }
 155: 
 156: /* Return current offset on a file */
 157: OFFSET tell_(f)
 158: FILEID *f;
 159: {
 160:     return((OFFSET)ftell(fd[*f]));
 161: }
 162: 
 163: /* Get FILE (stream) for a file */
 164: FILE *getfile(fid)
 165: FILEID fid;
 166: {
 167:     return(fd[fid]);
 168: }

Defined functions