home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd2.bin / bbs / gnu / f2c-1993.04.28-src.lha / GNU / src / amiga / f2c-1993.04.28 / libI77 / open.c < prev    next >
C/C++ Source or Header  |  1993-04-28  |  4KB  |  230 lines
  1. #include "sys/types.h"
  2. #include "sys/stat.h"
  3. #include "f2c.h"
  4. #include "fio.h"
  5. #include "string.h"
  6. #include "rawio.h"
  7.  
  8. #ifdef KR_headers
  9. extern char *malloc(), *mktemp();
  10. extern integer f_clos();
  11. #else
  12. #undef abs
  13. #undef min
  14. #undef max
  15. #include "stdlib.h"
  16. extern int f__canseek(FILE*);
  17. extern integer f_clos(cllist*);
  18. #endif
  19.  
  20. #ifdef NON_ANSI_RW_MODES
  21. char *f__r_mode[2] = {"r", "r"};
  22. char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
  23. #else
  24. char *f__r_mode[2] = {"rb", "r"};
  25. char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
  26. #endif
  27.  
  28. #ifdef KR_headers
  29. f__isdev(s) char *s;
  30. #else
  31. f__isdev(char *s)
  32. #endif
  33. {
  34. #ifdef NON_UNIX_STDIO
  35.     int i, j;
  36.  
  37.     i = open(s,O_RDONLY);
  38.     if (i == -1)
  39.         return 0;
  40.     j = isatty(i);
  41.     close(i);
  42.     return j;
  43. #else
  44.     struct stat x;
  45.  
  46.     if(stat(s, &x) == -1) return(0);
  47. #ifdef S_IFMT
  48.     switch(x.st_mode&S_IFMT) {
  49.         case S_IFREG:
  50.         case S_IFDIR:
  51.             return(0);
  52.         }
  53. #else
  54. #ifdef S_ISREG
  55.     /* POSIX version */
  56.     if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
  57.         return(0);
  58.     else
  59. #else
  60.     Help! How does stat work on this system?
  61. #endif
  62. #endif
  63.         return(1);
  64. #endif
  65. }
  66. #ifdef KR_headers
  67. integer f_open(a) olist *a;
  68. #else
  69. integer f_open(olist *a)
  70. #endif
  71. {    unit *b;
  72.     int n;
  73.     integer rv;
  74.     char buf[256], *s;
  75.     cllist x;
  76. #ifdef NON_UNIX_STDIO
  77.     FILE *tf;
  78. #else
  79.     struct stat stb;
  80. #endif
  81.     if(a->ounit>=MXUNIT || a->ounit<0)
  82.         err(a->oerr,101,"open")
  83.     f__curunit = b = &f__units[a->ounit];
  84.     if(b->ufd) {
  85.         if(a->ofnm==0)
  86.         {
  87.         same:    if (a->oblnk)
  88.                 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
  89.             return(0);
  90.         }
  91. #ifdef NON_UNIX_STDIO
  92.         if (b->ufnm
  93.          && strlen(b->ufnm) == a->ofnmlen
  94.          && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
  95.             goto same;
  96. #else
  97.         g_char(a->ofnm,a->ofnmlen,buf);
  98.         if (f__inode(buf,&n) == b->uinode && n == b->udev)
  99.             goto same;
  100. #endif
  101.         x.cunit=a->ounit;
  102.         x.csta=0;
  103.         x.cerr=a->oerr;
  104.         if ((rv = f_clos(&x)) != 0)
  105.             return rv;
  106.         }
  107.     b->url = (int)a->orl;
  108.     b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
  109.     if(a->ofm==0)
  110.     {    if(b->url>0) b->ufmt=0;
  111.         else b->ufmt=1;
  112.     }
  113.     else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
  114.     else b->ufmt=0;
  115. #ifdef url_Adjust
  116.     if (b->url && !b->ufmt)
  117.         url_Adjust(b->url);
  118. #endif
  119.     if (a->ofnm) {
  120.         g_char(a->ofnm,a->ofnmlen,buf);
  121.         if (!buf[0])
  122.             err(a->oerr,107,"open")
  123.         }
  124.     else
  125.         sprintf(buf, "fort.%ld", a->ounit);
  126.     b->uscrtch = 0;
  127.     switch(a->osta ? *a->osta : 'u')
  128.     {
  129.     case 'o':
  130.     case 'O':
  131. #ifdef NON_UNIX_STDIO
  132.         if(access(buf,0))
  133. #else
  134.         if(stat(buf,&stb))
  135. #endif
  136.             err(a->oerr,errno,"open")
  137.         break;
  138.      case 's':
  139.      case 'S':
  140.         b->uscrtch=1;
  141. #ifdef _POSIX_SOURCE
  142.         tmpnam(buf);
  143. #else
  144.         (void) strcpy(buf,"tmp.FXXXXXX");
  145.         (void) mktemp(buf);
  146. #endif
  147.         goto replace;
  148.     case 'n':
  149.     case 'N':
  150. #ifdef NON_UNIX_STDIO
  151.         if(!access(buf,0))
  152. #else
  153.         if(!stat(buf,&stb))
  154. #endif
  155.             err(a->oerr,128,"open")
  156.         /* no break */
  157.     case 'r':    /* Fortran 90 replace option */
  158.     case 'R':
  159.  replace:
  160. #ifdef NON_UNIX_STDIO
  161.         if (tf = fopen(buf,f__w_mode[0]))
  162.             fclose(tf);
  163. #else
  164.         (void) close(creat(buf, 0666));
  165. #endif
  166.     }
  167.  
  168.     b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
  169.     if(b->ufnm==NULL) err(a->oerr,113,"no space");
  170.     (void) strcpy(b->ufnm,buf);
  171.     b->uend=0;
  172.     b->uwrt = 0;
  173.     if(f__isdev(buf))
  174.     {    b->ufd = fopen(buf,f__r_mode[b->ufmt]);
  175.         if(b->ufd==NULL) err(a->oerr,errno,buf)
  176.     }
  177.     else {
  178.         if(!(b->ufd = fopen(buf, f__r_mode[b->ufmt]))) {
  179. #ifdef NON_UNIX_STDIO
  180.             if (b->ufd = fopen(buf, f__w_mode[b->ufmt+2]))
  181.                 b->uwrt = 2;
  182.             else if (b->ufd = fopen(buf, f__w_mode[b->ufmt]))
  183.                 b->uwrt = 1;
  184.             else
  185. #else
  186.             if ((n = open(buf,O_WRONLY)) >= 0)
  187.                 b->uwrt = 2;
  188.             else {
  189.                 n = creat(buf, 0666);
  190.                 b->uwrt = 1;
  191.                 }
  192.             if (n < 0
  193.             || (b->ufd = fdopen(n, f__w_mode[b->ufmt])) == NULL)
  194. #endif
  195.                 err(a->oerr, errno, "open");
  196.             }
  197.     }
  198.     b->useek=f__canseek(b->ufd);
  199. #ifndef NON_UNIX_STDIO
  200.     if((b->uinode=f__inode(buf,&b->udev))==-1)
  201.         err(a->oerr,108,"open")
  202. #endif
  203.     if(b->useek)
  204.         if (a->orl)
  205.             rewind(b->ufd);
  206.         else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
  207.             && fseek(b->ufd, 0L, SEEK_END))
  208.                 err(a->oerr,129,"open");
  209.     return(0);
  210. }
  211. #ifdef KR_headers
  212. fk_open(seq,fmt,n) ftnint n;
  213. #else
  214. fk_open(int seq, int fmt, ftnint n)
  215. #endif
  216. {    char nbuf[10];
  217.     olist a;
  218.     (void) sprintf(nbuf,"fort.%ld",n);
  219.     a.oerr=1;
  220.     a.ounit=n;
  221.     a.ofnm=nbuf;
  222.     a.ofnmlen=strlen(nbuf);
  223.     a.osta=NULL;
  224.     a.oacc= seq==SEQ?"s":"d";
  225.     a.ofm = fmt==FMT?"f":"u";
  226.     a.orl = seq==DIR?1:0;
  227.     a.oblnk=NULL;
  228.     return(f_open(&a));
  229. }
  230.