summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjmz <jmz@FreeBSD.org>1997-04-13 01:13:52 +0000
committerjmz <jmz@FreeBSD.org>1997-04-13 01:13:52 +0000
commit5d93c9d5fb208d10eacf608b44ee02d3cd5b4a16 (patch)
treeac4dad5704ec3ceee2678cc665cb3fad24d50c45
parent5b8c55b34e7a6f0087c138e43e85652af3f37aee (diff)
downloadFreeBSD-src-5d93c9d5fb208d10eacf608b44ee02d3cd5b4a16.zip
FreeBSD-src-5d93c9d5fb208d10eacf608b44ee02d3cd5b4a16.tar.gz
Upgrade to the 1997/02/19 version.
-rw-r--r--include/f2c.h11
-rw-r--r--usr.bin/f2c/Notice2
-rw-r--r--usr.bin/f2c/README43
-rw-r--r--usr.bin/f2c/cds.c26
-rw-r--r--usr.bin/f2c/data.c44
-rw-r--r--usr.bin/f2c/defines.h10
-rw-r--r--usr.bin/f2c/defs.h42
-rw-r--r--usr.bin/f2c/disclaimer15
-rw-r--r--usr.bin/f2c/equiv.c45
-rw-r--r--usr.bin/f2c/error.c28
-rw-r--r--usr.bin/f2c/exec.c41
-rw-r--r--usr.bin/f2c/expr.c134
-rw-r--r--usr.bin/f2c/f2c.116
-rw-r--r--usr.bin/f2c/f2c.h11
-rw-r--r--usr.bin/f2c/format.c53
-rw-r--r--usr.bin/f2c/formatdata.c30
-rw-r--r--usr.bin/f2c/gram.dcl22
-rw-r--r--usr.bin/f2c/gram.exec8
-rw-r--r--usr.bin/f2c/gram.head1
-rw-r--r--usr.bin/f2c/init.c31
-rw-r--r--usr.bin/f2c/intr.c126
-rw-r--r--usr.bin/f2c/io.c39
-rw-r--r--usr.bin/f2c/lex.c111
-rw-r--r--usr.bin/f2c/main.c79
-rw-r--r--usr.bin/f2c/malloc.c27
-rw-r--r--usr.bin/f2c/mem.c26
-rw-r--r--usr.bin/f2c/memset.c26
-rw-r--r--usr.bin/f2c/misc.c35
-rw-r--r--usr.bin/f2c/names.c57
-rw-r--r--usr.bin/f2c/niceprintf.c28
-rw-r--r--usr.bin/f2c/output.c125
-rw-r--r--usr.bin/f2c/p1output.c28
-rw-r--r--usr.bin/f2c/parse_args.c63
-rw-r--r--usr.bin/f2c/permission23
-rw-r--r--usr.bin/f2c/pread.c28
-rw-r--r--usr.bin/f2c/proc.c68
-rw-r--r--usr.bin/f2c/put.c31
-rw-r--r--usr.bin/f2c/putpcc.c125
-rw-r--r--usr.bin/f2c/sysdep.c44
-rw-r--r--usr.bin/f2c/sysdep.h32
-rw-r--r--usr.bin/f2c/vax.c38
-rw-r--r--usr.bin/f2c/version.c4
42 files changed, 1110 insertions, 666 deletions
diff --git a/include/f2c.h b/include/f2c.h
index 8f18f6c..6514cd9 100644
--- a/include/f2c.h
+++ b/include/f2c.h
@@ -8,6 +8,7 @@
#define F2C_INCLUDE
typedef long int integer;
+typedef unsigned long uinteger;
typedef char *address;
typedef short int shortint;
typedef float real;
@@ -18,7 +19,12 @@ typedef long int logical;
typedef short int shortlogical;
typedef char logical1;
typedef char integer1;
-/* typedef long long longint; */ /* system-dependent */
+#if 0 /* Adjust for integer*8. */
+typedef long long longint; /* system-dependent */
+typedef unsigned long long ulongint; /* system-dependent */
+#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
+#endif
#define TRUE_ (1)
#define FALSE_ (0)
@@ -154,6 +160,9 @@ typedef struct Namelist Namelist;
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (doublereal)min(a,b)
#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b) ((a) >> (b) & 1)
+#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
/* procedure parameter types for -A and -C++ */
diff --git a/usr.bin/f2c/Notice b/usr.bin/f2c/Notice
index 9715a19..8db1d7b 100644
--- a/usr.bin/f2c/Notice
+++ b/usr.bin/f2c/Notice
@@ -1,5 +1,5 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1997 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
diff --git a/usr.bin/f2c/README b/usr.bin/f2c/README
index b8e5a67..8267bea 100644
--- a/usr.bin/f2c/README
+++ b/usr.bin/f2c/README
@@ -9,8 +9,8 @@ you have a K&R C compiler), compile with -DKR_headers .
On non-Unix systems where files have separate binary and text modes,
you may need to "make xsumr.out" rather than "make xsum.out".
-If (in accordance with what follows) you need to modify the makefile
-or any of the source files, first issue a "make xsum.out" (or, if
+If (in accordance with what follows) you need to any of the source
+files (excluding the makefile), first issue a "make xsum.out" (or, if
appropriate, "make xsumr.out") to check the validity of the f2c source,
then make your changes, then type "make f2c".
@@ -21,13 +21,13 @@ system.
Should you get the message "xsum0.out xsum1.out differ", see what lines
are different (`diff xsum0.out xsum1.out`) and ask netlib
-(e.g., netlib@research.att.com) to send you the files in question,
+(e.g., netlib@netlib.bell-labs.com) to send you the files in question,
plus the current xsum0.out (which may have changed) "from f2c/src".
For example, if exec.c and expr.c have incorrect check sums, you would
send netlib the message
send exec.c expr.c xsum0.out from f2c/src
-You can also ftp these files from netlib.att.com; for more details, ask
-netlib@research.att.com to "send readme from f2c".
+You can also ftp these files from netlib.bell-labs.com; for more
+details, ask netlib@netlib.bell-labs.com to "send readme from f2c".
On some systems, the malloc and free in malloc.c let f2c run faster
than do the standard malloc and free. Other systems may not tolerate
@@ -38,7 +38,10 @@ system, you may either modify the makefile appropriately (remove
cc -c -DCRAY malloc.c
before typing "make". Still other systems have a -lmalloc that
provides performance competitive with that from malloc.c; you may
-wish to compare the two on your system.
+wish to compare the two on your system. In general, if f2c faults
+when you first try to run it, try compiling malloc.c with -DCRAY;
+this is necessary with at least one version of Linux (but not with
+others).
On some BSD systems, you may need to create a file named "string.h"
whose single line is
@@ -88,6 +91,26 @@ other systems, just compile all the .c files in libF77 and libI77,
and put the resulting objects (except one or both of the Version
objects) into a library, called perhaps f2c.lib .
+In general, under Linux it is necessary to compile libI77 with
+-DNON_UNIX_STDIO . Under at least one variant of Linux, you can make
+and install a shared-library version of libf2c by compiling libI77
+with -DNON_UNIX_STDIO, creating libf2c.a as above, and then executing
+
+ mkdir t
+ ln lib?77/*.o t
+ cd t; cc -shared -o ../libf2c.so -Wl,-soname,libf2c.so.1 *.o
+ cd ..
+ rm -r t
+ rm /usr/lib/libf2c*
+ mv libf2c.a libf2c.so /usr/lib
+ cd /usr/lib
+ ln libf2c.so libf2c.so.1
+ ln libf2c.so libf2c.so.1.0.0
+
+On some other systems, /usr/local/lib is the appropriate installation
+directory.
+
+
Some older C compilers object to
typedef void (*foo)();
or to
@@ -127,19 +150,19 @@ send the E-mail message
send dtoa.c g_fmt.c from fp
-to netlib@research.att.com (or use anonymous ftp from netlib.att.com
-and look in directory /netlib/fp).
+to netlib@netlib.bell-labs.com (or use anonymous ftp from
+netlib.bell-labs.com and look in directory /netlib/fp).
The makefile has a rule for creating tokdefs.h. If you cannot use the
makefile, an alternative is to extract tokdefs.h from the beginning of
gram.c: it's the first 100 lines.
-Please send bug reports to dmg@research.att.com . The old index file
+Please send bug reports to dmg@bell-labs.com . The old index file
(now called "readme" due to unfortunate changes in netlib conventions:
"send readme from f2c") will report recent changes in the recent-change
log at its end; all changes will be shown in the "changes" file
("send changes from f2c"). To keep current source, you will need to
request xsum0.out and version.c, in addition to the changed source
-files. Changes first appear on netlib@research.att.com, and in due
+files. Changes first appear on netlib@netlib.bell-labs.com, and in due
time propagate to the other netlib sites that are kept current.
diff --git a/usr.bin/f2c/cds.c b/usr.bin/f2c/cds.c
index 80e91ae..e5bacaa 100644
--- a/usr.bin/f2c/cds.c
+++ b/usr.bin/f2c/cds.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1993, 1994 by AT&T, Lucent Technologies 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.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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
-this software.
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* Put strings representing decimal floating-point numbers
diff --git a/usr.bin/f2c/data.c b/usr.bin/f2c/data.c
index 44b84ef..7454039 100644
--- a/usr.bin/f2c/data.c
+++ b/usr.bin/f2c/data.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1993 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1993 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -77,7 +77,8 @@ dataval(register expptr repp, register expptr valp)
p = nextdata(&elen);
if(p == NULL)
{
- err("too many initializers");
+ if (lineno != err_lineno)
+ err("too many initializers");
toomanyinit = YES;
goto ret;
}
@@ -449,7 +450,7 @@ make_param(register struct Paramblock *p, expptr e)
#endif
{
register expptr q;
- struct Constblock qc;
+ Constp qc;
if (p->vstg == STGARG)
errstr("Dummy argument %.50s appears in a parameter statement.",
@@ -463,11 +464,12 @@ make_param(register struct Paramblock *p, expptr e)
if (q->tag == TEXPR)
p->paramval = q = fixexpr((Exprp)q);
if (q->tag == TADDR && q->addrblock.uname_tag == UNAM_CONST) {
- qc.Const = q->addrblock.user.Const;
- qc.tag = TCONST;
- qc.vtype = q->addrblock.vtype;
- qc.vleng = q->addrblock.vleng;
- q = (expptr)&qc;
+ qc = mkconst(TYCHAR);
+ qc->Const = q->addrblock.user.Const;
+ qc->vleng = q->addrblock.vleng;
+ q->addrblock.vleng = 0;
+ frexpr(q);
+ p->paramval = q = (expptr)qc;
}
if (!ISCONST(q) || q->constblock.vtype != TYCHAR) {
errstr("invalid value for character parameter %s",
diff --git a/usr.bin/f2c/defines.h b/usr.bin/f2c/defines.h
index db23ade..1ed4537 100644
--- a/usr.bin/f2c/defines.h
+++ b/usr.bin/f2c/defines.h
@@ -187,6 +187,14 @@ typedef long int ftnint;
#define OPDABS 59 /* abs macro under forcedouble */
#define OPMIN2 60 /* min(a,b) macro */
#define OPMAX2 61 /* max(a,b) macro */
+#define OPBITTEST 62 /* btest */
+#define OPBITCLR 63 /* ibclr */
+#define OPBITSET 64 /* ibset */
+#define OPQBITCLR 65 /* ibclr, integer*8 */
+#define OPQBITSET 66 /* ibset, integer*8 */
+#define OPBITBITS 67 /* ibits */
+#define OPBITSH 68 /* ishft */
+#define OPBITSHC 69 /* ishftc */
/* label type codes -- used with the ASSIGN statement */
@@ -206,6 +214,7 @@ typedef long int ftnint;
#define INTRSPEC 5
#define INTRBOOL 6
#define INTRCNST 7 /* constants, e.g. bigint(1.0) v. bigint (1d0) */
+#define INTRBGEN 8 /* bit manipulation */
/* I/O statement codes - these all form Integer Constants, and are always
@@ -244,6 +253,7 @@ typedef long int ftnint;
#define IDENT_LEN 31 /* Maximum length user.ident */
+#define MAXNAMELEN 50 /* Maximum Fortran name length */
/* type masks - TYLOGICAL defined in ftypes */
diff --git a/usr.bin/f2c/defs.h b/usr.bin/f2c/defs.h
index 3404f14..2d80862 100644
--- a/usr.bin/f2c/defs.h
+++ b/usr.bin/f2c/defs.h
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories, Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "sysdep.h"
@@ -75,7 +75,7 @@ extern long headoffset; /* Since the header block requires data we
extern char main_alias[]; /* name given to PROGRAM psuedo-op */
extern char *token;
extern int maxtoklen, toklen;
-extern long lineno;
+extern long err_lineno, lineno;
extern char *infname;
extern int needkwd;
extern struct Labelblock *thislabel;
@@ -150,7 +150,7 @@ extern flag multitype; /* YES iff there is more than one return value
possible */
extern int blklevel;
extern long lastiolabno;
-extern int lastlabno;
+extern long lastlabno;
extern int lastvarno;
extern int lastargslot; /* integer offset pointing to the next free
location for an argument to the current routine */
@@ -227,6 +227,7 @@ struct Ctlframe
int ctlabels[4]; /* Control labels, defined below */
int dolabel; /* label marking end of this DO loop */
Namep donamep; /* DO index variable */
+ expptr doinit; /* for use with -onetrip */
expptr domax; /* constant or temp variable holding MAX
loop value; or expr of while(expr) */
expptr dostep; /* expression */
@@ -359,7 +360,7 @@ extern struct Hashentry *lasthash;
struct Intrpacked /* bits for intrinsic function description */
{
- unsigned f1:3;
+ unsigned f1:4;
unsigned f2:4;
unsigned f3:7;
unsigned f4:1;
@@ -714,9 +715,9 @@ struct Eqvchain
struct Literal
{
short littype;
- short litnum; /* numeric part of the assembler
+ short lituse; /* usage count */
+ long litnum; /* numeric part of the assembler
label for this constant value */
- int lituse; /* usage count */
union {
ftnint litival;
double litdval[2];
@@ -958,7 +959,7 @@ int ncat Argdcl((expptr));
void negate_const Argdcl((Constp));
void new_endif(Void);
Extsym* newentry Argdcl((Namep, int));
-int newlabel(Void);
+long newlabel(Void);
void newproc(Void);
Addrp nextdata Argdcl((long*));
void nice_printf Argdcl((FILEP, char*, ...));
@@ -1019,6 +1020,7 @@ void setimpl Argdcl((int, long, int, int));
void setintr Argdcl((Namep));
void settype Argdcl((Namep, int, long));
void sigcatch Argdcl((int));
+void sserr Argdcl((Namep));
void start_formatting(Void);
void startioctl(Void);
void startproc Argdcl((Extsym*, int));
diff --git a/usr.bin/f2c/disclaimer b/usr.bin/f2c/disclaimer
deleted file mode 100644
index 59db1ec..0000000
--- a/usr.bin/f2c/disclaimer
+++ /dev/null
@@ -1,15 +0,0 @@
-f2c is a Fortran to C converter under development by
- David Gay (AT&T Bell Labs)
- Stu Feldman (Bellcore)
- Mark Maimone (Carnegie-Mellon University)
- Norm Schryer (AT&T Bell Labs)
-Please send bug reports to dmg@research.att.com or uunet!research!dmg.
-
-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
-this software.
diff --git a/usr.bin/f2c/equiv.c b/usr.bin/f2c/equiv.c
index 645a77a..0b7c94c 100644
--- a/usr.bin/f2c/equiv.c
+++ b/usr.bin/f2c/equiv.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1993-5 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1993-6 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -68,7 +68,8 @@ doequiv(Void)
for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
{
offset = 0;
- primp = q->eqvitem.eqvlhs;
+ if (!(primp = q->eqvitem.eqvlhs))
+ continue;
vardcl(np = primp->namep);
if(primp->argsp || primp->fcharp)
{
@@ -396,3 +397,17 @@ nsubs(register struct Listblock *p)
return(n);
}
+
+ struct Primblock *
+#ifdef KR_headers
+primchk(e) expptr e;
+#else
+primchk(expptr e)
+#endif
+{
+ if (e->headblock.tag != TPRIM) {
+ err("Invalid name in EQUIVALENCE.");
+ return 0;
+ }
+ return &e->primblock;
+ }
diff --git a/usr.bin/f2c/error.c b/usr.bin/f2c/error.c
index 049008e..0899d82 100644
--- a/usr.bin/f2c/error.c
+++ b/usr.bin/f2c/error.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1993, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
diff --git a/usr.bin/f2c/exec.c b/usr.bin/f2c/exec.c
index bcd1e08..5e3d7b2 100644
--- a/usr.bin/f2c/exec.c
+++ b/usr.bin/f2c/exec.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1993 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1993 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -536,12 +536,16 @@ exdo(int range, Namep loopname, chainp spec)
/* Declare the loop initialization value, casting it properly and declaring a
register if need be */
+ ctlstack->doinit = 0;
if (ISCONST (DOINIT) || !onetripflag)
/* putx added 6-29-89 (mwm), not sure if fixtype is required, but I doubt it
since mkconv is called just before */
doinit = putx (mkconv (dotype, DOINIT));
- else {
- doinit = (expptr) mktmp(dotype, ENULL);
+ else {
+ if (onetripflag)
+ ctlstack->doinit = doinit = (expptr) mktmp0(dotype, ENULL);
+ else
+ doinit = (expptr) mktmp(dotype, ENULL);
puteq (cpexpr (doinit), DOINIT);
} /* else */
@@ -601,7 +605,8 @@ exdo(int range, Namep loopname, chainp spec)
if (onetripflag)
test = mkexpr (OPOR, test,
mkexpr (OPEQ, cpexpr((expptr)dovarp), cpexpr (doinit)));
- init = mkexpr (OPASSIGN, cpexpr((expptr)dovarp), doinit);
+ init = mkexpr (OPASSIGN, cpexpr((expptr)dovarp),
+ ctlstack->doinit ? cpexpr(doinit) : doinit);
inc = mkexpr (OPPLUSEQ, (expptr)dovarp, cpexpr (ctlstack -> dostep));
if (!onetripflag && ISCONST (ctlstack -> domax) && ISCONST (doinit)
@@ -697,6 +702,8 @@ enddo(int here)
frtemp((Addrp)e);
else
frexpr(e);
+ if (e = ctlstack->doinit)
+ frtemp((Addrp)e);
}
else if (ctlstack->dowhile)
p1for_end ();
diff --git a/usr.bin/f2c/expr.c b/usr.bin/f2c/expr.c
index 258facc..59ea9b6 100644
--- a/usr.bin/f2c/expr.c
+++ b/usr.bin/f2c/expr.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -317,7 +317,8 @@ mkconv(register int t, register expptr p)
/* If we're casting a constant which is not in the literal table ... */
- else if( ISCONST(p) && pt!=TYADDR && pt != TYCHAR)
+ else if( ISCONST(p) && pt!=TYADDR && pt != TYCHAR
+ || p->tag == TADDR && p->addrblock.uname_tag == UNAM_CONST)
{
if (ISINT(t) && ISINT(pt) || ISREAL(t) && ISREAL(pt)) {
/* avoid trouble with -i2 */
@@ -326,6 +327,8 @@ mkconv(register int t, register expptr p)
}
q = (expptr) mkconst(t);
consconv(t, &q->constblock, &p->constblock );
+ if (p->tag == TADDR)
+ q->constblock.vstg = p->addrblock.user.kludge.vstg1;
frexpr(p);
}
else {
@@ -921,26 +924,35 @@ fixargs(int doput, struct Listblock *p0)
p->datap = doput ? (char *)putconst((Constp)q)
: (char *)q;
+ continue;
}
/* Take a function name and turn it into an Addr. This only happens when
nothing else has figured out the function beforehand */
- else if(qtag==TPRIM && q->primblock.argsp==0 &&
- q->primblock.namep->vclass==CLPROC &&
- q->primblock.namep->vprocclass != PTHISPROC)
+ if (qtag == TPRIM && q->primblock.argsp == 0) {
+ if (q->primblock.namep->vclass==CLPROC
+ && q->primblock.namep->vprocclass != PTHISPROC) {
p->datap = (char *)mkaddr(q->primblock.namep);
+ continue;
+ }
- else if(qtag==TPRIM && q->primblock.argsp==0 &&
- q->primblock.namep->vdim!=NULL)
+ if (q->primblock.namep->vdim != NULL) {
p->datap = (char *)mkscalar(q->primblock.namep);
+ if ((q->primblock.fcharp||q->primblock.lcharp)
+ && (q->primblock.namep->vtype != TYCHAR
+ || q->primblock.namep->vdim))
+ sserr(q->primblock.namep);
+ continue;
+ }
- else if(qtag==TPRIM && q->primblock.argsp==0 &&
- q->primblock.namep->vdovar &&
- (t = (tagptr) memversion(q->primblock.namep)) )
+ if (q->primblock.namep->vdovar
+ && (t = (tagptr) memversion(q->primblock.namep))) {
p->datap = (char *)fixtype(t);
- else
- p->datap = (char *)fixtype(q);
+ continue;
+ }
+ }
+ p->datap = (char *)fixtype(q);
}
return(nargs);
}
@@ -1004,7 +1016,6 @@ adjust_arginfo(register Namep np)
}
-
expptr
#ifdef KR_headers
mkfunct(p0)
@@ -1412,10 +1423,12 @@ mklhs(register struct Primblock *p, int subkeep)
if(p->fcharp || p->lcharp)
{
if(np->vtype != TYCHAR)
- errstr("substring of noncharacter %s", np->fvarname);
+ sserr(np);
else {
if(p->lcharp == NULL)
- p->lcharp = (expptr) cpexpr(s->vleng);
+ p->lcharp = (expptr)(
+ /* s->vleng == 0 only with errors */
+ s->vleng ? cpexpr(s->vleng) : ICON(1));
if(p->fcharp) {
doing_vleng = 1;
s->vleng = fixtype(mkexpr(OPMINUS,
@@ -2246,6 +2259,13 @@ addop:
case OPBITNOT:
case OPLSHIFT:
case OPRSHIFT:
+ case OPBITTEST:
+ case OPBITCLR:
+ case OPBITSET:
+#ifdef TYQUAD
+ case OPQBITCLR:
+ case OPQBITSET:
+#endif
case OPLT:
case OPGT:
@@ -2408,7 +2428,8 @@ cktype(register int op, register int lt, register int rt)
else if( ! ISNUMERIC(lt) || ! ISNUMERIC(rt) )
ERR("comparison of nonarithmetic data")
- return(TYLOGICAL);
+ case OPBITTEST:
+ return(TYLOGICAL);
case OPCONCAT:
if(lt==TYCHAR && rt==TYCHAR)
@@ -2472,6 +2493,17 @@ cktype(register int op, register int lt, register int rt)
case OPDABS:
return(lt);
+ case OPBITCLR:
+ case OPBITSET:
+ if (lt < TYLONG)
+ lt = TYLONG;
+ return(lt);
+#ifdef TYQUAD
+ case OPQBITCLR:
+ case OPQBITSET:
+ return TYQUAD;
+#endif
+
case OPCOMMA:
case OPCOMMA_ARG:
case OPQUEST:
@@ -2638,10 +2670,25 @@ fold(register expptr e)
break;
case OPRSHIFT:
- p->Const.ci = lp->constblock.Const.ci >>
+ p->Const.ci = (unsigned long)lp->constblock.Const.ci >>
rp->constblock.Const.ci;
break;
+ case OPBITTEST:
+ p->Const.ci = (lp->constblock.Const.ci &
+ 1L << rp->constblock.Const.ci) != 0;
+ break;
+
+ case OPBITCLR:
+ p->Const.ci = lp->constblock.Const.ci &
+ ~(1L << rp->constblock.Const.ci);
+ break;
+
+ case OPBITSET:
+ p->Const.ci = lp->constblock.Const.ci |
+ 1L << rp->constblock.Const.ci;
+ break;
+
case OPCONCAT:
ll = lp->constblock.vleng->constblock.Const.ci;
lr = rp->constblock.vleng->constblock.Const.ci;
@@ -2895,8 +2942,17 @@ conspower(Constp p, Constp ap, ftnint n)
x0.vstg = 0;
if(n < 0)
{
+ n = -n;
if( ISINT(type) )
{
+ switch(ap->Const.ci) {
+ case 0:
+ err("0 ** negative number");
+ return;
+ case 1:
+ case -1:
+ goto mult;
+ }
err("integer ** negative number");
return;
}
@@ -2905,11 +2961,10 @@ conspower(Constp p, Constp ap, ftnint n)
err("0.0 ** negative number");
return;
}
- n = -n;
consbinop(OPSLASH, type, &x, p, &x0);
}
else
- consbinop(OPSTAR, type, &x, p, &x0);
+ mult: consbinop(OPSTAR, type, &x, p, &x0);
for( ; ; )
{
@@ -3132,6 +3187,8 @@ consbinop(int opcode, int type, Constp cpp, Constp app, Constp bpp)
k = 0;
else k = 1;
break;
+ case TYLOGICAL:
+ k = ap->ci - bp->ci;
}
switch(opcode)
@@ -3364,3 +3421,16 @@ zdiv(register dcomplex *c, register dcomplex *a, register dcomplex *b)
c->dimag = (a->dimag - a->dreal*ratio) / den;
}
}
+
+
+ void
+#ifdef KR_headers
+sserr(np) Namep np;
+#else
+sserr(Namep np)
+#endif
+{
+ errstr(np->vtype == TYCHAR
+ ? "substring of character array %.70s"
+ : "substring of noncharacter %.73s", np->fvarname);
+ }
diff --git a/usr.bin/f2c/f2c.1 b/usr.bin/f2c/f2c.1
index 9c3d537..4011fcb 100644
--- a/usr.bin/f2c/f2c.1
+++ b/usr.bin/f2c/f2c.1
@@ -3,7 +3,7 @@
.\" the file /usr/src/bin/f2c/Notice states:
.\"
.\"/****************************************************************
-.\"Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore.
+.\"Copyright 1990 - 1997 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
@@ -35,12 +35,15 @@
.Nm f2c
.Op Fl AaCcEfgpRrsUuw
.Op Fl C++
+.Op Fl cd
+.Op Fl d Ar dir
.Op Fl ec
.Op Fl e1c
.Op Fl ext
.Op Fl h Ns Op Cm d
.Op Fl \&I2
.Op Fl \&i2
+.Op Fl i90
.Op Fl kr Ns Op Cm d
.Op Fl o Ar name
.Op Fl onetrip
@@ -96,6 +99,14 @@ Compile code to check that subscripts are within declared array bounds.
Output C++ code.
.It Fl c
Include original Fortran source as comments.
+.It Fl cd
+Do not recognize cdabs, cdcos, cdexp, cdlog, cdsin, and
+cdsqrt as synonyms for the double complex intrinsics
+zabs, zcos, zexp, zlog, zsin, and zsqrt, respectively.
+.It Fl d Ar dir
+Write `.c' files in directory
+.Ar dir
+instead of the current directory
.It Fl E
Declare uninitialized COMMON to be Extern (overridably defined in
.Pa f2c.h
@@ -150,6 +161,9 @@ and
.Fl Df2c_i2 ),
so INTEGER and LOGICAL variables may be assigned by INQUIRE and array lengths
are stored in short ints
+.It Fl i90
+Do not recognize the Fortran 90 bit-manipulation intrinsics btest,
+iand, ibclr, ibits, ibset, ieor, ior, ishft, and ishftc.
.It Fl kr Ns Op Cm d
Use temporary values to enforce Fortran expression evaluation
where K&R (first edition) parenthesization rules allow rearrangement.
diff --git a/usr.bin/f2c/f2c.h b/usr.bin/f2c/f2c.h
index 8f18f6c..6514cd9 100644
--- a/usr.bin/f2c/f2c.h
+++ b/usr.bin/f2c/f2c.h
@@ -8,6 +8,7 @@
#define F2C_INCLUDE
typedef long int integer;
+typedef unsigned long uinteger;
typedef char *address;
typedef short int shortint;
typedef float real;
@@ -18,7 +19,12 @@ typedef long int logical;
typedef short int shortlogical;
typedef char logical1;
typedef char integer1;
-/* typedef long long longint; */ /* system-dependent */
+#if 0 /* Adjust for integer*8. */
+typedef long long longint; /* system-dependent */
+typedef unsigned long long ulongint; /* system-dependent */
+#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
+#endif
#define TRUE_ (1)
#define FALSE_ (0)
@@ -154,6 +160,9 @@ typedef struct Namelist Namelist;
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (doublereal)min(a,b)
#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b) ((a) >> (b) & 1)
+#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
/* procedure parameter types for -A and -C++ */
diff --git a/usr.bin/f2c/format.c b/usr.bin/f2c/format.c
index 10aa39d..bcd9b99 100644
--- a/usr.bin/f2c/format.c
+++ b/usr.bin/f2c/format.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* Format.c -- this file takes an intermediate file (generated by pass 1
@@ -436,7 +436,7 @@ addrlit(addrp)
addrlit(Addrp addrp)
#endif
{
- int memno = addrp->memno;
+ long memno = addrp->memno;
struct Literal *litp, *lastlit;
lastlit = litpool + nliterals;
@@ -1347,16 +1347,23 @@ write_assigned_fmts(FILE *outfile)
{
register chainp cp;
Namep np;
+ char *comma, *type;
int did_one = 0;
cp = assigned_fmts = revchain(assigned_fmts);
- nice_printf(outfile, "/* Assigned format variables */\nchar ");
+ nice_printf(outfile, "/* Assigned format variables */\n");
do {
np = (Namep)cp->datap;
- if (did_one)
- nice_printf(outfile, ", ");
- did_one = 1;
- nice_printf(outfile, "*%s_fmt", np->fvarname);
+ if (did_one == np->vstg) {
+ comma = ", ";
+ type = "";
+ }
+ else {
+ comma = did_one ? ";\n" : "";
+ type = np->vstg == STGAUTO ? "char " : "static char ";
+ did_one = np->vstg;
+ }
+ nice_printf(outfile, "%s%s*%s_fmt", comma, type, np->fvarname);
}
while(cp = cp->nextp);
nice_printf(outfile, ";\n\n");
@@ -1818,7 +1825,7 @@ list_decls(FILE *outfile)
"%.64s declared EXTERNAL but never used.",
var->fvarname);
/* to retain names declared EXTERNAL */
- /* but not referenced, change
+ /* but not referenced, change */
/* "continue" to "stg = STGEXT" */
continue;
}
@@ -2507,8 +2514,8 @@ do_p1_elseifstart(outfile)
#else
do_p1_elseifstart(FILE *outfile)
#endif
-{
- if (*ei_next++) {
+{ /* with sufficiently illegal input, ei_next == ei_last == 0 is possible */
+ if (ei_next < ei_last && *ei_next++) {
prev_tab(outfile);
nice_printf(outfile, /*{*/
"} else /* if(complicated condition) */ {\n" /*}*/ );
diff --git a/usr.bin/f2c/formatdata.c b/usr.bin/f2c/formatdata.c
index 690ee10..501463a 100644
--- a/usr.bin/f2c/formatdata.c
+++ b/usr.bin/f2c/formatdata.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1993-5 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1993-6 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -961,7 +961,7 @@ wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
#endif
TYLONG, TYDREAL, TYLONG, TYDREAL,
TYCHAR, TYSHORT,
- TYLONG, TYCHAR};
+ TYLONG, TYCHAR, 0 /* for TYBLANK */ };
extern int htype;
char *z;
diff --git a/usr.bin/f2c/gram.dcl b/usr.bin/f2c/gram.dcl
index fadbb5b..b30a45c 100644
--- a/usr.bin/f2c/gram.dcl
+++ b/usr.bin/f2c/gram.dcl
@@ -138,11 +138,11 @@ equivset: SLPAR equivlist SRPAR
equivlist: lhs
{ $$=ALLOC(Eqvchain);
- $$->eqvitem.eqvlhs = (struct Primblock *)$1;
+ $$->eqvitem.eqvlhs = primchk($1);
}
| equivlist SCOMMA lhs
{ $$=ALLOC(Eqvchain);
- $$->eqvitem.eqvlhs = (struct Primblock *) $3;
+ $$->eqvitem.eqvlhs = primchk($3);
$$->eqvnextp = $1;
}
;
@@ -229,6 +229,7 @@ var: name dims
datavar: lhs
{ Namep np;
+ struct Primblock *pp = (struct Primblock *)$1;
int tt = $1->tag;
if (tt != TPRIM) {
if (tt == TCONST)
@@ -236,16 +237,27 @@ datavar: lhs
else
erri("tag %d in data statement",tt);
$$ = 0;
+ err_lineno = lineno;
break;
}
- np = ( (struct Primblock *) $1) -> namep;
+ np = pp -> namep;
vardcl(np);
+ if ((pp->fcharp || pp->lcharp)
+ && (np->vtype != TYCHAR || np->vdim))
+ sserr(np);
if(np->vstg == STGCOMMON)
extsymtab[np->vardesc.varno].extinit = YES;
else if(np->vstg==STGEQUIV)
eqvclass[np->vardesc.varno].eqvinit = YES;
- else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
- dclerr("inconsistent storage classes", np);
+ else if(np->vstg!=STGINIT && np->vstg!=STGBSS) {
+ errstr(np->vstg == STGARG
+ ? "Dummy argument \"%.60s\" in data statement."
+ : "Cannot give data to \"%.75s\"",
+ np->fvarname);
+ $$ = 0;
+ err_lineno = lineno;
+ break;
+ }
$$ = mkchain((char *)$1, CHNULL);
}
| SLPAR datavarlist SCOMMA dospec SRPAR
diff --git a/usr.bin/f2c/gram.exec b/usr.bin/f2c/gram.exec
index 0dc6010..39d7e42 100644
--- a/usr.bin/f2c/gram.exec
+++ b/usr.bin/f2c/gram.exec
@@ -1,10 +1,10 @@
exec: iffable
- | SDO end_spec intonlyon label intonlyoff opt_comma dospecw
+ | SDO end_spec label opt_comma dospecw
{
- if($4->labdefined)
+ if($3->labdefined)
execerr("no backward DO loops", CNULL);
- $4->blklevel = blklevel+1;
- exdo($4->labelno, NPNULL, $7);
+ $3->blklevel = blklevel+1;
+ exdo($3->labelno, NPNULL, $5);
}
| SDO end_spec opt_comma dospecw
{
diff --git a/usr.bin/f2c/gram.head b/usr.bin/f2c/gram.head
index dd822fd..183dfeb 100644
--- a/usr.bin/f2c/gram.head
+++ b/usr.bin/f2c/gram.head
@@ -48,6 +48,7 @@ extern flag intonly;
static chainp datastack;
extern long laststfcn, thisstno;
extern int can_include; /* for netlib */
+extern struct Primblock *primchk Argdcl((expptr));
#define ESNULL (Extsym *)0
#define NPNULL (Namep)0
diff --git a/usr.bin/f2c/init.c b/usr.bin/f2c/init.c
index c9a9702..bc0dff4 100644
--- a/usr.bin/f2c/init.c
+++ b/usr.bin/f2c/init.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -56,6 +56,7 @@ FILEP blkdfile;
char *token;
int maxtoklen, toklen;
+long err_lineno;
long lineno; /* Current line in the input file, NOT the
Fortran statement label number */
char *infname;
@@ -220,7 +221,7 @@ int nallchargs;
flag multitype;
ftnint procleng;
long lastiolabno;
-int lastlabno;
+long lastlabno;
int lastvarno;
int lastargslot;
int autonum[TYVOID];
diff --git a/usr.bin/f2c/intr.c b/usr.bin/f2c/intr.c
index be4bcb7..c83325f 100644
--- a/usr.bin/f2c/intr.c
+++ b/usr.bin/f2c/intr.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992, 1994-5 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992, 1994-6 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -37,6 +37,7 @@ struct Intrbits
char intrno /* :7 */;
char dblcmplx;
char dblintrno; /* for -r8 */
+ char extflag; /* for -cd, -i90 */
};
/* List of all intrinsic functions. */
@@ -203,6 +204,24 @@ LOCAL struct Intrblock
"fpmake", { INTRGEN, 2, 91 },
"fpscal", { INTRGEN, 2, 93 },
+"cdabs", { INTRSPEC, TYDREAL, 13, 1, 0, 1 },
+"cdsqrt", { INTRSPEC, TYDCOMPLEX, 38, 1, 0, 1 },
+"cdexp", { INTRSPEC, TYDCOMPLEX, 42, 1, 0, 1 },
+"cdlog", { INTRSPEC, TYDCOMPLEX, 46, 1, 0, 1 },
+"cdsin", { INTRSPEC, TYDCOMPLEX, 52, 1, 0, 1 },
+"cdcos", { INTRSPEC, TYDCOMPLEX, 56, 1, 0, 1 },
+
+"iand", { INTRBOOL, TYUNKNOWN, OPBITAND, 0, 0, 2 },
+"ior", { INTRBOOL, TYUNKNOWN, OPBITOR, 0, 0, 2 },
+"ieor", { INTRBOOL, TYUNKNOWN, OPBITXOR, 0, 0, 2 },
+
+"btest", { INTRBGEN, TYLOGICAL, OPBITTEST,0, 0, 2 },
+"ibclr", { INTRBGEN, TYUNKNOWN, OPBITCLR, 0, 0, 2 },
+"ibset", { INTRBGEN, TYUNKNOWN, OPBITSET, 0, 0, 2 },
+"ibits", { INTRBGEN, TYUNKNOWN, OPBITBITS,0, 0, 2 },
+"ishft", { INTRBGEN, TYUNKNOWN, OPBITSH, 0, 0, 2 },
+"ishftc", { INTRBGEN, TYUNKNOWN, OPBITSHC, 0, 0, 2 },
+
"" };
@@ -346,6 +365,7 @@ LOCAL struct Specblock
{ TYREAL,TYREAL,2,"r_scal" },
{ TYDREAL,TYDREAL,2,"d_scal" },
+
{ 0 }
} ;
@@ -493,6 +513,12 @@ intrcall(Namep np, struct Listblock *argsp, int nargs)
int mtype;
int op;
int f1field, f2field, f3field;
+ char *s;
+ static char bit_bits[] = "?bit_bits",
+ bit_shift[] = "?bit_shift",
+ bit_cshift[] = "?bit_cshift";
+ static char *bitop[3] = { bit_bits, bit_shift, bit_cshift };
+ static int t_pref[2] = { 'l', 'q' };
packed.ijunk = np->vardesc.varno;
f1field = packed.bits.f1;
@@ -512,6 +538,67 @@ intrcall(Namep np, struct Listblock *argsp, int nargs)
switch(f1field)
{
+ case INTRBGEN:
+ op = f3field;
+ if( ! ONEOF(mtype, MSKINT) )
+ goto badtype;
+ if (op < OPBITBITS) {
+ if(nargs != 2)
+ goto badnargs;
+ if (op != OPBITTEST) {
+#ifdef TYQUAD
+ if (mtype == TYQUAD)
+ op += 2;
+#endif
+ goto intrbool2;
+ }
+ q = mkexpr(op, (expptr)argsp->listp->datap,
+ (expptr)argsp->listp->nextp->datap);
+ q->exprblock.vtype = TYLOGICAL;
+ goto intrbool2a;
+ }
+ if (nargs != 2 && (nargs != 3 || op == OPBITSH))
+ goto badnargs;
+ cp = argsp->listp;
+ ep = (expptr)cp->datap;
+ if (ep->headblock.vtype < TYLONG)
+ cp->datap = (char *)mkconv(TYLONG, ep);
+ while(cp->nextp) {
+ cp = cp->nextp;
+ ep = (expptr)cp->datap;
+ if (ep->headblock.vtype != TYLONG)
+ cp->datap = (char *)mkconv(TYLONG, ep);
+ }
+ if (op == OPBITSH) {
+ ep = (expptr)argsp->listp->nextp->datap;
+ if (ISCONST(ep)) {
+ if ((i = ep->constblock.Const.ci) < 0) {
+ q = (expptr)argsp->listp->datap;
+ if (ISCONST(q)) {
+ ep->constblock.Const.ci = -i;
+ op = OPRSHIFT;
+ goto intrbool2;
+ }
+ }
+ else {
+ op = OPLSHIFT;
+ goto intrbool2;
+ }
+ }
+ }
+ else if (nargs == 2) {
+ if (op == OPBITBITS)
+ goto badnargs;
+ cp->nextp = mkchain((char*)ICON(-1), 0);
+ }
+ ep = (expptr)argsp->listp->datap;
+ i = ep->headblock.vtype;
+ s = bitop[op - OPBITBITS];
+ *s = t_pref[i - TYLONG];
+ ap = builtin(i, s, 1);
+ return fixexpr((Exprp)
+ mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
+
case INTRBOOL:
op = f3field;
if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
@@ -526,9 +613,11 @@ intrcall(Namep np, struct Listblock *argsp, int nargs)
{
if(nargs != 2)
goto badnargs;
+ intrbool2:
q = mkexpr(op, (expptr)argsp->listp->datap,
(expptr)argsp->listp->nextp->datap);
}
+ intrbool2a:
frchain( &(argsp->listp) );
free( (charptr) argsp);
return(q);
@@ -735,11 +824,19 @@ intrfunct(char *s)
#endif
{
register struct Intrblock *p;
+ int i;
+ extern int intr_omit;
for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
{
if( !strcmp(s, p->intrfname) )
{
+ if (i = p->intrval.extflag) {
+ if (i & intr_omit)
+ return 0;
+ if (noextflag)
+ errext(s);
+ }
packed.bits.f1 = p->intrval.intrgroup;
packed.bits.f2 = p->intrval.intrstuff;
packed.bits.f3 = p->intrval.intrno;
@@ -793,6 +890,7 @@ intraddr(Namep np)
case INTRMAX:
case INTRBOOL:
case INTRCNST:
+ case INTRBGEN:
bad:
errstr("cannot pass %s as actual", np->fvarname);
return((Addrp)errnode());
diff --git a/usr.bin/f2c/io.c b/usr.bin/f2c/io.c
index 0e32f0e..12ecedd 100644
--- a/usr.bin/f2c/io.c
+++ b/usr.bin/f2c/io.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1993, 1994, 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* Routines to generate code for I/O statements.
@@ -33,7 +33,7 @@ this software.
#include "names.h"
#include "iob.h"
-extern int inqmask;
+extern int byterev, inqmask;
static void dofclose Argdcl((void));
static void dofinquire Argdcl((void));
@@ -302,7 +302,7 @@ fmtstmt(register struct Labelblock *lp)
if(lp->labtype == LABUNKNOWN)
{
lp->labtype = LABFORMAT;
- lp->labelno = newlabel();
+ lp->labelno = (int)newlabel();
}
else if(lp->labtype != LABFORMAT)
{
@@ -689,7 +689,7 @@ doiolist(chainp p0)
q = (tagptr)p->datap;
if(q->tag == TIMPLDO)
{
- exdo(range=newlabel(), (Namep)0,
+ exdo(range = (int)newlabel(), (Namep)0,
q->impldoblock.impdospec);
doiolist(q->impldoblock.datalist);
enddo(range);
@@ -813,7 +813,10 @@ putio(expptr nelt, register expptr addr)
: call3(TYINT, "do_lio", mc, nelt, addr);
}
else {
- char *s = ioformatted==FORMATTED ? "do_fio" : "do_uio";
+ char *s = ioformatted==FORMATTED ? "do_fio"
+ : !byterev ? "do_uio"
+ : ONEOF(type, M(TYCHAR)|M(TYINT1)|M(TYLOGICAL1))
+ ? "do_ucio" : "do_unio";
q = c ? call3(TYINT, s, nelt, addr, (expptr)c)
: call2(TYINT, s, nelt, addr);
}
diff --git a/usr.bin/f2c/lex.c b/usr.bin/f2c/lex.c
index 0650e50..6e779e1 100644
--- a/usr.bin/f2c/lex.c
+++ b/usr.bin/f2c/lex.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992 - 1997 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -309,13 +309,14 @@ doinclude(char *name)
chainp I;
extern chainp Iargs;
+ err_lineno = -1;
if(inclp)
{
inclp->incllno = thislin;
inclp->inclcode = code;
inclp->inclstno = nxtstno;
- if(nextcd)
- inclp->incllinp = copyn(inclp->incllen = endcd-nextcd , nextcd);
+ if(nextcd && (j = endcd - nextcd) > 0)
+ inclp->incllinp = copyn(inclp->incllen = j, nextcd);
else
inclp->incllinp = 0;
}
@@ -416,6 +417,7 @@ popinclude(Void)
free(infname);
--nincl;
+ err_lineno = -1;
t = inclp->inclnext;
free( (charptr) inclp);
inclp = t;
@@ -541,7 +543,13 @@ first:
retval = STO;
break;
}
- retval = gettok();
+ if (tokno == 2 && stkey == SDO) {
+ intonly = 1;
+ retval = gettok();
+ intonly = 0;
+ }
+ else
+ retval = gettok();
break;
reteos:
@@ -730,7 +738,7 @@ top:
/* Handle the Comment cards (a 'C', 'c', '*', or '!' in the first column). */
- else if(comstart[c & 0xfff])
+ else if(comstart[c & (Table_size-1)])
{
if (feof (infile)
#ifdef EOF_CHAR
@@ -1101,6 +1109,8 @@ crunch(Void)
nh = *j0 - '0';
ten = 10;
j1 = prvstr;
+ if (j1 > sbuf && j1[-1] == MYQUOTE)
+ --j1;
if (j1+4 < j)
j1 = j-4;
for(;;) {
@@ -1110,13 +1120,16 @@ crunch(Void)
nh += ten * (*j0-'0');
ten*=10;
}
- /* a hollerith must be preceded by a punctuation mark.
+/* A Hollerith string must be preceded by a punctuation mark.
'*' is possible only as repetition factor in a data statement
- not, in particular, in character*2h
-*/
+ not, in particular, in character*2h .
+ To avoid some confusion with missing commas in FORMAT statements,
+ treat a preceding string as a punctuation mark.
+ */
if( !(*j0=='*'&&sbuf[0]=='d') && *j0!='/'
- && *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.')
+ && *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.'
+ && *j0 != MYQUOTE)
goto copychar;
nh0 = nh;
if(i+nh > lastch)
@@ -1358,6 +1371,8 @@ gettok(Void)
struct Punctlist *pp;
struct Dotlist *pd;
register int ch;
+ static char Exp_mi[] = "X**-Y treated as X**(-Y)",
+ Exp_pl[] = "X**+Y treated as X**(+Y)";
char *i, *j, *n1, *p;
@@ -1390,28 +1405,44 @@ gettok(Void)
if (++nextch <= lastch)
switch(ch) {
case '/':
- if (*nextch == '/') {
+ switch(*nextch) {
+ case '/':
nextch++;
val = SCONCAT;
- }
- else if (new_dcl && parlev == 0)
- val = SSLASHD;
+ break;
+ case '=':
+ goto sne;
+ default:
+ if (new_dcl && parlev == 0)
+ val = SSLASHD;
+ }
return val;
case '*':
if (*nextch == '*') {
nextch++;
+ if (noextflag
+ && nextch <= lastch)
+ switch(*nextch) {
+ case '-':
+ errext(Exp_mi);
+ break;
+ case '+':
+ errext(Exp_pl);
+ }
return SPOWER;
}
break;
case '<':
- if (*nextch == '=') {
+ switch(*nextch) {
+ case '=':
nextch++;
val = SLE;
- }
- if (*nextch == '>') {
+ break;
+ case '>':
+ sne:
nextch++;
val = SNE;
- }
+ }
goto extchk;
case '=':
if (*nextch == '=') {
@@ -1487,16 +1518,16 @@ gettok(Void)
return(SFUNCTION);
}
- if(toklen > 50)
+ if(toklen > MAXNAMELEN)
{
- char buff[100];
- sprintf(buff, toklen >= 60
- ? "name %.56s... too long, truncated to %.*s"
+ char buff[MAXNAMELEN+50];
+ sprintf(buff, toklen >= MAXNAMELEN+10
+ ? "name %.*s... too long, truncated to %.*s"
: "name %s too long, truncated to %.*s",
- token, 50, token);
+ MAXNAMELEN+6, token, MAXNAMELEN, token);
err(buff);
- toklen = 50;
- token[50] = '\0';
+ toklen = MAXNAMELEN;
+ token[MAXNAMELEN] = '\0';
}
if(toklen==1 && *nextch==MYQUOTE) {
val = token[0];
@@ -1516,8 +1547,8 @@ gettok(Void)
/* Check for NAG's special hex constant */
if (nextch[1] == '#' && nextch < lastch
- || nextch[2] == '#' && isdigit(nextch[1]
- && lastch - nextch >= 2)) {
+ || nextch[2] == '#' && isdigit(nextch[1])
+ && lastch - nextch >= 2) {
radix = atoi (nextch);
if (*++nextch != '#')
@@ -1664,7 +1695,7 @@ unclassifiable(Void)
if (se < sbuf)
return;
lastch = s - 1;
- if (se - s > 10)
+ if (++se - s > 10)
se = s + 10;
for(; s < se; s++)
if (*s == MYQUOTE) {
diff --git a/usr.bin/f2c/main.c b/usr.bin/f2c/main.c
index f58a177..4183855 100644
--- a/usr.bin/f2c/main.c
+++ b/usr.bin/f2c/main.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
extern char F2C_version[];
@@ -30,6 +30,7 @@ int complex_seen, dcomplex_seen;
LOCAL int Max_ftn_files;
+int badargs;
char **ftn_files;
int current_ftn_file = 0;
@@ -47,6 +48,9 @@ flag checksubs = NO;
flag r8flag = NO;
flag use_bs = YES;
flag keepsubs = NO;
+flag byterev = NO;
+int intr_omit;
+static int no_cd, no_i90;
#ifdef TYQUAD
flag use_tyquad = YES;
#endif
@@ -72,6 +76,7 @@ static int uselongints = NO; /* YES => tyint = TYLONG */
int addftnsrc = NO; /* Include ftn source in output */
int usedefsforcommon = NO; /* Use #defines for common reference */
int forcedouble = YES; /* force real functions to double */
+int dneg = NO; /* f77 treatment of unary minus */
int Ansi = NO;
int def_equivs = YES;
int tyioint = TYLONG;
@@ -155,12 +160,21 @@ static arg_info table[] = {
f2c_entry ("f", P_NO_ARGS, P_INT, &warn72, 2),
f2c_entry ("s", P_NO_ARGS, P_INT, &keepsubs, 1),
f2c_entry ("d", P_ONE_ARG, P_STRING, &outbuf, 0),
+ f2c_entry ("cd", P_NO_ARGS, P_INT, &no_cd, 1),
+ f2c_entry ("i90", P_NO_ARGS, P_INT, &no_i90, 2),
#ifdef TYQUAD
f2c_entry ("!i8", P_NO_ARGS, P_INT, &use_tyquad, NO),
#endif
/* options omitted from man pages */
+ /* -b ==> for unformatted I/O, call do_unio (for noncharacter */
+ /* data of length > 1 byte) and do_ucio (for the rest) rather */
+ /* than do_uio. This permits modifying libI77 to byte-reverse */
+ /* numeric data. */
+
+ f2c_entry ("b", P_NO_ARGS, P_INT, &byterev, YES),
+
/* -ev ==> implement equivalence with initialized pointers */
f2c_entry ("ev", P_NO_ARGS, P_INT, &def_equivs, NO),
@@ -185,7 +199,13 @@ static arg_info table[] = {
/* -Dnnn = debug level nnn */
- f2c_entry ("D", P_ONE_ARG, P_INT, &debugflag, YES)
+ f2c_entry ("D", P_ONE_ARG, P_INT, &debugflag, YES),
+
+ /* -dneg ==> under (default) -!R, imitate f77's bizarre */
+ /* treatment of unary minus of REAL expressions by */
+ /* promoting them to DOUBLE PRECISION . */
+
+ f2c_entry ("dneg", P_NO_ARGS, P_INT, &dneg, YES)
}; /* table */
extern char *c_functions; /* "c_functions" */
@@ -269,6 +289,8 @@ set_externs(Void)
protorettypes[TYREAL] = "E_f";
casttypes[TYREAL] = "E_fp";
}
+ else
+ dneg = 0;
if (maxregvar > MAXREGVAR) {
warni("-O%d: too many register variables", maxregvar);
@@ -462,6 +484,9 @@ main(int argc, char **argv)
parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info),
ftn_files, Max_ftn_files);
+ if (badargs)
+ return 1;
+ intr_omit = no_cd | no_i90;
if (keepsubs && checksubs) {
warn("-C suppresses -s\n");
keepsubs = 0;
@@ -499,22 +524,21 @@ main(int argc, char **argv)
pass1_file=opf(p1_file, binwrite);
initkey();
if (file_name && *file_name) {
- cdfilename = coutput;
if (debugflag != 1) {
- if (!o_coutput)
- coutput = c_name(file_name,'c');
- else
- coutput = o_coutput;
- cdfilename = copys(outbtail);
- if (Castargs1 >= 2)
+ if (!o_coutput)
+ coutput = c_name(file_name,'c');
+ else
+ coutput = o_coutput;
+ if (Castargs1 >= 2)
proto_fname = c_name(file_name,'P');
- }
+ }
+ cdfilename = coutput;
if (skipC)
coutput = 0;
- if (coutput[0] == '-') {
- c_output = stdout;
- coutput = 0;
- }
+ if (coutput[0] == '-'){
+ c_output = stdout;
+ coutput = 0;
+ }
else if (!(c_output = fopen(coutput, textwrite))) {
file_name = coutput;
coutput = 0; /* don't delete read-only .c file */
@@ -619,6 +643,7 @@ sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | /
{
warn("missing final end statement");
endproc();
+ nerr = 1;
}
done(nerr ? 1 : 0);
/* NOT REACHED */ return 0;
diff --git a/usr.bin/f2c/malloc.c b/usr.bin/f2c/malloc.c
index 85bc5e3..3f5cb2a 100644
--- a/usr.bin/f2c/malloc.c
+++ b/usr.bin/f2c/malloc.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1994 by AT&T, Lucent Technologies 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.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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
-this software.
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#ifndef CRAY
@@ -93,7 +93,6 @@ malloc(register Unsigned size)
r->len = SBGULP - sizeof(mem);
r->next = F;
F = r;
- top1 += SBGULP;
q->len = size;
}
return (Char *) (q+1);
diff --git a/usr.bin/f2c/mem.c b/usr.bin/f2c/mem.c
index b8fc123..4e3d777 100644
--- a/usr.bin/f2c/mem.c
+++ b/usr.bin/f2c/mem.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1994 by AT&T, Lucent Technologies 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.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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
-this software.
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
diff --git a/usr.bin/f2c/memset.c b/usr.bin/f2c/memset.c
index 98a7ce7..4d6ab47 100644
--- a/usr.bin/f2c/memset.c
+++ b/usr.bin/f2c/memset.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 by AT&T, Lucent Technologies 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.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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
-this software.
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* This is for the benefit of people whose systems don't provide
diff --git a/usr.bin/f2c/misc.c b/usr.bin/f2c/misc.c
index bfaeb8a74..f5cca53 100644
--- a/usr.bin/f2c/misc.c
+++ b/usr.bin/f2c/misc.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992 - 1995 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -491,7 +491,7 @@ mklabel(ftnint l)
many("statement labels", 's', maxstno);
lp->stateno = l;
- lp->labelno = newlabel();
+ lp->labelno = (int)newlabel();
lp->blklevel = 0;
lp->labused = NO;
lp->fmtlabused = NO;
@@ -502,11 +502,10 @@ mklabel(ftnint l)
return(lp);
}
-
- int
+ long
newlabel(Void)
{
- return( ++lastlabno );
+ return ++lastlabno;
}
diff --git a/usr.bin/f2c/names.c b/usr.bin/f2c/names.c
index ac84be4..b0e1058 100644
--- a/usr.bin/f2c/names.c
+++ b/usr.bin/f2c/names.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -140,8 +140,20 @@ new_arg_length(Namep arg)
#endif
{
static char buf[64];
- sprintf (buf, "%s_len", arg->fvarname);
-
+ char *fmt = "%s_len", *s = arg->fvarname;
+ switch(*s) {
+ case 'r':
+ if (!strcmp(s+1, "et_val"))
+ goto adjust_fmt;
+ break;
+ case 'h':
+ case 'i':
+ if (!s[1]) {
+ adjust_fmt:
+ fmt = "%s_length"; /* avoid conflict with libF77 */
+ }
+ }
+ sprintf (buf, fmt, s);
return buf;
} /* new_arg_length */
@@ -241,7 +253,7 @@ lit_name(struct Literal *litp)
case TYINT1:
val = litp -> litval.litival;
if (val >= 256 || val < -255)
- sprintf (buf, "ci1_b%d", litp -> litnum);
+ sprintf (buf, "ci1_b%ld", litp -> litnum);
else if (val < 0)
sprintf (buf, "ci1_n%ld", -val);
else
@@ -250,7 +262,7 @@ lit_name(struct Literal *litp)
case TYSHORT:
val = litp -> litval.litival;
if (val >= 32768 || val <= -32769)
- sprintf (buf, "cs_b%d", litp -> litnum);
+ sprintf (buf, "cs_b%ld", litp -> litnum);
else if (val < 0)
sprintf (buf, "cs_n%ld", -val);
else
@@ -262,7 +274,7 @@ lit_name(struct Literal *litp)
#endif
val = litp -> litval.litival;
if (val >= 100000 || val <= -10000)
- sprintf (buf, "c_b%d", litp -> litnum);
+ sprintf (buf, "c_b%ld", litp -> litnum);
else if (val < 0)
sprintf (buf, "c_n%ld", -val);
else
@@ -294,7 +306,7 @@ lit_name(struct Literal *litp)
case TYDCOMPLEX:
case TYSUBR:
default:
- sprintf (buf, "c_b%d", litp -> litnum);
+ sprintf (buf, "c_b%ld", litp -> litnum);
} /* switch */
return buf;
} /* lit_name */
@@ -815,8 +827,9 @@ char *c_keywords[] = {
"protected", "public", "r", "real", "register", "return",
"short", "shortint", "shortlogical", "signed", "sin", "sinh",
"sizeof", "sqrt", "static", "struct", "switch", "tan", "tanh",
- "template", "this", "try", "type", "typedef", "union",
- "unsigned", "vars", "virtual", "void", "volatile", "while", "z"
+ "template", "this", "try", "type", "typedef", "uinteger",
+ "ulongint", "union", "unsigned", "vars", "virtual", "void",
+ "volatile", "while", "z"
}; /* c_keywords */
int n_keywords = sizeof(c_keywords)/sizeof(char *);
diff --git a/usr.bin/f2c/niceprintf.c b/usr.bin/f2c/niceprintf.c
index af6d5d0..0d5f5cc 100644
--- a/usr.bin/f2c/niceprintf.c
+++ b/usr.bin/f2c/niceprintf.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1993, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
diff --git a/usr.bin/f2c/output.c b/usr.bin/f2c/output.c
index b495b26..03d0ed0 100644
--- a/usr.bin/f2c/output.c
+++ b/usr.bin/f2c/output.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -111,6 +111,13 @@ table_entry opcode_table[] = {
/* OPDABS 59 */ { UNARY_OP, 0, "dabs(%l)" },
/* OPMIN2 60 */ { BINARY_OP, 0, "min(%l,%r)" },
/* OPMAX2 61 */ { BINARY_OP, 0, "max(%l,%r)" },
+ /* OPBITTEST 62 */ { BINARY_OP, 0, "bit_test(%l,%r)" },
+ /* OPBITCLR 63 */ { BINARY_OP, 0, "bit_clear(%l,%r)" },
+ /* OPBITSET 64 */ { BINARY_OP, 0, "bit_set(%l,%r)" },
+#ifdef TYQUAD
+ /* OPQBITCLR 65 */ { BINARY_OP, 0, "qbit_clear(%l,%r)" },
+ /* OPQBITSET 66 */ { BINARY_OP, 0, "qbit_set(%l,%r)" },
+#endif
/* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
@@ -119,13 +126,14 @@ table_entry opcode_table[] = {
#define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
+extern int dneg;
static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
static void output_arg_list Argdcl((FILEP, struct Listblock*));
static void output_binary Argdcl((FILEP, Exprp));
static void output_list Argdcl((FILEP, struct Listblock*));
-static void output_literal Argdcl((FILEP, int, Constp));
+static void output_literal Argdcl((FILEP, long, Constp));
static void output_prim Argdcl((FILEP, struct Primblock*));
static void output_unary Argdcl((FILEP, Exprp));
@@ -591,7 +599,7 @@ out_addr(FILE *fp, struct Addrblock *addrp)
out_const(fp, (Constp)addrp);
break;
case STGMEMNO:
- output_literal (fp, (int)addrp->memno,
+ output_literal (fp, addrp->memno,
(Constp)addrp);
break;
default:
@@ -692,10 +700,10 @@ out_addr(FILE *fp, struct Addrblock *addrp)
#ifdef KR_headers
output_literal(fp, memno, cp)
FILE *fp;
- int memno;
+ long memno;
Constp cp;
#else
-output_literal(FILE *fp, int memno, Constp cp)
+output_literal(FILE *fp, long memno, Constp cp)
#endif
{
struct Literal *litp, *lastlit;
@@ -783,7 +791,7 @@ output_unary(FILE *fp, struct Exprblock *e)
switch (e -> opcode) {
case OPNEG:
- if (e->vtype == TYREAL && forcedouble) {
+ if (e->vtype == TYREAL && dneg) {
e->opcode = OPNEG_KLUDGE;
output_binary(fp,e);
e->opcode = OPNEG;
@@ -840,14 +848,15 @@ opconv_fudge(fp, e)
opconv_fudge(FILE *fp, struct Exprblock *e)
#endif
{
- /* special handling for ichar and character*1 */
+ /* special handling for conversions, ichar and character*1 */
register expptr lp;
register union Expression *Offset;
register char *cp;
int lt;
- char buf[8];
+ char buf[8], *s;
unsigned int k;
Namep np;
+ Addrp ap;
if (!(lp = e->leftp)) /* possible with erroneous Fortran */
return 1;
@@ -911,9 +920,41 @@ opconv_fudge(FILE *fp, struct Exprblock *e)
badtag("opconv_fudge", lp->tag);
}
}
- if (lt != e->vtype)
- nice_printf(fp, "(%s) ",
- c_type_decl(e->vtype, 0));
+ if (lt != e->vtype) {
+ s = c_type_decl(e->vtype, 0);
+ if (ISCOMPLEX(lt)) {
+ tryagain:
+ np = (Namep)e->leftp;
+ switch(np->tag) {
+ case TNAME:
+ nice_printf(fp, "(%s) %s%sr", s,
+ np->cvarname,
+ np->vstg == STGARG ? "->" : ".");
+ return 1;
+ case TADDR:
+ ap = (Addrp)np;
+ switch(ap->uname_tag) {
+ case UNAM_IDENT:
+ nice_printf(fp, "(%s) %s.r", s,
+ ap->user.ident);
+ return 1;
+ case UNAM_NAME:
+ nice_printf(fp, "(%s) ", s);
+ out_addr(fp, ap);
+ nice_printf(fp, ".r");
+ return 1;
+ }
+ case TEXPR:
+ e = (Exprp)np;
+ if (e->opcode == OPWHATSIN)
+ goto tryagain;
+ default:
+ fatali("Unexpected tag %d in opconv_fudge",
+ np->tag);
+ }
+ }
+ nice_printf(fp, "(%s) ", s);
+ }
return 0;
}
@@ -1103,30 +1144,29 @@ out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
arglist = arglist -> nextp;
} /* if ISCOMPLEX */
+ /* prepare to cast procedure parameters -- set A if we know how */
+ np = name->tag == TEXPR && name->exprblock.opcode == OPWHATSIN
+ ? (Namep)name->exprblock.leftp : (Namep)name;
+
+ A = Ac = 0;
+ if (np->tag == TNAME && (at = np->arginfo)) {
+ if (at->nargs > 0)
+ A = at->atypes;
+ if (Ansi && (at->defined || at->nargs > 0))
+ Ac = at->atypes;
+ }
+
/* Now we can actually start to write out the function invocation */
if (ftype == TYREAL && forcereal)
nice_printf(outfile, "(real)");
if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
nice_printf (outfile, "(");
- np = (Namep)name->exprblock.leftp; /*expr_out will free name */
expr_out (outfile, name);
nice_printf (outfile, ")");
}
- else {
- np = (Namep)name;
+ else
expr_out(outfile, name);
- }
-
- /* prepare to cast procedure parameters -- set A if we know how */
-
- A = Ac = 0;
- if (np->tag == TNAME && (at = np->arginfo)) {
- if (at->nargs > 0)
- A = at->atypes;
- if (Ansi && (at->defined || at->nargs > 0))
- Ac = at->atypes;
- }
nice_printf(outfile, "(");
@@ -1252,17 +1292,16 @@ out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
} else {
expptr memoffset;
- if (q->tag == TADDR &&
+ if (q->tag == TADDR && (
!ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
- && (
- ONEOF(q->addrblock.vstg,
+ && (ONEOF(q->addrblock.vstg,
M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
- || ((memoffset = q->addrblock.memoffset)
+ || ((memoffset = q->addrblock.memoffset)
&& (!ISICON(memoffset)
|| memoffset->constblock.Const.ci)))
|| ONEOF(q->addrblock.vstg,
M(STGINIT)|M(STGAUTO)|M(STGBSS))
- && !q->addrblock.isarray)
+ && !q->addrblock.isarray))
nice_printf (outfile, "&");
else if (q -> tag == TNAME
&& !oneof_stg(&q->nameblock, q -> nameblock.vstg,
diff --git a/usr.bin/f2c/p1output.c b/usr.bin/f2c/p1output.c
index fc0e9ff..93204ab 100644
--- a/usr.bin/f2c/p1output.c
+++ b/usr.bin/f2c/p1output.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1993, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
diff --git a/usr.bin/f2c/parse_args.c b/usr.bin/f2c/parse_args.c
index 98468e2..b6dc75d 100644
--- a/usr.bin/f2c/parse_args.c
+++ b/usr.bin/f2c/parse_args.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1994-5 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* parse_args
@@ -94,6 +94,7 @@ static int arg_parse Argdcl((char*, arg_info*));
static char *lower_string Argdcl((char*, char*));
static int match Argdcl((char*, char*, arg_info*, boolean));
static int put_one_arg Argdcl((int, char*, char**, char*, char*));
+extern int badargs;
boolean
@@ -148,6 +149,7 @@ parse_args(int argc, char **argv, arg_info *table, int entries, char **others, i
fprintf (stderr, "%s: too many parameters: ",
this_program);
fprintf (stderr, "'%s' ignored\n", *argv);
+ badargs++;
} /* else */
} /* if (others) */
argv0 = *++argv;
@@ -219,6 +221,7 @@ arg_verify(char **argv, arg_info *table, int entries)
fprintf (stderr, "%s [arg_verify]: too many ", this_program);
fprintf (stderr, "flags in entry %d: '%x' (hex)\n", i,
arg_flags (*arg));
+ badargs++;
} /* if */
/* Check the argument count */
@@ -230,6 +233,7 @@ arg_verify(char **argv, arg_info *table, int entries)
fprintf (stderr, "%s [arg_verify]: invalid ", this_program);
fprintf (stderr, "argument count in entry %d: '%d'\n", i,
count);
+ badargs++;
} /* if count != P_NO_ARGS ... */
/* Check the result field; want to be able to store results */
@@ -239,6 +243,7 @@ arg_verify(char **argv, arg_info *table, int entries)
fprintf (stderr, "%s [arg_verify]: ", this_program);
fprintf (stderr, "no argument storage given for ");
fprintf (stderr, "entry %d\n", i);
+ badargs++;
} /* if arg_result_ptr */
}
@@ -246,10 +251,12 @@ arg_verify(char **argv, arg_info *table, int entries)
{ int type = arg_result_type (*arg);
- if (type < P_STRING || type > P_DOUBLE)
+ if (type < P_STRING || type > P_DOUBLE) {
fprintf(stderr,
"%s [arg_verify]: bad arg type in entry %d: '%d'\n",
this_program, i, type);
+ badargs++;
+ }
}
/* Check table size */
@@ -260,6 +267,7 @@ arg_verify(char **argv, arg_info *table, int entries)
fprintf (stderr, "%s [arg_verify]: bad ", this_program);
fprintf (stderr, "table size in entry %d: '%d'\n", i,
size);
+ badargs++;
} /* if (arg_count == P_INFINITE_ARGS && size < 1) */
}
@@ -469,11 +477,14 @@ put_one_arg(int type, char *str, char **store, char *prefix, char *string)
case P_FILE:
case P_OLD_FILE:
case P_NEW_FILE:
- *store = str;
- if (str == NULL)
- fprintf (stderr, "%s: Missing argument after '%s%s'\n",
- this_program, prefix, string);
- length = str ? strlen (str) : 0;
+ if (str == NULL) {
+ fprintf(stderr, "%s: Missing argument after '%s%s'\n",
+ this_program, prefix, string);
+ length = 0;
+ badargs++;
+ }
+ else
+ length = strlen(*store = str);
break;
case P_CHAR:
*((char *) store) = *str;
@@ -482,19 +493,23 @@ put_one_arg(int type, char *str, char **store, char *prefix, char *string)
case P_SHORT:
L = atol(str);
*(short *)store = (short) L;
- if (L != *(short *)store)
+ if (L != *(short *)store) {
fprintf(stderr,
"%s%s parameter '%ld' is not a SHORT INT (truncating to %d)\n",
prefix, string, L, *(short *)store);
+ badargs++;
+ }
length = strlen (str);
break;
case P_INT:
L = atol(str);
*(int *)store = (int)L;
- if (L != *(int *)store)
+ if (L != *(int *)store) {
fprintf(stderr,
"%s%s parameter '%ld' is not an INT (truncating to %d)\n",
prefix, string, L, *(int *)store);
+ badargs++;
+ }
length = strlen (str);
break;
case P_LONG:
@@ -510,8 +525,8 @@ put_one_arg(int type, char *str, char **store, char *prefix, char *string)
length = strlen (str);
break;
default:
- fprintf (stderr, "put_one_arg: bad type '%d'\n",
- type);
+ fprintf (stderr, "put_one_arg: bad type '%d'\n", type);
+ badargs++;
break;
} /* switch */
} /* if (store) */
diff --git a/usr.bin/f2c/permission b/usr.bin/f2c/permission
deleted file mode 100644
index cdee9a2..0000000
--- a/usr.bin/f2c/permission
+++ /dev/null
@@ -1,23 +0,0 @@
-/****************************************************************
-Copyright 1990 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
-this software.
-****************************************************************/
-
diff --git a/usr.bin/f2c/pread.c b/usr.bin/f2c/pread.c
index f9cef59..eb1576a 100644
--- a/usr.bin/f2c/pread.c
+++ b/usr.bin/f2c/pread.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992, 1993, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
diff --git a/usr.bin/f2c/proc.c b/usr.bin/f2c/proc.c
index 656d9bb..6796d52 100644
--- a/usr.bin/f2c/proc.c
+++ b/usr.bin/f2c/proc.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1994, 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1994-6 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -172,7 +172,7 @@ putentries(FILE *outfile)
#endif
/* put out wrappers for multiple entries */
{
- char base[IDENT_LEN];
+ char base[MAXNAMELEN+4];
struct Entrypoint *e;
Namep *A, *Ae, *Ae1, **Alp, *a, **a1, np;
chainp args, lengths;
@@ -246,7 +246,8 @@ putentries(FILE *outfile)
}
for(; a < Ae1; a++)
if (np = *a)
- nice_printf(outfile, ", %s_len", np->fvarname);
+ nice_printf(outfile, ", %s",
+ new_arg_length(np));
else
nice_printf(outfile, ", (ftnint)0");
nice_printf(outfile, /*(*/ ");\n");
@@ -439,8 +440,18 @@ startproc(Extsym *progname, int class)
puthead(CNULL, CLMAIN);
if (progname)
strcpy (main_alias, progname->cextname);
- } else
+ } else {
+ if (progname) {
+ /* Construct an empty subroutine with this name */
+ /* in case the name is needed to force loading */
+ /* of this block-data subprogram: the name can */
+ /* appear elsewhere in an external statement. */
+ entrypt(CLPROC, TYSUBR, (ftnint)0, progname, (chainp)0);
+ endproc();
+ newproc();
+ }
puthead(CNULL, CLBLOCK);
+ }
if(class == CLMAIN)
newentry( mkname(" MAIN"), 0 )->extinit = 1;
p->entryname = progname;
@@ -760,7 +771,7 @@ doentry(struct Entrypoint *ep)
else if(type != proctype)
multitype = YES;
if(rtvlabel[type] == 0)
- rtvlabel[type] = newlabel();
+ rtvlabel[type] = (int)newlabel();
ep->typelabel = rtvlabel[type];
if(type == TYCHAR)
@@ -1062,9 +1073,14 @@ docommon(Void)
comvar->voffset = extptr->extleng;
comvar->vardesc.varno = extptr - extsymtab;
if(type == TYCHAR)
- size = comvar->vleng->constblock.Const.ci;
+ if (comvar->vleng)
+ size = comvar->vleng->constblock.Const.ci;
+ else {
+ dclerr("character*(*) in common", comvar);
+ size = 1;
+ }
else
- size = typesize[type];
+ size = typesize[type];
if(t = comvar->vdim)
if( (neltp = t->nelt) && ISCONST(neltp) )
size *= neltp->constblock.Const.ci;
@@ -1454,7 +1470,9 @@ settype(register Namep v, register int type, register ftnint length)
else if(v->vstg != -type)
dclerr("incompatible storage declarations", v);
}
- else if(v->vtype == TYUNKNOWN || v->vimpltype && v->vtype != type)
+ else if(v->vtype == TYUNKNOWN
+ || v->vtype != type
+ && (v->vimpltype || v->vinftype || v->vinfproc))
{
if( (v->vtype = lengtype(type, length))==TYCHAR )
if (length>=0)
@@ -1462,6 +1480,8 @@ settype(register Namep v, register int type, register ftnint length)
else if (parstate >= INDATA)
v->vleng = ICON(1); /* avoid a memory fault */
v->vimpltype = 0;
+ v->vinftype = 0; /* 19960709 */
+ v->vinfproc = 0; /* 19960709 */
if (v->vclass == CLPROC) {
if (v->vstg == STGEXT
@@ -1485,7 +1505,7 @@ settype(register Namep v, register int type, register ftnint length)
}
}
}
- else if(v->vtype!=type) {
+ else if(v->vtype != type && v->vtype != lengtype(type, length)) {
incompat:
dclerr("incompatible type declarations", v);
}
@@ -1551,10 +1571,6 @@ lengtype(register int type, ftnint len)
case 2: return TYLOGICAL2;
case 4: goto ret;
}
-#if 0 /*!!??!!*/
- if(length == typesize[TYLOGICAL])
- goto ret;
-#endif
break;
case TYLONG:
diff --git a/usr.bin/f2c/put.c b/usr.bin/f2c/put.c
index 6520ed5..25425c5 100644
--- a/usr.bin/f2c/put.c
+++ b/usr.bin/f2c/put.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1991, 1993, 1994, 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/*
@@ -67,7 +67,8 @@ int ops2 [ ] =
P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
P2BAD, P2BAD, P2BAD, P2BAD,
1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
- 1,1,1,1 /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
+ 1,1,1,1, /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
+ 1,1,1,1,1 /* OPBITTEST, OPBITCLR, OPBITSET, OPQBIT{CLR,SET} */
};
diff --git a/usr.bin/f2c/putpcc.c b/usr.bin/f2c/putpcc.c
index 6d87d3c..c104098 100644
--- a/usr.bin/f2c/putpcc.c
+++ b/usr.bin/f2c/putpcc.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1996 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* INTERMEDIATE CODE GENERATION FOR S. C. JOHNSON C COMPILERS */
@@ -45,7 +45,7 @@ static tagptr putmnmx Argdcl((tagptr));
static tagptr putop Argdcl((tagptr));
static tagptr putpower Argdcl((tagptr));
-#define FOUR 4
+extern int init_ac[TYSUBR+1];
extern int ops2[];
extern int proc_argchanges, proc_protochanges;
extern int krparens;
@@ -351,6 +351,13 @@ putx(register expptr p)
case OPMAX2:
case OPDMIN:
case OPDMAX:
+ case OPBITTEST:
+ case OPBITCLR:
+ case OPBITSET:
+#ifdef TYQUAD
+ case OPQBITSET:
+ case OPQBITCLR:
+#endif
putopp:
p = putop(p);
break;
@@ -391,6 +398,7 @@ putop(expptr p)
expptr lp, tp;
int pt, lt, lt1;
int comma;
+ char *hsave;
switch(p->exprblock.opcode) /* check for special cases and rewrite */
{
@@ -442,7 +450,18 @@ putop(expptr p)
return putop (p);
}
if (lt == TYCHAR) {
- p->exprblock.leftp = putx(p->exprblock.leftp);
+ if (ISCONST(p->exprblock.leftp)
+ && ISNUMERIC(p->exprblock.vtype)) {
+ hsave = halign;
+ halign = 0;
+ p->exprblock.leftp = putx((expptr)
+ putconst((Constp)
+ p->exprblock.leftp));
+ halign = hsave;
+ }
+ else
+ p->exprblock.leftp =
+ putx(p->exprblock.leftp);
return p;
}
if (pt < lt && ONEOF(lt,MSKINT|MSKREAL))
@@ -1385,7 +1404,7 @@ type_fixup(Argtypes *at, Atype *a, int k)
if (!infertypes)
return 0;
for(ep = entries; ep; ep = ep->entnextp)
- if (at == ep->entryname->arginfo) {
+ if (ep->entryname && at == ep->entryname->arginfo) {
a->type = k % 100;
return proc_argchanges = 1;
}
@@ -1421,7 +1440,6 @@ save_argtypes(chainp arglist, Argtypes **at0, Argtypes **at1, int ccall, char *f
0,
#endif
initargs, initargs+1,0,0,0,initargs+2};
- extern int init_ac[TYSUBR+1];
i0 = init_ac[type];
t = init_ap[type];
@@ -1578,19 +1596,16 @@ save_argtypes(chainp arglist, Argtypes **at0, Argtypes **at1, int ccall, char *f
}
}
- void
+ static char*
#ifdef KR_headers
-saveargtypes(p)
- register Exprp p;
+get_argtypes(p, pat0, pat1) Exprp p; Argtypes ***pat0, ***pat1;
#else
-saveargtypes(register Exprp p)
+get_argtypes(Exprp p, Argtypes ***pat0, Argtypes ***pat1)
#endif
- /* for writing prototypes */
{
Addrp a;
Argtypes **at0, **at1;
Namep np;
- chainp arglist;
expptr rp;
Extsym *e;
char *fname;
@@ -1625,10 +1640,30 @@ saveargtypes(register Exprp p)
bug:
Fatal("Confusion in saveargtypes");
}
+ *pat0 = at0;
+ *pat1 = at1;
+ return fname;
+ }
+
+ void
+#ifdef KR_headers
+saveargtypes(p)
+ register Exprp p;
+#else
+saveargtypes(register Exprp p)
+#endif
+ /* for writing prototypes */
+{
+ Argtypes **at0, **at1;
+ chainp arglist;
+ expptr rp;
+ char *fname;
+
+ fname = get_argtypes(p, &at0, &at1);
rp = p->rightp;
arglist = rp && rp->tag == TLIST ? rp->listblock.listp : 0;
save_argtypes(arglist, at0, at1, p->opcode == OPCCALL,
- fname, a->vstg, 0, 0, 0);
+ fname, p->leftp->addrblock.vstg, 0, 0, 0);
}
/* putcall - fix up the argument list, and write out the invocation. p
@@ -1660,6 +1695,8 @@ putcall(expptr p0, Addrp *temp)
parameter list, since we're calling a C
library routine */
char *s;
+ Argtypes *at, **at0, **at1;
+ Atype *At, *Ate;
type = p -> vtype;
charsp = NULL;
@@ -1682,18 +1719,24 @@ putcall(expptr p0, Addrp *temp)
/* Count the number of explicit arguments, including lengths of character
variables */
- for(cp = arglist ; cp ; cp = cp->nextp)
- if(!byvalue) {
+ if (!byvalue) {
+ get_argtypes(p, &at0, &at1);
+ At = Ate = 0;
+ if ((at = *at0) && at->nargs >= 0) {
+ At = at->atypes;
+ Ate = At + at->nargs;
+ At += init_ac[type];
+ }
+ for(cp = arglist ; cp ; cp = cp->nextp) {
q = (expptr) cp->datap;
- if( ISCONST(q) )
- {
+ if( ISCONST(q) ) {
/* Even constants are passed by reference, so we need to put them in the
literal table */
q = (expptr) putconst((Constp)q);
cp->datap = (char *) q;
- }
+ }
/* Save the length expression of character variables (NOT character
procedures) for the end of the argument list */
@@ -1703,8 +1746,9 @@ putcall(expptr p0, Addrp *temp)
|| q->headblock.vstg == STGARG
&& q->tag == TADDR
&& q->addrblock.uname_tag == UNAM_NAME
- && q->addrblock.user.name->vprocclass == PTHISPROC))
- {
+ && q->addrblock.user.name->vprocclass == PTHISPROC)
+ && (!At || At->type % 100 % TYSUBR == TYCHAR))
+ {
p0 = cpexpr(q->headblock.vleng);
charsp = mkchain((char *)p0, charsp);
if (q->headblock.vclass == CLUNKNOWN
@@ -1714,6 +1758,9 @@ putcall(expptr p0, Addrp *temp)
&& q->addrblock.uname_tag == UNAM_CONST)
p0->constblock.Const.ci
+= q->addrblock.user.Const.ccp1.blanks;
+ }
+ if (At && ++At == Ate)
+ At = 0;
}
}
charsp = revchain(charsp);
@@ -1796,8 +1843,18 @@ putcall(expptr p0, Addrp *temp)
cp -> datap = (char *) putx (fixtype((expptr)putchop(q)));
else if( ! ISERROR(q) )
{
- if(byvalue
- || q->tag == TEXPR && q->exprblock.opcode == OPCHARCAST)
+ if(byvalue) {
+ if (q->tag == TEXPR && q->exprblock.opcode == OPCONV) {
+ if (ISCOMPLEX(q->exprblock.leftp->headblock.vtype)
+ && q->exprblock.leftp->tag == TEXPR)
+ q->exprblock.leftp = putcxop(q->exprblock.leftp);
+ else
+ q->exprblock.leftp = putx(q->exprblock.leftp);
+ }
+ else
+ cp -> datap = (char *) putx(q);
+ }
+ else if (q->tag == TEXPR && q->exprblock.opcode == OPCHARCAST)
cp -> datap = (char *) putx(q);
else {
expptr t, t1;
diff --git a/usr.bin/f2c/sysdep.c b/usr.bin/f2c/sysdep.c
index 29b1a05..5469034 100644
--- a/usr.bin/f2c/sysdep.c
+++ b/usr.bin/f2c/sysdep.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990 - 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
#include "usignal.h"
@@ -82,7 +82,7 @@ set_tmp_names(Void)
int k;
if (debugflag == 1)
return;
- k = strlen(tmpdir) + 16;
+ k = strlen(tmpdir) + 24;
c_functions = (char *)ckalloc(7*k);
initfname = c_functions + k;
initbname = initfname + k;
@@ -115,13 +115,13 @@ set_tmp_names(Void)
sprintf(p1_bakfile, "%sf2c_p1fb", t);
sprintf(sortfname, "%sf2c_sort", t);
#else
- int pid = getpid();
- sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
- sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
- sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
- sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
- sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
- sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
+ long pid = getpid();
+ sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
+ sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
+ sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
+ sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
+ sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
+ sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
#endif
sprintf(initbname, "%s.b", initfname);
}
diff --git a/usr.bin/f2c/sysdep.h b/usr.bin/f2c/sysdep.h
index 192e3a9..e3a68ef 100644
--- a/usr.bin/f2c/sysdep.h
+++ b/usr.bin/f2c/sysdep.h
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1991, 1994 by AT&T Bell Laboratories, Bellcore.
+Copyright 1990, 1991, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
/* This file is included at the start of defs.h; this file
@@ -94,5 +94,5 @@ extern char *chr_fmt[], escapes[], *str_fmt[];
#include "ctype.h"
-#define Table_size 256
-/* Table_size should be 1 << (bits/byte) */
+#define Bits_per_Byte 8
+#define Table_size (1 << Bits_per_Byte)
diff --git a/usr.bin/f2c/vax.c b/usr.bin/f2c/vax.c
index 57c4be9..fa78805 100644
--- a/usr.bin/f2c/vax.c
+++ b/usr.bin/f2c/vax.c
@@ -1,24 +1,24 @@
/****************************************************************
-Copyright 1990, 1992, 1993, 1994 by AT&T Bell Laboratories and Bellcore.
+Copyright 1990, 1992, 1993, 1994 by AT&T, Lucent Technologies 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
-this software.
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent 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, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness. In no event shall AT&T, Lucent 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 this software.
****************************************************************/
#include "defs.h"
@@ -141,13 +141,17 @@ make_int_expr(expptr e)
{
chainp listp;
Addrp ap;
+ expptr e1;
if (e != ENULL)
switch (e -> tag) {
case TADDR:
- if (e -> addrblock.vstg == STGARG
- && !e->addrblock.isarray)
- e = mkexpr (OPWHATSIN, e, ENULL);
+ if (e->addrblock.isarray) {
+ if (e1 = e->addrblock.memoffset)
+ e->addrblock.memoffset = make_int_expr(e1);
+ }
+ else if (e->addrblock.vstg == STGARG)
+ e = mkexpr(OPWHATSIN, e, ENULL);
break;
case TEXPR:
e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp);
diff --git a/usr.bin/f2c/version.c b/usr.bin/f2c/version.c
index e82655b..87a0922 100644
--- a/usr.bin/f2c/version.c
+++ b/usr.bin/f2c/version.c
@@ -1,2 +1,2 @@
-char F2C_version[] = "19950920";
-char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19950920\n";
+char F2C_version[] = "19970219";
+char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19970219\n";
OpenPOWER on IntegriCloud