1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
/*
* Copyright (C) 1991-2000 by CERN/IT/PDP/DM
* All rights reserved
*/
#ifndef lint
static char sccsid[] = "@(#)$RCSfile: getfilep.c,v $ $Revision: 1.1 $ $Date: 2005/03/29 09:27:19 $ CERN/IT/PDP/DM Frederic Hemmer";
#endif /* not lint */
/* getfilep.c Fortran I/O to C mapper */
/*
* DISCLAIMER : This software is provided as is, without any warranty
* of reliability. It has been written by looking at
* IRIX internal structures and is therefore subject to
* modifications of IRIX system.
*/
/* changed by date description */
/*+-----------+-----------+--------------------------------------------+*/
/* F. Hemmer 13 Dec 90 Initial writing for IRIX 3.1 */
/* F. Hemmer 23 Jan 91 Added MIPS Ultrix support */
#if defined(sgi)
#include <stdio.h> /* Standard Input/Output */
#include <cmplrs/fio.h>
#include <osdep.h>
#define DEBUG 0
extern unit *f77units;
unit *uinc;
FILE DLL_DECL *getfilep_(lun) /* Get file pointer associated to lun. */
int *lun;
{
register int i; /* F77 unit array index */
struct UNIT *units; /* F77 unit array pointer */
register char *p; /* For pointer calculation */
p = (char *)f77units;
/*
* IRIX apparently only uses 0 < unit < mxunit-1
*/
for (i=0;i<mxunit-1;i++) {
p += sizeof(unit);
#if DEBUG
fprintf(stdout,"f77units[%d]: unit=%d, fp=%x\n",i,
((struct UNIT *)p)->luno,
((struct UNIT *)p)->ufd);
#endif /* DEBUG */
if (((struct UNIT *)p)->luno == *lun) {
return(((struct UNIT *)p)->ufd);
}
}
return((FILE *)-1);
}
#endif /* (sgi) */
#if defined (_AIX)
#include <stdio.h>
#include <sys/limits.h>
#include <osdep.h>
#include <sys/stat.h>
FILE DLL_DECL *
getfilep(filename)
char *filename;
{
struct stat statbuf;
int i, j;
ino_t inodef;
static FILE *filep = 0;
/* go through the process of getting file pointer only */
/* the first time that getfilep is called.later use the*/
/* same pointer.Hence filep is defined static. */
if (filep == 0) {
/*
* first put null character at end of file name since fortran leaves
* all trailing blank
*/
i = 255;
while (filename[i] == ' ')
i--;
filename[++i] = '\0';
/* now get the inode number of the file */
if ((j = stat(filename, &statbuf)) == -1) {
return ((FILE *) - 1);
}
inodef = statbuf.st_ino;
/* now look for a file descriptor with same inode number */
/* and associate a stream with it and return the stream */
for (i = 0; i <= getdtablesize(); i++) {
if ((j = fstat(i, &statbuf)) == -1)
continue;
if (inodef == statbuf.st_ino) {
filep = fdopen(i, "r");
return (filep);
}
}
return ((FILE *) - 1);
} else
return (filep);
}
#endif /* _AIX */
|
