/****************************************************************
Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore.
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T Bell Laboratories or
Bellcore or any of their entities not be used in advertising or
publicity pertaining to distribution of the software without
specific, written prior permission.
AT&T and Bellcore disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness. In no event shall AT&T or Bellcore be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
****************************************************************/
static char Ptok
[128], Pct
[Table_size
];
static int *tfirst
, *tlast
, *tnext
, tmax
;
tfirst
= (int *)realloc((char *)tfirst
,
(tmax
+= TGULP
)*sizeof(int));
"Pfile: realloc failure!\n");
"unexpected character 0x%.2x = '%c' on line %ld of %s\n",
"unexpected type \"%s\" on line %ld of %s\n",
fprintf(stderr
, "%s type from `f2c -%s` on line %ld of %s\n",
tname
, option
, Plineno
, Pfname
);
"%sdetected on line %ld of %s\n", msg
, Plineno
, Pfname
);
static int seen
[2] = {0,0};
"Illegal combination of LOGICAL types -- mixing -I4 with -I2 or -i2\n\t");
if (tylogical
== TYLONG
|| lastmsg
>= 2)
badflag("LOGICAL", "I4");
if (tylogical
== TYSHORT
|| lastmsg
& 1)
badflag("LOGICAL", "i2` or `f2c -I2");
#define checklogical(n) /* */
static int seen
[2] = {0,0};
detected("Illegal mixture of -R and -!R ");
if (k
== forcedouble
|| warned
)
badflag("REAL return", k
? "!R" : "R");
"%s cannot be both a procedure and a common block (line %ld of %s)\n",
e
->fextname
, Plineno
, Pfname
);
if ((c
= getc(pf
)) < '0' || c
> '9')
if ((c
= getc(pf
)) == ' ') {
static void argverify(), Pbadret();
if ((c
= numread(pf
, &nargs
)) != ' ') {
/* just a typed external */
if (e
->extstg
== STGUNKNOWN
) {
if (e
->extstg
== STGEXT
) {
for(i
= 0; i
< nargs
; i
++) {
if ((c
= numread(pf
, &type
)) != ' '
|| type
!= TYFTNLEN
+ 100 && type
% 100 > TYSUBR
)
if (e
->extstg
== STGUNKNOWN
) {
gmem(sizeof(Argtypes
) + (nargs
-1)*sizeof(Atype
), 1);
at
->dnargs
= at
->nargs
= nargs
;
for(ae
= a
+ nargs
; a
< ae
; a
++) {
else if (e
->extstg
!= STGEXT
) {
char buf
[128], cbuf
[128];
if ((c
= getc(pf
)) == EOF
)
if ((c
= getc(pf
)) == EOF
)
se
= buf
+ sizeof(buf
) - 1;
if ((c
= getc(pf
)) == EOF
)
if (s
>= se
|| Pct
[c
] != P_anum
)
if (s
<= buf
|| *s
!= '_')
if ((c
= getc(pf
)) == EOF
)
return readref(pf
, e
, (int)L
);
if (e
->extstg
== STGUNKNOWN
) {
else if (e
->extstg
!= STGCOMMON
)
else if (e
->maxleng
!= L
) {
"incompatible lengths for common block %s (line %ld of %s)\n",
se
= s
+ sizeof(Ptok
) - 1;
if ((c
= getc(pf
)) == EOF
) {
"unexpected end of file in %s\n",
if ((c
= getc(pf
)) != '*') {
if (canend
&& comlen(pf
))
while((c
= getc(pf
)) != '*') {
if (!strcmp(Ptok
+1, "_f"))
if (!strcmp(Ptok
+1, "_f")) {
/* TYREAL under forcedouble */
if (!strcmp(Ptok
+1, "_f"))
if (!strcmp(Ptok
+1, "_f"))
if (!strcmp(Ptok
+1, "oublereal"))
if (!strcmp(Ptok
+1, "nt"))
if (!strcmp(Ptok
+1, "nteger"))
if (!strcmp(Ptok
+1, "nteger1"))
if (!strcmp(Ptok
+1, "ogical")) {
if (!strcmp(Ptok
+1, "ogical1"))
if (!strcmp(Ptok
+1, "ongint"))
if (!strcmp(Ptok
+1, "eal")) {
if (!strcmp(Ptok
+1, "hortint"))
if (!strcmp(Ptok
+1, "hortlogical")) {
fprintf(stderr
,"Error: expected %s, not \"%s\" (line %ld of %s)\n",
what
, Ptok
, Plineno
, Pfname
);
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
else if (!strcmp(Ptok
+1, "1_fp"))
else if (!strcmp(Ptok
+1, "8_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
else if (!strcmp(Ptok
+1, "1_fp"))
else if (!strcmp(Ptok
+1, "2_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "_fp"))
if (!strcmp(Ptok
+1, "har"))
else if (!strcmp(Ptok
+1, "omplex"))
if (!strcmp(Ptok
+1, "oublereal"))
else if (!strcmp(Ptok
+1, "oublecomplex"))
if (!strcmp(Ptok
+1, "tnlen"))
if (!strcmp(Ptok
+1, "nteger"))
if (!strcmp(Ptok
+1, "ogical")) {
else if (!strcmp(Ptok
+1, "ogical1"))
if (!strcmp(Ptok
+1, "eal"))
if (!strcmp(Ptok
+1, "hortint"))
else if (!strcmp(Ptok
+1, "hortlogical")) {
if (tnext
== tfirst
&& !strcmp(Ptok
+1, "oid")) {
if ((i
= Ptoken(pf
,0)) != /*(*/ ')')
wanted(i
, /*(*/ "\")\"");
if (rv
< 100 && (i
= Ptoken(pf
,0)) != '*')
if ((i
= Ptoken(pf
,0)) == P_anum
)
i
= Ptoken(pf
,0); /* skip variable name */
wanted(i
, "\",\" or \")\"");
s
= Ptok
+ strlen(Ptok
) - 1;
"warning: %s does not end in _ (line %ld of %s)\n",
strncpy(buf
, Ptok
, n
= s
- Ptok
);
fprintf(stderr
, "%s for %s (line %ld of %s):\n\t", msg
,
p
->fextname
, Plineno
, Pfname
);
Pbadmsg("inconsistent types",p
);
fprintf(stderr
, "here %s, previously %s\n",
Argtype(p
->extype
+200,buf2
));
if (p
->extype
!= ftype
) {
Pbadmsg("differing numbers of arguments",p
);
fprintf(stderr
, "here %d, previously %d\n",
for(aty
= at
->atypes
; t
< te
; t
++, aty
++) {
if (k
== TYUNKNOWN
+ 200)
&& !type_fixup(at
,aty
,k
))
else if (j
% 100 % TYSUBR
!= k
% TYSUBR
&& !type_fixup(at
,aty
,k
))
else if (k
< 200 || j
< 200)
else if (k
== TYUNKNOWN
+200)
else if (j
!= TYUNKNOWN
+200)
Pbadmsg("differing calling sequences",p
);
"arg %d: here %s, prevously %s\n",
i
, Argtype(k
,buf1
), Argtype(j
,buf2
));
/* We've subsequently learned the right type,
as in the call on zoo below...
if (p
->extstg
== STGCOMMON
) {
k
= sizeof(Argtypes
) + (i
-1)*sizeof(Atype
);
at
= p
->arginfo
= (Argtypes
*)gmem(k
,1);
at
->dnargs
= at
->nargs
= i
;
at
->defined
= at
->changes
= 0;
for(aty
= at
->atypes
; t
< te
; aty
++) {
|| (s
[-1] != 'P' && s
[-1] != 'p'))
if (!(pf
= fopen(fname
, textread
))) {
fprintf(stderr
, "can't open %s\n", fname
);
for(s
= " \t\n\r\v\f"; *s
; s
++)
for(s
= "*,();"; *s
; s
++)
for(i
= '0'; i
<= '9'; i
++)
for(s
= "abcdefghijklmnopqrstuvwxyz"; i
= *s
; s
++)
Pct
[i
] = Pct
[i
+'A'-'a'] = P_anum
;
|| !strcmp(Ptok
, "extern") && (i
= Ptoken(pf
,0)) != P_anum
)
if ((i
= Ptoken(pf
,0)) != P_anum
)
p
= mkext(trimunder(), Ptok
);
if ((i
= Ptoken(pf
,0)) != '(')
if (p
->arginfo
->nargs
< 0)
wanted(i
, "\";\" or \",\"");
char **f1files
, **f1files0
, *s
;
f1files0
= f1files
= ffiles
;
/* following should be unnecessary, as we won't be back here */
tfirst
= tnext
= tlast
= 0;
for (e
= extsymtab
; e
< ee
; e
++)
if (at
->nargs
< 0 || at
->changes
)
"%d prototype%s updated while reading prototypes.\n", k
,