diff options
50 files changed, 4984 insertions, 1910 deletions
diff --git a/usr.bin/f2c/Notice b/usr.bin/f2c/Notice index 64af9f1..9715a19 100644 --- a/usr.bin/f2c/Notice +++ b/usr.bin/f2c/Notice @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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 ed88aaa..b8e5a67 100644 --- a/usr.bin/f2c/README +++ b/usr.bin/f2c/README @@ -1,10 +1,10 @@ Type "make" to check the validity of the f2c source and compile f2c. On a PC, you may need to compile xsum.c with -DMSDOS (i.e., with -MSDOS #defined). If your system does not understand ANSI/ISO C -syntax (i.e., if you have a K&R C compiler), compile xsum.c with --DKR_headers. (Eventually this will also be required of the f2c -source proper.) +MSDOS #defined). + +If your compiler does not understand ANSI/ISO C syntax (i.e., if +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". @@ -20,15 +20,21 @@ You may need to modify usignal.h if you are not running f2c on a UNIX system. Should you get the message "xsum0.out xsum1.out differ", see what lines -are different (`diff xsum0.out xsum1.out`) and ask netlib to send you -the files in question "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 from f2c/src +are different (`diff xsum0.out xsum1.out`) and ask netlib +(e.g., netlib@research.att.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". On some systems, the malloc and free in malloc.c let f2c run faster -than do the standard malloc and free. Other systems cannot tolerate -redefinition of malloc and free. If yours is such a system, you may -either modify the makefile appropriately, or simply execute +than do the standard malloc and free. Other systems may not tolerate +redefinition of malloc and free (though changes of 8 Nov. 1994 may +render this less of a problem than hitherto). If yours is such a +system, you may either modify the makefile appropriately (remove +"malloc.o" from the "OBJECTS =" assignment), or simply execute 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 @@ -66,9 +72,21 @@ message of the form Compiler error ... cannot open intermediate file ... On many systems, it is best to combine libF77 and libI77 into a single -library, say libf2c, as suggested in "readme from f2c". If you do this, -then you should adjust the definition of link_msg in sysdep.c -appropriately (e.g., replacing "-lF77 -lI77" by "-lf2c"). +library, say libf2c, as suggested in "readme from f2c". If you do not +do this, then you should adjust the definition of link_msg in sysdep.c +appropriately (e.g., replacing "-lf2c" by "-lF77 -lI77"). On Unix +systems, the easiest way to create libf2c.a is to make libF77/libF77.a +and libI77/libI77.a (after reading and heeding libF77/README and +libI77/README), and then to say + + cp libF77/libF77.a libf2c.a + ar ruv libf2c.a libI77/*.o + ranlib libf2c.a + +The last step, ranlib, may not be necessary on your system. On +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 . Some older C compilers object to typedef void (*foo)(); @@ -85,10 +103,43 @@ test by compiling lex.c with NO_EOF_CHAR_CHECK #defined, or can change control-Z to some other character by #defining EOF_CHAR to be the desired value. + +If your machine has IEEE, VAX, or IBM-mainframe arithmetic, but your +printf is inaccurate (e.g., with Symantec C++ version 6.0, +printf("%.17g",12.) prints 12.000000000000001), you can make f2c print +correctly rounded numbers by compiling with -DUSE_DTOA and adding +dtoa.o g_fmt.o to the makefile's OBJECTS = line, so it becomes + + OBJECTS = $(OBJECTSd) malloc.o dtoa.o g_fmt.o + +Also add the rule + + dtoa.o: dtoa.c + $(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c + +(without the initial tab) to the makefile, where IEEE... is one of +IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's +arithmetic. See the comments near the start of dtoa.c. + +The relevant source files, dtoa.c and g_fmt.c, are available +separately from netlib's fp directory. For example, you could +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). + +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 (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. +files. Changes first appear on netlib@research.att.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 3a9a9dc..80e91ae 100644 --- a/usr.bin/f2c/cds.c +++ b/usr.bin/f2c/cds.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993, 1994 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 @@ -31,11 +31,16 @@ this software. * Arrange that the return value, rv, satisfies rv[0] == '-' || rv[-1] == '-' . */ -#include "sysdep.h" +#include "defs.h" char * +#ifdef KR_headers cds(s, z0) - char *s, *z0; + char *s; + char *z0; +#else +cds(char *s, char *z0) +#endif { int ea, esign, et, i, k, nd = 0, sign = 0, tz; char c, *z; diff --git a/usr.bin/f2c/data.c b/usr.bin/f2c/data.c index 5d11216..44b84ef 100644 --- a/usr.bin/f2c/data.c +++ b/usr.bin/f2c/data.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993 - 1995 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 @@ -29,13 +29,18 @@ static char datafmt[] = "%s\t%09ld\t%d"; static char *cur_varname; /* another initializer, called from parser */ + void +#ifdef KR_headers dataval(repp, valp) -register expptr repp, valp; + register expptr repp; + register expptr valp; +#else +dataval(register expptr repp, register expptr valp) +#endif { int i, nrep; ftnint elen; register Addrp p; - Addrp nextdata(); if (parstate < INDATA) { frexpr(repp); @@ -53,11 +58,18 @@ register expptr repp, valp; } frexpr(repp); - if( ! ISCONST(valp) ) - { - err("non-constant initializer"); - goto ret; - } + if( ! ISCONST(valp) ) { + if (valp->tag == TADDR + && valp->addrblock.uname_tag == UNAM_CONST) { + /* kludge */ + frexpr(valp->addrblock.memoffset); + valp->tag = TCONST; + } + else { + err("non-constant initializer"); + goto ret; + } + } if(toomanyinit) goto ret; for(i = 0 ; i < nrep ; ++i) @@ -78,8 +90,13 @@ ret: } -Addrp nextdata(elenp) -ftnint *elenp; + Addrp +#ifdef KR_headers +nextdata(elenp) + ftnint *elenp; +#else +nextdata(ftnint *elenp) +#endif { register struct Impldoblock *ip; struct Primblock *pp; @@ -220,17 +237,21 @@ next: LOCAL FILEP dfile; - + void +#ifdef KR_headers setdata(varp, valp, elen) -register Addrp varp; -ftnint elen; -register Constp valp; + register Addrp varp; + register Constp valp; + ftnint elen; +#else +setdata(register Addrp varp, register Constp valp, ftnint elen) +#endif { struct Constblock con; register int type; int i, k, valtype; ftnint offset; - char *dataname(), *varname; + char *varname; static Addrp badvar; register unsigned char *s; static int last_lineno; @@ -291,8 +312,6 @@ register Constp valp; switch(type) { case TYLOGICAL: - if (tylogical != TYLONG) - type = tylogical; case TYINT1: case TYLOGICAL1: case TYLOGICAL2: @@ -347,13 +366,18 @@ register Constp valp; output form of name is padded with blanks and preceded with a storage class digit */ -char *dataname(stg,memno) - int stg; - long memno; + char* +#ifdef KR_headers +dataname(stg, memno) + int stg; + long memno; +#else +dataname(int stg, long memno) +#endif { static char varname[64]; register char *s, *t; - char buf[16], *memname(); + char buf[16]; if (stg == STGCOMMON) { varname[0] = '2'; @@ -372,9 +396,13 @@ char *dataname(stg,memno) - + void +#ifdef KR_headers frdata(p0) -chainp p0; + chainp p0; +#else +frdata(chainp p0) +#endif { register struct Chain *p; register tagptr q; @@ -398,28 +426,49 @@ chainp p0; } - + void +#ifdef KR_headers dataline(varname, offset, type) -char *varname; -ftnint offset; -int type; + char *varname; + ftnint offset; + int type; +#else +dataline(char *varname, ftnint offset, int type) +#endif { fprintf(dfile, datafmt, varname, offset, type); } void +#ifdef KR_headers make_param(p, e) - register struct Paramblock *p; - expptr e; + register struct Paramblock *p; + expptr e; +#else +make_param(register struct Paramblock *p, expptr e) +#endif { register expptr q; + struct Constblock qc; + if (p->vstg == STGARG) + errstr("Dummy argument %.50s appears in a parameter statement.", + p->fvarname); p->vclass = CLPARAM; impldcl((Namep)p); + if (e->headblock.vtype != TYCHAR) + e = putx(fixtype(e)); p->paramval = q = mkconv(p->vtype, e); if (p->vtype == TYCHAR) { if (q->tag == TEXPR) - p->paramval = q = fixexpr(q); + 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; + } if (!ISCONST(q) || q->constblock.vtype != TYCHAR) { errstr("invalid value for character parameter %s", p->fvarname); diff --git a/usr.bin/f2c/defines.h b/usr.bin/f2c/defines.h index fc7eb18..db23ade 100644 --- a/usr.bin/f2c/defines.h +++ b/usr.bin/f2c/defines.h @@ -288,9 +288,3 @@ typedef long int ftnint; #define NO66(s) if(no66flag) err66(s) #define NOEXT(s) if(noextflag) errext(s) - -/* round a up to the nearest multiple of b: - - a = b * floor ( (a + (b - 1)) / b )*/ - -#define roundup(a,b) ( b * ( (a+b-1)/b) ) diff --git a/usr.bin/f2c/defs.h b/usr.bin/f2c/defs.h index 6bb2ca2..3404f14 100644 --- a/usr.bin/f2c/defs.h +++ b/usr.bin/f2c/defs.h @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories, Bellcore. +Copyright 1990 - 1995 by AT&T Bell Laboratories, Bellcore. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby @@ -31,7 +31,6 @@ this software. #define MAXINCLUDES 10 #define MAXLITERALS 200 /* Max number of constants in the literal pool */ -#define MAXTOKENLEN 502 /* length of longest token */ #define MAXCTL 20 #define MAXHASH 401 #define MAXSTNO 801 @@ -50,7 +49,6 @@ typedef struct Constblock *Constp; typedef struct Exprblock *Exprp; typedef struct Nameblock *Namep; -extern FILEP opf(); extern FILEP infile; extern FILEP diagfile; extern FILEP textfile; @@ -67,7 +65,7 @@ extern int current_ftn_file; extern int maxcontin; extern char *blkdfname, *initfname, *sortfname; -extern long int headoffset; /* Since the header block requires data we +extern long headoffset; /* Since the header block requires data we don't know about until AFTER each function has been processed, we keep a pointer to the current (dummy) header @@ -75,8 +73,8 @@ extern long int headoffset; /* Since the header block requires data we here */ extern char main_alias[]; /* name given to PROGRAM psuedo-op */ -extern char token [ ]; -extern int toklen; +extern char *token; +extern int maxtoklen, toklen; extern long lineno; extern char *infname; extern int needkwd; @@ -301,7 +299,7 @@ extern int complex_seen, dcomplex_seen; struct Labelblock { int labelno; /* Internal label */ - unsigned blklevel:8; /* level of nesting , for branch-in-loop + unsigned blklevel:8; /* level of nesting, for branch-in-loop checking */ unsigned labused:1; unsigned fmtlabused:1; @@ -488,6 +486,7 @@ struct Exprblock unsigned opcode; expptr leftp; expptr rightp; + int typefixed; }; @@ -497,7 +496,7 @@ union Constant char *ccp0; ftnint blanks; } ccp1; - ftnint ci; /* Constant long integer */ + ftnint ci; /* Constant longeger */ double cd[2]; char *cds[2]; }; @@ -680,8 +679,8 @@ struct Equivblock struct Eqvchain *equivs; /* List (Eqvchain) of primblocks holding variable identifiers */ flag eqvinit; - long int eqvtop; - long int eqvbottom; + long eqvtop; + long eqvbottom; int eqvtype; } ; #define eqvleng eqvtop @@ -697,7 +696,7 @@ struct Eqvchain struct Primblock *eqvlhs; Namep eqvname; } eqvitem; - long int eqvoffset; + long eqvoffset; } ; @@ -733,52 +732,322 @@ extern char Letters[]; struct Dims { expptr lb, ub; }; - -/* popular functions with non integer return values */ - - -int *ckalloc(); -char *varstr(), *nounder(), *addunder(); -char *copyn(), *copys(); -chainp hookup(), mkchain(), revchain(); -ftnint convci(); -char *convic(); -char *setdoto(); -double convcd(); -Namep mkname(); -struct Labelblock *mklabel(), *execlab(); -Extsym *mkext(), *newentry(); -expptr addrof(), call1(), call2(), call3(), call4(); -Addrp builtin(), mktmp(), mktmp0(), mktmpn(), autovar(); -Addrp mkplace(), mkaddr(), putconst(), memversion(); -expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype(); -expptr errnode(), mkaddcon(), mkintcon(), putcxop(); -tagptr cpexpr(); -ftnint lmin(), lmax(), iarrlen(); -char *dbconst(), *flconst(); - -void puteq (), putex1 (); -expptr putx (), putsteq (), putassign (); - extern int forcedouble; /* force real functions to double */ extern int doin_setbound; /* special handling for array bounds */ extern int Ansi; -extern char *cds(), *cpstring(), *dtos(), *string_num(); -extern char *c_type_decl(); extern char hextoi_tab[]; #define hextoi(x) hextoi_tab[(x) & 0xff] extern char *casttypes[], *ftn_types[], *protorettypes[], *usedcasts[]; extern int Castargs, infertypes; extern FILE *protofile; -extern void exit(), inferdcl(), protowrite(), save_argtypes(); extern char binread[], binwrite[], textread[], textwrite[]; extern char *ei_first, *ei_last, *ei_next; extern char *wh_first, *wh_last, *wh_next; -extern void putwhile(); -extern char *halign; +extern char *halign, *outbuf, *outbtail; extern flag keepsubs; #ifdef TYQUAD extern flag use_tyquad; #endif -extern int n_keywords, n_st_fields; -extern char *c_keywords[], *st_fields[]; +extern int n_keywords; +extern char *c_keywords[]; + +#ifdef KR_headers +#define Argdcl(x) () +#define Void /* void */ +#else +#define Argdcl(x) x +#define Void void +#endif + +char* Alloc Argdcl((int)); +char* Argtype Argdcl((int, char*)); +void Fatal Argdcl((char*)); +struct Impldoblock* mkiodo Argdcl((chainp, chainp)); +tagptr Inline Argdcl((int, int, chainp)); +struct Labelblock* execlab Argdcl((long)); +struct Labelblock* mklabel Argdcl((long)); +struct Listblock* mklist Argdcl((chainp)); +void Un_link_all Argdcl((int)); +void add_extern_to_list Argdcl((Addrp, chainp*)); +int addressable Argdcl((tagptr)); +tagptr addrof Argdcl((tagptr)); +char* addunder Argdcl((char*)); +Addrp autovar Argdcl((int, int, tagptr, char*)); +void backup Argdcl((char*, char*)); +void bad_atypes Argdcl((Argtypes*, char*, int, int, int, char*, char*)); +int badchleng Argdcl((tagptr)); +void badop Argdcl((char*, int)); +void badstg Argdcl((char*, int)); +void badtag Argdcl((char*, int)); +void badthing Argdcl((char*, char*, int)); +void badtype Argdcl((char*, int)); +Addrp builtin Argdcl((int, char*, int)); +char* c_name Argdcl((char*, int)); +tagptr call0 Argdcl((int, char*)); +tagptr call1 Argdcl((int, char*, tagptr)); +tagptr call2 Argdcl((int, char*, tagptr, tagptr)); +tagptr call3 Argdcl((int, char*, tagptr, tagptr, tagptr)); +tagptr call4 Argdcl((int, char*, tagptr, tagptr, tagptr, tagptr)); +tagptr callk Argdcl((int, char*, chainp)); +void cast_args Argdcl((int, chainp)); +char* cds Argdcl((char*, char*)); +void changedtype Argdcl((Namep)); +ptr ckalloc Argdcl((int)); +int cktype Argdcl((int, int, int)); +void clf Argdcl((FILEP*, char*, int)); +int cmpstr Argdcl((char*, char*, long, long)); +char* c_type_decl Argdcl((int, int)); +Extsym* comblock Argdcl((char*)); +char* comm_union_name Argdcl((int)); +void consconv Argdcl((int, Constp, Constp)); +void consnegop Argdcl((Constp)); +int conssgn Argdcl((tagptr)); +char* convic Argdcl((long)); +void copy_data Argdcl((chainp)); +char* copyn Argdcl((int, char*)); +char* copys Argdcl((char*)); +tagptr cpblock Argdcl((int, char*)); +tagptr cpexpr Argdcl((tagptr)); +void cpn Argdcl((int, char*, char*)); +char* cpstring Argdcl((char*)); +void dataline Argdcl((char*, long, int)); +char* dataname Argdcl((int, long)); +void dataval Argdcl((tagptr, tagptr)); +void dclerr Argdcl((char*, Namep)); +void def_commons Argdcl((FILEP)); +void def_start Argdcl((FILEP, char*, char*, char*)); +void deregister Argdcl((Namep)); +void do_uninit_equivs Argdcl((FILEP, ptr)); +void doequiv(Void); +int dofork(Void); +void doinclude Argdcl((char*)); +void doio Argdcl((chainp)); +void done Argdcl((int)); +void donmlist(Void); +int dsort Argdcl((char*, char*)); +char* dtos Argdcl((double)); +void elif_out Argdcl((FILEP, tagptr)); +void end_else_out Argdcl((FILEP)); +void enddcl(Void); +void enddo Argdcl((int)); +void endio(Void); +void endioctl(Void); +void endproc(Void); +void entrypt Argdcl((int, int, long, Extsym*, chainp)); +int eqn Argdcl((int, char*, char*)); +char* equiv_name Argdcl((int, char*)); +void err Argdcl((char*)); +void err66 Argdcl((char*)); +void errext Argdcl((char*)); +void erri Argdcl((char*, int)); +void errl Argdcl((char*, long)); +tagptr errnode(Void); +void errstr Argdcl((char*, char*)); +void exarif Argdcl((tagptr, struct Labelblock*, struct Labelblock*, struct Labelblock*)); +void exasgoto Argdcl((Namep)); +void exassign Argdcl((Namep, struct Labelblock*)); +void excall Argdcl((Namep, struct Listblock*, int, struct Labelblock**)); +void exdo Argdcl((int, Namep, chainp)); +void execerr Argdcl((char*, char*)); +void exelif Argdcl((tagptr)); +void exelse(Void); +void exenddo Argdcl((Namep)); +void exendif(Void); +void exequals Argdcl((struct Primblock*, tagptr)); +void exgoto Argdcl((struct Labelblock*)); +void exif Argdcl((tagptr)); +void exreturn Argdcl((tagptr)); +void exstop Argdcl((int, tagptr)); +void extern_out Argdcl((FILEP, Extsym*)); +void fatali Argdcl((char*, int)); +void fatalstr Argdcl((char*, char*)); +void ffilecopy Argdcl((FILEP, FILEP)); +void fileinit(Void); +int fixargs Argdcl((int, struct Listblock*)); +tagptr fixexpr Argdcl((Exprp)); +tagptr fixtype Argdcl((tagptr)); +char* flconst Argdcl((char*, char*)); +void flline(Void); +void fmt_init(Void); +void fmtname Argdcl((Namep, Addrp)); +int fmtstmt Argdcl((struct Labelblock*)); +tagptr fold Argdcl((tagptr)); +void frchain Argdcl((chainp*)); +void frdata Argdcl((chainp)); +void freetemps(Void); +void freqchain Argdcl((struct Equivblock*)); +void frexchain Argdcl((chainp*)); +void frexpr Argdcl((tagptr)); +void frrpl(Void); +void frtemp Argdcl((Addrp)); +char* gmem Argdcl((int, int)); +void hashclear(Void); +chainp hookup Argdcl((chainp, chainp)); +expptr imagpart Argdcl((Addrp)); +void impldcl Argdcl((Namep)); +int in_vector Argdcl((char*, char**, int)); +void incomm Argdcl((Extsym*, Namep)); +void inferdcl Argdcl((Namep, int)); +int inilex Argdcl((char*)); +void initkey(Void); +int inregister Argdcl((Namep)); +long int commlen Argdcl((chainp)); +long int convci Argdcl((int, char*)); +long int iarrlen Argdcl((Namep)); +long int lencat Argdcl((expptr)); +long int lmax Argdcl((long, long)); +long int lmin Argdcl((long, long)); +long int wr_char_len Argdcl((FILEP, struct Dimblock*, int, int)); +Addrp intraddr Argdcl((Namep)); +tagptr intrcall Argdcl((Namep, struct Listblock*, int)); +int intrfunct Argdcl((char*)); +void ioclause Argdcl((int, expptr)); +int iocname(Void); +int is_negatable Argdcl((Constp)); +int isaddr Argdcl((tagptr)); +int isnegative_const Argdcl((Constp)); +int isstatic Argdcl((tagptr)); +chainp length_comp Argdcl((struct Entrypoint*, int)); +int lengtype Argdcl((int, long)); +char* lexline Argdcl((ptr)); +void list_arg_types Argdcl((FILEP, struct Entrypoint*, chainp, int, char*)); +void list_decls Argdcl((FILEP)); +void list_init_data Argdcl((FILE **, char *, FILE *)); +void listargs Argdcl((FILEP, struct Entrypoint*, int, chainp)); +char* lit_name Argdcl((struct Literal*)); +int log_2 Argdcl((long)); +char* lower_string Argdcl((char*, char*)); +int main Argdcl((int, char**)); +expptr make_int_expr Argdcl((expptr)); +void make_param Argdcl((struct Paramblock*, tagptr)); +void many Argdcl((char*, char, int)); +void margin_printf Argdcl((FILEP, char*, ...)); +int maxtype Argdcl((int, int)); +char* mem Argdcl((int, int)); +void mem_init(Void); +char* memname Argdcl((int, long)); +Addrp memversion Argdcl((Namep)); +tagptr mkaddcon Argdcl((long)); +Addrp mkaddr Argdcl((Namep)); +Addrp mkarg Argdcl((int, int)); +tagptr mkbitcon Argdcl((int, int, char*)); +chainp mkchain Argdcl((char*, chainp)); +Constp mkconst Argdcl((int)); +tagptr mkconv Argdcl((int, tagptr)); +tagptr mkcxcon Argdcl((tagptr, tagptr)); +tagptr mkexpr Argdcl((int, tagptr, tagptr)); +Extsym* mkext Argdcl((char*, char*)); +Extsym* mkext1 Argdcl((char*, char*)); +Addrp mkfield Argdcl((Addrp, char*, int)); +tagptr mkfunct Argdcl((tagptr)); +tagptr mkintcon Argdcl((long)); +tagptr mklhs Argdcl((struct Primblock*, int)); +tagptr mklogcon Argdcl((int)); +Namep mkname Argdcl((char*)); +Addrp mkplace Argdcl((Namep)); +tagptr mkprim Argdcl((Namep, struct Listblock*, chainp)); +tagptr mkrealcon Argdcl((int, char*)); +Addrp mkscalar Argdcl((Namep)); +void mkstfunct Argdcl((struct Primblock*, tagptr)); +tagptr mkstrcon Argdcl((int, char*)); +Addrp mktmp Argdcl((int, tagptr)); +Addrp mktmp0 Argdcl((int, tagptr)); +Addrp mktmpn Argdcl((int, int, tagptr)); +void namelist Argdcl((Namep)); +int ncat Argdcl((expptr)); +void negate_const Argdcl((Constp)); +void new_endif(Void); +Extsym* newentry Argdcl((Namep, int)); +int newlabel(Void); +void newproc(Void); +Addrp nextdata Argdcl((long*)); +void nice_printf Argdcl((FILEP, char*, ...)); +void not_both Argdcl((char*)); +void np_init(Void); +int oneof_stg Argdcl((Namep, int, int)); +int op_assign Argdcl((int)); +tagptr opconv Argdcl((tagptr, int)); +FILEP opf Argdcl((char*, char*)); +void out_addr Argdcl((FILEP, Addrp)); +void out_asgoto Argdcl((FILEP, tagptr)); +void out_call Argdcl((FILEP, int, int, tagptr, tagptr, tagptr)); +void out_const Argdcl((FILEP, Constp)); +void out_else Argdcl((FILEP)); +void out_for Argdcl((FILEP, tagptr, tagptr, tagptr)); +void out_init(Void); +void outbuf_adjust(Void); +void p1_label Argdcl((long)); +void prcona Argdcl((FILEP, long)); +void prconi Argdcl((FILEP, long)); +void prconr Argdcl((FILEP, Constp, int)); +void procinit(Void); +void procode Argdcl((FILEP)); +void prolog Argdcl((FILEP, chainp)); +void protowrite Argdcl((FILEP, int, char*, struct Entrypoint*, chainp)); +expptr prune_left_conv Argdcl((expptr)); +int put_one_arg Argdcl((int, char*, char**, char*, char*)); +expptr putassign Argdcl((expptr, expptr)); +Addrp putchop Argdcl((tagptr)); +void putcmgo Argdcl((tagptr, int, struct Labelblock**)); +Addrp putconst Argdcl((Constp)); +tagptr putcxop Argdcl((tagptr)); +void puteq Argdcl((expptr, expptr)); +void putexpr Argdcl((expptr)); +void puthead Argdcl((char*, int)); +void putif Argdcl((tagptr, int)); +void putout Argdcl((tagptr)); +expptr putsteq Argdcl((Addrp, Addrp)); +void putwhile Argdcl((tagptr)); +tagptr putx Argdcl((tagptr)); +void r8fix(Void); +int rdlong Argdcl((FILEP, long*)); +int rdname Argdcl((FILEP, ptr, char*)); +void read_Pfiles Argdcl((char**)); +Addrp realpart Argdcl((Addrp)); +chainp revchain Argdcl((chainp)); +int same_expr Argdcl((tagptr, tagptr)); +int same_ident Argdcl((tagptr, tagptr)); +void save_argtypes Argdcl((chainp, Argtypes**, Argtypes**, int, char*, int, int, int, int)); +void saveargtypes Argdcl((Exprp)); +void set_externs(Void); +void set_tmp_names(Void); +void setbound Argdcl((Namep, int, struct Dims*)); +void setdata Argdcl((Addrp, Constp, long)); +void setext Argdcl((Namep)); +void setfmt Argdcl((struct Labelblock*)); +void setimpl Argdcl((int, long, int, int)); +void setintr Argdcl((Namep)); +void settype Argdcl((Namep, int, long)); +void sigcatch Argdcl((int)); +void start_formatting(Void); +void startioctl(Void); +void startproc Argdcl((Extsym*, int)); +void startrw(Void); +char* string_num Argdcl((char*, long)); +int struct_eq Argdcl((chainp, chainp)); +tagptr subcheck Argdcl((Namep, tagptr)); +tagptr suboffset Argdcl((struct Primblock*)); +int type_fixup Argdcl((Argtypes*, Atype*, int)); +void unamstring Argdcl((Addrp, char*)); +void unclassifiable(Void); +void vardcl Argdcl((Namep)); +void warn Argdcl((char*)); +void warn1 Argdcl((char*, char*)); +void warni Argdcl((char*, int)); +void wr_abbrevs Argdcl((FILEP, int, chainp)); +char* wr_ardecls Argdcl((FILE*, struct Dimblock*, long)); +void wr_array_init Argdcl((FILEP, int, chainp)); +void wr_common_decls Argdcl((FILEP)); +void wr_equiv_init Argdcl((FILEP, int, chainp*, int)); +void wr_globals Argdcl((FILEP)); +void wr_nv_ident_help Argdcl((FILEP, Addrp)); +void wr_struct Argdcl((FILEP, chainp)); +void wronginf Argdcl((Namep)); +void yyerror Argdcl((char*)); +int yylex(Void); +int yyparse(Void); + +#ifdef USE_DTOA +#define atof(x) strtod(x,0) +void g_fmt Argdcl((char*, double)); +#endif diff --git a/usr.bin/f2c/equiv.c b/usr.bin/f2c/equiv.c index 019e206..645a77a 100644 --- a/usr.bin/f2c/equiv.c +++ b/usr.bin/f2c/equiv.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993-5 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 @@ -23,14 +23,17 @@ this software. #include "defs.h" -LOCAL eqvcommon(), eqveqv(), nsubs(); +static void eqvcommon Argdcl((struct Equivblock*, int, long int)); +static void eqveqv Argdcl((int, int, long int)); +static int nsubs Argdcl((struct Listblock*)); /* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */ /* called at end of declarations section to process chains created by EQUIVALENCE statements */ -doequiv() + void +doequiv(Void) { register int i; int inequiv; /* True if one namep occurs in @@ -69,7 +72,7 @@ doequiv() vardcl(np = primp->namep); if(primp->argsp || primp->fcharp) { - expptr offp, suboffset(); + expptr offp; /* Pad ones onto the end of an array declaration when needed */ @@ -114,14 +117,6 @@ doequiv() case STGUNKNOWN: case STGBSS: case STGEQUIV: - if (in_vector(np->cvarname, st_fields, - n_st_fields) >= 0) { - k = strlen(np->cvarname); - strcpy(s = mem(k+2,0), np->cvarname); - s[k] = '_'; - s[k+1] = 0; - np->cvarname = s; - } break; case STGCOMMON: @@ -239,10 +234,15 @@ doequiv() /* put equivalence chain p at common block comno + comoffset */ -LOCAL eqvcommon(p, comno, comoffset) -struct Equivblock *p; -int comno; -ftnint comoffset; + LOCAL void +#ifdef KR_headers +eqvcommon(p, comno, comoffset) + struct Equivblock *p; + int comno; + ftnint comoffset; +#else +eqvcommon(struct Equivblock *p, int comno, ftnint comoffset) +#endif { int ovarno; ftnint k, offq; @@ -315,9 +315,15 @@ ftnint comoffset; * adjust offsets of ovarno elements and top and bottom of nvarno chain */ -LOCAL eqveqv(nvarno, ovarno, delta) -int ovarno, nvarno; -ftnint delta; + LOCAL void +#ifdef KR_headers +eqveqv(nvarno, ovarno, delta) + int nvarno; + int ovarno; + ftnint delta; +#else +eqveqv(int nvarno, int ovarno, ftnint delta) +#endif { register struct Equivblock *neweqv, *oldeqv; register Namep np; @@ -347,9 +353,13 @@ ftnint delta; - + void +#ifdef KR_headers freqchain(p) -register struct Equivblock *p; + register struct Equivblock *p; +#else +freqchain(register struct Equivblock *p) +#endif { register struct Eqvchain *q, *oq; @@ -368,8 +378,13 @@ register struct Equivblock *p; /* nsubs -- number of subscripts in this arglist (just the length of the list) */ -LOCAL nsubs(p) -register struct Listblock *p; + LOCAL int +#ifdef KR_headers +nsubs(p) + register struct Listblock *p; +#else +nsubs(register struct Listblock *p) +#endif { register int n; register chainp q; diff --git a/usr.bin/f2c/error.c b/usr.bin/f2c/error.c index fd68d14..049008e 100644 --- a/usr.bin/f2c/error.c +++ b/usr.bin/f2c/error.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993, 1994 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 @@ -23,26 +23,41 @@ this software. #include "defs.h" -warni(s,t) - char *s; - int t; + void +#ifdef KR_headers +warni(s, t) + char *s; + int t; +#else +warni(char *s, int t) +#endif { char buf[100]; sprintf(buf,s,t); warn(buf); } -warn1(s,t) -char *s, *t; + void +#ifdef KR_headers +warn1(s, t) + char *s; + char *t; +#else +warn1(char *s, char *t) +#endif { char buff[100]; sprintf(buff, s, t); warn(buff); } - + void +#ifdef KR_headers warn(s) -char *s; + char *s; +#else +warn(char *s) +#endif { if(nowarnflag) return; @@ -55,9 +70,14 @@ char *s; ++nwarn; } - + void +#ifdef KR_headers errstr(s, t) -char *s, *t; + char *s; + char *t; +#else +errstr(char *s, char *t) +#endif { char buff[100]; sprintf(buff, s, t); @@ -65,19 +85,28 @@ char *s, *t; } - -erri(s,t) -char *s; -int t; + void +#ifdef KR_headers +erri(s, t) + char *s; + int t; +#else +erri(char *s, int t) +#endif { char buff[100]; sprintf(buff, s, t); err(buff); } -errl(s,t) -char *s; -long t; + void +#ifdef KR_headers +errl(s, t) + char *s; + long t; +#else +errl(char *s, long t) +#endif { char buff[100]; sprintf(buff, s, t); @@ -86,8 +115,13 @@ long t; char *err_proc = 0; + void +#ifdef KR_headers err(s) -char *s; + char *s; +#else +err(char *s) +#endif { if (err_proc) fprintf(diagfile, @@ -102,18 +136,26 @@ char *s; ++nerr; } - + void +#ifdef KR_headers yyerror(s) -char *s; + char *s; +#else +yyerror(char *s) +#endif { err(s); } - + void +#ifdef KR_headers dclerr(s, v) -char *s; -Namep v; + char *s; + Namep v; +#else +dclerr(char *s, Namep v) +#endif { char buff[100]; @@ -127,9 +169,14 @@ Namep v; } - + void +#ifdef KR_headers execerr(s, n) -char *s, *n; + char *s; + char *n; +#else +execerr(char *s, char *n) +#endif { char buf1[100], buf2[100]; @@ -139,8 +186,13 @@ char *s, *n; } + void +#ifdef KR_headers Fatal(t) -char *t; + char *t; +#else +Fatal(char *t) +#endif { fprintf(diagfile, "Compiler error line %ld", lineno); if (infname) @@ -151,9 +203,14 @@ char *t; - -fatalstr(t,s) -char *t, *s; + void +#ifdef KR_headers +fatalstr(t, s) + char *t; + char *s; +#else +fatalstr(char *t, char *s) +#endif { char buff[100]; sprintf(buff, t, s); @@ -161,10 +218,14 @@ char *t, *s; } - -fatali(t,d) -char *t; -int d; + void +#ifdef KR_headers +fatali(t, d) + char *t; + int d; +#else +fatali(char *t, int d) +#endif { char buff[100]; sprintf(buff, t, d); @@ -172,10 +233,15 @@ int d; } - + void +#ifdef KR_headers badthing(thing, r, t) -char *thing, *r; -int t; + char *thing; + char *r; + int t; +#else +badthing(char *thing, char *r, int t) +#endif { char buff[50]; sprintf(buff, "Impossible %s %d in routine %s", thing, t, r); @@ -183,19 +249,27 @@ int t; } - + void +#ifdef KR_headers badop(r, t) -char *r; -int t; + char *r; + int t; +#else +badop(char *r, int t) +#endif { badthing("opcode", r, t); } - + void +#ifdef KR_headers badtag(r, t) -char *r; -int t; + char *r; + int t; +#else +badtag(char *r, int t) +#endif { badthing("tag", r, t); } @@ -203,28 +277,41 @@ int t; - + void +#ifdef KR_headers badstg(r, t) -char *r; -int t; + char *r; + int t; +#else +badstg(char *r, int t) +#endif { badthing("storage class", r, t); } - + void +#ifdef KR_headers badtype(r, t) -char *r; -int t; + char *r; + int t; +#else +badtype(char *r, int t) +#endif { badthing("type", r, t); } - + void +#ifdef KR_headers many(s, c, n) -char *s, c; -int n; + char *s; + char c; + int n; +#else +many(char *s, char c, int n) +#endif { char buff[250]; @@ -234,18 +321,26 @@ int n; Fatal(buff); } - + void +#ifdef KR_headers err66(s) -char *s; + char *s; +#else +err66(char *s) +#endif { errstr("Fortran 77 feature used: %s", s); --nerr; } - + void +#ifdef KR_headers errext(s) -char *s; + char *s; +#else +errext(char *s) +#endif { errstr("f2c extension used: %s", s); --nerr; diff --git a/usr.bin/f2c/exec.c b/usr.bin/f2c/exec.c index b986492..bcd1e08 100644 --- a/usr.bin/f2c/exec.c +++ b/usr.bin/f2c/exec.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993 - 1995 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 @@ -25,23 +25,33 @@ this software. #include "p1defs.h" #include "names.h" -LOCAL void exar2(), popctl(), pushctl(); +static void exar2 Argdcl((int, tagptr, struct Labelblock*, struct Labelblock*)); +static void popctl Argdcl((void)); +static void pushctl Argdcl((int)); /* Logical IF codes */ - + void +#ifdef KR_headers exif(p) -expptr p; + expptr p; +#else +exif(expptr p) +#endif { pushctl(CTLIF); putif(p, 0); /* 0 => if, not elseif */ } - + void +#ifdef KR_headers exelif(p) -expptr p; + expptr p; +#else +exelif(expptr p) +#endif { if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX) putif(p, 1); /* 1 ==> elseif */ @@ -52,8 +62,8 @@ expptr p; - -exelse() + void +exelse(Void) { register struct Ctlframe *c; @@ -66,8 +76,12 @@ exelse() execerr("else out of place", CNULL); } - + void +#ifdef KR_headers exendif() +#else +exendif() +#endif { while(ctlstack->ctltype == CTLIFX) { popctl(); @@ -86,7 +100,12 @@ exendif() } + void +#ifdef KR_headers +new_endif() +#else new_endif() +#endif { if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX) pushctl(CTLIFX); @@ -98,8 +117,12 @@ new_endif() zero) */ LOCAL void +#ifdef KR_headers pushctl(code) - int code; + int code; +#else +pushctl(int code) +#endif { register int i; @@ -109,12 +132,13 @@ pushctl(code) for(i = 0 ; i < 4 ; ++i) ctlstack->ctlabels[i] = 0; ctlstack->dowhile = 0; + ctlstack->domax = ctlstack->dostep = 0; /* in case of errors */ ++blklevel; } LOCAL void -popctl() +popctl(Void) { if( ctlstack-- < ctls ) Fatal("control stack empty"); @@ -125,7 +149,8 @@ popctl() /* poplab -- update the flags in labeltab */ -LOCAL poplab() + LOCAL void +poplab(Void) { register struct Labelblock *lp; @@ -146,9 +171,13 @@ LOCAL poplab() /* BRANCHING CODE */ - + void +#ifdef KR_headers exgoto(lab) -struct Labelblock *lab; + struct Labelblock *lab; +#else +exgoto(struct Labelblock *lab) +#endif { lab->labused = 1; p1_goto (lab -> stateno); @@ -159,10 +188,14 @@ struct Labelblock *lab; - + void +#ifdef KR_headers exequals(lp, rp) -register struct Primblock *lp; -register expptr rp; + register struct Primblock *lp; + register expptr rp; +#else +exequals(register struct Primblock *lp, register expptr rp) +#endif { if(lp->tag != TPRIM) { @@ -173,9 +206,12 @@ register expptr rp; else if(lp->namep->vclass!=CLVAR && lp->argsp) { if(parstate >= INEXEC) - err("statement function amid executables"); + errstr("statement function %.62s amid executables.", + lp->namep->fvarname); mkstfunct(lp, rp); } + else if (lp->vtype == TYSUBR) + err("illegal use of subroutine name"); else { expptr new_lp, new_rp; @@ -195,9 +231,14 @@ register expptr rp; long laststfcn = -1, thisstno; int doing_stmtfcn; + void +#ifdef KR_headers mkstfunct(lp, rp) -struct Primblock *lp; -expptr rp; + struct Primblock *lp; + expptr rp; +#else +mkstfunct(struct Primblock *lp, expptr rp) +#endif { register struct Primblock *p; register Namep np; @@ -230,8 +271,10 @@ expptr rp; if( ((tagptr)(args->datap))->tag!=TPRIM || (p = (struct Primblock *)(args->datap) )->argsp || - p->fcharp || p->lcharp ) + p->fcharp || p->lcharp ) { err("non-variable argument in statement function definition"); + args->datap = 0; + } else { @@ -245,8 +288,12 @@ expptr rp; } static void +#ifdef KR_headers mixed_type(np) - Namep np; + Namep np; +#else +mixed_type(Namep np) +#endif { char buf[128]; sprintf(buf, "%s function %.90s invoked as subroutine", @@ -254,12 +301,16 @@ mixed_type(np) warn(buf); } - + void +#ifdef KR_headers excall(name, args, nstars, labels) -Namep name; -struct Listblock *args; -int nstars; -struct Labelblock *labels[ ]; + Namep name; + struct Listblock *args; + int nstars; + struct Labelblock **labels; +#else +excall(Namep name, struct Listblock *args, int nstars, struct Labelblock **labels) +#endif { register expptr p; @@ -275,6 +326,8 @@ struct Labelblock *labels[ ]; settype(name, TYSUBR, (ftnint)0); } p = mkfunct( mkprim(name, args, CHNULL) ); + if (p->tag == TERROR) + return; /* Subroutines and their identifiers acquire the type INT */ @@ -289,14 +342,17 @@ struct Labelblock *labels[ ]; } - + void +#ifdef KR_headers exstop(stop, p) -int stop; -register expptr p; + int stop; + register expptr p; +#else +exstop(int stop, register expptr p) +#endif { char *str; int n; - expptr mkstrcon(); if(p) { @@ -354,10 +410,17 @@ register expptr p; positive increment tests are placed above the body, negative increment tests are placed below (see enddo() ) */ + void +#ifdef KR_headers exdo(range, loopname, spec) -int range; /* end label */ -Namep loopname; -chainp spec; /* input spec must have at least 2 exprs */ + int range; + Namep loopname; + chainp spec; +#else +exdo(int range, Namep loopname, chainp spec) +#endif + /* range = end label */ + /* input spec must have at least 2 exprs */ { register expptr p; register Namep np; @@ -555,8 +618,13 @@ chainp spec; /* input spec must have at least 2 exprs */ p1_for (init, test, inc); } + void +#ifdef KR_headers exenddo(np) - Namep np; + Namep np; +#else +exenddo(Namep np) +#endif { Namep np1; int here; @@ -585,9 +653,13 @@ exenddo(np) enddo(here); } - + void +#ifdef KR_headers enddo(here) -int here; + int here; +#else +enddo(int here) +#endif { register struct Ctlframe *q; Namep np; /* name of the current DO index */ @@ -613,16 +685,18 @@ int here; ctlstack->ctlabels[i] = 0; deregister(ctlstack->donamep); ctlstack->donamep->vdovar = NO; - e = ctlstack->dostep; - if (e->tag == TADDR && e->addrblock.istemp) - frtemp((Addrp)e); - else - frexpr(e); - e = ctlstack->domax; - if (e->tag == TADDR && e->addrblock.istemp) - frtemp((Addrp)e); - else - frexpr(e); + /* ctlstack->dostep and ctlstack->domax can be zero */ + /* with sufficiently bizarre (erroneous) syntax */ + if (e = ctlstack->dostep) + if (e->tag == TADDR && e->addrblock.istemp) + frtemp((Addrp)e); + else + frexpr(e); + if (e = ctlstack->domax) + if (e->tag == TADDR && e->addrblock.istemp) + frtemp((Addrp)e); + else + frexpr(e); } else if (ctlstack->dowhile) p1for_end (); @@ -642,12 +716,16 @@ int here; } } + void +#ifdef KR_headers exassign(vname, labelval) - register Namep vname; -struct Labelblock *labelval; + register Namep vname; + struct Labelblock *labelval; +#else +exassign(register Namep vname, struct Labelblock *labelval) +#endif { Addrp p; - expptr mkaddcon(); register Addrp q; char *fs; register chainp cp, cpprev; @@ -698,7 +776,6 @@ struct Labelblock *labelval; /* Code for FORMAT label... */ if (!labelval->labdefined || fs) { - extern void fmtname(); labelval->fmtlabused = 1; p = ALLOC(Addrblock); @@ -721,10 +798,16 @@ struct Labelblock *labelval; } /* exassign */ - + void +#ifdef KR_headers exarif(expr, neglab, zerlab, poslab) -expptr expr; -struct Labelblock *neglab, *zerlab, *poslab; + expptr expr; + struct Labelblock *neglab; + struct Labelblock *zerlab; + struct Labelblock *poslab; +#else +exarif(expptr expr, struct Labelblock *neglab, struct Labelblock *zerlab, struct Labelblock *poslab) +#endif { register int lm, lz, lp; @@ -775,10 +858,15 @@ struct Labelblock *neglab, *zerlab, *poslab; in order to make the 1 pass algorithm work. */ LOCAL void +#ifdef KR_headers exar2(op, e, l1, l2) - int op; - expptr e; - struct Labelblock *l1, *l2; + int op; + expptr e; + struct Labelblock *l1; + struct Labelblock *l2; +#else +exar2(int op, expptr e, struct Labelblock *l1, struct Labelblock *l2) +#endif { expptr comp; @@ -794,8 +882,13 @@ exar2(op, e, l1, l2) /* exreturn -- return the value in p from a SUBROUTINE call -- used to implement the alternate return mechanism */ + void +#ifdef KR_headers exreturn(p) -register expptr p; + register expptr p; +#else +exreturn(register expptr p) +#endif { if(procclass != CLPROC) warn("RETURN statement in main or block data"); @@ -815,11 +908,15 @@ register expptr p; } + void +#ifdef KR_headers exasgoto(labvar) -Namep labvar; + Namep labvar; +#else +exasgoto(Namep labvar) +#endif { register Addrp p; - void p1_asgoto(); p = mkplace(labvar); if( ! ISINT(p->vtype) ) diff --git a/usr.bin/f2c/expr.c b/usr.bin/f2c/expr.c index eeccf42..258facc 100644 --- a/usr.bin/f2c/expr.c +++ b/usr.bin/f2c/expr.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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 @@ -25,21 +25,26 @@ this software. #include "output.h" #include "names.h" -LOCAL void conspower(), consbinop(), zdiv(); -LOCAL expptr fold(), mkpower(), stfcall(); -#ifndef stfcall_MAX -#define stfcall_MAX 144 -#endif - typedef struct { double dreal, dimag; } dcomplex; +static void consbinop Argdcl((int, int, Constp, Constp, Constp)); +static void conspower Argdcl((Constp, Constp, long int)); +static void zdiv Argdcl((dcomplex*, dcomplex*, dcomplex*)); +static tagptr mkpower Argdcl((tagptr)); +static tagptr stfcall Argdcl((Namep, struct Listblock*)); + extern char dflttype[26]; extern int htype; /* little routines to create constant blocks */ -Constp mkconst(t) -register int t; + Constp +#ifdef KR_headers +mkconst(t) + register int t; +#else +mkconst(register int t) +#endif { register Constp p; @@ -52,8 +57,13 @@ register int t; /* mklogcon -- Make Logical Constant */ -expptr mklogcon(l) -register int l; + expptr +#ifdef KR_headers +mklogcon(l) + register int l; +#else +mklogcon(register int l) +#endif { register Constp p; @@ -66,8 +76,13 @@ register int l; /* mkintcon -- Make Integer Constant */ -expptr mkintcon(l) -ftnint l; + expptr +#ifdef KR_headers +mkintcon(l) + ftnint l; +#else +mkintcon(ftnint l) +#endif { register Constp p; @@ -81,8 +96,13 @@ ftnint l; /* mkaddcon -- Make Address Constant, given integer value */ -expptr mkaddcon(l) -register long l; + expptr +#ifdef KR_headers +mkaddcon(l) + register long l; +#else +mkaddcon(register long l) +#endif { register Constp p; @@ -96,9 +116,14 @@ register long l; /* mkrealcon -- Make Real Constant. The type t is assumed to be TYREAL or TYDREAL */ -expptr mkrealcon(t, d) - register int t; - char *d; + expptr +#ifdef KR_headers +mkrealcon(t, d) + register int t; + char *d; +#else +mkrealcon(register int t, char *d) +#endif { register Constp p; @@ -115,24 +140,46 @@ expptr mkrealcon(t, d) quad, octal and hex bases may be input. Constants may not exceed 32 bits, or whatever the size of (struct Constblock).ci may be. */ -expptr mkbitcon(shift, leng, s) -int shift; -int leng; -char *s; + expptr +#ifdef KR_headers +mkbitcon(shift, leng, s) + int shift; + int leng; + char *s; +#else +mkbitcon(int shift, int leng, char *s) +#endif { register Constp p; - register long x; + register long x, y, z; + int len; + char buff[100], *fmt, *s0 = s; + static char *kind[3] = { "Binary", "Hex", "Octal" }; p = mkconst(TYLONG); - x = 0; + x = y = 0; while(--leng >= 0) - if(*s != ' ') + if(*s != ' ') { + z = x; x = (x << shift) | hextoi(*s++); - /* mwm wanted to change the type to short for short constants, - * but this is dangerous -- there is no syntax for long constants + y |= (((unsigned long)x) >> shift) - z; + } + /* Don't change the type to short for short constants, as + * that is dangerous -- there is no syntax for long constants * with small values. */ p->Const.ci = x; + if (y) { + if (--shift == 3) + shift = 1; + if ((len = (int)leng) > 60) + sprintf(buff, "%s constant '%.60s' truncated.", + kind[shift], s0); + else + sprintf(buff, "%s constant '%.*s' truncated.", + kind[shift], len, s0); + err(buff); + } return( (expptr) p ); } @@ -143,9 +190,14 @@ char *s; /* mkstrcon -- Make string constant. Allocates storage and initializes the memory for a copy of the input Fortran-string. */ -expptr mkstrcon(l,v) -int l; -register char *v; + expptr +#ifdef KR_headers +mkstrcon(l, v) + int l; + register char *v; +#else +mkstrcon(int l, register char *v) +#endif { register Constp p; register char *s; @@ -165,12 +217,17 @@ register char *v; /* mkcxcon -- Make complex contsant. A complex number is a pair of values, each of which may be integer, real or double. */ -expptr mkcxcon(realp,imagp) -register expptr realp, imagp; + expptr +#ifdef KR_headers +mkcxcon(realp, imagp) + register expptr realp; + register expptr imagp; +#else +mkcxcon(register expptr realp, register expptr imagp) +#endif { int rtype, itype; register Constp p; - expptr errnode(); rtype = realp->headblock.vtype; itype = imagp->headblock.vtype; @@ -215,7 +272,8 @@ register expptr realp, imagp; /* errnode -- Allocate a new error block */ -expptr errnode() + expptr +errnode(Void) { struct Errorblock *p; p = ALLOC(Errorblock); @@ -232,13 +290,17 @@ expptr errnode() Note that casting to a character copies only the first sizeof(char) bytes. */ -expptr mkconv(t, p) -register int t; -register expptr p; + expptr +#ifdef KR_headers +mkconv(t, p) + register int t; + register expptr p; +#else +mkconv(register int t, register expptr p) +#endif { register expptr q; register int pt, charwarn = 1; - expptr opconv(); if (t >= 100) { t -= 100; @@ -285,9 +347,14 @@ register expptr p; /* opconv -- Convert expression p to type t using the main expression evaluator; returns an OPCONV expression, I think 14-jun-88 mwm */ -expptr opconv(p, t) -expptr p; -int t; + expptr +#ifdef KR_headers +opconv(p, t) + expptr p; + int t; +#else +opconv(expptr p, int t) +#endif { register expptr q; @@ -302,8 +369,13 @@ int t; /* addrof -- Create an ADDR expression operation */ -expptr addrof(p) -expptr p; + expptr +#ifdef KR_headers +addrof(p) + expptr p; +#else +addrof(expptr p) +#endif { return( mkexpr(OPADDR, p, ENULL) ); } @@ -312,13 +384,17 @@ expptr p; /* cpexpr - Returns a new copy of input expression p */ -tagptr cpexpr(p) -register tagptr p; + tagptr +#ifdef KR_headers +cpexpr(p) + register tagptr p; +#else +cpexpr(register tagptr p) +#endif { register tagptr e; int tag; register chainp ep, pp; - tagptr cpblock(); /* This table depends on the ordering of the T macros, e.g. TNAME */ @@ -399,8 +475,13 @@ register tagptr p; /* frexpr -- Free expression -- frees up memory used by expression p */ + void +#ifdef KR_headers frexpr(p) -register tagptr p; + register tagptr p; +#else +frexpr(register tagptr p) +#endif { register chainp q; @@ -459,8 +540,12 @@ register tagptr p; } void +#ifdef KR_headers wronginf(np) - Namep np; + Namep np; +#else +wronginf(Namep np) +#endif { int c, k; warn1("fixing wrong type inferred for %.65s", np->fvarname); @@ -474,8 +559,13 @@ wronginf(np) /* fix up types in expression; replace subtrees and convert names to address blocks */ -expptr fixtype(p) -register tagptr p; + expptr +#ifdef KR_headers +fixtype(p) + register tagptr p; +#else +fixtype(register tagptr p) +#endif { if(p == 0) @@ -504,6 +594,8 @@ register tagptr p; only a subexpr of its parameter. */ case TEXPR: + if (((Exprp)p)->typefixed) + return (expptr)p; return( fixexpr((Exprp)p) ); case TLIST: @@ -533,7 +625,12 @@ register tagptr p; int -badchleng(p) register expptr p; +#ifdef KR_headers +badchleng(p) + register expptr p; +#else +badchleng(register expptr p) +#endif { if (!p->headblock.vleng) { if (p->headblock.tag == TADDR @@ -549,8 +646,12 @@ badchleng(p) register expptr p; static expptr +#ifdef KR_headers cplenexpr(p) - expptr p; + expptr p; +#else +cplenexpr(expptr p) +#endif { expptr rv; @@ -567,15 +668,21 @@ cplenexpr(p) Parameter p should have a TEXPR tag at its root, else an error is returned */ -expptr fixexpr(p) -register Exprp p; + expptr +#ifdef KR_headers +fixexpr(p) + register Exprp p; +#else +fixexpr(register Exprp p) +#endif { expptr lp; register expptr rp; register expptr q; + char *hsave; int opcode, ltype, rtype, ptype, mtype; - if( ISERROR(p) ) + if( ISERROR(p) || p->typefixed ) return( (expptr) p ); else if(p->tag != TEXPR) badtag("fixexpr", p->tag); @@ -591,6 +698,7 @@ register Exprp p; if(opcode==OPASSIGN && lp->tag!=TADDR) { err("left side of assignment must be variable"); + eret: frexpr((expptr)p); return( errnode() ); } @@ -605,10 +713,7 @@ register Exprp p; rtype = 0; if(ltype==TYERROR || rtype==TYERROR) - { - frexpr((expptr)p); - return( errnode() ); - } + goto eret; /* Now work on the whole expression */ @@ -630,13 +735,19 @@ register Exprp p; } if( (ptype = cktype(opcode, ltype, rtype)) == TYERROR) - { - frexpr((expptr)p); - return( errnode() ); - } - - if (ltype == TYCHAR && ISCONST(lp)) - p->leftp = lp = (expptr)putconst((Constp)lp); + goto eret; + + if (ltype == TYCHAR && ISCONST(lp)) { + if (opcode == OPCONV) { + hsave = halign; + halign = 0; + lp = (expptr)putconst((Constp)lp); + halign = hsave; + } + else + lp = (expptr)putconst((Constp)lp); + p->leftp = lp; + } if (rtype == TYCHAR && ISCONST(rp)) p->rightp = rp = (expptr)putconst((Constp)rp); @@ -649,7 +760,8 @@ register Exprp p; break; case OPASSIGN: - if (rtype == TYREAL || ISLOGICAL(ptype)) + if (rtype == TYREAL || ISLOGICAL(ptype) + || rtype == TYDREAL && ltype == TYREAL && !ISCONST(rp)) break; case OPPLUSEQ: case OPSTAREQ: @@ -699,7 +811,10 @@ register Exprp p; break; case OPPOWER: - return( mkpower((expptr)p) ); + rp = mkpower((expptr)p); + if (rp->tag == TEXPR) + rp->exprblock.typefixed = 1; + return rp; case OPLT: case OPLE: @@ -720,8 +835,7 @@ register Exprp p; } } mtype = cktype(OPMINUS, ltype, rtype); - if(mtype==TYDREAL && ( (ltype==TYREAL && ! ISCONST(lp)) || - (rtype==TYREAL && ! ISCONST(rp)) )) + if(mtype==TYDREAL && (ltype==TYREAL || rtype==TYREAL)) break; if( ISCOMPLEX(mtype) ) break; @@ -769,21 +883,27 @@ register Exprp p; } p->vtype = ptype; + p->typefixed = 1; return((expptr) p); } /* fix an argument list, taking due care for special first level cases */ + int +#ifdef KR_headers fixargs(doput, p0) -int doput; /* doput is true if constants need to be passed by reference */ -struct Listblock *p0; + int doput; + struct Listblock *p0; +#else +fixargs(int doput, struct Listblock *p0) +#endif + /* doput is true if constants need to be passed by reference */ { register chainp p; register tagptr q, t; register int qtag; int nargs; - Addrp mkscalar(); nargs = 0; if(p0) @@ -830,8 +950,13 @@ struct Listblock *p0; /* mkscalar -- only called by fixargs above, and by some routines in io.c */ -Addrp mkscalar(np) -register Namep np; + Addrp +#ifdef KR_headers +mkscalar(np) + register Namep np; +#else +mkscalar(register Namep np) +#endif { register Addrp ap; @@ -857,10 +982,15 @@ register Namep np; static void -adjust_arginfo(np) /* adjust arginfo to omit the length arg for the +#ifdef KR_headers +adjust_arginfo(np) + register Namep np; +#else +adjust_arginfo(register Namep np) +#endif + /* adjust arginfo to omit the length arg for the arg that we now know to be a character-valued function */ - register Namep np; { struct Entrypoint *ep; register chainp args; @@ -875,8 +1005,13 @@ adjust_arginfo(np) /* adjust arginfo to omit the length arg for the -expptr mkfunct(p0) - expptr p0; + expptr +#ifdef KR_headers +mkfunct(p0) + expptr p0; +#else +mkfunct(expptr p0) +#endif { register struct Primblock *p = (struct Primblock *)p0; struct Entrypoint *ep; @@ -884,7 +1019,6 @@ expptr mkfunct(p0) Extsym *extp; register Namep np; register expptr q; - expptr intrcall(); extern chainp new_procs; int k, nargs; int class; @@ -943,7 +1077,8 @@ expptr mkfunct(p0) fatalstr( "Cannot invoke common variable %.50s as a function.", np->fvarname); - fatali("invalid class code %d for function", class); + errstr("%.80s cannot be called.", np->fvarname); + goto error; } /* F77 doesn't allow subscripting of function calls */ @@ -1016,9 +1151,14 @@ error: -LOCAL expptr stfcall(np, actlist) -Namep np; -struct Listblock *actlist; + static expptr +#ifdef KR_headers +stfcall(np, actlist) + Namep np; + struct Listblock *actlist; +#else +stfcall(Namep np, struct Listblock *actlist) +#endif { register chainp actuals; int nargs; @@ -1028,10 +1168,13 @@ struct Listblock *actlist; Namep tnp; register struct Rplblock *rp; struct Rplblock *tlist; - static int inv_count; - if (++inv_count > stfcall_MAX) - Fatal("Loop invoking recursive statement function?"); + if (np->arginfo) { + errstr("statement function %.66s calls itself.", + np->fvarname); + return ICON(0); + } + np->arginfo = (Argtypes *)np; /* arbitrary nonzero value */ if(actlist) { actuals = actlist->listp; @@ -1054,8 +1197,13 @@ struct Listblock *actlist; /* copy actual arguments into temporaries */ while(actuals!=NULL && formals!=NULL) { + if (!(tnp = (Namep) formals->datap)) { + /* buggy statement function declaration */ + q = ICON(1); + goto done; + } rp = ALLOC(Rplblock); - rp->rplnp = tnp = (Namep) formals->datap; + rp->rplnp = tnp; ap = fixtype((tagptr)actuals->datap); if(tnp->vtype==ap->headblock.vtype && tnp->vtype!=TYCHAR && (ap->tag==TCONST || ap->tag==TADDR) ) @@ -1123,8 +1271,9 @@ struct Listblock *actlist; free((char *)rpllist); rpllist = rp; } + done: frchain( &oactp ); - --inv_count; + np->arginfo = 0; return(q); } @@ -1134,8 +1283,13 @@ static int replaced; /* mkplace -- Figure out the proper storage class for the input name and return an addrp with the appropriate stuff */ -Addrp mkplace(np) -register Namep np; + Addrp +#ifdef KR_headers +mkplace(np) + register Namep np; +#else +mkplace(register Namep np) +#endif { register Addrp s; register struct Rplblock *rp; @@ -1182,9 +1336,13 @@ register Namep np; } static expptr -subskept(p,a) -struct Primblock *p; -Addrp a; +#ifdef KR_headers +subskept(p, a) + struct Primblock *p; + Addrp a; +#else +subskept(struct Primblock *p, Addrp a) +#endif { expptr ep; struct Listblock *Lb; @@ -1212,10 +1370,15 @@ Addrp a; for array subscripts, stack offset, and substring offsets. The f -> C translator will need this only to worry about the subscript stuff */ -expptr mklhs(p, subkeep) -register struct Primblock *p; int subkeep; + expptr +#ifdef KR_headers +mklhs(p, subkeep) + register struct Primblock *p; + int subkeep; +#else +mklhs(register struct Primblock *p, int subkeep) +#endif { - expptr suboffset(); register Addrp s; Namep np; @@ -1280,8 +1443,13 @@ register struct Primblock *p; int subkeep; /* deregister -- remove a register allocation from the list; assumes that names are deregistered in stack order (LIFO order - Last In First Out) */ + void +#ifdef KR_headers deregister(np) -Namep np; + Namep np; +#else +deregister(Namep np) +#endif { if(nregvar>0 && regnamep[nregvar-1]==np) { @@ -1295,8 +1463,13 @@ Namep np; /* memversion -- moves a DO index REGISTER into a memory location; other objects are passed through untouched */ -Addrp memversion(np) -register Namep np; + Addrp +#ifdef KR_headers +memversion(np) + register Namep np; +#else +memversion(register Namep np) +#endif { register Addrp s; @@ -1312,8 +1485,13 @@ register Namep np; /* inregister -- looks for the input name in the global list regnamep */ + int +#ifdef KR_headers inregister(np) -register Namep np; + register Namep np; +#else +inregister(register Namep np) +#endif { register int i; @@ -1328,14 +1506,18 @@ register Namep np; /* suboffset -- Compute the offset from the start of the array, given the subscripts as arguments */ -expptr suboffset(p) -register struct Primblock *p; + expptr +#ifdef KR_headers +suboffset(p) + register struct Primblock *p; +#else +suboffset(register struct Primblock *p) +#endif { int n; expptr si, size; chainp cp; expptr e, e1, offp, prod; - expptr subcheck(); struct Dimblock *dimp; expptr sub[MAXDIM+1]; register Namep np; @@ -1402,9 +1584,14 @@ register struct Primblock *p; -expptr subcheck(np, p) -Namep np; -register expptr p; + expptr +#ifdef KR_headers +subcheck(np, p) + Namep np; + register expptr p; +#else +subcheck(Namep np, register expptr p) +#endif { struct Dimblock *dimp; expptr t, checkvar, checkcond, badcall; @@ -1469,12 +1656,16 @@ badsub: -Addrp mkaddr(p) -register Namep p; + Addrp +#ifdef KR_headers +mkaddr(p) + register Namep p; +#else +mkaddr(register Namep p) +#endif { Extsym *extp; register Addrp t; - Addrp intraddr(); int k; switch( p->vstg) @@ -1532,6 +1723,11 @@ register Namep p; case STGINTR: return ( intraddr (p)); + + case STGSTFUNCT: + + errstr("invalid use of statement function %.64s.", p->fvarname); + return putconst((Constp)ICON(0)); } badstg("mkaddr", p->vstg); /* NOT REACHED */ return 0; @@ -1544,8 +1740,14 @@ register Namep p; function returns a string (for the return value, which is the first parameter), or when a variable-length string is passed to a function. */ -Addrp mkarg(type, argno) -int type, argno; + Addrp +#ifdef KR_headers +mkarg(type, argno) + int type; + int argno; +#else +mkarg(int type, int argno) +#endif { register Addrp p; @@ -1570,10 +1772,15 @@ int type, argno; extra (uninitialized) storage, since it could be a paramblock or nameblock */ -expptr mkprim(v0, args, substr) - Namep v0; - struct Listblock *args; - chainp substr; + expptr +#ifdef KR_headers +mkprim(v0, args, substr) + Namep v0; + struct Listblock *args; + chainp substr; +#else +mkprim(Namep v0, struct Listblock *args, chainp substr) +#endif { typedef union { struct Paramblock paramblock; @@ -1628,8 +1835,13 @@ expptr mkprim(v0, args, substr) This function is called on identifiers known to be variables or recursive references to the same function */ + void +#ifdef KR_headers vardcl(v) -register Namep v; + register Namep v; +#else +vardcl(register Namep v) +#endif { struct Dimblock *t; expptr neltp; @@ -1697,8 +1909,13 @@ register Namep v; /* Set the implicit type declaration of parameter p based on its first letter */ + void +#ifdef KR_headers impldcl(p) -register Namep p; + register Namep p; +#else +impldcl(register Namep p) +#endif { register int k; int type; @@ -1725,9 +1942,13 @@ register Namep p; } void -inferdcl(np,type) - Namep np; - int type; +#ifdef KR_headers +inferdcl(np, type) + Namep np; + int type; +#else +inferdcl(Namep np, int type) +#endif { int k = impltype[letter(np->fvarname[0])]; if (k != type) { @@ -1740,25 +1961,65 @@ inferdcl(np,type) np->vinfproc = 1; } + LOCAL int +#ifdef KR_headers +zeroconst(e) + expptr e; +#else +zeroconst(expptr e) +#endif +{ + register Constp c = (Constp) e; + if (c->tag == TCONST) + switch(c->vtype) { + case TYINT1: + case TYSHORT: + case TYLONG: +#ifdef TYQUAD + case TYQUAD: +#endif + return c->Const.ci == 0; -#define ICONEQ(z, c) (ISICON(z) && z->constblock.Const.ci==c) -#define COMMUTE { e = lp; lp = rp; rp = e; } + case TYREAL: + case TYDREAL: + if (c->vstg == 1) + return !strcmp(c->Const.cds[0],"0."); + return c->Const.cd[0] == 0.; + case TYCOMPLEX: + case TYDCOMPLEX: + if (c->vstg == 1) + return !strcmp(c->Const.cds[0],"0.") + && !strcmp(c->Const.cds[1],"0."); + return c->Const.cd[0] == 0. && c->Const.cd[1] == 0.; + } + return 0; + } +#define ICONEQ(z, c) (ISICON(z) && z->constblock.Const.ci==c) +#define COMMUTE { e = lp; lp = rp; rp = e; } + /* mkexpr -- Make expression, and simplify constant subcomponents (tree order is not preserved). Assumes that lp is nonempty, and uses fold() to simplify adjacent constants */ -expptr mkexpr(opcode, lp, rp) -int opcode; -register expptr lp, rp; + expptr +#ifdef KR_headers +mkexpr(opcode, lp, rp) + int opcode; + register expptr lp; + register expptr rp; +#else +mkexpr(int opcode, register expptr lp, register expptr rp) +#endif { register expptr e, e1; int etype; int ltype, rtype; int ltag, rtag; long L; + static long divlineno; ltype = lp->headblock.vtype; ltag = lp->tag; @@ -1781,7 +2042,7 @@ register expptr lp, rp; if( ISCONST(lp) ) COMMUTE - if( ISICON(rp) ) + if( ISICON(rp) ) { if(rp->constblock.Const.ci == 0) goto retright; @@ -1791,12 +2052,10 @@ register expptr lp, rp; case OPSLASH: case OPMOD: - if( ICONEQ(rp, 0) ) - { - err("attempted division by zero"); - rp = ICON(1); - break; - } + if( zeroconst(rp) && lineno != divlineno ) { + warn("attempted division by zero"); + divlineno = lineno; + } if(opcode == OPMOD) break; @@ -1821,7 +2080,7 @@ mulop: (x * CONST1) / CONST2 ==> x * (CONST1 / CONST2) */ - if (lp->tag != TEXPR || !lp->exprblock.rightp + if (!ISINT(etype) || lp->tag != TEXPR || !lp->exprblock.rightp || !ISICON(lp->exprblock.rightp)) break; @@ -2070,8 +2329,14 @@ error: /* cktype -- Check and return the type of the expression */ +#ifdef KR_headers cktype(op, lt, rt) -register int op, lt, rt; + register int op; + register int lt; + register int rt; +#else +cktype(register int op, register int lt, register int rt) +#endif { char *errs; @@ -2218,7 +2483,6 @@ register int op, lt, rt; case OPDOT: case OPARROW: return (lt); - break; default: badop("cktype", op); } @@ -2228,12 +2492,20 @@ error1: return(TYERROR); } + static void +intovfl(Void) +{ err("overflow simplifying integer constants."); } + /* fold -- simplifies constant expressions; it assumes that e -> leftp and e -> rightp are TCONST or NULL */ - LOCAL expptr + expptr +#ifdef KR_headers fold(e) - register expptr e; + register expptr e; +#else +fold(register expptr e) +#endif { Constp p; register expptr lp, rp; @@ -2241,7 +2513,7 @@ fold(e) int i, bl, ll, lr; char *q, *s; struct Constblock lcon, rcon; - long L; + ftnint L; double d; opcode = e->exprblock.opcode; @@ -2283,8 +2555,11 @@ fold(e) #ifdef TYQUAD case TYQUAD: #endif - if ((L = lp->constblock.Const.ci) < 0) + if ((L = lp->constblock.Const.ci) < 0) { lp->constblock.Const.ci = -L; + if (L != -lp->constblock.Const.ci) + intovfl(); + } goto retlp; case TYREAL: case TYDREAL: @@ -2317,7 +2592,7 @@ fold(e) case OPCOMMA_ARG: case OPQUEST: case OPCOLON: - return(e); + goto ereturn; case OPAND: p->Const.ci = lp->constblock.Const.ci && @@ -2357,6 +2632,9 @@ fold(e) case OPLSHIFT: p->Const.ci = lp->constblock.Const.ci << rp->constblock.Const.ci; + if ((((unsigned long)p->Const.ci) >> rp->constblock.Const.ci) + != lp->constblock.Const.ci) + intovfl(); break; case OPRSHIFT: @@ -2383,11 +2661,16 @@ fold(e) case OPPOWER: - if( ! ISINT(rtype) ) - return(e); + if( !ISINT(rtype) + || rp->constblock.Const.ci < 0 && zeroconst(lp)) + goto ereturn; conspower(p, (Constp)lp, rp->constblock.Const.ci); break; + case OPSLASH: + if (zeroconst(rp)) + goto ereturn; + /* no break */ default: if(ltype == TYCHAR) @@ -2410,15 +2693,24 @@ fold(e) frexpr(e); return( (expptr) p ); + ereturn: + free((char *)p); + return e; } /* assign constant l = r , doing coercion */ + void +#ifdef KR_headers consconv(lt, lc, rc) - int lt; - register Constp lc, rc; + int lt; + register Constp lc; + register Constp rc; +#else +consconv(int lt, register Constp lc, register Constp rc) +#endif { int rt = rc->vtype; register union Constant *lv = &lc->Const, *rv = &rc->Const; @@ -2485,10 +2777,16 @@ consconv(lt, lc, rc) /* Negate constant value -- changes the input node's value */ + void +#ifdef KR_headers consnegop(p) -register Constp p; + register Constp p; +#else +consnegop(register Constp p) +#endif { register char *s; + ftnint L; if (p->vstg) { if (ISCOMPLEX(p->vtype)) { @@ -2509,7 +2807,9 @@ register Constp p; #ifdef TYQUAD case TYQUAD: #endif - p->Const.ci = - p->Const.ci; + p->Const.ci = -(L = p->Const.ci); + if (L != -p->Const.ci) + intovfl(); break; case TYCOMPLEX: @@ -2530,9 +2830,14 @@ register Constp p; /* conspower -- Expand out an exponentiation */ LOCAL void +#ifdef KR_headers conspower(p, ap, n) - Constp p, ap; - ftnint n; + Constp p; + Constp ap; + ftnint n; +#else +conspower(Constp p, Constp ap, ftnint n) +#endif { register union Constant *powp = &p->Const; register int type; @@ -2623,19 +2928,23 @@ conspower(p, ap, n) matching the input type */ LOCAL void -zerodiv() -{ Fatal("division by zero during constant evaluation; cannot recover"); } - - LOCAL void +#ifdef KR_headers consbinop(opcode, type, cpp, app, bpp) - int opcode, type; - Constp cpp, app, bpp; + int opcode; + int type; + Constp cpp; + Constp app; + Constp bpp; +#else +consbinop(int opcode, int type, Constp cpp, Constp app, Constp bpp) +#endif { register union Constant *ap = &app->Const, *bp = &bpp->Const, *cp = &cpp->Const; int k; double ad[2], bd[2], temp; + ftnint a, b; cpp->vstg = 0; @@ -2659,6 +2968,8 @@ consbinop(opcode, type, cpp, app, bpp) case TYQUAD: #endif cp->ci = ap->ci + bp->ci; + if (ap->ci != cp->ci - bp->ci) + intovfl(); break; case TYCOMPLEX: case TYDCOMPLEX: @@ -2680,6 +2991,8 @@ consbinop(opcode, type, cpp, app, bpp) case TYQUAD: #endif cp->ci = ap->ci - bp->ci; + if (ap->ci != bp->ci + cp->ci) + intovfl(); break; case TYCOMPLEX: case TYDCOMPLEX: @@ -2700,7 +3013,9 @@ consbinop(opcode, type, cpp, app, bpp) #ifdef TYQUAD case TYQUAD: #endif - cp->ci = ap->ci * bp->ci; + cp->ci = (a = ap->ci) * (b = bp->ci); + if (a && cp->ci / a != b) + intovfl(); break; case TYREAL: case TYDREAL: @@ -2723,20 +3038,14 @@ consbinop(opcode, type, cpp, app, bpp) #ifdef TYQUAD case TYQUAD: #endif - if (!bp->ci) - zerodiv(); cp->ci = ap->ci / bp->ci; break; case TYREAL: case TYDREAL: - if (!bd[0]) - zerodiv(); cp->cd[0] = ad[0] / bd[0]; break; case TYCOMPLEX: case TYDCOMPLEX: - if (!bd[0] && !bd[1]) - zerodiv(); zdiv((dcomplex*)cp, (dcomplex*)ad, (dcomplex*)bd); break; } @@ -2854,8 +3163,12 @@ consbinop(opcode, type, cpp, app, bpp) /* conssgn - returns the sign of a Fortran constant */ +#ifdef KR_headers conssgn(p) -register expptr p; + register expptr p; +#else +conssgn(register expptr p) +#endif { register char *s; @@ -2907,12 +3220,17 @@ register expptr p; char *powint[ ] = { "pow_ii", #ifdef TYQUAD - "pow_qi", + "pow_qq", #endif "pow_ri", "pow_di", "pow_ci", "pow_zi" }; -LOCAL expptr mkpower(p) -register expptr p; + LOCAL expptr +#ifdef KR_headers +mkpower(p) + register expptr p; +#else +mkpower(register expptr p) +#endif { register expptr q, lp, rp; int ltype, rtype, mtype, tyi; @@ -3012,8 +3330,14 @@ register expptr p; LOCAL void +#ifdef KR_headers zdiv(c, a, b) - register dcomplex *a, *b, *c; + register dcomplex *c; + register dcomplex *a; + register dcomplex *b; +#else +zdiv(register dcomplex *c, register dcomplex *a, register dcomplex *b) +#endif { double ratio, den; double abr, abi; diff --git a/usr.bin/f2c/f2c.1 b/usr.bin/f2c/f2c.1 index 2a59dff..241fd98 100644 --- a/usr.bin/f2c/f2c.1 +++ b/usr.bin/f2c/f2c.1 @@ -21,7 +21,10 @@ .TH F2C 1 .CT 1 prog_other .SH NAME -f\^2c \(mi Convert Fortran 77 to C or C++ +f2c \- Convert Fortran 77 to C or C++ +. \" f\^2c changed to f2c in the previous line for the benefit of +. \" people on systems (e.g. Sun systems) whose makewhatis cannot +. \" cope with troff formatting commands. .SH SYNOPSIS .B f\^2c [ @@ -72,6 +75,14 @@ variables in INQUIREs. Option .L -I4 confirms the default rendering of INTEGER as long int. .TP +.BI -I dir +Look for a non-absolute include file first in the directory of the +current input file, then in directories specified by \f(CW-I\fP +options (one directory per option). Options +\f(CW-I2\fP and \f(CW-I4\fP +have precedence, so, e.g., a directory named \f(CW2\fP +should be specified by \f(CW-I./2\fP . +.TP .B -onetrip Compile DO loops that are performed at least once if reached. (Fortran 77 DO loops are not performed at all if the upper limit is smaller than the lower limit.) @@ -86,10 +97,9 @@ case. Make the default type of a variable `undefined' rather than using the default Fortran rules. .TP .B -w -Suppress all warning messages. -If the option is +Suppress all warning messages, or, if the option is .LR -w66 , -only Fortran 66 compatibility warnings are suppressed. +just Fortran 66 compatibility warnings. .PP The following options are peculiar to .IR f\^2c . @@ -114,6 +124,13 @@ Output C++ code. .B -c Include original Fortran source as comments. .TP +.BI -d dir +Write +.L .c +files in directory +.I dir +instead of the current directory. +.TP .B -E Declare uninitialized .SM COMMON @@ -226,7 +243,9 @@ to .SM DOUBLE COMPLEX. .TP .B -s -Preserve multidimensional subscripts. +Preserve multidimensional subscripts. Suppressed by option +.L -C +\&. .TP .BI -T dir Put temporary files in directory @@ -296,6 +315,7 @@ see the reference below. .br .SH FILES .TP +.nr )I 1.75i .IB file .[fF] input file .TP diff --git a/usr.bin/f2c/f2c.h b/usr.bin/f2c/f2c.h index fc1e979..8f18f6c 100644 --- a/usr.bin/f2c/f2c.h +++ b/usr.bin/f2c/f2c.h @@ -36,9 +36,9 @@ typedef short flag; typedef short ftnlen; typedef short ftnint; #else -typedef long flag; -typedef long ftnlen; -typedef long ftnint; +typedef long int flag; +typedef long int ftnlen; +typedef long int ftnint; #endif /*external read, write*/ @@ -131,7 +131,7 @@ union Multitype { /* for multiple entry points */ typedef union Multitype Multitype; -typedef long Long; /* No longer used; formerly in Namelist */ +/*typedef long int Long;*/ /* No longer used; formerly in Namelist */ struct Vardesc { /* for Namelist */ char *name; diff --git a/usr.bin/f2c/format.c b/usr.bin/f2c/format.c index 80faacc..10aa39d 100644 --- a/usr.bin/f2c/format.c +++ b/usr.bin/f2c/format.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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 @@ -40,29 +40,51 @@ static char this_proc_name[52]; /* Name of the current procedure. This is probably too simplistic to handle multiple entry points */ -static int p1getd(), p1gets(), p1getf(), get_p1_token(); -static int p1get_const(), p1getn(); -static expptr do_format(), do_p1_name_pointer(), do_p1_const(); -static expptr do_p1_expr(), do_p1_ident(), do_p1_charp(), do_p1_extern(); -static expptr do_p1_head(), do_p1_list(), do_p1_literal(); -static void do_p1_label(), do_p1_asgoto(), do_p1_goto(); -static void do_p1_if(), do_p1_else(), do_p1_elif(), do_p1_endif(); -static void do_p1_endelse(), do_p1_subr_ret(), do_p1_comp_goto(); -static void do_p1_for(), do_p1_end_for(), do_p1_fortran(); -static void do_p1_1while(), do_p1_2while(), do_p1_elseifstart(); -static void do_p1_comment(), do_p1_set_line(); -static expptr do_p1_addr(); -static void proto(); -void list_arg_types(); -chainp length_comp(); -void listargs(); +static tagptr do_format Argdcl((FILEP, FILEP)); +static void do_p1_1while Argdcl((FILEP)); +static void do_p1_2while Argdcl((FILEP, FILEP)); +static tagptr do_p1_addr Argdcl((FILEP, FILEP)); +static void do_p1_asgoto Argdcl((FILEP, FILEP)); +static tagptr do_p1_charp Argdcl((FILEP)); +static void do_p1_comment Argdcl((FILEP, FILEP)); +static void do_p1_comp_goto Argdcl((FILEP, FILEP)); +static tagptr do_p1_const Argdcl((FILEP)); +static void do_p1_elif Argdcl((FILEP, FILEP)); +static void do_p1_else Argdcl((FILEP)); +static void do_p1_elseifstart Argdcl((FILEP)); +static void do_p1_end_for Argdcl((FILEP)); +static void do_p1_endelse Argdcl((FILEP)); +static void do_p1_endif Argdcl((FILEP)); +static tagptr do_p1_expr Argdcl((FILEP, FILEP)); +static tagptr do_p1_extern Argdcl((FILEP)); +static void do_p1_for Argdcl((FILEP, FILEP)); +static void do_p1_fortran Argdcl((FILEP, FILEP)); +static void do_p1_goto Argdcl((FILEP, FILEP)); +static tagptr do_p1_head Argdcl((FILEP, FILEP)); +static tagptr do_p1_ident Argdcl((FILEP)); +static void do_p1_if Argdcl((FILEP, FILEP)); +static void do_p1_label Argdcl((FILEP, FILEP)); +static tagptr do_p1_list Argdcl((FILEP, FILEP)); +static tagptr do_p1_literal Argdcl((FILEP)); +static tagptr do_p1_name_pointer Argdcl((FILEP)); +static void do_p1_set_line Argdcl((FILEP)); +static void do_p1_subr_ret Argdcl((FILEP, FILEP)); +static int get_p1_token Argdcl((FILEP)); +static int p1get_const Argdcl((FILEP, int, Constp*)); +static int p1getd Argdcl((FILEP, long int*)); +static int p1getf Argdcl((FILEP, char**)); +static int p1getn Argdcl((FILEP, int, char**)); +static int p1gets Argdcl((FILEP, char*, int)); +static void proto Argdcl((FILEP, Argtypes*, char*)); + extern chainp assigned_fmts; -static char filename[P1_FILENAME_MAX]; -extern int gflag; +char filename[P1_FILENAME_MAX]; +extern int gflag, sharp_line; int gflag1; extern char *parens; -start_formatting () + void +start_formatting(Void) { FILE *infile; static int wrote_one = 0; @@ -96,7 +118,7 @@ start_formatting () nice_printf (c_file, ";\n"); prev_tab (c_file); - gflag1 = 0; + gflag1 = sharp_line = 0; if (this_proc_name[0]) nice_printf (c_file, "} /* %s */\n", this_proc_name); @@ -145,8 +167,12 @@ start_formatting () static void +#ifdef KR_headers put_semi(outfile) - FILE *outfile; + FILE *outfile; +#else +put_semi(FILE *outfile) +#endif { nice_printf (outfile, ";\n"); last_was_label = 0; @@ -158,8 +184,14 @@ put_semi(outfile) the appropriate C code to outfile when possible. When reading an expression, the expression tree is returned instead. */ -static expptr do_format (infile, outfile) -FILE *infile, *outfile; + static expptr +#ifdef KR_headers +do_format(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_format(FILE *infile, FILE *outfile) +#endif { int token_type, was_c_token; expptr retval = ENULL; @@ -198,9 +230,9 @@ FILE *infile, *outfile; retval = do_p1_extern (infile); break; case P1_HEAD: - gflag1 = 0; + gflag1 = sharp_line = 0; retval = do_p1_head (infile, outfile); - gflag1 = gflag; + gflag1 = sharp_line = gflag; break; case P1_LIST: retval = do_p1_list (infile, outfile); @@ -288,8 +320,13 @@ FILE *infile, *outfile; static void -do_p1_comment (infile, outfile) -FILE *infile, *outfile; +#ifdef KR_headers +do_p1_comment(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_comment(FILE *infile, FILE *outfile) +#endif { extern int c_output_line_length, in_comment; @@ -301,19 +338,23 @@ FILE *infile, *outfile; length = strlen (storage); - gflag1 = 0; + gflag1 = sharp_line = 0; in_comment = 1; if (length > c_output_line_length - 6) - margin_printf (outfile, "/*%s*/\n", storage); + margin_printf(outfile, "/*%s*/\n", storage); else - margin_printf (outfile, length ? "/* %s */\n" : "\n", storage); + margin_printf(outfile, length ? "/* %s */\n" : "\n", storage); in_comment = 0; - gflag1 = gflag; + gflag1 = sharp_line = gflag; } /* do_p1_comment */ static void -do_p1_set_line (infile) -FILE *infile; +#ifdef KR_headers +do_p1_set_line(infile) + FILE *infile; +#else +do_p1_set_line(FILE *infile) +#endif { int status; long new_line_number = -1; @@ -331,8 +372,13 @@ FILE *infile; } /* do_p1_set_line */ -static expptr do_p1_name_pointer (infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_name_pointer(infile) + FILE *infile; +#else +do_p1_name_pointer(FILE *infile) +#endif { Namep namep = (Namep) NULL; int status; @@ -350,8 +396,13 @@ FILE *infile; -static expptr do_p1_const (infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_const(infile) + FILE *infile; +#else +do_p1_const(FILE *infile) +#endif { struct Constblock *c = (struct Constblock *) NULL; long type = -1; @@ -377,9 +428,36 @@ FILE *infile; return (expptr) c; } /* do_p1_const */ + void +#ifdef KR_headers +addrlit(addrp) + Addrp addrp; +#else +addrlit(Addrp addrp) +#endif +{ + int memno = addrp->memno; + struct Literal *litp, *lastlit; + + lastlit = litpool + nliterals; + for (litp = litpool; litp < lastlit; litp++) + if (litp->litnum == memno) { + addrp->vtype = litp->littype; + *((union Constant *) &(addrp->user)) = + *((union Constant *) &(litp->litval)); + addrp->vstg = STGMEMNO; + return; + } + err("addrlit failure!"); + } -static expptr do_p1_literal (infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_literal(infile) + FILE *infile; +#else +do_p1_literal(FILE *infile) +#endif { int status; long memno; @@ -392,24 +470,12 @@ FILE *infile; else if (status == 0) err ("do_p1_literal: Missing memno in p1 file"); else { - struct Literal *litp, *lastlit; - addrp = ALLOC (Addrblock); addrp -> tag = TADDR; addrp -> vtype = TYUNKNOWN; addrp -> Field = NULL; - - lastlit = litpool + nliterals; - for (litp = litpool; litp < lastlit; litp++) - if (litp -> litnum == memno) { - addrp -> vtype = litp -> littype; - *((union Constant *) &(addrp -> user)) = - *((union Constant *) &(litp -> litval)); - break; - } /* if litp -> litnum == memno */ - addrp -> memno = memno; - addrp -> vstg = STGMEMNO; + addrlit(addrp); addrp -> uname_tag = UNAM_CONST; } /* else */ @@ -417,12 +483,17 @@ FILE *infile; } /* do_p1_literal */ -static void do_p1_label (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_label(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_label(FILE *infile, FILE *outfile) +#endif { int status; ftnint stateno; - char *user_label (); struct Labelblock *L; char *fmt; @@ -450,8 +521,14 @@ FILE *infile, *outfile; -static void do_p1_asgoto (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_asgoto(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_asgoto(FILE *infile, FILE *outfile) +#endif { expptr expr; @@ -461,12 +538,17 @@ FILE *infile, *outfile; } /* do_p1_asgoto */ -static void do_p1_goto (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_goto(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_goto(FILE *infile, FILE *outfile) +#endif { int status; long stateno; - char *user_label (); status = p1getd (infile, &stateno); @@ -480,8 +562,14 @@ FILE *infile, *outfile; } /* do_p1_goto */ -static void do_p1_if (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_if(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_if(FILE *infile, FILE *outfile) +#endif { expptr cond; @@ -493,15 +581,26 @@ FILE *infile, *outfile; } /* do_p1_if */ -static void do_p1_else (outfile) -FILE *outfile; + static void +#ifdef KR_headers +do_p1_else(outfile) + FILE *outfile; +#else +do_p1_else(FILE *outfile) +#endif { out_else (outfile); } /* do_p1_else */ -static void do_p1_elif (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_elif(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_elif(FILE *infile, FILE *outfile) +#endif { expptr cond; @@ -512,22 +611,38 @@ FILE *infile, *outfile; elif_out (outfile, cond); } /* do_p1_elif */ -static void do_p1_endif (outfile) -FILE *outfile; + static void +#ifdef KR_headers +do_p1_endif(outfile) + FILE *outfile; +#else +do_p1_endif(FILE *outfile) +#endif { endif_out (outfile); } /* do_p1_endif */ -static void do_p1_endelse (outfile) -FILE *outfile; + static void +#ifdef KR_headers +do_p1_endelse(outfile) + FILE *outfile; +#else +do_p1_endelse(FILE *outfile) +#endif { end_else_out (outfile); } /* do_p1_endelse */ -static expptr do_p1_addr (infile, outfile) -FILE *infile, *outfile; + static expptr +#ifdef KR_headers +do_p1_addr(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_addr(FILE *infile, FILE *outfile) +#endif { Addrp addrp = (Addrp) NULL; int status; @@ -552,8 +667,14 @@ FILE *infile, *outfile; -static void do_p1_subr_ret (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_subr_ret(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_subr_ret(FILE *infile, FILE *outfile) +#endif { expptr retval; @@ -568,8 +689,14 @@ FILE *infile, *outfile; -static void do_p1_comp_goto (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_comp_goto(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_comp_goto(FILE *infile, FILE *outfile) +#endif { expptr index; expptr labels; @@ -590,8 +717,14 @@ FILE *infile, *outfile; } /* do_p1_comp_goto */ -static void do_p1_for (infile, outfile) -FILE *infile, *outfile; + static void +#ifdef KR_headers +do_p1_for(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_for(FILE *infile, FILE *outfile) +#endif { expptr init, test, inc; @@ -602,16 +735,26 @@ FILE *infile, *outfile; out_for (outfile, init, test, inc); } /* do_p1_for */ -static void do_p1_end_for (outfile) -FILE *outfile; + static void +#ifdef KR_headers +do_p1_end_for(outfile) + FILE *outfile; +#else +do_p1_end_for(FILE *outfile) +#endif { out_end_for (outfile); } /* do_p1_end_for */ static void +#ifdef KR_headers do_p1_fortran(infile, outfile) - FILE *infile, *outfile; + FILE *infile; + FILE *outfile; +#else +do_p1_fortran(FILE *infile, FILE *outfile) +#endif { char buf[P1_STMTBUFSIZE]; if (!p1gets(infile, buf, P1_STMTBUFSIZE)) @@ -621,8 +764,14 @@ do_p1_fortran(infile, outfile) } -static expptr do_p1_expr (infile, outfile) -FILE *infile, *outfile; + static expptr +#ifdef KR_headers +do_p1_expr(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_expr(FILE *infile, FILE *outfile) +#endif { int status; long opcode, type; @@ -666,8 +815,13 @@ FILE *infile, *outfile; } /* do_p1_expr */ -static expptr do_p1_ident(infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_ident(infile) + FILE *infile; +#else +do_p1_ident(FILE *infile) +#endif { Addrp addrp; int status; @@ -702,8 +856,13 @@ FILE *infile; return (expptr) addrp; } /* do_p1_ident */ -static expptr do_p1_charp(infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_charp(infile) + FILE *infile; +#else +do_p1_charp(FILE *infile) +#endif { Addrp addrp; int status; @@ -741,8 +900,13 @@ FILE *infile; } -static expptr do_p1_extern (infile) -FILE *infile; + static expptr +#ifdef KR_headers +do_p1_extern(infile) + FILE *infile; +#else +do_p1_extern(FILE *infile) +#endif { Addrp addrp; @@ -767,8 +931,14 @@ FILE *infile; -static expptr do_p1_head (infile, outfile) -FILE *infile, *outfile; + static expptr +#ifdef KR_headers +do_p1_head(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_head(FILE *infile, FILE *outfile) +#endif { int status; int add_n_; @@ -822,8 +992,14 @@ FILE *infile, *outfile; } /* do_p1_head */ -static expptr do_p1_list (infile, outfile) -FILE *infile, *outfile; + static expptr +#ifdef KR_headers +do_p1_list(infile, outfile) + FILE *infile; + FILE *outfile; +#else +do_p1_list(FILE *infile, FILE *outfile) +#endif { long tag, type, count; int status; @@ -873,9 +1049,15 @@ FILE *infile, *outfile; } /* do_p1_list */ -chainp length_comp(e, add_n) /* get lengths of characters args */ - struct Entrypoint *e; - int add_n; + chainp +#ifdef KR_headers +length_comp(e, add_n) + struct Entrypoint *e; + int add_n; +#else +length_comp(struct Entrypoint *e, int add_n) +#endif + /* get lengths of characters args */ { chainp lengths; chainp args, args1; @@ -924,11 +1106,16 @@ chainp length_comp(e, add_n) /* get lengths of characters args */ return revchain(lengths); } -void listargs(outfile, entryp, add_n_, lengths) - FILE *outfile; - struct Entrypoint *entryp; - int add_n_; - chainp lengths; + void +#ifdef KR_headers +listargs(outfile, entryp, add_n_, lengths) + FILE *outfile; + struct Entrypoint *entryp; + int add_n_; + chainp lengths; +#else +listargs(FILE *outfile, struct Entrypoint *entryp, int add_n_, chainp lengths) +#endif { chainp args; char *s; @@ -977,12 +1164,17 @@ void listargs(outfile, entryp, add_n_, lengths) } /* listargs */ -void list_arg_types(outfile, entryp, lengths, add_n_, finalnl) -FILE *outfile; -struct Entrypoint *entryp; -chainp lengths; -int add_n_; -char *finalnl; + void +#ifdef KR_headers +list_arg_types(outfile, entryp, lengths, add_n_, finalnl) + FILE *outfile; + struct Entrypoint *entryp; + chainp lengths; + int add_n_; + char *finalnl; +#else +list_arg_types(FILE *outfile, struct Entrypoint *entryp, chainp lengths, int add_n_, char *finalnl) +#endif { chainp args; int last_type = -1, last_class = -1; @@ -1084,8 +1276,12 @@ char *finalnl; } /* list_arg_types */ static void +#ifdef KR_headers write_formats(outfile) - FILE *outfile; + FILE *outfile; +#else +write_formats(FILE *outfile) +#endif { register struct Labelblock *lp; int first = 1; @@ -1108,8 +1304,12 @@ write_formats(outfile) } static void +#ifdef KR_headers write_ioblocks(outfile) - FILE *outfile; + FILE *outfile; +#else +write_ioblocks(FILE *outfile) +#endif { register iob_data *L; register char *f, **s, *sep; @@ -1138,8 +1338,12 @@ write_ioblocks(outfile) } static void +#ifdef KR_headers write_assigned_fmts(outfile) - FILE *outfile; + FILE *outfile; +#else +write_assigned_fmts(FILE *outfile) +#endif { register chainp cp; Namep np; @@ -1159,8 +1363,12 @@ write_assigned_fmts(outfile) } static char * +#ifdef KR_headers to_upper(s) - register char *s; + register char *s; +#else +to_upper(register char *s) +#endif { static char buf[64]; register char *t = buf; @@ -1201,9 +1409,13 @@ to_upper(s) */ static void +#ifdef KR_headers write_namelists(nmch, outfile) - chainp nmch; - FILE *outfile; + chainp nmch; + FILE *outfile; +#else +write_namelists(chainp nmch, FILE *outfile) +#endif { Namep var; struct Hashentry *entry; @@ -1274,12 +1486,15 @@ write_namelists(nmch, outfile) */ static int +#ifdef KR_headers fixexttype(var) - Namep var; + Namep var; +#else +fixexttype(Namep var) +#endif { Extsym *e; int type, type1; - extern void changedtype(); type = var->vtype; e = &extsymtab[var->vardesc.varno]; @@ -1295,17 +1510,22 @@ fixexttype(var) } static void -ref_defs(outfile, refdefs) FILE *outfile; chainp refdefs; +#ifdef KR_headers +ref_defs(outfile, refdefs) + FILE *outfile; + chainp refdefs; +#else +ref_defs(FILE *outfile, chainp refdefs) +#endif { chainp cp; int eb, i, j, n; struct Dimblock *dimp; - long L; expptr b, vl; Namep var; char *amp, *comma; - ind_printf(0, outfile, "\n"); + margin_printf(outfile, "\n"); for(cp = refdefs = revchain(refdefs); cp; cp = cp->nextp) { var = (Namep)cp->datap; cp->datap = 0; @@ -1353,7 +1573,8 @@ ref_defs(outfile, refdefs) FILE *outfile; chainp refdefs; } nice_printf(outfile, " + a_0"); } - if (var->vstg != STGARG && (b = dimp->baseoffset)) { + if ((var->vstg != STGARG /* || checksubs */ ) + && (b = dimp->baseoffset)) { b = cpexpr(b); if (var->vtype == TYCHAR) b = mkexpr(OPSTAR, cpexpr(var->vleng), b); @@ -1361,7 +1582,7 @@ ref_defs(outfile, refdefs) FILE *outfile; chainp refdefs; expr_out(outfile, b); } if (ISCOMPLEX(var->vtype)) { - ind_printf(0, outfile, "\n"); + margin_printf(outfile, "\n"); def_start(outfile, var->cvarname, "_ref", CNULL); comma = "("; for(i = 1; i <= n; i++, comma = ",") @@ -1373,18 +1594,22 @@ ref_defs(outfile, refdefs) FILE *outfile; chainp refdefs; nice_printf(outfile, "%sa_%d", comma, i); nice_printf(outfile, ")"); } - ind_printf(0, outfile, "]\n" + eb); + margin_printf(outfile, "]\n" + eb); } nice_printf(outfile, "\n"); frchain(&refdefs); } -list_decls (outfile) -FILE *outfile; + void +#ifdef KR_headers +list_decls(outfile) + FILE *outfile; +#else +list_decls(FILE *outfile) +#endif { extern chainp used_builtins; extern struct Hashentry *hashtab; - extern ftnint wr_char_len(); struct Hashentry *entry; int write_header = 1; int last_class = -1, last_stg = -1; @@ -1686,7 +1911,7 @@ FILE *outfile; hsize - x); nice_printf(outfile, "; } %s_st;\n", var->cvarname); def_start(outfile, var->cvarname, CNULL, var->cvarname); - ind_printf(0, outfile, "_st.val\n"); + margin_printf(outfile, "_st.val\n"); last_type = -1; write_header = 2; continue; @@ -1724,7 +1949,6 @@ FILE *outfile; Alias1: if (Alias) { char *amp, *lp, *name, *rp; - char *equiv_name (); ftnint voff = var -> voffset; int et0, expr_type, k; Extsym *E; @@ -1806,7 +2030,7 @@ FILE *outfile; last_type = last_class = last_stg = -1; write_header = 0; if (Define) { - ind_printf(0, outfile, ")\n"); + margin_printf(outfile, ")\n"); write_header = 2; } continue; @@ -1841,9 +2065,14 @@ FILE *outfile; } /* list_decls */ -do_uninit_equivs (outfile, did_one) -FILE *outfile; -int *did_one; + void +#ifdef KR_headers +do_uninit_equivs(outfile, did_one) + FILE *outfile; + int *did_one; +#else +do_uninit_equivs(FILE *outfile, int *did_one) +#endif { extern int nequiv; struct Equivblock *eqv, *lasteqv = eqvclass + nequiv; @@ -1878,12 +2107,18 @@ int *did_one; dimension is greater than 1, a string comment about the original size is returned */ -char *wr_ardecls(outfile, dimp, size) -FILE *outfile; -struct Dimblock *dimp; -long size; + char * +#ifdef KR_headers +wr_ardecls(outfile, dimp, size) + FILE *outfile; + struct Dimblock *dimp; + long size; +#else +wr_ardecls(FILE *outfile, struct Dimblock *dimp, long size) +#endif { int i, k; + ftnint j; static char buf[1000]; if (dimp == (struct Dimblock *) NULL) @@ -1895,13 +2130,22 @@ long size; for (i = 0; i < dimp -> ndim; i++) { expptr this_size = dimp -> dims[i].dimsize; - if (!ISICON (this_size)) - err ("wr_ardecls: nonconstant array size"); + if (ISCONST(this_size)) { + if (ISINT(this_size->constblock.vtype)) + j = this_size -> constblock.Const.ci; + else if (ISREAL(this_size->constblock.vtype)) + j = (ftnint)this_size -> constblock.Const.cd[0]; + else + goto non_const; + size *= j; + sprintf(buf+k, "[%ld]", j); + k += strlen(buf+k); + /* BSD prevents getting strlen from sprintf */ + } else { - size *= this_size -> constblock.Const.ci; - sprintf(buf+k, "[%ld]", this_size -> constblock.Const.ci); - k += strlen(buf+k); /* BSD prevents combining this with prev stmt */ - } /* else */ + non_const: + err ("wr_ardecls: nonconstant array size"); + } } /* for i = 0 */ nice_printf (outfile, "[%ld]", size); @@ -1919,8 +2163,13 @@ long size; ---------------------------------------------------------------------- */ -static int get_p1_token (infile) -FILE *infile; + static int +#ifdef KR_headers +get_p1_token(infile) + FILE *infile; +#else +get_p1_token(FILE *infile) +#endif { int token = P1_UNKNOWN; @@ -1941,12 +2190,16 @@ FILE *infile; /* Returns a (null terminated) string from the input file */ -static int p1gets (fp, str, size) -FILE *fp; -char *str; -int size; + static int +#ifdef KR_headers +p1gets(fp, str, size) + FILE *fp; + char *str; + int size; +#else +p1gets(FILE *fp, char *str, int size) +#endif { - char *fgets (); char c; if (str == NULL) @@ -1974,10 +2227,15 @@ int size; } /* p1gets */ -static int p1get_const (infile, type, resultp) -FILE *infile; -int type; -struct Constblock **resultp; + static int +#ifdef KR_headers +p1get_const(infile, type, resultp) + FILE *infile; + int type; + struct Constblock **resultp; +#else +p1get_const(FILE *infile, int type, struct Constblock **resultp) +#endif { int status; struct Constblock *result; @@ -2024,17 +2282,26 @@ struct Constblock **resultp; return status; } /* p1get_const */ -static int p1getd (infile, result) -FILE *infile; -long *result; + static int +#ifdef KR_headers +p1getd(infile, result) + FILE *infile; + long *result; +#else +p1getd(FILE *infile, long *result) +#endif { return fscanf (infile, "%ld", result); } /* p1getd */ static int +#ifdef KR_headers p1getf(infile, result) - FILE *infile; - char **result; + FILE *infile; + char **result; +#else +p1getf(FILE *infile, char **result) +#endif { char buf[1324]; @@ -2048,14 +2315,18 @@ p1getf(infile, result) return k; } -static int p1getn (infile, count, result) -FILE *infile; -int count; -char **result; + static int +#ifdef KR_headers +p1getn(infile, count, result) + FILE *infile; + int count; + char **result; +#else +p1getn(FILE *infile, int count, char **result) +#endif { char *bufptr; - extern ptr ckalloc (); bufptr = (char *) ckalloc (count); @@ -2069,17 +2340,20 @@ char **result; } /* p1getn */ static void +#ifdef KR_headers proto(outfile, at, fname) - FILE *outfile; - Argtypes *at; - char *fname; + FILE *outfile; + Argtypes *at; + char *fname; +#else +proto(FILE *outfile, Argtypes *at, char *fname) +#endif { int i, j, k, n; char *comma; Atype *atypes; Namep np; chainp cp; - extern void bad_atypes(); if (at) { /* Correct types that we learn on the fly, e.g. @@ -2163,11 +2437,16 @@ proto(outfile, at, fname) } void +#ifdef KR_headers protowrite(protofile, type, name, e, lengths) - FILE *protofile; - char *name; - struct Entrypoint *e; - chainp lengths; + FILE *protofile; + int type; + char *name; + struct Entrypoint *e; + chainp lengths; +#else +protowrite(FILE *protofile, int type, char *name, struct Entrypoint *e, chainp lengths) +#endif { extern char used_rets[]; int asave; @@ -2182,8 +2461,12 @@ protowrite(protofile, type, name, e, lengths) } static void +#ifdef KR_headers do_p1_1while(outfile) - FILE *outfile; + FILE *outfile; +#else +do_p1_1while(FILE *outfile) +#endif { if (*wh_next) { nice_printf(outfile, @@ -2195,8 +2478,13 @@ do_p1_1while(outfile) } static void +#ifdef KR_headers do_p1_2while(infile, outfile) - FILE *infile, *outfile; + FILE *infile; + FILE *outfile; +#else +do_p1_2while(FILE *infile, FILE *outfile) +#endif { expptr test; @@ -2213,8 +2501,12 @@ do_p1_2while(infile, outfile) } static void +#ifdef KR_headers do_p1_elseifstart(outfile) - FILE *outfile; + FILE *outfile; +#else +do_p1_elseifstart(FILE *outfile) +#endif { if (*ei_next++) { prev_tab(outfile); diff --git a/usr.bin/f2c/format.h b/usr.bin/f2c/format.h index a88c038..3de97f6 100644 --- a/usr.bin/f2c/format.h +++ b/usr.bin/f2c/format.h @@ -4,7 +4,9 @@ extern int c_output_line_length; /* max # chars per line in C source code */ -char *wr_ardecls (/* FILE *, struct Dimblock * */); -void list_init_data (), wr_one_init (), wr_output_values (); -int do_init_data (); -chainp data_value (); +chainp data_value Argdcl((FILEP, long int, int)); +int do_init_data Argdcl((FILEP, FILEP)); +void list_init_data Argdcl((FILEP*, char*, FILEP)); +char* wr_ardecls Argdcl((FILEP, struct Dimblock*, long int)); +void wr_one_init Argdcl((FILEP, char*, chainp*, int)); +void wr_output_values Argdcl((FILEP, Namep, chainp)); diff --git a/usr.bin/f2c/formatdata.c b/usr.bin/f2c/formatdata.c index 541472a..690ee10 100644 --- a/usr.bin/f2c/formatdata.c +++ b/usr.bin/f2c/formatdata.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1993-5 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 @@ -29,14 +29,19 @@ this software. #define MAX_INIT_LINE 100 #define NAME_MAX 64 -static int memno2info(); +static int memno2info Argdcl((int, Namep*)); -extern char *initbname; -extern void def_start(); + extern char *initbname; -void list_init_data(Infile, Inname, outfile) - FILE **Infile, *outfile; - char *Inname; + void +#ifdef KR_headers +list_init_data(Infile, Inname, outfile) + FILE **Infile; + char *Inname; + FILE *outfile; +#else +list_init_data(FILE **Infile, char *Inname, FILE *outfile) +#endif { FILE *sortfp; int status; @@ -70,8 +75,14 @@ void list_init_data(Infile, Inname, outfile) /* do_init_data -- returns YES when at least one declaration has been written */ -int do_init_data(outfile, infile) -FILE *outfile, *infile; + int +#ifdef KR_headers +do_init_data(outfile, infile) + FILE *outfile; + FILE *infile; +#else +do_init_data(FILE *outfile, FILE *infile) +#endif { char varname[NAME_MAX], ovarname[NAME_MAX]; ftnint offset; @@ -129,15 +140,19 @@ FILE *outfile, *infile; ftnint +#ifdef KR_headers wr_char_len(outfile, dimp, n, extra1) - FILE *outfile; - int n; - struct Dimblock *dimp; - int extra1; + FILE *outfile; + struct Dimblock *dimp; + int n; + int extra1; +#else +wr_char_len(FILE *outfile, struct Dimblock *dimp, int n, int extra1) +#endif { int i, nd; expptr e; - ftnint rv; + ftnint j, rv; if (!dimp) { nice_printf (outfile, extra1 ? "[%d+1]" : "[%d]", n); @@ -148,11 +163,19 @@ wr_char_len(outfile, dimp, n, extra1) rv = n; for(i = 0; i < nd; i++) { e = dimp->dims[i].dimsize; - if (!ISICON (e)) - err ("wr_char_len: nonconstant array size"); + if (ISCONST(e)) { + if (ISINT(e->constblock.vtype)) + j = e->constblock.Const.ci; + else if (ISREAL(e->constblock.vtype)) + j = (ftnint)e->constblock.Const.cd[0]; + else + goto non_const; + nice_printf(outfile, "*%ld", j); + rv *= j; + } else { - nice_printf(outfile, "*%ld", e->constblock.Const.ci); - rv *= e->constblock.Const.ci; + non_const: + err ("wr_char_len: nonconstant array size"); } } /* extra1 allows for stupid C compilers that complain about @@ -167,15 +190,20 @@ wr_char_len(outfile, dimp, n, extra1) static int eqvmemno; /* kludge */ static void +#ifdef KR_headers write_char_init(outfile, Values, namep) - FILE *outfile; - chainp *Values; - Namep namep; + FILE *outfile; + chainp *Values; + Namep namep; +#else +write_char_init(FILE *outfile, chainp *Values, Namep namep) +#endif { struct Equivblock *eqv; long size; struct Dimblock *dimp; int i, nd, type; + ftnint j; expptr ds; if (!namep) @@ -191,10 +219,19 @@ write_char_init(outfile, Values, namep) if (dimp = namep->vdim) for(i = 0, nd = dimp->ndim; i < nd; i++) { ds = dimp->dims[i].dimsize; - if (!ISICON(ds)) + if (ISCONST(ds)) { + if (ISINT(ds->constblock.vtype)) + j = ds->constblock.Const.ci; + else if (ISREAL(ds->constblock.vtype)) + j = (ftnint)ds->constblock.Const.cd[0]; + else + goto non_const; + size *= j; + } + else { + non_const: err("write_char_values: nonconstant array size"); - else - size *= ds->constblock.Const.ci; + } } *Values = revchain(*Values); eqv->eqvtop = size; @@ -203,9 +240,9 @@ write_char_init(outfile, Values, namep) wr_equiv_init(outfile, nequiv, Values, 0); def_start(outfile, namep->cvarname, CNULL, ""); if (type == TYCHAR) - ind_printf(0, outfile, "((char *)&equiv_%d)\n\n", eqvmemno); + margin_printf(outfile, "((char *)&equiv_%d)\n\n", eqvmemno); else - ind_printf(0, outfile, dimp + margin_printf(outfile, dimp ? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n", c_type_decl(type,0), eqvmemno); } @@ -214,11 +251,16 @@ write_char_init(outfile, Values, namep) by info. When is_addr is true, info is an Addrp; otherwise, treat it as a Namep */ -void wr_one_init (outfile, varname, Values, keepit) -FILE *outfile; -char *varname; -chainp *Values; -int keepit; + void +#ifdef KR_headers +wr_one_init(outfile, varname, Values, keepit) + FILE *outfile; + char *varname; + chainp *Values; + int keepit; +#else +wr_one_init(FILE *outfile, char *varname, chainp *Values, int keepit) +#endif { static int memno; static union { @@ -310,7 +352,7 @@ int keepit; nice_printf(outfile, " };\n"); ch_ar_dim = -1; def_start(outfile, name, CNULL, name); - ind_printf(0, outfile, "_st.val\n"); + margin_printf(outfile, "_st.val\n"); goto done; } } @@ -371,16 +413,18 @@ int keepit; -chainp data_value (infile, offset, type) -FILE *infile; -ftnint offset; -int type; + chainp +#ifdef KR_headers +data_value(infile, offset, type) + FILE *infile; + ftnint offset; + int type; +#else +data_value(FILE *infile, ftnint offset, int type) +#endif { char line[MAX_INIT_LINE + 1], *pointer; chainp vals, prev_val; -#ifndef atol - long atol(); -#endif char *newval; if (fgets (line, MAX_INIT_LINE, infile) == NULL) { @@ -436,7 +480,7 @@ int type; } /* data_value */ static void -overlapping() +overlapping(Void) { extern char *filename0; static int warned = 0; @@ -452,13 +496,18 @@ overlapping() nerr++; } - static void make_one_const(); + static void make_one_const Argdcl((int, union Constant*, chainp)); static long charlen; -void wr_output_values (outfile, namep, values) -FILE *outfile; -Namep namep; -chainp values; + void +#ifdef KR_headers +wr_output_values(outfile, namep, values) + FILE *outfile; + Namep namep; + chainp values; +#else +wr_output_values(FILE *outfile, Namep namep, chainp values) +#endif { int type = TYUNKNOWN; struct Constblock Const; @@ -493,10 +542,15 @@ chainp values; } -wr_array_init (outfile, type, values) -FILE *outfile; -int type; -chainp values; + void +#ifdef KR_headers +wr_array_init(outfile, type, values) + FILE *outfile; + int type; + chainp values; +#else +wr_array_init(FILE *outfile, int type, chainp values) +#endif { int size = typesize[type]; long index, main_index = 0; @@ -602,10 +656,14 @@ chainp values; static void +#ifdef KR_headers make_one_const(type, storage, values) - int type; - union Constant *storage; - chainp values; + int type; + union Constant *storage; + chainp values; +#else +make_one_const(int type, union Constant *storage, chainp values) +#endif { union Constant *Const; register char **L; @@ -661,11 +719,15 @@ make_one_const(type, storage, values) } /* make_one_const */ - -rdname (infile, vargroupp, name) -FILE *infile; -int *vargroupp; -char *name; + int +#ifdef KR_headers +rdname(infile, vargroupp, name) + FILE *infile; + int *vargroupp; + char *name; +#else +rdname(FILE *infile, int *vargroupp, char *name) +#endif { register int i, c; @@ -689,9 +751,14 @@ char *name; return YES; } /* rdname */ -rdlong (infile, n) -FILE *infile; -ftnint *n; + int +#ifdef KR_headers +rdlong(infile, n) + FILE *infile; + ftnint *n; +#else +rdlong(FILE *infile, ftnint *n) +#endif { register int c; @@ -708,9 +775,13 @@ ftnint *n; static int -memno2info (memno, info) - int memno; - Namep *info; +#ifdef KR_headers +memno2info(memno, info) + int memno; + Namep *info; +#else +memno2info(int memno, Namep *info) +#endif { chainp this_var; extern chainp new_vars; @@ -744,10 +815,14 @@ memno2info (memno, info) } /* memno2info */ static chainp +#ifdef KR_headers do_string(outfile, v, nloc) - FILEP outfile; - register chainp v; - ftnint *nloc; + FILE *outfile; + register chainp v; + ftnint *nloc; +#else +do_string(FILE *outfile, register chainp v, ftnint *nloc) +#endif { register chainp cp, v0; ftnint dloc, k, loc; @@ -779,9 +854,8 @@ do_string(outfile, v, nloc) goto done; } v0 = v; - if (!(v = v->nextp)) + if (!(v = v->nextp) || !(cp = (chainp)v->datap)) break; - cp = (chainp)v->datap; dloc = (ftnint)cp->datap; if (loc != dloc) break; @@ -793,10 +867,14 @@ do_string(outfile, v, nloc) } static chainp +#ifdef KR_headers Ado_string(outfile, v, nloc) - FILEP outfile; - register chainp v; - ftnint *nloc; + FILE *outfile; + register chainp v; + ftnint *nloc; +#else +Ado_string(FILE *outfile, register chainp v, ftnint *nloc) +#endif { register chainp cp, v0; ftnint dloc, k, loc; @@ -821,9 +899,8 @@ Ado_string(outfile, v, nloc) goto done; } v0 = v; - if (!(v = v->nextp)) + if (!(v = v->nextp) || !(cp = (chainp)v->datap)) break; - cp = (chainp)v->datap; dloc = (ftnint)cp->datap; if (loc != dloc) break; @@ -835,9 +912,13 @@ Ado_string(outfile, v, nloc) } static char * -Len(L,type) - long L; - int type; +#ifdef KR_headers +Len(L, type) + long L; + int type; +#else +Len(long L, int type) +#endif { static char buf[24]; if (L == 1 && type != TYCHAR) @@ -846,14 +927,18 @@ Len(L,type) return buf; } + void +#ifdef KR_headers wr_equiv_init(outfile, memno, Values, iscomm) - FILE *outfile; - int memno; - chainp *Values; - int iscomm; + FILE *outfile; + int memno; + chainp *Values; + int iscomm; +#else +wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm) +#endif { struct Equivblock *eqv; - char *equiv_name (); int btype, curtype, dtype, filltype, filltype1, j, k, wasblank, xtype; static char Blank[] = ""; register char *comma = Blank; diff --git a/usr.bin/f2c/gram.dcl b/usr.bin/f2c/gram.dcl index 9a25c25..fadbb5b 100644 --- a/usr.bin/f2c/gram.dcl +++ b/usr.bin/f2c/gram.dcl @@ -56,6 +56,7 @@ typename: SINTEGER { $$ = TYLONG; } | SDIMENSION { $$ = TYUNKNOWN; } | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; } | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; } + | SBYTE { $$ = TYINT1; } ; lengspec: @@ -228,6 +229,15 @@ var: name dims datavar: lhs { Namep np; + int tt = $1->tag; + if (tt != TPRIM) { + if (tt == TCONST) + err("parameter in data statement"); + else + erri("tag %d in data statement",tt); + $$ = 0; + break; + } np = ( (struct Primblock *) $1) -> namep; vardcl(np); if(np->vstg == STGCOMMON) diff --git a/usr.bin/f2c/gram.head b/usr.bin/f2c/gram.head index 4af7dc7..dd822fd 100644 --- a/usr.bin/f2c/gram.head +++ b/usr.bin/f2c/gram.head @@ -49,21 +49,12 @@ static chainp datastack; extern long laststfcn, thisstno; extern int can_include; /* for netlib */ -ftnint convci(); -Addrp nextdata(); -expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon(); -expptr mkcxcon(); -struct Listblock *mklist(); -struct Listblock *mklist(); -struct Impldoblock *mkiodo(); -Extsym *comblock(); #define ESNULL (Extsym *)0 #define NPNULL (Namep)0 #define LBNULL (struct Listblock *)0 -extern void freetemps(), make_param(); static void -pop_datastack() { +pop_datastack(Void) { chainp d0 = datastack; if (d0->datap) curdtp = (chainp)d0->datap; @@ -163,8 +154,7 @@ stat: thislabel entry endproc(); /* lastwasbranch = NO; -- set in endproc() */ } | thislabel SUNKNOWN - { extern void unclassifiable(); - unclassifiable(); + { unclassifiable(); /* flline flushes the current line, ignoring the rest of the text there */ diff --git a/usr.bin/f2c/index b/usr.bin/f2c/index index 09422b3..5212535 100644 --- a/usr.bin/f2c/index +++ b/usr.bin/f2c/index @@ -1,23 +1,12 @@ -# ====== index for f2c/src ====== - -file f2c/src/all -for bundle of complete f2c source - -# NOTE: "all from f2c/src" is the complete f2c source (sans libraries). +# ====== index for f2c/src ====== +# NOTE: "all from f2c/src" is the complete f2c source (sans libraries). # The remaining files in this directory are the component modules # of "all from f2c/src", so you can request just the modules that # have changed since last you updated your f2c source. You can # tell what has changed by looking at the timestamps at the end # of "readme from f2c". - -file f2c/src/notice - -file f2c/src/readme - file f2c/src/cds.c -file f2c/src/changes - file f2c/src/data.c file f2c/src/defines.h @@ -38,8 +27,6 @@ file f2c/src/f2c.1t file f2c/src/f2c.h -file f2c/src/fc - file f2c/src/format.c file f2c/src/format.h @@ -116,8 +103,6 @@ file f2c/src/put.c file f2c/src/putpcc.c -file f2c/src/readme - file f2c/src/sysdep.c file f2c/src/sysdep.h @@ -133,3 +118,10 @@ file f2c/src/version.c file f2c/src/xsum.c file f2c/src/xsum0.out + +file f2c/src/Notice + +file f2c/src/README + +file f2c/src/readme + diff --git a/usr.bin/f2c/index.html b/usr.bin/f2c/index.html index f93c66c..2265f2a 100644 --- a/usr.bin/f2c/index.html +++ b/usr.bin/f2c/index.html @@ -1,11 +1,10 @@ -<TITLE>f2c/src/index</TITLE><UL> +<HTML> +<HEAD><TITLE>/netlib/f2c/src</TITLE></HEAD> +<BODY> +<H2>/netlib/f2c/src</H2> +<UL> <PRE> ====== index for f2c/src ====== -</PRE> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/all.Z">f2c/src/all</A><MENU> -<LI><EM>for: </EM>bundle of complete f2c source -</MENU> -<PRE> NOTE: "all from f2c/src" is the complete f2c source (sans libraries). The remaining files in this directory are the component modules of "all from f2c/src", so you can request just the modules that @@ -13,130 +12,127 @@ have changed since last you updated your f2c source. You can tell what has changed by looking at the timestamps at the end of "readme from f2c". </PRE> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/notice.Z">f2c/src/notice</A><MENU> -</MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/readme.Z">f2c/src/readme</A><MENU> -</MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/cds.c.Z">f2c/src/cds.c</A><MENU> +<LI><EM>file: </EM><A HREF="cds.c.Z">cds.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/cds.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/changes.Z">f2c/src/changes</A><MENU> +<LI><EM>file: </EM><A HREF="data.c.Z">data.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/data.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/data.c.Z">f2c/src/data.c</A><MENU> +<LI><EM>file: </EM><A HREF="defines.h.Z">defines.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/defines.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/defines.h.Z">f2c/src/defines.h</A><MENU> +<LI><EM>file: </EM><A HREF="defs.h.Z">defs.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/defs.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/defs.h.Z">f2c/src/defs.h</A><MENU> +<LI><EM>file: </EM><A HREF="equiv.c.Z">equiv.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/equiv.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/equiv.c.Z">f2c/src/equiv.c</A><MENU> +<LI><EM>file: </EM><A HREF="error.c.Z">error.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/error.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/error.c.Z">f2c/src/error.c</A><MENU> +<LI><EM>file: </EM><A HREF="exec.c.Z">exec.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/exec.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/exec.c.Z">f2c/src/exec.c</A><MENU> +<LI><EM>file: </EM><A HREF="expr.c.Z">expr.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/expr.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/expr.c.Z">f2c/src/expr.c</A><MENU> +<LI><EM>file: </EM><A HREF="f2c.1.Z">f2c.1</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/f2c.1.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/f2c.1.Z">f2c/src/f2c.1</A><MENU> +<LI><EM>file: </EM><A HREF="f2c.1t.Z">f2c.1t</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/f2c.1t.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/f2c.1t.Z">f2c/src/f2c.1t</A><MENU> +<LI><EM>file: </EM><A HREF="f2c.h.Z">f2c.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/f2c.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/f2c.h.Z">f2c/src/f2c.h</A><MENU> +<LI><EM>file: </EM><A HREF="format.c.Z">format.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/format.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/fc.Z">f2c/src/fc</A><MENU> +<LI><EM>file: </EM><A HREF="format.h.Z">format.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/format.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/format.c.Z">f2c/src/format.c</A><MENU> +<LI><EM>file: </EM><A HREF="formatdata.c.Z">formatdata.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/formatdata.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/format.h.Z">f2c/src/format.h</A><MENU> +<LI><EM>file: </EM><A HREF="ftypes.h.Z">ftypes.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/ftypes.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/formatdata.c.Z">f2c/src/formatdata.c</A><MENU> +<LI><EM>file: </EM><A HREF="gram.c.Z">gram.c</A><MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/ftypes.h.Z">f2c/src/ftypes.h</A><MENU> +<LI><EM>file: </EM><A HREF="gram.dcl.Z">gram.dcl</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/gram.dcl.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.c.Z">f2c/src/gram.c</A><MENU> +<LI><EM>file: </EM><A HREF="gram.exec.Z">gram.exec</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/gram.exec.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.dcl.Z">f2c/src/gram.dcl</A><MENU> +<LI><EM>file: </EM><A HREF="gram.expr.Z">gram.expr</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/gram.expr.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.exec.Z">f2c/src/gram.exec</A><MENU> +<LI><EM>file: </EM><A HREF="gram.head.Z">gram.head</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/gram.head.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.expr.Z">f2c/src/gram.expr</A><MENU> +<LI><EM>file: </EM><A HREF="gram.io.Z">gram.io</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/gram.io.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.head.Z">f2c/src/gram.head</A><MENU> +<LI><EM>file: </EM><A HREF="init.c.Z">init.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/init.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/gram.io.Z">f2c/src/gram.io</A><MENU> +<LI><EM>file: </EM><A HREF="intr.c.Z">intr.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/intr.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/init.c.Z">f2c/src/init.c</A><MENU> +<LI><EM>file: </EM><A HREF="io.c.Z">io.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/io.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/intr.c.Z">f2c/src/intr.c</A><MENU> +<LI><EM>file: </EM><A HREF="iob.h.Z">iob.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/iob.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/io.c.Z">f2c/src/io.c</A><MENU> +<LI><EM>file: </EM><A HREF="lex.c.Z">lex.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/lex.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/iob.h.Z">f2c/src/iob.h</A><MENU> +<LI><EM>file: </EM><A HREF="machdefs.h.Z">machdefs.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/machdefs.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/lex.c.Z">f2c/src/lex.c</A><MENU> +<LI><EM>file: </EM><A HREF="main.c.Z">main.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/main.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/machdefs.h.Z">f2c/src/machdefs.h</A><MENU> +<LI><EM>file: </EM><A HREF="makefile.Z">makefile</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/makefile.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/main.c.Z">f2c/src/main.c</A><MENU> +<LI><EM>file: </EM><A HREF="malloc.c.Z">malloc.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/malloc.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/makefile.Z">f2c/src/makefile</A><MENU> +<LI><EM>file: </EM><A HREF="mem.c.Z">mem.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/mem.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/malloc.c.Z">f2c/src/malloc.c</A><MENU> +<LI><EM>file: </EM><A HREF="memset.c.Z">memset.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/memset.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/mem.c.Z">f2c/src/mem.c</A><MENU> +<LI><EM>file: </EM><A HREF="misc.c.Z">misc.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/misc.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/memset.c.Z">f2c/src/memset.c</A><MENU> +<LI><EM>file: </EM><A HREF="names.c.Z">names.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/names.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/misc.c.Z">f2c/src/misc.c</A><MENU> +<LI><EM>file: </EM><A HREF="names.h.Z">names.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/names.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/names.c.Z">f2c/src/names.c</A><MENU> +<LI><EM>file: </EM><A HREF="niceprintf.c.Z">niceprintf.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/niceprintf.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/names.h.Z">f2c/src/names.h</A><MENU> +<LI><EM>file: </EM><A HREF="niceprintf.h.Z">niceprintf.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/niceprintf.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/niceprintf.c.Z">f2c/src/niceprintf.c</A><MENU> +<LI><EM>file: </EM><A HREF="notice.Z">notice</A><MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/niceprintf.h.Z">f2c/src/niceprintf.h</A><MENU> +<LI><EM>file: </EM><A HREF="output.c.Z">output.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/output.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/notice.Z">f2c/src/notice</A><MENU> +<LI><EM>file: </EM><A HREF="output.h.Z">output.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/output.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/output.c.Z">f2c/src/output.c</A><MENU> +<LI><EM>file: </EM><A HREF="p1defs.h.Z">p1defs.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/p1defs.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/output.h.Z">f2c/src/output.h</A><MENU> +<LI><EM>file: </EM><A HREF="p1output.c.Z">p1output.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/p1output.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/p1defs.h.Z">f2c/src/p1defs.h</A><MENU> +<LI><EM>file: </EM><A HREF="parse.h.Z">parse.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/parse.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/p1output.c.Z">f2c/src/p1output.c</A><MENU> +<LI><EM>file: </EM><A HREF="parse_args.c.Z">parse_args.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/parse_args.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/parse.h.Z">f2c/src/parse.h</A><MENU> +<LI><EM>file: </EM><A HREF="pccdefs.h.Z">pccdefs.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/pccdefs.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/parse_args.c.Z">f2c/src/parse_args.c</A><MENU> +<LI><EM>file: </EM><A HREF="pread.c.Z">pread.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/pread.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/pccdefs.h.Z">f2c/src/pccdefs.h</A><MENU> +<LI><EM>file: </EM><A HREF="proc.c.Z">proc.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/proc.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/pread.c.Z">f2c/src/pread.c</A><MENU> +<LI><EM>file: </EM><A HREF="put.c.Z">put.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/put.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/proc.c.Z">f2c/src/proc.c</A><MENU> +<LI><EM>file: </EM><A HREF="putpcc.c.Z">putpcc.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/putpcc.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/put.c.Z">f2c/src/put.c</A><MENU> +<LI><EM>file: </EM><A HREF="sysdep.c.Z">sysdep.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/sysdep.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/putpcc.c.Z">f2c/src/putpcc.c</A><MENU> +<LI><EM>file: </EM><A HREF="sysdep.h.Z">sysdep.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/sysdep.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/readme.Z">f2c/src/readme</A><MENU> +<LI><EM>file: </EM><A HREF="tokens.Z">tokens</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/tokens.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/sysdep.c.Z">f2c/src/sysdep.c</A><MENU> +<LI><EM>file: </EM><A HREF="usignal.h.Z">usignal.h</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/usignal.h.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/sysdep.h.Z">f2c/src/sysdep.h</A><MENU> +<LI><EM>file: </EM><A HREF="vax.c.Z">vax.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/vax.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/tokens.Z">f2c/src/tokens</A><MENU> +<LI><EM>file: </EM><A HREF="version.c.Z">version.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/version.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/usignal.h.Z">f2c/src/usignal.h</A><MENU> +<LI><EM>file: </EM><A HREF="xsum.c.Z">xsum.c</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/xsum.c.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/vax.c.Z">f2c/src/vax.c</A><MENU> +<LI><EM>file: </EM><A HREF="xsum0.out.Z">xsum0.out</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/xsum0.out.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/version.c.Z">f2c/src/version.c</A><MENU> +<LI><EM>file: </EM><A HREF="Notice.Z">Notice</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/Notice.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/xsum.c.Z">f2c/src/xsum.c</A><MENU> +<LI><EM>file: </EM><A HREF="README.Z">README</A> (<A HREF="ftp://netlib.att.com/netlib.depend/f2c/src/README.tar">with dependencies</A>)<MENU> </MENU> -<LI><EM>file: </EM><A HREF="ftp://netlib.att.com/netlib/f2c/src/xsum0.out.Z">f2c/src/xsum0.out</A><MENU> +<LI><EM>file: </EM><A HREF="readme.Z">readme</A><MENU> </MENU> -<P><LI><A HREF="ftp://netlib.att.com/netlib/bib/thesaurus.Z">glossary/thesaurus of terms used in this index</A> +<P><LI><A HREF="/netlib/bib/thesaurus.html.Z">index help</A> </UL> -<P><A HREF="ftp://netlib.att.com/netlib/bib/ericjack.Z">Eric and Jack</EM> +<P><A HREF="/netlib/bib/ericjack.html.Z">Eric and Jack</EM> +</BODY></HTML> diff --git a/usr.bin/f2c/init.c b/usr.bin/f2c/init.c index 67bcd1e..c9a9702 100644 --- a/usr.bin/f2c/init.c +++ b/usr.bin/f2c/init.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992 - 1995 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 @@ -54,8 +54,8 @@ FILEP initfile; FILEP blkdfile; -char token[MAXTOKENLEN+2]; -int toklen; +char *token; +int maxtoklen, toklen; long lineno; /* Current line in the input file, NOT the Fortran statement label number */ char *infname; @@ -156,7 +156,7 @@ char *dfltarg[] = { #endif "(real *)0", "(doublereal *)0", "(complex *)0", "(doublecomplex *)0", - "(logical1 *)0","(shortlogical *)0)", "(logical *)0", "(char *)0" + "(logical1 *)0","(shortlogical *)0", "(logical *)0", "(char *)0" }; static char *dflt0proc[] = { @@ -289,11 +289,11 @@ char *wh_first, *wh_next, *wh_last; #define ALLOCN(n,x) (struct x *) ckalloc((n)*sizeof(struct x)) -fileinit() + void +fileinit(Void) { register char *s; register int i, j; - extern void fmt_init(), mem_init(), np_init(); lastiolabno = 100000; lastlabno = 0; @@ -303,6 +303,8 @@ fileinit() infile = stdin; + maxtoklen = 502; + token = (char *)ckalloc(maxtoklen+2); memset(dflttype, tyreal, 26); memset(dflttype + 'i' - 'a', tyint, 6); memset(hextoi_tab, 16, sizeof(hextoi_tab)); @@ -341,7 +343,8 @@ fileinit() out_init (); } -hashclear() /* clear hash table */ + void +hashclear(Void) /* clear hash table */ { register struct Hashentry *hp; register Namep p; @@ -371,7 +374,8 @@ hashclear() /* clear hash table */ } } -procinit() + void +procinit(Void) { register struct Labelblock *lp; struct Chain *cp; @@ -379,7 +383,6 @@ procinit() struct memblock; extern struct memblock *curmemblock, *firstmemblock; extern char *mem_first, *mem_next, *mem_last, *mem0_last; - extern void frexchain(); curmemblock = firstmemblock; mem_next = mem_first; @@ -463,16 +466,20 @@ procinit() setimpl(tyint, (ftnint) 0, 'i', 'n'); } setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */ - setlog(); } - + void +#ifdef KR_headers setimpl(type, length, c1, c2) -int type; -ftnint length; -int c1, c2; + int type; + ftnint length; + int c1; + int c2; +#else +setimpl(int type, ftnint length, int c1, int c2) +#endif { int i; char buff[100]; diff --git a/usr.bin/f2c/intr.c b/usr.bin/f2c/intr.c index 210047f..be4bcb7 100644 --- a/usr.bin/f2c/intr.c +++ b/usr.bin/f2c/intr.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992, 1994-5 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 @@ -24,8 +24,6 @@ this software. #include "defs.h" #include "names.h" -void cast_args (); - union { int ijunk; @@ -406,7 +404,7 @@ char *callbyvalue[ ] = }; void -r8fix() /* adjust tables for -r8 */ +r8fix(Void) /* adjust tables for -r8 */ { register struct Intrblock *I; register struct Specblock *S; @@ -476,16 +474,21 @@ r8fix() /* adjust tables for -r8 */ } } -expptr intrcall(np, argsp, nargs) -Namep np; -struct Listblock *argsp; -int nargs; + + expptr +#ifdef KR_headers +intrcall(np, argsp, nargs) + Namep np; + struct Listblock *argsp; + int nargs; +#else +intrcall(Namep np, struct Listblock *argsp, int nargs) +#endif { int i, rettype; Addrp ap; register struct Specblock *sp; register struct Chain *cp; - expptr Inline(), mkcxcon(), mkrealcon(); expptr q, ep; int mtype; int op; @@ -544,6 +547,9 @@ int nargs; expptr qr, qi; qr = (expptr) argsp->listp->datap; qi = (expptr) argsp->listp->nextp->datap; + if (qr->headblock.vtype == TYDREAL + || qi->headblock.vtype == TYDREAL) + rettype = TYDCOMPLEX; if(ISCONST(qr) && ISCONST(qi)) q = mkcxcon(qr,qi); else q = mkexpr(OPCONV,mkconv(rettype-2,qr), @@ -720,9 +726,13 @@ bad: - + int +#ifdef KR_headers intrfunct(s) -char *s; + char *s; +#else +intrfunct(char *s) +#endif { register struct Intrblock *p; @@ -745,8 +755,13 @@ char *s; -Addrp intraddr(np) -Namep np; + Addrp +#ifdef KR_headers +intraddr(np) + Namep np; +#else +intraddr(Namep np) +#endif { Addrp q; register struct Specblock *sp; @@ -788,9 +803,14 @@ bad: -void cast_args (maxtype, args) -int maxtype; -chainp args; + void +#ifdef KR_headers +cast_args(maxtype, args) + int maxtype; + chainp args; +#else +cast_args(int maxtype, chainp args) +#endif { for (; args; args = args -> nextp) { expptr e = (expptr) args->datap; @@ -808,10 +828,15 @@ chainp args; -expptr Inline(fno, type, args) -int fno; -int type; -struct Chain *args; + expptr +#ifdef KR_headers +Inline(fno, type, args) + int fno; + int type; + struct Chain *args; +#else +Inline(int fno, int type, struct Chain *args) +#endif { register expptr q, t, t1; @@ -843,7 +868,7 @@ struct Chain *args; case 27: /* len of character string */ q = (expptr) cpexpr(((tagptr)args->datap)->headblock.vleng); frexpr((expptr)args->datap); - return(q); + return mkconv(tyioint, q); case 14: /* half-integer mod */ case 15: /* mod */ diff --git a/usr.bin/f2c/io.c b/usr.bin/f2c/io.c index 761876c..0e32f0e 100644 --- a/usr.bin/f2c/io.c +++ b/usr.bin/f2c/io.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1993, 1994 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,9 +35,18 @@ this software. extern int inqmask; -LOCAL void dofclose(), dofinquire(), dofinquire(), dofmove(), dofopen(), - doiolist(), ioset(), ioseta(), iosetc(), iosetip(), iosetlc(), - putio(), putiocall(); +static void dofclose Argdcl((void)); +static void dofinquire Argdcl((void)); +static void dofmove Argdcl((char*)); +static void dofopen Argdcl((void)); +static void doiolist Argdcl((chainp)); +static void ioset Argdcl((int, int, expptr)); +static void ioseta Argdcl((int, Addrp)); +static void iosetc Argdcl((int, expptr)); +static void iosetip Argdcl((int, int)); +static void iosetlc Argdcl((int, int, int)); +static void putio Argdcl((expptr, expptr)); +static void putiocall Argdcl((expptr)); iob_data *iob_list; Addrp io_structs[9]; @@ -277,9 +286,13 @@ LOCAL io_setup io_stuff[] = { #undef zork - + int +#ifdef KR_headers fmtstmt(lp) -register struct Labelblock *lp; + register struct Labelblock *lp; +#else +fmtstmt(register struct Labelblock *lp) +#endif { if(lp == NULL) { @@ -300,11 +313,16 @@ register struct Labelblock *lp; } + void +#ifdef KR_headers setfmt(lp) -struct Labelblock *lp; + struct Labelblock *lp; +#else +setfmt(struct Labelblock *lp) +#endif { - int n; - char *s0, *lexline(); + int n, parity; + char *s0; register char *s, *se, *t; register k; @@ -332,25 +350,37 @@ struct Labelblock *lp; /* fix MYQUOTES (\002's) and \\'s */ + parity = 1; while(s < se) switch(*s++) { case 2: - t += 3; break; + if ((parity ^= 1) && *s == 2) { + t -= 2; + ++s; + } + else + t += 3; + break; case '"': case '\\': t++; break; } s = s0; + parity = 1; if (lp) { lp->fmtstring = t = mem((int)(t - s + 1), 0); while(s < se) switch(k = *s++) { case 2: - t[0] = '\\'; - t[1] = '0'; - t[2] = '0'; - t[3] = '2'; - t += 4; + if ((parity ^= 1) && *s == 2) + s++; + else { + t[0] = '\\'; + t[1] = '0'; + t[2] = '0'; + t[3] = '2'; + t += 4; + } break; case '"': case '\\': @@ -365,8 +395,12 @@ struct Labelblock *lp; } - + void +#ifdef KR_headers startioctl() +#else +startioctl() +#endif { register int i; @@ -378,7 +412,7 @@ startioctl() } static long -newiolabel() { +newiolabel(Void) { long rv; rv = ++lastiolabno; skiplabel = mklabel(rv); @@ -386,8 +420,8 @@ newiolabel() { return rv; } - -endioctl() + void +endioctl(Void) { int i; expptr p; @@ -504,8 +538,8 @@ endioctl() } - -iocname() + int +iocname(Void) { register int i; int found, mask; @@ -534,9 +568,14 @@ iocname() } + void +#ifdef KR_headers ioclause(n, p) -register int n; -register expptr p; + register int n; + register expptr p; +#else +ioclause(register int n, register expptr p) +#endif { struct Ioclist *iocp; @@ -602,11 +641,14 @@ register expptr p; /* io list item */ + void +#ifdef KR_headers doio(list) -chainp list; + chainp list; +#else +doio(chainp list) +#endif { - expptr call0(); - if(ioformatted == NAMEDIRECTED) { if(list) @@ -616,7 +658,7 @@ chainp list; { doiolist(list); ioroutine[0] = 'e'; - if (skiplab || ioroutine[4] == 'l') + if (skiplab) jumplab = 0; putiocall( call0(TYINT, ioroutine) ); } @@ -627,14 +669,18 @@ chainp list; LOCAL void +#ifdef KR_headers doiolist(p0) - chainp p0; + chainp p0; +#else +doiolist(chainp p0) +#endif { chainp p; register tagptr q; register expptr qe; register Namep qn; - Addrp tp, mkscalar(); + Addrp tp; int range; extern char *ohalign; @@ -683,7 +729,6 @@ doiolist(p0) { if(iostmt == IOWRITE) { - ftnint lencat(); expptr qvl; qvl = NULL; if( ISCHAR(qe) ) @@ -723,9 +768,13 @@ doiolist(p0) }; LOCAL void +#ifdef KR_headers putio(nelt, addr) - expptr nelt; - register expptr addr; + expptr nelt; + register expptr addr; +#else +putio(expptr nelt, register expptr addr) +#endif { int type; register expptr q; @@ -775,11 +824,9 @@ putio(nelt, addr) - -endio() + void +endio(Void) { - extern void p1_label(); - if(skiplab) { if (ioformatted != NAMEDIRECTED) @@ -805,8 +852,12 @@ endio() LOCAL void +#ifdef KR_headers putiocall(q) - register expptr q; + register expptr q; +#else +putiocall(register expptr q) +#endif { int tyintsave; @@ -828,9 +879,13 @@ putiocall(q) } void +#ifdef KR_headers fmtname(np, q) - Namep np; - register Addrp q; + Namep np; + register Addrp q; +#else +fmtname(Namep np, register Addrp q) +#endif { register int k; register char *s, *t; @@ -852,8 +907,13 @@ fmtname(np, q) sprintf(t, "%s_fmt", s); } -LOCAL Addrp asg_addr(p) - union Expression *p; + LOCAL Addrp +#ifdef KR_headers +asg_addr(p) + union Expression *p; +#else +asg_addr(union Expression *p) +#endif { register Addrp q; @@ -870,14 +930,13 @@ LOCAL Addrp asg_addr(p) return q; } -startrw() + void +startrw(Void) { register expptr p; register Namep np; register Addrp unitp, fmtp, recp; register expptr nump; - Addrp mkscalar(); - expptr mkaddcon(); int iostmt1; flag intfile, sequential, ok, varfmt; struct io_setup *ios; @@ -1121,7 +1180,7 @@ endfmt: LOCAL void -dofopen() +dofopen(Void) { register expptr p; @@ -1155,7 +1214,7 @@ dofopen() LOCAL void -dofclose() +dofclose(Void) { register expptr p; @@ -1171,7 +1230,7 @@ dofclose() LOCAL void -dofinquire() +dofinquire(Void) { register expptr p; if(p = V(IOSUNIT)) @@ -1204,8 +1263,12 @@ dofinquire() LOCAL void +#ifdef KR_headers dofmove(subname) - char *subname; + char *subname; +#else +dofmove(char *subname) +#endif { register expptr p; @@ -1221,9 +1284,14 @@ dofmove(subname) static int ioset_assign = OPASSIGN; LOCAL void +#ifdef KR_headers ioset(type, offset, p) - int type, offset; - register expptr p; + int type; + int offset; + register expptr p; +#else +ioset(int type, int offset, register expptr p) +#endif { offset /= SZLONG; if(statstruct && ISCONST(p)) { @@ -1283,12 +1351,14 @@ ioset(type, offset, p) LOCAL void +#ifdef KR_headers iosetc(offset, p) - int offset; - register expptr p; + int offset; + register expptr p; +#else +iosetc(int offset, register expptr p) +#endif { - extern Addrp putchop(); - if(p == NULL) ioset(TYADDR, offset, ICON(0) ); else if(p->headblock.vtype == TYCHAR) { @@ -1302,9 +1372,13 @@ iosetc(offset, p) LOCAL void +#ifdef KR_headers ioseta(offset, p) - int offset; - register Addrp p; + int offset; + register Addrp p; +#else +ioseta(int offset, register Addrp p) +#endif { char *s, *s1; static char who[] = "ioseta"; @@ -1389,8 +1463,13 @@ ioseta(offset, p) LOCAL void +#ifdef KR_headers iosetip(i, offset) - int i, offset; + int i; + int offset; +#else +iosetip(int i, int offset) +#endif { register expptr p; @@ -1410,8 +1489,14 @@ iosetip(i, offset) LOCAL void +#ifdef KR_headers iosetlc(i, offp, offl) - int i, offp, offl; + int i; + int offp; + int offl; +#else +iosetlc(int i, int offp, int offl) +#endif { register expptr p; if( (p = V(i)) && p->headblock.vtype==TYCHAR) diff --git a/usr.bin/f2c/iob.h b/usr.bin/f2c/iob.h index 9f2269b..065d813 100644 --- a/usr.bin/f2c/iob.h +++ b/usr.bin/f2c/iob.h @@ -20,5 +20,7 @@ typedef struct defines defines; extern iob_data *iob_list; extern struct Addrblock *io_structs[9]; -extern void def_start(), new_iob_data(), other_undefs(); -extern char *tostring(); +void def_start Argdcl((FILEP, char*, char*, char*)); +void new_iob_data Argdcl((io_setup*, char*)); +void other_undefs Argdcl((FILEP)); +char* tostring Argdcl((char*, int)); diff --git a/usr.bin/f2c/lex.c b/usr.bin/f2c/lex.c index a9900be..0650e50 100644 --- a/usr.bin/f2c/lex.c +++ b/usr.bin/f2c/lex.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992 - 1995 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 @@ -52,7 +52,6 @@ this software. LOCAL int stkey; /* Type of the current statement (DO, END, IF, etc) */ -extern char token[]; /* holds the actual token text */ static int needwkey; ftnint yystno; flag intonly; @@ -96,8 +95,12 @@ typedef struct comment_buf { } comment_buf; static comment_buf *cbfirst, *cbcur; static char *cbinit, *cbnext, *cblast; -static void flush_comments(); +static void flush_comments Argdcl((void)); extern flag use_bs; +static char *lastfile = "??", *lastfile0 = "?"; +static char fbuf[P1_FILENAME_MAX]; +static long lastline; +static void putlineno(Void); /* Comment buffering data @@ -186,6 +189,7 @@ LOCAL struct Keylist keys[ ] = { "automatic", SAUTOMATIC, YES }, { "backspace", SBACKSPACE }, { "blockdata", SBLOCK }, + { "byte", SBYTE }, { "call", SCALL }, { "character", SCHARACTER, YES }, { "close", SCLOSE, YES }, @@ -237,12 +241,22 @@ LOCAL struct Keylist keys[ ] = { 0, 0 } }; -LOCAL void analyz(), crunch(), store_comment(); -LOCAL int getcd(), getcds(), getkwd(), gettok(); +static void analyz Argdcl((void)); +static void crunch Argdcl((void)); +static int getcd Argdcl((char*, int)); +static int getcds Argdcl((void)); +static int getkwd Argdcl((void)); +static int gettok Argdcl((void)); +static void store_comment Argdcl((char*)); LOCAL char *stbuf[3]; + int +#ifdef KR_headers inilex(name) -char *name; + char *name; +#else +inilex(char *name) +#endif { stbuf[0] = Alloc(3*P1_STMTBUFSIZE); stbuf[1] = stbuf[0] + P1_STMTBUFSIZE; @@ -257,15 +271,21 @@ char *name; /* throw away the rest of the current line */ -flline() + void +flline(Void) { lexstate = RETEOS; } -char *lexline(n) -int *n; + char * +#ifdef KR_headers +lexline(n) + int *n; +#else +lexline(int *n) +#endif { *n = (lastch - nextch) + 1; return(nextch); @@ -274,14 +294,20 @@ int *n; - + void +#ifdef KR_headers doinclude(name) -char *name; + char *name; +#else +doinclude(char *name) +#endif { FILEP fp; struct Inclfile *t; - char *lastslash, *s, *s0, *temp; - int k; + char *name0, *lastslash, *s, *s0, *temp; + int j, k; + chainp I; + extern chainp Iargs; if(inclp) { @@ -320,6 +346,7 @@ char *name; #endif ) lastslash = s; + name0 = name; if(lastslash) { k = lastslash - s0 + 1; temp = Alloc(k + strlen(name) + 1); @@ -328,15 +355,44 @@ char *name; name = temp; } fp = fopen(name, textread); + if (!fp && (I = Iargs)) { + k = strlen(name0) + 2; + for(; I; I = I->nextp) { + j = strlen(s = I->datap); + name = Alloc(j + k); + strcpy(name, s); + switch(s[j-1]) { + case '/': +#ifdef MSDOS + case ':': + case '\\': +#endif + break; + default: + name[j++] = '/'; + } + strcpy(name+j, name0); + if (fp = fopen(name, textread)) { + free(name0); + goto havefp; + } + free(name); + name = name0; + } + } } if (fp) { + havefp: t = inclp; inclp = ALLOC(Inclfile); inclp->inclnext = t; prevlin = thislin = 0; infname = inclp->inclname = name; infile = inclp->inclfp = fp; + lastline = 0; + putlineno(); + lastline = 0; } else { @@ -348,7 +404,8 @@ char *name; -LOCAL popinclude() + LOCAL int +popinclude(Void) { struct Inclfile *t; register char *p; @@ -369,11 +426,14 @@ LOCAL popinclude() infile = inclp->inclfp; infname = inclp->inclname; - prevlin = thislin = inclp->incllno; + lineno = prevlin = thislin = inclp->incllno; code = inclp->inclcode; stno = nxtstno = inclp->inclstno; if(inclp->incllinp) { + lastline = 0; + putlineno(); + lastline = lineno; endcd = nextcd = sbuf; k = inclp->incllen; p = inclp->incllinp; @@ -387,11 +447,13 @@ LOCAL popinclude() } -static char *lastfile = "??", *lastfile0 = "?"; -static char fbuf[P1_FILENAME_MAX]; - -void p1_line_number (line_number) -long line_number; + void +#ifdef KR_headers +p1_line_number(line_number) + long line_number; +#else +p1_line_number(long line_number) +#endif { if (lastfile != lastfile0) { p1puts(P1_FILENAME, fbuf); @@ -401,9 +463,8 @@ long line_number; } static void -putlineno() +putlineno(Void) { - static long lastline; extern int gflag; register char *s0, *s1; @@ -434,8 +495,8 @@ putlineno() } } - -yylex() + int +yylex(Void) { static int tokno; int retval; @@ -500,7 +561,7 @@ reteos: } LOCAL void -contmax() +contmax(Void) { lineno = thislin; many("continuation lines", 'C', maxcontin); @@ -512,7 +573,7 @@ contmax() merged into one long card (hence the size of the buffer named sbuf) */ LOCAL int -getcds() +getcds(Void) { register char *p, *q; @@ -577,9 +638,17 @@ top: } static void -bang(a,b,c,d,e) /* save ! comments */ - char *a, *b, *c; - register char *d, *e; +#ifdef KR_headers +bang(a, b, c, d, e) + char *a; + char *b; + char *c; + register char *d; + register char *e; +#else +bang(char *a, char *b, char *c, register char *d, register char *e) +#endif + /* save ! comments */ { char buf[COMMENT_BUFFER_SIZE + 1]; register char *p, *pe; @@ -614,8 +683,13 @@ bang(a,b,c,d,e) /* save ! comments */ It assumes that b points to currently empty storage somewhere in sbuf */ LOCAL int +#ifdef KR_headers getcd(b, nocont) - register char *b; + register char *b; + int nocont; +#else +getcd(register char *b, int nocont) +#endif { register int c; register char *p, *bend; @@ -685,7 +759,7 @@ top: } if (*p < '1' || *p > '9') goto bad_cpp; - L = *p - '1'; /* bias down 1 */ + L = *p - '0'; while((c = *++p) >= '0' && c <= '9') L = 10*L + c - '0'; if (c != ' ' || *++p != '"') @@ -696,10 +770,11 @@ top: goto bad_cpp; *p = 0; i = p - bend++; - thislin = L; + thislin = L - 1; if (!infname || strcmp(infname, bend)) { if (infname) free(infname); + lastfile = 0; infname = Alloc(i); strcpy(infname, bend); if (inclp) @@ -892,6 +967,8 @@ initcheck: goto top; initline: + if (!lastline) + lastline = thislin; if (addftnsrc) { nst = (nst+1)%3; if (!laststb && stb0) @@ -934,12 +1011,27 @@ initline: return(STINITIAL); } + LOCAL void +#ifdef KR_headers +adjtoklen(newlen) + int newlen; +#else +adjtoklen(int newlen) +#endif +{ + while(maxtoklen < newlen) + maxtoklen = 2*maxtoklen + 2; + if (token = (char *)realloc(token, maxtoklen)) + return; + fprintf(stderr, "adjtoklen: realloc(%d) failure!\n", maxtoklen); + exit(2); + } /* crunch -- deletes all space characters, folds the backslash chars and Hollerith strings, quotes the Fortran strings */ LOCAL void -crunch() +crunch(Void) { register char *i, *j, *j0, *j1, *prvstr; int k, ten, nh, nh0, quote; @@ -992,14 +1084,12 @@ crunch() ++i; *i = escapes[*(unsigned char *)i]; } - if (len < MAXTOKENLEN) - *++j = *i; - else if (len == MAXTOKENLEN) - erri - ("String too long, truncating to %d chars", MAXTOKENLEN); + *++j = *i; len++; } /* for (;;) */ + if ((len = j - sbuf) > maxtoklen) + adjtoklen(len); j[1] = MYQUOTE; j += 2; prvstr = j; @@ -1029,14 +1119,14 @@ crunch() && *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.') goto copychar; nh0 = nh; - if(i+nh > lastch || nh > MAXTOKENLEN) + if(i+nh > lastch) { erri("%dH too big", nh); nh = lastch - i; - if (nh > MAXTOKENLEN) - nh = MAXTOKENLEN; nh0 = -1; } + if (nh > maxtoklen) + adjtoklen(nh); j0[1] = MYQUOTE; /* special marker */ j = j0 + 1; while(nh-- > 0) @@ -1076,7 +1166,7 @@ copychar: /*not a string or space -- copy, shifting case if necessary */ } LOCAL void -analyz() +analyz(Void) { register char *i; @@ -1150,7 +1240,7 @@ analyz() LOCAL int -getkwd() +getkwd(Void) { register char *i, *j; register struct Keylist *pk, *pend; @@ -1178,7 +1268,8 @@ getkwd() return(SUNKNOWN); } -initkey() + void +initkey(Void) { register struct Keylist *p; register int i,j; @@ -1212,8 +1303,12 @@ initkey() } LOCAL int +#ifdef KR_headers hexcheck(key) - int key; + int key; +#else +hexcheck(int key) +#endif { register int radix; register char *p; @@ -1256,9 +1351,9 @@ hexcheck(key) buffer. token initially contains garbage (leftovers from the prev token) */ LOCAL int -gettok() +gettok(Void) { -int havdot, havexp, havdbl; + int havdot, havexp, havdbl; int radix, val; struct Punctlist *pp; struct Dotlist *pd; @@ -1499,8 +1594,12 @@ badchar: /* Comment buffering code */ static void +#ifdef KR_headers store_comment(str) - char *str; + char *str; +#else +store_comment(char *str) +#endif { int len; comment_buf *ncb; @@ -1533,7 +1632,7 @@ store_comment(str) } static void -flush_comments() +flush_comments(Void) { register char *s, *s1; register comment_buf *cb; @@ -1556,7 +1655,7 @@ flush_comments() } void -unclassifiable() +unclassifiable(Void) { register char *s, *se; diff --git a/usr.bin/f2c/main.c b/usr.bin/f2c/main.c index 899e955..d3d1417c 100644 --- a/usr.bin/f2c/main.c +++ b/usr.bin/f2c/main.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1994 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 @@ -52,7 +52,6 @@ flag use_tyquad = YES; #endif int tyreal = TYREAL; int tycomplex = TYCOMPLEX; -extern void r8fix(), read_Pfiles(); int maxregvar = MAXREGVAR; /* if maxregvar > MAXREGVAR, error */ int maxequiv = MAXEQUIV; @@ -95,17 +94,15 @@ char *halign, *ohalign; int krparens = NO; int hsize; /* for padding under -h */ int htype; /* for wr_equiv_init under -h */ -char *o_coutput = 0; +chainp Iargs; #define f2c_entry(swit,count,type,store,size) \ p_entry ("-", swit, 0, count, type, store, size) static arg_info table[] = { - f2c_entry ("o", P_ONE_ARG, P_STRING, &o_coutput, YES), f2c_entry ("w66", P_NO_ARGS, P_INT, &ftn66flag, YES), f2c_entry ("w", P_NO_ARGS, P_INT, &nowarnflag, YES), f2c_entry ("66", P_NO_ARGS, P_INT, &no66flag, YES), - f2c_entry ("d", P_ONE_ARG, P_INT, &debugflag, YES), f2c_entry ("1", P_NO_ARGS, P_INT, &onetripflag, YES), f2c_entry ("onetrip", P_NO_ARGS, P_INT, &onetripflag, YES), f2c_entry ("I2", P_NO_ARGS, P_INT, &useshortints, YES), @@ -155,6 +152,7 @@ static arg_info table[] = { f2c_entry ("72", P_NO_ARGS, P_INT, &warn72, 1), 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), #ifdef TYQUAD f2c_entry ("!i8", P_NO_ARGS, P_INT, &use_tyquad, NO), #endif @@ -181,8 +179,11 @@ static arg_info table[] = { /* -!V ==> omit version msg (to facilitate using diff in regression testing) */ - f2c_entry ("!V", P_NO_ARGS, P_INT, &skipversion, 1) + f2c_entry ("!V", P_NO_ARGS, P_INT, &skipversion, 1), + /* -Dnnn = debug level nnn */ + + f2c_entry ("D", P_ONE_ARG, P_INT, &debugflag, YES) }; /* table */ extern char *c_functions; /* "c_functions" */ @@ -195,11 +196,8 @@ extern char *sortfname; /* "init_file" */ extern char *proto_fname; /* "proto_file" */ FILE *protofile; -extern void list_init_data(), set_tmp_names(), sigcatch(), Un_link_all(); -extern char *c_name(); - - -set_externs () + void +set_externs(Void) { static char *hset[3] = { 0, "integer", "doublereal" }; @@ -226,16 +224,16 @@ set_externs () tyioint = TYSHORT; szleng = typesize[TYSHORT]; def_i2 = "#define f2c_i2 1\n"; - inqmask = M(TYSHORT)|M(TYLOGICAL); + inqmask = M(TYSHORT)|M(TYLOGICAL2); goto checklong; } else szleng = typesize[TYLONG]; if (useshortints) { - inqmask = M(TYLONG); + /* inqmask = M(TYLONG); */ + /* used to disallow LOGICAL in INQUIRE under -I2 */ checklong: - protorettypes[TYLOGICAL] = typename[TYLOGICAL] = "shortlogical"; - typesize[TYLOGICAL] = typesize[TYSHORT]; + protorettypes[TYLOGICAL] = "shortlogical"; casttypes[TYLOGICAL] = "K_fp"; if (uselongints) err ("Can't use both long and short ints"); @@ -293,7 +291,7 @@ set_externs () static int -comm2dcl() +comm2dcl(Void) { Extsym *ext; if (ext1comm) @@ -304,8 +302,12 @@ comm2dcl() } static void +#ifdef KR_headers write_typedefs(outfile) - FILE *outfile; + FILE *outfile; +#else +write_typedefs(FILE *outfile) +#endif { register int i; register char *s, *p = 0; @@ -340,8 +342,12 @@ write_typedefs(outfile) } static void +#ifdef KR_headers commonprotos(outfile) - register FILE *outfile; + register FILE *outfile; +#else +commonprotos(register FILE *outfile) +#endif { register Extsym *e, *ee; register Argtypes *at; @@ -400,28 +406,64 @@ commonprotos(outfile) } } + static int +#ifdef KR_headers +I_args(argc, a) + int argc; + char **a; +#else +I_args(int argc, char **a) +#endif +{ + char **a0, **a1, **ae, *s; + + ae = a + argc; + a0 = a; + for(a1 = ++a; a < ae; a++) { + if (!(s = *a)) + break; + if (*s == '-' && s[1] == 'I' && s[2] + && (s[3] || s[2] != '2' && s[2] != '4')) + Iargs = mkchain(s+2, Iargs); + else + *a1++ = s; + } + Iargs = revchain(Iargs); + *a1 = 0; + return a1 - a0; + } + int retcode = 0; + int +#ifdef KR_headers main(argc, argv) -int argc; -char **argv; + int argc; + char **argv; +#else +main(int argc, char **argv) +#endif { int c2d, k; FILE *c_output; char *cdfilename; static char stderrbuf[BUFSIZ]; - extern void def_commons(); extern char **dfltproc, *dflt1proc[]; extern char link_msg[]; diagfile = stderr; setbuf(stderr, stderrbuf); /* arrange for fast error msgs */ + argc = I_args(argc, argv); /* extract -I args */ Max_ftn_files = argc - 1; ftn_files = (char **)ckalloc((argc+1)*sizeof(char *)); parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info), ftn_files, Max_ftn_files); + if (keepsubs && checksubs) { + warn("-C suppresses -s\n"); + keepsubs = 0; + } if (!can_include && ext1comm == 2) ext1comm = 1; if (ext1comm && !extcomm) @@ -438,6 +480,7 @@ char **argv; else dfltproc = dflt1proc; + outbuf_adjust(); set_externs(); fileinit(); read_Pfiles(ftn_files); @@ -448,27 +491,21 @@ char **argv; filename0 = file_name = ftn_files[current_ftn_file = k - 1]; set_tmp_names(); - sigcatch(); + sigcatch(0); c_file = opf(c_functions, textwrite); 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; + coutput = c_name(file_name,'c'); + cdfilename = copys(outbtail); if (Castargs1 >= 2) proto_fname = c_name(file_name,'P'); } - cdfilename = coutput; if (skipC) 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 */ @@ -575,11 +612,18 @@ sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | / endproc(); } done(nerr ? 1 : 0); + /* NOT REACHED */ return 0; } -FILEP opf(fn, mode) -char *fn, *mode; + FILEP +#ifdef KR_headers +opf(fn, mode) + char *fn; + char *mode; +#else +opf(char *fn, char *mode) +#endif { FILEP fp; if( fp = fopen(fn, mode) ) @@ -590,10 +634,15 @@ char *fn, *mode; } + void +#ifdef KR_headers clf(p, what, quit) - FILEP *p; - char *what; - int quit; + FILEP *p; + char *what; + int quit; +#else +clf(FILEP *p, char *what, int quit) +#endif { if(p!=NULL && *p!=NULL && *p!=stdout) { @@ -609,8 +658,13 @@ clf(p, what, quit) } + void +#ifdef KR_headers done(k) -int k; + int k; +#else +done(int k) +#endif { clf(&initfile, "initfile", 0); clf(&c_file, "c_file", 0); diff --git a/usr.bin/f2c/malloc.c b/usr.bin/f2c/malloc.c index e4414da..85bc5e3 100644 --- a/usr.bin/f2c/malloc.c +++ b/usr.bin/f2c/malloc.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1994 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 @@ -24,84 +24,103 @@ this software. #ifndef CRAY #define STACKMIN 512 #define MINBLK (2*sizeof(struct mem) + 16) -#define MSTUFF _malloc_stuff_ -#define F MSTUFF.free -#define B MSTUFF.busy +#define F _malloc_free_ #define SBGULP 8192 -char *memcpy(); +#include "string.h" /* for memcpy */ -struct mem { +#ifdef KR_headers +#define Char char +#define Unsigned unsigned +#define Int /*int*/ +#else +#define Char void +#define Unsigned size_t +#define Int int +#endif + +typedef struct mem { struct mem *next; - unsigned len; - }; + Unsigned len; + } mem; -struct { - struct mem *free; - char *busy; - } MSTUFF; +mem *F; -char * + Char * +#ifdef KR_headers malloc(size) -register unsigned size; + register Unsigned size; +#else +malloc(register Unsigned size) +#endif { - register struct mem *p, *q, *r, *s; + register mem *p, *q, *r, *s; unsigned register k, m; - extern char *sbrk(); + extern Char *sbrk(Int); char *top, *top1; size = (size+7) & ~7; - r = (struct mem *) &F; + r = (mem *) &F; for (p = F, q = 0; p; r = p, p = p->next) { - if ((k = p->len) >= size && (!q || m > k)) { m = k; q = p; s = r; } + if ((k = p->len) >= size && (!q || m > k)) { + m = k; + q = p; + s = r; + } } if (q) { if (q->len - size >= MINBLK) { /* split block */ - p = (struct mem *) (((char *) (q+1)) + size); + p = (mem *) (((char *) (q+1)) + size); p->next = q->next; - p->len = q->len - size - sizeof(struct mem); + p->len = q->len - size - sizeof(mem); s->next = p; q->len = size; } - else s->next = q->next; + else + s->next = q->next; } else { - top = B ? B : (char *)(((long)sbrk(0) + 7) & ~7); - if (F && (char *)(F+1) + F->len == B) - { q = F; F = F->next; } - else q = (struct mem *) top; - top1 = (char *)(q+1) + size; - if (top1 > top) { - if (sbrk((int)(top1-top+SBGULP)) == (char *) -1) - return 0; - r = (struct mem *)top1; - r->len = SBGULP - sizeof(struct mem); - r->next = F; - F = r; - top1 += SBGULP; + top = (Char *)(((long)sbrk(0) + 7) & ~7); + if (F && (char *)(F+1) + F->len == top) { + q = F; + F = F->next; } + else + q = (mem *) top; + top1 = (char *)(q+1) + size; + if (sbrk((int)(top1-top+SBGULP)) == (Char *) -1) + return 0; + r = (mem *)top1; + r->len = SBGULP - sizeof(mem); + r->next = F; + F = r; + top1 += SBGULP; q->len = size; - B = top1; } - return (char *) (q+1); + return (Char *) (q+1); } + void +#ifdef KR_headers free(f) -char *f; + Char *f; +#else +free(Char *f) +#endif { - struct mem *p, *q, *r; + mem *p, *q, *r; char *pn, *qn; if (!f) return; - q = (struct mem *) (f - sizeof(struct mem)); - qn = f + q->len; - for (p = F, r = (struct mem *) &F; ; r = p, p = p->next) { - if (qn == (char *) p) { - q->len += p->len + sizeof(struct mem); + q = (mem *) ((char *)f - sizeof(mem)); + qn = (char *)f + q->len; + for (p = F, r = (mem *) &F; ; r = p, p = p->next) { + if (qn == (Char *) p) { + q->len += p->len + sizeof(mem); p = p->next; } pn = p ? ((char *) (p+1)) + p->len : 0; - if (pn == (char *) q) { - p->len += sizeof(struct mem) + q->len; + if (pn == (Char *) q) { + p->len += sizeof(mem) + q->len; q->len = 0; q->next = p; r->next = p; @@ -115,22 +134,27 @@ char *f; } } -char * + Char * +#ifdef KR_headers realloc(f, size) -char *f; -unsigned size; + Char *f; + Unsigned size; +#else +realloc(Char *f, Unsigned size) +#endif { - struct mem *p; - char *q, *f1; - unsigned s1; + mem *p; + Char *q, *f1; + Unsigned s1; if (!f) return malloc(size); - p = (struct mem *) (f - sizeof(struct mem)); + p = (mem *) ((char *)f - sizeof(mem)); s1 = p->len; free(f); - if (s1 > size) s1 = size + 7 & ~7; + if (s1 > size) + s1 = size + 7 & ~7; if (!p->len) { - f1 = (char *)(p->next + 1); + f1 = (Char *)(p->next + 1); memcpy(f1, f, s1); f = f1; } diff --git a/usr.bin/f2c/mem.c b/usr.bin/f2c/mem.c index 940e9c1..b8fc123 100644 --- a/usr.bin/f2c/mem.c +++ b/usr.bin/f2c/mem.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1994 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 @@ -27,11 +27,14 @@ this software. #define MEMBSIZE 32000 #define GMEMBSIZE 16000 - extern void exit(); - char * +#ifdef KR_headers gmem(n, round) - int n, round; + int n; + int round; +#else +gmem(int n, int round) +#endif { static char *last, *next; char *rv; @@ -70,7 +73,7 @@ gmem(n, round) char *mem_first, *mem_next, *mem_last, *mem0_last; void -mem_init() +mem_init(Void) { curmemblock = firstmemblock = mem0 = (memblock *)Alloc(sizeof(memblock)); @@ -82,8 +85,13 @@ mem_init() } char * +#ifdef KR_headers mem(n, round) - int n, round; + int n; + int round; +#else +mem(int n, int round) +#endif { memblock *b; register char *rv, *s; @@ -123,9 +131,13 @@ mem(n, round) } char * -tostring(s,n) - register char *s; - int n; +#ifdef KR_headers +tostring(s, n) + register char *s; + int n; +#else +tostring(register char *s, int n) +#endif { register char *s1, *se, **sf; char *rv, *s0; @@ -154,16 +166,24 @@ tostring(s,n) } char * +#ifdef KR_headers cpstring(s) - register char *s; + register char *s; +#else +cpstring(register char *s) +#endif { return strcpy(mem(strlen(s)+1,0), s); } void +#ifdef KR_headers new_iob_data(ios, name) - register io_setup *ios; - char *name; + register io_setup *ios; + char *name; +#else +new_iob_data(register io_setup *ios, char *name) +#endif { register iob_data *iod; register char **s, **se; @@ -182,9 +202,13 @@ new_iob_data(ios, name) } char * +#ifdef KR_headers string_num(pfx, n) - char *pfx; - long n; + char *pfx; + long n; +#else +string_num(char *pfx, long n) +#endif { char buf[32]; sprintf(buf, "%s%ld", pfx, n); @@ -195,9 +219,15 @@ string_num(pfx, n) static defines *define_list; void +#ifdef KR_headers def_start(outfile, s1, s2, post) - FILE *outfile; - char *s1, *s2, *post; + FILE *outfile; + char *s1; + char *s2; + char *post; +#else +def_start(FILE *outfile, char *s1, char *s2, char *post) +#endif { defines *d; int n, n1; @@ -219,8 +249,12 @@ def_start(outfile, s1, s2, post) } void +#ifdef KR_headers other_undefs(outfile) - FILE *outfile; + FILE *outfile; +#else +other_undefs(FILE *outfile) +#endif { defines *d; if (d = define_list) { diff --git a/usr.bin/f2c/misc.c b/usr.bin/f2c/misc.c index d8ad3cf..bfaeb8a74 100644 --- a/usr.bin/f2c/misc.c +++ b/usr.bin/f2c/misc.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992 - 1995 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 @@ -22,10 +22,17 @@ this software. ****************************************************************/ #include "defs.h" - -int oneof_stg (name, stg, mask) - Namep name; - int stg, mask; +#include "limits.h" + + int +#ifdef KR_headers +oneof_stg(name, stg, mask) + Namep name; + int stg; + int mask; +#else +oneof_stg(Namep name, int stg, int mask) +#endif { if (stg == STGCOMMON && name) { if ((mask & M(STGEQUIV))) @@ -40,8 +47,13 @@ int oneof_stg (name, stg, mask) /* op_assign -- given a binary opcode, return the associated assignment operator */ -int op_assign (opcode) -int opcode; + int +#ifdef KR_headers +op_assign(opcode) + int opcode; +#else +op_assign(int opcode) +#endif { int retval = -1; @@ -66,9 +78,14 @@ int opcode; char * -Alloc(n) /* error-checking version of malloc */ +#ifdef KR_headers +Alloc(n) + int n; +#else +Alloc(int n) +#endif + /* error-checking version of malloc */ /* ckalloc initializes memory to 0; Alloc does not */ - int n; { char errbuf[32]; register char *rv; @@ -81,20 +98,30 @@ Alloc(n) /* error-checking version of malloc */ return rv; } - + void +#ifdef KR_headers cpn(n, a, b) -register int n; -register char *a, *b; + register int n; + register char *a; + register char *b; +#else +cpn(register int n, register char *a, register char *b) +#endif { while(--n >= 0) *b++ = *a++; } - + int +#ifdef KR_headers eqn(n, a, b) -register int n; -register char *a, *b; + register int n; + register char *a; + register char *b; +#else +eqn(register int n, register char *a, register char *b) +#endif { while(--n >= 0) if(*a++ != *b++) @@ -107,10 +134,17 @@ register char *a, *b; - -cmpstr(a, b, la, lb) /* compare two strings */ -register char *a, *b; -ftnint la, lb; + int +#ifdef KR_headers +cmpstr(a, b, la, lb) + register char *a; + register char *b; + ftnint la; + ftnint lb; +#else +cmpstr(register char *a, register char *b, ftnint la, ftnint lb) +#endif + /* compare two strings */ { register char *aend, *bend; aend = a + la; @@ -157,8 +191,14 @@ ftnint la, lb; /* hookup -- Same as LISP NCONC, that is a destructive append of two lists */ -chainp hookup(x,y) -register chainp x, y; + chainp +#ifdef KR_headers +hookup(x, y) + register chainp x; + register chainp y; +#else +hookup(register chainp x, register chainp y) +#endif { register chainp p; @@ -173,8 +213,13 @@ register chainp x, y; -struct Listblock *mklist(p) -chainp p; + struct Listblock * +#ifdef KR_headers +mklist(p) + chainp p; +#else +mklist(chainp p) +#endif { register struct Listblock *q; @@ -185,9 +230,14 @@ chainp p; } -chainp mkchain(p,q) -register char * p; -register chainp q; + chainp +#ifdef KR_headers +mkchain(p, q) + register char * p; + register chainp q; +#else +mkchain(register char * p, register chainp q) +#endif { register chainp r; @@ -205,8 +255,12 @@ register chainp q; } chainp +#ifdef KR_headers revchain(next) - register chainp next; + register chainp next; +#else +revchain(register chainp next) +#endif { register chainp p, prev = 0; @@ -224,31 +278,42 @@ revchain(next) /* if not, it has room for appending an _. */ char * +#ifdef KR_headers addunder(s) - register char *s; + register char *s; +#else +addunder(register char *s) +#endif { - register int c, i; + register int c, i, j; char *s0 = s; - i = 0; + i = j = 0; while(c = *s++) if (c == '_') - i++; + i++, j++; else i = 0; if (!i) { *s-- = 0; *s = '_'; } + else if (j == 2) + s[-2] = 0; return( s0 ); } /* copyn -- return a new copy of the input Fortran-string */ -char *copyn(n, s) -register int n; -register char *s; + char * +#ifdef KR_headers +copyn(n, s) + register int n; + register char *s; +#else +copyn(register int n, register char *s) +#endif { register char *p, *q; @@ -262,8 +327,13 @@ register char *s; /* copys -- return a new copy of the input C-string */ -char *copys(s) -char *s; + char * +#ifdef KR_headers +copys(s) + char *s; +#else +copys(char *s) +#endif { return( copyn( strlen(s)+1 , s) ); } @@ -273,21 +343,51 @@ char *s; /* convci -- Convert Fortran-string to integer; assumes that input is a legal number, with no trailing blanks */ -ftnint convci(n, s) -register int n; -register char *s; + ftnint +#ifdef KR_headers +convci(n, s) + register int n; + register char *s; +#else +convci(register int n, register char *s) +#endif { - ftnint sum; + ftnint sum, t; + char buff[100], *s0; + int n0; + + s0 = s; + n0 = n; sum = 0; - while(n-- > 0) - sum = 10*sum + (*s++ - '0'); + while(n-- > 0) { + /* sum = 10*sum + (*s++ - '0'); */ + t = *s++ - '0'; + if (sum > LONG_MAX/10) { + ovfl: + if (n0 > 60) + n0 = 60; + sprintf(buff, "integer constant %.*s truncated.", + n0, s0); + err(buff); + return LONG_MAX; + } + sum *= 10; + if (sum > LONG_MAX - t) + goto ovfl; + sum += t; + } return(sum); -} + } /* convic - Convert Integer constant to string */ -char *convic(n) -ftnint n; + char * +#ifdef KR_headers +convic(n) + ftnint n; +#else +convic(ftnint n) +#endif { static char s[20]; register char *t; @@ -308,8 +408,13 @@ ftnint n; /* mkname -- add a new identifier to the environment, including the closed hash table. */ -Namep mkname(s) -register char *s; + Namep +#ifdef KR_headers +mkname(s) + register char *s; +#else +mkname(register char *s) +#endif { struct Hashentry *hp; register Namep q; @@ -326,7 +431,7 @@ register char *s; i = 2; } if (!i && in_vector(s0,c_keywords,n_keywords) >= 0) - i = 1; + i = 2; hash %= maxhash; /* Add the name to the closed hash table */ @@ -365,8 +470,13 @@ register char *s; } -struct Labelblock *mklabel(l) -ftnint l; + struct Labelblock * +#ifdef KR_headers +mklabel(l) + ftnint l; +#else +mklabel(ftnint l) +#endif { register struct Labelblock *lp; @@ -393,7 +503,8 @@ ftnint l; } -newlabel() + int +newlabel(Void) { return( ++lastlabno ); } @@ -401,8 +512,13 @@ newlabel() /* this label appears in a branch context */ -struct Labelblock *execlab(stateno) -ftnint stateno; + struct Labelblock * +#ifdef KR_headers +execlab(stateno) + ftnint stateno; +#else +execlab(ftnint stateno) +#endif { register struct Labelblock *lp; @@ -427,8 +543,14 @@ ftnint stateno; /* find or put a name in the external symbol table */ -Extsym *mkext(f,s) -char *f, *s; + Extsym * +#ifdef KR_headers +mkext1(f, s) + char *f; + char *s; +#else +mkext1(char *f, char *s) +#endif { Extsym *p; @@ -454,9 +576,30 @@ char *f, *s; } -Addrp builtin(t, s, dbi) -int t, dbi; -char *s; + Extsym * +#ifdef KR_headers +mkext(f, s) + char *f; + char *s; +#else +mkext(char *f, char *s) +#endif +{ + Extsym *e = mkext1(f, s); + if (e->extstg == STGCOMMON) + errstr("%.52s cannot be a subprogram: it is a common block.",f); + return e; + } + + Addrp +#ifdef KR_headers +builtin(t, s, dbi) + int t; + char *s; + int dbi; +#else +builtin(int t, char *s, int dbi) +#endif { register Extsym *p; register Addrp q; @@ -492,10 +635,14 @@ char *s; } - -add_extern_to_list (addr, list_store) -Addrp addr; -chainp *list_store; + void +#ifdef KR_headers +add_extern_to_list(addr, list_store) + Addrp addr; + chainp *list_store; +#else +add_extern_to_list(Addrp addr, chainp *list_store) +#endif { chainp last = CHNULL; chainp list; @@ -523,8 +670,13 @@ chainp *list_store; } /* add_extern_to_list */ + void +#ifdef KR_headers frchain(p) -register chainp *p; + register chainp *p; +#else +frchain(register chainp *p) +#endif { register chainp q; @@ -539,8 +691,12 @@ register chainp *p; } void +#ifdef KR_headers frexchain(p) - register chainp *p; + register chainp *p; +#else +frexchain(register chainp *p) +#endif { register chainp q, r; @@ -557,9 +713,14 @@ frexchain(p) } -tagptr cpblock(n,p) -register int n; -register char * p; + tagptr +#ifdef KR_headers +cpblock(n, p) + register int n; + register char *p; +#else +cpblock(register int n, register char *p) +#endif { register ptr q; @@ -569,14 +730,26 @@ register char * p; -ftnint lmax(a, b) -ftnint a, b; + ftnint +#ifdef KR_headers +lmax(a, b) + ftnint a; + ftnint b; +#else +lmax(ftnint a, ftnint b) +#endif { return( a>b ? a : b); } -ftnint lmin(a, b) -ftnint a, b; + ftnint +#ifdef KR_headers +lmin(a, b) + ftnint a; + ftnint b; +#else +lmin(ftnint a, ftnint b) +#endif { return(a < b ? a : b); } @@ -584,8 +757,13 @@ ftnint a, b; +#ifdef KR_headers maxtype(t1, t2) -int t1, t2; + int t1; + int t2; +#else +maxtype(int t1, int t2) +#endif { int t; @@ -598,8 +776,13 @@ int t1, t2; /* return log base 2 of n if n a power of 2; otherwise -1 */ + int +#ifdef KR_headers log_2(n) -ftnint n; + ftnint n; +#else +log_2(ftnint n) +#endif { int k; @@ -614,8 +797,8 @@ ftnint n; } - -frrpl() + void +frrpl(Void) { struct Rplblock *rp; @@ -633,10 +816,15 @@ frrpl() int callk_kludge; -expptr callk(type, name, args) -int type; -char *name; -chainp args; + expptr +#ifdef KR_headers +callk(type, name, args) + int type; + char *name; + chainp args; +#else +callk(int type, char *name, chainp args) +#endif { register expptr p; @@ -649,10 +837,18 @@ chainp args; -expptr call4(type, name, arg1, arg2, arg3, arg4) -int type; -char *name; -expptr arg1, arg2, arg3, arg4; + expptr +#ifdef KR_headers +call4(type, name, arg1, arg2, arg3, arg4) + int type; + char *name; + expptr arg1; + expptr arg2; + expptr arg3; + expptr arg4; +#else +call4(int type, char *name, expptr arg1, expptr arg2, expptr arg3, expptr arg4) +#endif { struct Listblock *args; args = mklist( mkchain((char *)arg1, @@ -665,10 +861,17 @@ expptr arg1, arg2, arg3, arg4; -expptr call3(type, name, arg1, arg2, arg3) -int type; -char *name; -expptr arg1, arg2, arg3; + expptr +#ifdef KR_headers +call3(type, name, arg1, arg2, arg3) + int type; + char *name; + expptr arg1; + expptr arg2; + expptr arg3; +#else +call3(int type, char *name, expptr arg1, expptr arg2, expptr arg3) +#endif { struct Listblock *args; args = mklist( mkchain((char *)arg1, @@ -681,10 +884,16 @@ expptr arg1, arg2, arg3; -expptr call2(type, name, arg1, arg2) -int type; -char *name; -expptr arg1, arg2; + expptr +#ifdef KR_headers +call2(type, name, arg1, arg2) + int type; + char *name; + expptr arg1; + expptr arg2; +#else +call2(int type, char *name, expptr arg1, expptr arg2) +#endif { struct Listblock *args; @@ -695,26 +904,42 @@ expptr arg1, arg2; -expptr call1(type, name, arg) -int type; -char *name; -expptr arg; + expptr +#ifdef KR_headers +call1(type, name, arg) + int type; + char *name; + expptr arg; +#else +call1(int type, char *name, expptr arg) +#endif { return( callk(type,name, (chainp)mklist(mkchain((char *)arg,CHNULL)) )); } -expptr call0(type, name) -int type; -char *name; + expptr +#ifdef KR_headers +call0(type, name) + int type; + char *name; +#else +call0(int type, char *name) +#endif { return( callk(type, name, CHNULL) ); } -struct Impldoblock *mkiodo(dospec, list) -chainp dospec, list; + struct Impldoblock * +#ifdef KR_headers +mkiodo(dospec, list) + chainp dospec; + chainp list; +#else +mkiodo(chainp dospec, chainp list) +#endif { register struct Impldoblock *q; @@ -731,8 +956,13 @@ chainp dospec, list; /* ckalloc -- Allocate 1 memory unit of size n, checking for out of memory error */ -ptr ckalloc(n) -register int n; + ptr +#ifdef KR_headers +ckalloc(n) + register int n; +#else +ckalloc(register int n) +#endif { register ptr p; p = (ptr)calloc(1, (unsigned) n); @@ -744,9 +974,13 @@ register int n; } - + int +#ifdef KR_headers isaddr(p) -register expptr p; + register expptr p; +#else +isaddr(register expptr p) +#endif { if(p->tag == TADDR) return(YES); @@ -774,9 +1008,13 @@ register expptr p; - + int +#ifdef KR_headers isstatic(p) -register expptr p; + register expptr p; +#else +isstatic(register expptr p) +#endif { extern int useauto; if(p->headblock.vleng && !ISCONST(p->headblock.vleng)) @@ -802,8 +1040,13 @@ register expptr p; /* addressable -- return True iff it is a constant value, or can be referenced by constant values */ + int +#ifdef KR_headers addressable(p) -register expptr p; + register expptr p; +#else +addressable(register expptr p) +#endif { switch(p->tag) { @@ -822,8 +1065,13 @@ register expptr p; /* isnegative_const -- returns true if the constant is negative. Returns false for imaginary and nonnumeric constants */ -int isnegative_const (cp) -struct Constblock *cp; + int +#ifdef KR_headers +isnegative_const(cp) + struct Constblock *cp; +#else +isnegative_const(struct Constblock *cp) +#endif { int retval; @@ -853,8 +1101,13 @@ struct Constblock *cp; return retval; } /* isnegative_const */ + void +#ifdef KR_headers negate_const(cp) - Constp cp; + Constp cp; +#else +negate_const(Constp cp) +#endif { if (cp == (struct Constblock *) NULL) return; @@ -911,8 +1164,14 @@ negate_const(cp) } /* switch */ } /* negate_const */ -ffilecopy (infp, outfp) -FILE *infp, *outfp; + void +#ifdef KR_headers +ffilecopy(infp, outfp) + FILE *infp; + FILE *outfp; +#else +ffilecopy(FILE *infp, FILE *outfp) +#endif { while (!feof (infp)) { register c = getc (infp); @@ -927,8 +1186,15 @@ FILE *infp, *outfp; c_keywords must be in alphabetical order (as defined by strcmp). */ -int in_vector(str, keywds, n) -char *str; char **keywds; register int n; + int +#ifdef KR_headers +in_vector(str, keywds, n) + char *str; + char **keywds; + register int n; +#else +in_vector(char *str, char **keywds, register int n) +#endif { register char **K = keywds; register int n1, t; @@ -950,8 +1216,13 @@ char *str; char **keywds; register int n; } /* in_vector */ -int is_negatable (Const) -Constp Const; + int +#ifdef KR_headers +is_negatable(Const) + Constp Const; +#else +is_negatable(Constp Const) +#endif { int retval = 0; if (Const != (Constp) NULL) @@ -987,8 +1258,14 @@ Constp Const; return retval; } /* is_negatable */ + void +#ifdef KR_headers backup(fname, bname) - char *fname, *bname; + char *fname; + char *bname; +#else +backup(char *fname, char *bname) +#endif { FILE *b, *f; static char couldnt[] = "Couldn't open %.80s"; @@ -1010,8 +1287,14 @@ backup(fname, bname) /* struct_eq -- returns YES if structures have the same field names and types, NO otherwise */ -int struct_eq (s1, s2) -chainp s1, s2; + int +#ifdef KR_headers +struct_eq(s1, s2) + chainp s1; + chainp s2; +#else +struct_eq(chainp s1, chainp s2) +#endif { struct Dimblock *d1, *d2; Constp cp1, cp2; @@ -1033,20 +1316,13 @@ chainp s1, s2; /* compare dimensions (needed for comparing COMMON blocks) */ if (d1 = v1->vdim) { - if (!(cp1 = (Constp)d1->nelt) || cp1->tag != TCONST) - return NO; - if (!(d2 = v2->vdim)) - if (cp1->Const.ci == 1) - continue; - else - return NO; - if (!(cp2 = (Constp)d2->nelt) || cp2->tag != TCONST + if (!(cp1 = (Constp)d1->nelt) || cp1->tag != TCONST + || !(d2 = v2->vdim) + || !(cp2 = (Constp)d2->nelt) || cp2->tag != TCONST || cp1->Const.ci != cp2->Const.ci) return NO; } - else if ((d2 = v2->vdim) && (!(cp2 = (Constp)d2->nelt) - || cp2->tag != TCONST - || cp2->Const.ci != 1)) + else if (v2->vdim) return NO; } /* while s1 != CHNULL && s2 != CHNULL */ diff --git a/usr.bin/f2c/names.c b/usr.bin/f2c/names.c index e826f3e..ac84be4 100644 --- a/usr.bin/f2c/names.c +++ b/usr.bin/f2c/names.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992 - 1995 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 @@ -56,8 +56,14 @@ this software. /* generate variable references */ -char *c_type_decl (type, is_extern) -int type, is_extern; + char * +#ifdef KR_headers +c_type_decl(type, is_extern) + int type; + int is_extern; +#else +c_type_decl(int type, int is_extern) +#endif { static char buff[100]; @@ -121,11 +127,17 @@ int type, is_extern; } /* c_type_decl */ -char *new_func_length() + char * +new_func_length(Void) { return "ret_val_len"; } -char *new_arg_length(arg) - Namep arg; + char * +#ifdef KR_headers +new_arg_length(arg) + Namep arg; +#else +new_arg_length(Namep arg) +#endif { static char buf[64]; sprintf (buf, "%s_len", arg->fvarname); @@ -140,8 +152,12 @@ char *new_arg_length(arg) order */ void -declare_new_addr (addrp) -struct Addrblock *addrp; +#ifdef KR_headers +declare_new_addr(addrp) + struct Addrblock *addrp; +#else +declare_new_addr(struct Addrblock *addrp) +#endif { extern chainp new_vars; @@ -149,9 +165,14 @@ struct Addrblock *addrp; } /* declare_new_addr */ -wr_nv_ident_help (outfile, addrp) -FILE *outfile; -struct Addrblock *addrp; + void +#ifdef KR_headers +wr_nv_ident_help(outfile, addrp) + FILE *outfile; + struct Addrblock *addrp; +#else +wr_nv_ident_help(FILE *outfile, struct Addrblock *addrp) +#endif { int eltcount = 0; @@ -170,8 +191,13 @@ struct Addrblock *addrp; nice_printf (outfile, "[%d]", eltcount); } /* wr_nv_ident_help */ -int nv_type_help (addrp) -struct Addrblock *addrp; + int +#ifdef KR_headers +nv_type_help(addrp) + struct Addrblock *addrp; +#else +nv_type_help(struct Addrblock *addrp) +#endif { if (addrp == (struct Addrblock *) NULL) return -1; @@ -196,11 +222,17 @@ struct Addrblock *addrp; default -> c_b<memno> (default label) */ -char *lit_name (litp) -struct Literal *litp; + char * +#ifdef KR_headers +lit_name(litp) + struct Literal *litp; +#else +lit_name(struct Literal *litp) +#endif { static char buf[CONST_IDENT_MAX]; ftnint val; + char *fmt; if (litp == (struct Literal *) NULL) return NULL; @@ -209,15 +241,16 @@ struct Literal *litp; case TYINT1: val = litp -> litval.litival; if (val >= 256 || val < -255) - sprintf (buf, "c_b%d", litp -> litnum); + sprintf (buf, "ci1_b%d", litp -> litnum); else if (val < 0) sprintf (buf, "ci1_n%ld", -val); else sprintf(buf, "ci1__%ld", val); + break; case TYSHORT: val = litp -> litval.litival; if (val >= 32768 || val <= -32769) - sprintf (buf, "c_b%d", litp -> litnum); + sprintf (buf, "cs_b%d", litp -> litnum); else if (val < 0) sprintf (buf, "cs_n%ld", -val); else @@ -236,9 +269,15 @@ struct Literal *litp; sprintf (buf, "c__%ld", val); break; case TYLOGICAL1: + fmt = "cl1_%s"; + goto spr_logical; case TYLOGICAL2: + fmt = "cl2_%s"; + goto spr_logical; case TYLOGICAL: - sprintf (buf, "c_%s", (litp -> litval.litival + fmt = "c_%s"; + spr_logical: + sprintf (buf, fmt, (litp -> litval.litival ? "true" : "false")); break; case TYREAL: @@ -263,8 +302,12 @@ struct Literal *litp; char * +#ifdef KR_headers comm_union_name(count) - int count; + int count; +#else +comm_union_name(int count) +#endif { static char buf[12]; @@ -279,12 +322,16 @@ comm_union_name(count) output the global declarations, such as the static table of constant values */ -wr_globals (outfile) -FILE *outfile; + void +#ifdef KR_headers +wr_globals(outfile) + FILE *outfile; +#else +wr_globals(FILE *outfile) +#endif { struct Literal *litp, *lastlit; extern int hsize; - extern char *lit_name(); char *litname; int did_one, t; struct Constblock cb; @@ -345,8 +392,12 @@ FILE *outfile; } /* wr_globals */ ftnint +#ifdef KR_headers commlen(vl) - register chainp vl; + register chainp vl; +#else +commlen(register chainp vl) +#endif { ftnint size; int type; @@ -367,8 +418,12 @@ commlen(vl) } static void /* Pad common block if an EQUIVALENCE extended it. */ +#ifdef KR_headers pad_common(c) - Extsym *c; + Extsym *c; +#else +pad_common(Extsym *c) +#endif { register chainp cvl; register Namep v; @@ -430,8 +485,13 @@ pad_common(c) #define UNION_STRUCT 2 #define INIT_STRUCT 3 + void +#ifdef KR_headers wr_common_decls(outfile) - FILE *outfile; + FILE *outfile; +#else +wr_common_decls(FILE *outfile) +#endif { Extsym *ext; extern int extcomm; @@ -525,10 +585,14 @@ wr_common_decls(outfile) } /* for ext = extsymtab */ } /* wr_common_decls */ - -wr_struct (outfile, var_list) -FILE *outfile; -chainp var_list; + void +#ifdef KR_headers +wr_struct(outfile, var_list) + FILE *outfile; + chainp var_list; +#else +wr_struct(FILE *outfile, chainp var_list) +#endif { int last_type = -1; int did_one = 0; @@ -537,7 +601,7 @@ chainp var_list; for (this_var = var_list; this_var; this_var = this_var -> nextp) { Namep var = (Namep) this_var -> datap; int type; - char *comment = NULL, *wr_ardecls (); + char *comment = NULL; if (var == (Namep) NULL) err ("wr_struct: null variable"); @@ -587,8 +651,13 @@ chainp var_list; } /* wr_struct */ -char *user_label(stateno) -ftnint stateno; + char * +#ifdef KR_headers +user_label(stateno) + ftnint stateno; +#else +user_label(ftnint stateno) +#endif { static char buf[USER_LABEL_MAX + 1]; static char *Lfmt[2] = { "L_%ld", "L%ld" }; @@ -601,10 +670,15 @@ ftnint stateno; } /* user_label */ -char *temp_name (starter, num, storage) -char *starter; -int num; -char *storage; + char * +#ifdef KR_headers +temp_name(starter, num, storage) + char *starter; + int num; + char *storage; +#else +temp_name(char *starter, int num, char *storage) +#endif { static char buf[IDENT_LEN]; char *pointer = buf; @@ -621,9 +695,14 @@ char *storage; } /* temp_name */ -char *equiv_name (memno, store) -int memno; -char *store; + char * +#ifdef KR_headers +equiv_name(memno, store) + int memno; + char *store; +#else +equiv_name(int memno, char *store) +#endif { static char buf[IDENT_LEN]; char *pointer = buf; @@ -636,12 +715,15 @@ char *store; } /* equiv_name */ void +#ifdef KR_headers def_commons(of) - FILE *of; + FILE *of; +#else +def_commons(FILE *of) +#endif { Extsym *ext; int c, onefile, Union; - char buf[64]; chainp comm; extern int ext1comm; FILE *c_filesave = c_file; @@ -658,16 +740,19 @@ def_commons(of) for(ext = extsymtab; ext < nextext; ext++) if (ext->extstg == STGCOMMON && !ext->extinit && (comm = ext->allextp)) { - sprintf(buf, "%scom.c", ext->cextname); + sprintf(outbtail, "%scom.c", ext->cextname); if (onefile) fprintf(of, "/*>>>'%s'<<<*/\n", - buf); + outbtail); else { - c_file = of = fopen(buf,textwrite); + c_file = of = fopen(outbuf,textwrite); if (!of) - fatalstr("can't open %s", buf); + fatalstr("can't open %s", outbuf); } fprintf(of, "#include \"f2c.h\"\n"); + if (Ansi == 2) + fprintf(of, + "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n"); if (comm->nextp) { Union = 1; nice_printf(of, "union {\n"); @@ -686,8 +771,11 @@ def_commons(of) if (Union) prev_tab(of); nice_printf(of, "} %s;\n", ext->cextname); + if (Ansi == 2) + fprintf(of, + "\n#ifdef __cplusplus\n}\n#endif\n"); if (onefile) - fprintf(of, "/*<<<%s>>>*/\n", buf); + fprintf(of, "/*<<<%s>>>*/\n", outbtail); else fclose(of); } @@ -704,39 +792,31 @@ def_commons(of) */ char *c_keywords[] = { - "Long", "Multitype", "Namelist", "Vardesc", - "abs", "acos", "address", "alist", "asin", "asm", - "atan", "atan2", "auto", "break", - "case", "catch", "char", "cilist", "class", "cllist", - "complex", "const", "continue", "cos", "cosh", - "dabs", "default", "defined", "delete", - "dmax", "dmin", "do", "double", "doublecomplex", "doublereal", - "else", "entry", "enum", "exp", "extern", - "flag", "float", "for", "friend", "ftnint", "ftnlen", "goto", - "icilist", "if", "include", "inline", "inlist", "int", "integer", - "integer1", "log", "logical", "logical1", "long", "longint", - "max", "min", "new", - "olist", "operator", "overload", "private", "protected", "public", - "real", "register", "return", + "Long", "Multitype", "Namelist", "Vardesc", "abs", "acos", + "addr", "address", "aerr", "alist", "asin", "asm", "atan", + "atan2", "aunit", "auto", "break", "c", "case", "catch", "cerr", + "char", "ciend", "cierr", "cifmt", "cilist", "cirec", "ciunit", + "class", "cllist", "complex", "const", "continue", "cos", + "cosh", "csta", "cunit", "d", "dabs", "default", "defined", + "delete", "dims", "dmax", "dmin", "do", "double", + "doublecomplex", "doublereal", "else", "entry", "enum", "exp", + "extern", "far", "flag", "float", "for", "friend", "ftnint", + "ftnlen", "goto", "h", "huge", "i", "iciend", "icierr", + "icifmt", "icilist", "icirlen", "icirnum", "iciunit", "if", + "inacc", "inacclen", "inblank", "inblanklen", "include", + "indir", "indirlen", "inerr", "inex", "infile", "infilen", + "infmt", "infmtlen", "inform", "informlen", "inline", "inlist", + "inname", "innamed", "innamlen", "innrec", "innum", "inopen", + "inrecl", "inseq", "inseqlen", "int", "integer", "integer1", + "inunf", "inunflen", "inunit", "log", "logical", "logical1", + "long", "longint", "max", "min", "name", "near", "new", "nvars", + "oacc", "oblnk", "oerr", "ofm", "ofnm", "ofnmlen", "olist", + "operator", "orl", "osta", "ounit", "overload", "private", + "protected", "public", "r", "real", "register", "return", "short", "shortint", "shortlogical", "signed", "sin", "sinh", - "sizeof", "sqrt", "static", "struct", "switch", - "tan", "tanh", "template", "this", "try", "typedef", - "union", "unsigned", "virtual", "void", "volatile", "while" -}; /* c_keywords */ + "sizeof", "sqrt", "static", "struct", "switch", "tan", "tanh", + "template", "this", "try", "type", "typedef", "union", + "unsigned", "vars", "virtual", "void", "volatile", "while", "z" + }; /* c_keywords */ int n_keywords = sizeof(c_keywords)/sizeof(char *); - -char *st_fields[] = { - "addr", "aerr", "aunit", "c", "cerr", "ciend", "cierr", - "cifmt", "cirec", "ciunit", "csta", "cunit", "d", "dims", - "h", "i", "iciend", "icierr", "icifmt", "icirlen", - "icirnum", "iciunit", "inacc", "inacclen", "inblank", - "inblanklen", "indir", "indirlen", "inerr", "inex", - "infile", "infilen", "infmt", "infmtlen", "inform", - "informlen", "inname", "innamed", "innamlen", "innrec", - "innum", "inopen", "inrecl", "inseq", "inseqlen", "inunf", - "inunflen", "inunit", "name", "nvars", "oacc", "oblnk", - "oerr", "ofm", "ofnm", "ofnmlen", "orl", "osta", "ounit", - "r", "type", "vars", "z" - }; -int n_st_fields = sizeof(st_fields)/sizeof(char *); diff --git a/usr.bin/f2c/names.h b/usr.bin/f2c/names.h index 1ca17d0..16bcc0b 100644 --- a/usr.bin/f2c/names.h +++ b/usr.bin/f2c/names.h @@ -10,13 +10,10 @@ extern char *c_keywords[]; -char *new_io_ident (/* char * */); -char *new_func_length (/* char * */); -char *new_arg_length (/* Namep */); -void declare_new_addr (/* struct Addrblock * */); -char *nv_ident_help (/* struct Addrblock * */); -int nv_type_help (/* struct Addrblock */); -char *user_label (/* int */); -char *temp_name (/* int, char */); -char *c_type_decl (/* int, int */); -char *equiv_name (/* int, char * */); +char* c_type_decl Argdcl((int, int)); +void declare_new_addr Argdcl((Addrp)); +char* new_arg_length Argdcl((Namep)); +char* new_func_length Argdcl((void)); +int nv_type_help Argdcl((Addrp)); +char* temp_name Argdcl((char*, int, char*)); +char* user_label Argdcl((long int)); diff --git a/usr.bin/f2c/niceprintf.c b/usr.bin/f2c/niceprintf.c index 3c6cb3a..af6d5d0 100644 --- a/usr.bin/f2c/niceprintf.c +++ b/usr.bin/f2c/niceprintf.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1993, 1994 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 @@ -24,27 +24,41 @@ this software. #include "defs.h" #include "names.h" #include "output.h" +#ifndef KR_headers +#include "stdarg.h" +#endif #define TOO_LONG_INDENT (2 * tab_size) #define MAX_INDENT 44 #define MIN_INDENT 22 static int last_was_newline = 0; +int sharp_line = 0; int indent = 0; int in_comment = 0; int in_define = 0; extern int gflag1; - extern char *file_name; + extern char filename[]; + + static void ind_printf Argdcl((int, FILE*, char*, va_list)); - static int + static void +#ifdef KR_headers write_indent(fp, use_indent, extra_indent, start, end) - FILE *fp; - int use_indent, extra_indent; - char *start, *end; + FILE *fp; + int use_indent; + int extra_indent; + char *start; + char *end; +#else +write_indent(FILE *fp, int use_indent, int extra_indent, char *start, char *end) +#endif { int ind, tab; - if (gflag1 && last_was_newline) - fprintf(fp, "#line %ld \"%s\"\n", lineno, infname ? infname : file_name); + if (sharp_line) { + fprintf(fp, "#line %ld \"%s\"\n", lineno, filename); + sharp_line = 0; + } if (in_define == 1) { in_define = 2; use_indent = 0; @@ -76,25 +90,50 @@ write_indent(fp, use_indent, extra_indent, start, end) putc (*start++, fp); } /* write_indent */ - +#ifdef KR_headers /*VARARGS2*/ -int margin_printf (fp, a, b, c, d, e, f, g) -FILE *fp; -char *a; -long b, c, d, e, f, g; + void + margin_printf (fp, a, b, c, d, e, f, g) + FILE *fp; + char *a; + long b, c, d, e, f, g; { ind_printf (0, fp, a, b, c, d, e, f, g); } /* margin_printf */ /*VARARGS2*/ -int nice_printf (fp, a, b, c, d, e, f, g) -FILE *fp; -char *a; -long b, c, d, e, f, g; + void + nice_printf (fp, a, b, c, d, e, f, g) + FILE *fp; + char *a; + long b, c, d, e, f, g; { ind_printf (1, fp, a, b, c, d, e, f, g); } /* nice_printf */ +#define SPRINTF(x,a,b,c,d,e,f,g) sprintf(x,a,b,c,d,e,f,g) + +#else /* if (!defined(KR_HEADERS)) */ +#define SPRINTF(x,a,b,c,d,e,f,g) vsprintf(x,a,ap) + + void + margin_printf(FILE *fp, char *fmt, ...) +{ + va_list ap; + va_start(ap,fmt); + ind_printf(0, fp, fmt, ap); + va_end(ap); + } + + void + nice_printf(FILE *fp, char *fmt, ...) +{ + va_list ap; + va_start(ap,fmt); + ind_printf(1, fp, fmt, ap); + va_end(ap); + } +#endif #define max_line_len c_output_line_length /* 74Number of characters allowed on an output @@ -116,15 +155,19 @@ static int cursor_pos = 0; static int In_string = 0; void -np_init() +np_init(Void) { next_slot = output_buf = Alloc(MAX_OUTPUT_SIZE); memset(output_buf, 0, MAX_OUTPUT_SIZE); } static char * +#ifdef KR_headers adjust_pointer_in_string(pointer) - register char *pointer; + register char *pointer; +#else +adjust_pointer_in_string(register char *pointer) +#endif { register char *s, *s1, *se, *s0; @@ -152,8 +195,13 @@ adjust_pointer_in_string(pointer) * so we roll our own fwd_strcpy: */ static void +#ifdef KR_headers fwd_strcpy(t, s) - register char *t, *s; + register char *t; + register char *s; +#else +fwd_strcpy(register char *t, register char *s) +#endif { while(*t++ = *s++); } /* isident -- true iff character could belong to a unit. C allows @@ -166,11 +214,16 @@ fwd_strcpy(t, s) #define isident(x) (Tr[x] & 1) #define isntident(x) (!Tr[x]) -int ind_printf (use_indent, fp, a, b, c, d, e, f, g) -int use_indent; -FILE *fp; -char *a; -long b, c, d, e, f, g; + static void +#ifdef KR_headers + ind_printf (use_indent, fp, a, b, c, d, e, f, g) + int use_indent; + FILE *fp; + char *a; + long b, c, d, e, f, g; +#else + ind_printf (int use_indent, FILE *fp, char *a, va_list ap) +#endif { extern int max_line_len; extern FILEP c_file; @@ -181,11 +234,11 @@ long b, c, d, e, f, g; cursor_pos += indent - last_indent; last_indent = indent; - sprintf (next_slot, a, b, c, d, e, f, g); + SPRINTF (next_slot, a, b, c, d, e, f, g); if (fp != c_file) { fprintf (fp,"%s", next_slot); - return 1; + return; } /* if fp != c_file */ do { @@ -349,13 +402,14 @@ long b, c, d, e, f, g; else { last_was_newline = 1; extra_indent = 0; + sharp_line = gflag1; } } else { extra_indent = TOO_LONG_INDENT; if (In_string && !string_start) { if (Ansi == 1) { - fprintf(fp, "\"\n"); + fprintf(fp, gflag1 ? "\"\\\n" : "\"\n"); use_indent = 1; last_was_newline = 1; } @@ -366,7 +420,7 @@ long b, c, d, e, f, g; In_string = in_string0; } else { - if (in_define) + if (in_define/* | gflag1*/) putc('\\', fp); putc ('\n', fp); last_was_newline = 1; @@ -384,5 +438,4 @@ long b, c, d, e, f, g; } while (*next_slot); - return 0; } /* ind_printf */ diff --git a/usr.bin/f2c/notice b/usr.bin/f2c/notice index 64af9f1..9715a19 100644 --- a/usr.bin/f2c/notice +++ b/usr.bin/f2c/notice @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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/output.c b/usr.bin/f2c/output.c index 6d5bdd4..b495b26 100644 --- a/usr.bin/f2c/output.c +++ b/usr.bin/f2c/output.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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 @@ -122,14 +122,22 @@ table_entry opcode_table[] = { static char opeqable[sizeof(opcode_table)/sizeof(table_entry)]; -static void output_prim (); -static void output_unary (), output_binary (), output_arg_list (); -static void output_list (), output_literal (); +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_prim Argdcl((FILEP, struct Primblock*)); +static void output_unary Argdcl((FILEP, Exprp)); -void expr_out (fp, e) -FILE *fp; -expptr e; + void +#ifdef KR_headers +expr_out(fp, e) + FILE *fp; + expptr e; +#else +expr_out(FILE *fp, expptr e) +#endif { if (e == (expptr) NULL) return; @@ -146,7 +154,8 @@ expptr e; case TADDR: out_addr (fp, &(e -> addrblock)); goto end_out; - case TPRIM: warn ("expr_out: got TPRIM"); + case TPRIM: if (!nerr) + warn ("expr_out: got TPRIM"); output_prim (fp, &(e -> primblock)); return; @@ -239,9 +248,14 @@ expptr e; } /* expr_out */ -void out_and_free_statement (outfile, expr) -FILE *outfile; -expptr expr; + void +#ifdef KR_headers +out_and_free_statement(outfile, expr) + FILE *outfile; + expptr expr; +#else +out_and_free_statement(FILE *outfile, expptr expr) +#endif { if (expr) expr_out (outfile, expr); @@ -251,8 +265,14 @@ expptr expr; -int same_ident (left, right) -expptr left, right; + int +#ifdef KR_headers +same_ident(left, right) + expptr left; + expptr right; +#else +same_ident(expptr left, expptr right) +#endif { if (!left || !right) return 0; @@ -297,9 +317,14 @@ expptr left, right; } /* same_ident */ static int +#ifdef KR_headers samefpconst(c1, c2, n) - register Constp c1, c2; - register int n; + register Constp c1; + register Constp c2; + register int n; +#else +samefpconst(register Constp c1, register Constp c2, register int n) +#endif { char *s1, *s2; if (!c1->vstg && !c2->vstg) @@ -310,8 +335,13 @@ samefpconst(c1, c2, n) } static int +#ifdef KR_headers sameconst(c1, c2) - register Constp c1, c2; + register Constp c1; + register Constp c2; +#else +sameconst(register Constp c1, register Constp c2) +#endif { switch(c1->vtype) { case TYCOMPLEX: @@ -340,8 +370,14 @@ sameconst(c1, c2) somewhat pessimistic, but can afford to be because it's just used to optimize on the assignment operators (+=, -=, etc). */ -int same_expr (e1, e2) -expptr e1, e2; + int +#ifdef KR_headers +same_expr(e1, e2) + expptr e1; + expptr e2; +#else +same_expr(expptr e1, expptr e2) +#endif { if (!e1 || !e2) return !e1 && !e2; @@ -368,9 +404,14 @@ expptr e1, e2; -void out_name (fp, namep) - FILE *fp; - Namep namep; + void +#ifdef KR_headers +out_name(fp, namep) + FILE *fp; + Namep namep; +#else +out_name(FILE *fp, Namep namep) +#endif { extern int usedefsforcommon; Extsym *comm; @@ -398,9 +439,14 @@ static char *Longfmt = "%ld"; #define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n]) -void out_const(fp, cp) - FILE *fp; - register Constp cp; + void +#ifdef KR_headers +out_const(fp, cp) + FILE *fp; + register Constp cp; +#else +out_const(FILE *fp, register Constp cp) +#endif { static char real_buf[50], imag_buf[50]; unsigned int k; @@ -463,7 +509,13 @@ void out_const(fp, cp) #undef cpd static void -out_args(fp, ep) FILE *fp; expptr ep; +#ifdef KR_headers +out_args(fp, ep) + FILE *fp; + expptr ep; +#else +out_args(FILE *fp, expptr ep) +#endif { chainp arglist; @@ -482,9 +534,14 @@ out_args(fp, ep) FILE *fp; expptr ep; /* out_addr -- this routine isn't local because it is called by the system-generated identifier printing routines */ -void out_addr (fp, addrp) -FILE *fp; -struct Addrblock *addrp; + void +#ifdef KR_headers +out_addr(fp, addrp) + FILE *fp; + struct Addrblock *addrp; +#else +out_addr(FILE *fp, struct Addrblock *addrp) +#endif { extern Extsym *extsymtab; int was_array = 0; @@ -631,13 +688,17 @@ struct Addrblock *addrp; } /* out_addr */ -static void output_literal (fp, memno, cp) - FILE *fp; - int memno; - Constp cp; + static void +#ifdef KR_headers +output_literal(fp, memno, cp) + FILE *fp; + int memno; + Constp cp; +#else +output_literal(FILE *fp, int memno, Constp cp) +#endif { struct Literal *litp, *lastlit; - extern char *lit_name (); lastlit = litpool + nliterals; @@ -655,9 +716,14 @@ static void output_literal (fp, memno, cp) } /* output_literal */ -static void output_prim (fp, primp) -FILE *fp; -struct Primblock *primp; + static void +#ifdef KR_headers +output_prim(fp, primp) + FILE *fp; + struct Primblock *primp; +#else +output_prim(FILE *fp, struct Primblock *primp) +#endif { if (primp == NULL) return; @@ -672,9 +738,14 @@ struct Primblock *primp; -static void output_arg_list (fp, listp) -FILE *fp; -struct Listblock *listp; + static void +#ifdef KR_headers +output_arg_list(fp, listp) + FILE *fp; + struct Listblock *listp; +#else +output_arg_list(FILE *fp, struct Listblock *listp) +#endif { chainp arg_list; @@ -698,9 +769,14 @@ struct Listblock *listp; -static void output_unary (fp, e) -FILE *fp; -struct Exprblock *e; + static void +#ifdef KR_headers +output_unary(fp, e) + FILE *fp; + struct Exprblock *e; +#else +output_unary(FILE *fp, struct Exprblock *e) +#endif { if (e == NULL) return; @@ -738,8 +814,12 @@ struct Exprblock *e; static char * +#ifdef KR_headers findconst(m) - register long m; + register long m; +#else +findconst(register long m) +#endif { register struct Literal *litp, *litpe; @@ -752,9 +832,13 @@ findconst(m) } static int -opconv_fudge(fp,e) - FILE *fp; - struct Exprblock *e; +#ifdef KR_headers +opconv_fudge(fp, e) + FILE *fp; + struct Exprblock *e; +#else +opconv_fudge(FILE *fp, struct Exprblock *e) +#endif { /* special handling for ichar and character*1 */ register expptr lp; @@ -771,7 +855,7 @@ opconv_fudge(fp,e) if (lt == TYCHAR) { switch(lp->tag) { case TNAME: - nice_printf(fp, "*"); + nice_printf(fp, "*(unsigned char *)"); out_name(fp, (Namep)lp); return 1; case TCONST: @@ -779,8 +863,12 @@ opconv_fudge(fp,e) cp = lp->constblock.Const.ccp; tconst1: k = *(unsigned char *)cp; - sprintf(buf, chr_fmt[k], k); - nice_printf(fp, "'%s'", buf); + if (k < 128) { /* ASCII character */ + sprintf(buf, chr_fmt[k], k); + nice_printf(fp, "'%s'", buf); + } + else + nice_printf(fp, "%d", k); return 1; case TADDR: switch(lp->addrblock.vstg) { @@ -800,7 +888,7 @@ opconv_fudge(fp,e) Offset = lp->addrblock.memoffset; switch(lp->addrblock.uname_tag) { case UNAM_REF: - nice_printf(fp, "*"); + nice_printf(fp, "*(unsigned char *)"); return 0; case UNAM_NAME: np = lp->addrblock.user.name; @@ -817,7 +905,8 @@ opconv_fudge(fp,e) /* STGCOMMON or STGEQUIV would cause */ /* voffset to be added in a second time */ lp->addrblock.vstg = STGUNKNOWN; - break; + nice_printf(fp, "*(unsigned char *)&"); + return 0; default: badtag("opconv_fudge", lp->tag); } @@ -829,9 +918,14 @@ opconv_fudge(fp,e) } -static void output_binary (fp, e) -FILE *fp; -struct Exprblock *e; + static void +#ifdef KR_headers +output_binary(fp, e) + FILE *fp; + struct Exprblock *e; +#else +output_binary(FILE *fp, struct Exprblock *e) +#endif { char *format; extern table_entry opcode_table[]; @@ -953,11 +1047,18 @@ struct Exprblock *e; } /* else */ } /* output_binary */ - -out_call (outfile, op, ftype, len, name, args) -FILE *outfile; -int op, ftype; -expptr len, name, args; + void +#ifdef KR_headers +out_call(outfile, op, ftype, len, name, args) + FILE *outfile; + int op; + int ftype; + expptr len; + expptr name; + expptr args; +#else +out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args) +#endif { chainp arglist; /* Pointer to any actual arguments */ chainp cp; /* Iterator over argument lists */ @@ -1208,20 +1309,33 @@ expptr len, name, args; char * +#ifdef KR_headers flconst(buf, x) - char *buf, *x; + char *buf; + char *x; +#else +flconst(char *buf, char *x) +#endif { sprintf(buf, fl_fmt_string, x); return buf; } char * +#ifdef KR_headers dtos(x) - double x; + double x; +#else +dtos(double x) +#endif { static char buf[64]; +#ifdef USE_DTOA + g_fmt(buf, x); +#else sprintf(buf, db_fmt_string, x); - return buf; +#endif + return strcpy(mem(strlen(buf)+1,0), buf); } char tr_tab[Table_size]; @@ -1230,7 +1344,8 @@ char tr_tab[Table_size]; output.c. These structures include the output format to be used for Float, Double, Complex, and Double Complex constants. */ -void out_init () + void +out_init(Void) { extern int tab_size; register char *s; @@ -1276,9 +1391,14 @@ void out_init () } /* out_init */ -void extern_out (fp, extsym) -FILE *fp; -Extsym *extsym; + void +#ifdef KR_headers +extern_out(fp, extsym) + FILE *fp; + Extsym *extsym; +#else +extern_out(FILE *fp, Extsym *extsym) +#endif { if (extsym == (Extsym *) NULL) return; @@ -1289,9 +1409,14 @@ Extsym *extsym; -static void output_list (fp, listp) -FILE *fp; -struct Listblock *listp; + static void +#ifdef KR_headers +output_list(fp, listp) + FILE *fp; + struct Listblock *listp; +#else +output_list(FILE *fp, struct Listblock *listp) +#endif { int did_one = 0; chainp elts; @@ -1310,11 +1435,15 @@ struct Listblock *listp; } /* output_list */ -void out_asgoto (outfile, expr) -FILE *outfile; -expptr expr; + void +#ifdef KR_headers +out_asgoto(outfile, expr) + FILE *outfile; + expptr expr; +#else +out_asgoto(FILE *outfile, expptr expr) +#endif { - char *user_label(); chainp value; Namep namep; int k; @@ -1366,9 +1495,14 @@ expptr expr; nice_printf (outfile, "}\n"); } /* out_asgoto */ -void out_if (outfile, expr) -FILE *outfile; -expptr expr; + void +#ifdef KR_headers +out_if(outfile, expr) + FILE *outfile; + expptr expr; +#else +out_if(FILE *outfile, expptr expr) +#endif { nice_printf (outfile, "if ("); expr_out (outfile, expr); @@ -1377,9 +1511,13 @@ expptr expr; } /* out_if */ static void +#ifdef KR_headers output_rbrace(outfile, s) - FILE *outfile; - char *s; + FILE *outfile; + char *s; +#else +output_rbrace(FILE *outfile, char *s) +#endif { extern int last_was_label; register char *fmt; @@ -1393,32 +1531,52 @@ output_rbrace(outfile, s) nice_printf(outfile, fmt, s); } -void out_else (outfile) -FILE *outfile; + void +#ifdef KR_headers +out_else(outfile) + FILE *outfile; +#else +out_else(FILE *outfile) +#endif { prev_tab (outfile); output_rbrace(outfile, "} else {\n"); next_tab (outfile); } /* out_else */ -void elif_out (outfile, expr) -FILE *outfile; -expptr expr; + void +#ifdef KR_headers +elif_out(outfile, expr) + FILE *outfile; + expptr expr; +#else +elif_out(FILE *outfile, expptr expr) +#endif { prev_tab (outfile); output_rbrace(outfile, "} else "); out_if (outfile, expr); } /* elif_out */ -void endif_out (outfile) -FILE *outfile; + void +#ifdef KR_headers +endif_out(outfile) + FILE *outfile; +#else +endif_out(FILE *outfile) +#endif { prev_tab (outfile); output_rbrace(outfile, "}\n"); } /* endif_out */ -void end_else_out (outfile) -FILE *outfile; + void +#ifdef KR_headers +end_else_out(outfile) + FILE *outfile; +#else +end_else_out(FILE *outfile) +#endif { prev_tab (outfile); output_rbrace(outfile, "}\n"); @@ -1426,9 +1584,15 @@ FILE *outfile; -void compgoto_out (outfile, index, labels) -FILE *outfile; -expptr index, labels; + void +#ifdef KR_headers +compgoto_out(outfile, index, labels) + FILE *outfile; + expptr index; + expptr labels; +#else +compgoto_out(FILE *outfile, expptr index, expptr labels) +#endif { char *s1, *s2; @@ -1438,7 +1602,6 @@ expptr index, labels; erri ("compgoto_out: expected label list, got tag '%d'", labels -> tag); else { - extern char *user_label (); chainp elts; int i = 1; @@ -1472,9 +1635,16 @@ expptr index, labels; } /* compgoto_out */ -void out_for (outfile, init, test, inc) -FILE *outfile; -expptr init, test, inc; + void +#ifdef KR_headers +out_for(outfile, init, test, inc) + FILE *outfile; + expptr init; + expptr test; + expptr inc; +#else +out_for(FILE *outfile, expptr init, expptr test, expptr inc) +#endif { nice_printf (outfile, "for ("); expr_out (outfile, init); @@ -1487,8 +1657,13 @@ expptr init, test, inc; } /* out_for */ -void out_end_for (outfile) -FILE *outfile; + void +#ifdef KR_headers +out_end_for(outfile) + FILE *outfile; +#else +out_end_for(FILE *outfile) +#endif { prev_tab (outfile); nice_printf (outfile, "}\n"); diff --git a/usr.bin/f2c/output.h b/usr.bin/f2c/output.h index 2bc21da..97e3a0a 100644 --- a/usr.bin/f2c/output.h +++ b/usr.bin/f2c/output.h @@ -8,8 +8,6 @@ */ #include "niceprintf.h" -extern int nice_printf (); - /* Definitions for the opcode table. The table is indexed by the macros which are #defined in defines.h */ @@ -57,9 +55,10 @@ extern int in_string; extern table_entry opcode_table[]; -void expr_out (), out_init (), out_addr (), out_const (); -void out_name (), extern_out (), out_asgoto (); -void out_if (), out_else (), elif_out (); -void endif_out (), end_else_out (); -void compgoto_out (), out_for (); -void out_end_for (), out_and_free_statement (); +void compgoto_out Argdcl((FILEP, tagptr, tagptr)); +void endif_out Argdcl((FILEP)); +void expr_out Argdcl((FILEP, tagptr)); +void out_and_free_statement Argdcl((FILEP, tagptr)); +void out_end_for Argdcl((FILEP)); +void out_if Argdcl((FILEP, tagptr)); +void out_name Argdcl((FILEP, Namep)); diff --git a/usr.bin/f2c/p1defs.h b/usr.bin/f2c/p1defs.h index 16bda0e..c76af22 100644 --- a/usr.bin/f2c/p1defs.h +++ b/usr.bin/f2c/p1defs.h @@ -51,26 +51,24 @@ #define COMMENT_BUFFER_SIZE 255 /* max number of chars in each comment */ #define CONSTANT_STR_MAX 1000 /* max number of chars in string constant */ -extern void p1put (/* int */); -extern void p1_comment (/* char * */); -extern void p1_label (/* int */); -extern void p1_line_number (/* int */); -extern void p1put_filename(); -extern void p1_expr (/* expptr */); -extern void p1_head (/* int, char * */); -extern void p1_if (/* expptr */); -extern void p1_else (); -extern void p1_elif (/* expptr */); -extern void p1_endif (); -extern void p1else_end (); -extern void p1_subr_ret (/* expptr */); -extern void p1_goto(/* long */); -extern void p1comp_goto (/* expptr, int, struct Labelblock *[] */); -extern void p1_for (/* expptr, expptr, expptr */); -extern void p1for_end (); - - -extern void p1puts (/* int, char * */); +void p1_asgoto Argdcl((Addrp)); +void p1_comment Argdcl((char*)); +void p1_elif Argdcl((tagptr)); +void p1_else Argdcl((void)); +void p1_endif Argdcl((void)); +void p1_expr Argdcl((tagptr)); +void p1_for Argdcl((tagptr, tagptr, tagptr)); +void p1_goto Argdcl((long int)); +void p1_head Argdcl((int, char*)); +void p1_if Argdcl((tagptr)); +void p1_label Argdcl((long int)); +void p1_line_number Argdcl((long int)); +void p1_subr_ret Argdcl((tagptr)); +void p1comp_goto Argdcl((tagptr, int, struct Labelblock**)); +void p1else_end Argdcl((void)); +void p1for_end Argdcl((void)); +void p1put Argdcl((int)); +void p1puts Argdcl((int, char*)); /* The pass 1 intermediate file has the following format: diff --git a/usr.bin/f2c/p1output.c b/usr.bin/f2c/p1output.c index d4419b5..fc0e9ff 100644 --- a/usr.bin/f2c/p1output.c +++ b/usr.bin/f2c/p1output.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1993, 1994 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 @@ -27,13 +27,20 @@ this software. #include "names.h" -static void p1_addr(), p1_big_addr(), p1_binary(), p1_const(), p1_list(), - p1_literal(), p1_name(), p1_unary(), p1putn(); -static void p1putd (/* int, int */); -static void p1putds (/* int, int, char * */); -static void p1putdds (/* int, int, int, char * */); -static void p1putdd (/* int, int, int */); -static void p1putddd (/* int, int, int, int */); +static void p1_addr Argdcl((Addrp)); +static void p1_big_addr Argdcl((Addrp)); +static void p1_binary Argdcl((Exprp)); +static void p1_const Argdcl((Constp)); +static void p1_list Argdcl((struct Listblock*)); +static void p1_literal Argdcl((long int)); +static void p1_name Argdcl((Namep)); +static void p1_unary Argdcl((Exprp)); +static void p1putd Argdcl((int, long int)); +static void p1putdd Argdcl((int, int, int)); +static void p1putddd Argdcl((int, int, int, int)); +static void p1putdds Argdcl((int, int, int, char*)); +static void p1putds Argdcl((int, int, char*)); +static void p1putn Argdcl((int, int, char*)); /* p1_comment -- save the text of a Fortran comment in the intermediate @@ -41,8 +48,13 @@ static void p1putddd (/* int, int, int, int */); mapping them onto "/+" and "+/". str is assumed to hold no newlines and be null terminated; it may be modified by this function. */ -void p1_comment (str) -char *str; + void +#ifdef KR_headers +p1_comment(str) + char *str; +#else +p1_comment(char *str) +#endif { register unsigned char *pointer, *ustr; @@ -70,8 +82,13 @@ char *str; /* p1_name -- Writes the address of a hash table entry into the intermediate file */ -static void p1_name (namep) -Namep namep; + static void +#ifdef KR_headers +p1_name(namep) + Namep namep; +#else +p1_name(Namep namep) +#endif { p1putd (P1_NAME_POINTER, (long) namep); namep->visused = 1; @@ -79,8 +96,13 @@ Namep namep; -void p1_expr (expr) -expptr expr; + void +#ifdef KR_headers +p1_expr(expr) + expptr expr; +#else +p1_expr(expptr expr) +#endif { /* An opcode of 0 means a null entry */ @@ -131,8 +153,13 @@ expptr expr; -static void p1_const(cp) - register Constp cp; + static void +#ifdef KR_headers +p1_const(cp) + register Constp cp; +#else +p1_const(register Constp cp) +#endif { int type = cp->vtype; expptr vleng = cp->vleng; @@ -184,23 +211,38 @@ static void p1_const(cp) } /* p1_const */ -void p1_asgoto (addrp) -Addrp addrp; + void +#ifdef KR_headers +p1_asgoto(addrp) + Addrp addrp; +#else +p1_asgoto(Addrp addrp) +#endif { p1put (P1_ASGOTO); p1_addr (addrp); } /* p1_asgoto */ -void p1_goto (stateno) -ftnint stateno; + void +#ifdef KR_headers +p1_goto(stateno) + ftnint stateno; +#else +p1_goto(ftnint stateno) +#endif { p1putd (P1_GOTO, stateno); } /* p1_goto */ -static void p1_addr (addrp) - register struct Addrblock *addrp; + static void +#ifdef KR_headers +p1_addr(addrp) + register struct Addrblock *addrp; +#else +p1_addr(register struct Addrblock *addrp) +#endif { int stg; @@ -268,8 +310,13 @@ static void p1_addr (addrp) } /* p1_addr */ -static void p1_list (listp) -struct Listblock *listp; + static void +#ifdef KR_headers +p1_list(listp) + struct Listblock *listp; +#else +p1_list(struct Listblock *listp) +#endif { chainp lis; int count = 0; @@ -290,8 +337,13 @@ struct Listblock *listp; } /* p1_list */ -void p1_label (lab) -long lab; + void +#ifdef KR_headers +p1_label(lab) + long lab; +#else +p1_label(long lab) +#endif { if (parstate < INDATA) earlylabs = mkchain((char *)lab, earlylabs); @@ -301,15 +353,25 @@ long lab; -static void p1_literal (memno) -long memno; + static void +#ifdef KR_headers +p1_literal(memno) + long memno; +#else +p1_literal(long memno) +#endif { p1putd (P1_LITERAL, memno); } /* p1_literal */ -void p1_if (expr) -expptr expr; + void +#ifdef KR_headers +p1_if(expr) + expptr expr; +#else +p1_if(expptr expr) +#endif { p1put (P1_IF); p1_expr (expr); @@ -318,8 +380,13 @@ expptr expr; -void p1_elif (expr) -expptr expr; + void +#ifdef KR_headers +p1_elif(expr) + expptr expr; +#else +p1_elif(expptr expr) +#endif { p1put (P1_ELIF); p1_expr (expr); @@ -328,7 +395,8 @@ expptr expr; -void p1_else () + void +p1_else(Void) { p1put (P1_ELSE); } /* p1_else */ @@ -336,7 +404,8 @@ void p1_else () -void p1_endif () + void +p1_endif(Void) { p1put (P1_ENDIF); } /* p1_endif */ @@ -344,14 +413,20 @@ void p1_endif () -void p1else_end () + void +p1else_end(Void) { p1put (P1_ENDELSE); } /* p1else_end */ -static void p1_big_addr (addrp) -Addrp addrp; + static void +#ifdef KR_headers +p1_big_addr(addrp) + Addrp addrp; +#else +p1_big_addr(Addrp addrp) +#endif { if (addrp == (Addrp) NULL) return; @@ -365,8 +440,13 @@ Addrp addrp; -static void p1_unary (e) -struct Exprblock *e; + static void +#ifdef KR_headers +p1_unary(e) + struct Exprblock *e; +#else +p1_unary(struct Exprblock *e) +#endif { if (e == (struct Exprblock *) NULL) return; @@ -396,8 +476,13 @@ struct Exprblock *e; } /* p1_unary */ -static void p1_binary (e) -struct Exprblock *e; + static void +#ifdef KR_headers +p1_binary(e) + struct Exprblock *e; +#else +p1_binary(struct Exprblock *e) +#endif { if (e == (struct Exprblock *) NULL) return; @@ -409,16 +494,26 @@ struct Exprblock *e; } /* p1_binary */ -void p1_head (class, name) -int class; -char *name; + void +#ifdef KR_headers +p1_head(class, name) + int class; + char *name; +#else +p1_head(int class, char *name) +#endif { p1putds (P1_HEAD, class, name ? name : ""); } /* p1_head */ -void p1_subr_ret (retexp) -expptr retexp; + void +#ifdef KR_headers +p1_subr_ret(retexp) + expptr retexp; +#else +p1_subr_ret(expptr retexp) +#endif { p1put (P1_SUBR_RET); @@ -427,10 +522,15 @@ expptr retexp; -void p1comp_goto (index, count, labels) -expptr index; -int count; -struct Labelblock *labels[]; + void +#ifdef KR_headers +p1comp_goto(index, count, labels) + expptr index; + int count; + struct Labelblock **labels; +#else +p1comp_goto(expptr index, int count, struct Labelblock **labels) +#endif { struct Constblock c; int i; @@ -456,8 +556,15 @@ struct Labelblock *labels[]; -void p1_for (init, test, inc) -expptr init, test, inc; + void +#ifdef KR_headers +p1_for(init, test, inc) + expptr init; + expptr test; + expptr inc; +#else +p1_for(expptr init, expptr test, expptr inc) +#endif { p1put (P1_FOR); p1_expr (init); @@ -466,7 +573,8 @@ expptr init, test, inc; } /* p1_for */ -void p1for_end () + void +p1for_end(Void) { p1put (P1_ENDFOR); } /* p1for_end */ @@ -484,9 +592,14 @@ void p1for_end () /* p1puts -- Put a typed string into the Pass 1 intermediate file. Assumes that str contains no newlines and is null-terminated. */ -void p1puts (type, str) -int type; -char *str; + void +#ifdef KR_headers +p1puts(type, str) + int type; + char *str; +#else +p1puts(int type, char *str) +#endif { fprintf (pass1_file, "%d: %s\n", type, str); } /* p1puts */ @@ -494,9 +607,14 @@ char *str; /* p1putd -- Put a typed integer into the Pass 1 intermediate file. */ -static void p1putd (type, value) -int type; -long value; + static void +#ifdef KR_headers +p1putd(type, value) + int type; + long value; +#else +p1putd(int type, long value) +#endif { fprintf (pass1_file, "%d: %ld\n", type, value); } /* p1_putd */ @@ -504,8 +622,15 @@ long value; /* p1putdd -- Put a typed pair of integers into the intermediate file. */ -static void p1putdd (type, v1, v2) -int type, v1, v2; + static void +#ifdef KR_headers +p1putdd(type, v1, v2) + int type; + int v1; + int v2; +#else +p1putdd(int type, int v1, int v2) +#endif { fprintf (pass1_file, "%d: %d %d\n", type, v1, v2); } /* p1putdd */ @@ -513,8 +638,16 @@ int type, v1, v2; /* p1putddd -- Put a typed triple of integers into the intermediate file. */ -static void p1putddd (type, v1, v2, v3) -int type, v1, v2, v3; + static void +#ifdef KR_headers +p1putddd(type, v1, v2, v3) + int type; + int v1; + int v2; + int v3; +#else +p1putddd(int type, int v1, int v2, int v3) +#endif { fprintf (pass1_file, "%d: %d %d %d\n", type, v1, v2, v3); } /* p1putddd */ @@ -524,9 +657,15 @@ int type, v1, v2, v3; long L[2]; }; -static void p1putn (type, count, str) -int type, count; -char *str; + static void +#ifdef KR_headers +p1putn(type, count, str) + int type; + int count; + char *str; +#else +p1putn(int type, int count, char *str) +#endif { int i; @@ -542,26 +681,43 @@ char *str; /* p1put -- Put a type marker into the intermediate file. */ -void p1put(type) -int type; + void +#ifdef KR_headers +p1put(type) + int type; +#else +p1put(int type) +#endif { fprintf (pass1_file, "%d:\n", type); } /* p1put */ -static void p1putds (type, i, str) -int type; -int i; -char *str; + static void +#ifdef KR_headers +p1putds(type, i, str) + int type; + int i; + char *str; +#else +p1putds(int type, int i, char *str) +#endif { fprintf (pass1_file, "%d: %d %s\n", type, i, str); } /* p1putds */ -static void p1putdds (token, type, stg, str) -int token, type, stg; -char *str; + static void +#ifdef KR_headers +p1putdds(token, type, stg, str) + int token; + int type; + int stg; + char *str; +#else +p1putdds(int token, int type, int stg, char *str) +#endif { fprintf (pass1_file, "%d: %d %d %s\n", token, type, stg, str); } /* p1putdds */ diff --git a/usr.bin/f2c/parse.h b/usr.bin/f2c/parse.h index 1eb2c54..6de2399 100644 --- a/usr.bin/f2c/parse.h +++ b/usr.bin/f2c/parse.h @@ -34,6 +34,14 @@ typedef struct { int table_size; } arg_info; -extern int parse_args (); +#ifdef KR_headers +#define Argdcl(x) () +#else +#define Argdcl(x) x +#endif +int arg_verify Argdcl((char**, arg_info*, int)); +void init_store Argdcl((arg_info*, int)); +int match_table Argdcl((char*, arg_info*, int, int, int*)); +int parse_args Argdcl((int, char**, arg_info*, int, char**, int)); #endif diff --git a/usr.bin/f2c/parse_args.c b/usr.bin/f2c/parse_args.c index f978383..98468e2 100644 --- a/usr.bin/f2c/parse_args.c +++ b/usr.bin/f2c/parse_args.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1994 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 @@ -59,10 +59,15 @@ this software. /* ANSI C */ #include <stddef.h> #endif +#ifdef KR_headers +extern double atof(); +#else +#include "stdlib.h" +#include "string.h" +#endif #include "parse.h" #include <math.h> /* For atof */ #include <ctype.h> -#include "defs.h" #define MAX_INPUT_SIZE 1000 @@ -83,27 +88,27 @@ this software. typedef int boolean; -char *lower_string (/* char [], char * */); - static char *this_program = ""; -#ifndef atol -extern long atol(); +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*)); + + + boolean +#ifdef KR_headers +parse_args(argc, argv, table, entries, others, other_count) + int argc; + char **argv; + arg_info *table; + int entries; + char **others; + int other_count; +#else +parse_args(int argc, char **argv, arg_info *table, int entries, char **others, int other_count) #endif -static int arg_parse (/* char *, arg_info * */); - - -boolean parse_args (argc, argv, table, entries, others, other_count) -int argc; -char *argv[]; -arg_info table[]; -int entries; -char *others[]; -int other_count; { - boolean arg_verify (/* argv, table, entries */); - void init_store (/* table, entries */); - boolean result; if (argv) @@ -189,10 +194,15 @@ int other_count; } /* parse_args */ -boolean arg_verify (argv, table, entries) -char *argv[]; -arg_info table[]; -int entries; + boolean +#ifdef KR_headers +arg_verify(argv, table, entries) + char **argv; + arg_info *table; + int entries; +#else +arg_verify(char **argv, arg_info *table, int entries) +#endif { int i; char *this_program = ""; @@ -264,15 +274,18 @@ int entries; appears lowest in the table. The length of the match will be returned in length ONLY IF a match was found. */ -int match_table (norm_input, table, entries, use_prefix, length) -register char *norm_input; -arg_info table[]; -int entries; -boolean use_prefix; -int *length; + int +#ifdef KR_headers +match_table(norm_input, table, entries, use_prefix, length) + register char *norm_input; + arg_info *table; + int entries; + boolean use_prefix; + int *length; +#else +match_table(register char *norm_input, arg_info *table, int entries, boolean use_prefix, int *length) +#endif { - extern int match (/* char *, char *, arg_info *, boolean */); - char low_input[MAX_INPUT_SIZE]; register int i; int best_index = -1, best_length = 0; @@ -282,7 +295,7 @@ int *length; (void) lower_string (low_input, norm_input); for (i = 0; i < entries; i++) { - int this_length = match (norm_input, low_input, &table[i], use_prefix); + int this_length = match(norm_input, low_input, &table[i], use_prefix); if (this_length > best_length) { best_index = i; @@ -313,10 +326,16 @@ int *length; "dd" "d" "d" 2 <= here's the weird one */ -int match (norm_input, low_input, entry, use_prefix) -char *norm_input, *low_input; -arg_info *entry; -boolean use_prefix; + static int +#ifdef KR_headers +match(norm_input, low_input, entry, use_prefix) + char *norm_input; + char *low_input; + arg_info *entry; + boolean use_prefix; +#else +match(char *norm_input, char *low_input, arg_info *entry, boolean use_prefix) +#endif { char *norm_prefix = arg_prefix (*entry); char *norm_string = arg_string (*entry); @@ -370,8 +389,14 @@ boolean use_prefix; } /* match */ -char *lower_string (dest, src) -char *dest, *src; + static char * +#ifdef KR_headers +lower_string(dest, src) + char *dest; + char *src; +#else +lower_string(char *dest, char *src) +#endif { char *result = dest; register int c; @@ -387,9 +412,14 @@ char *dest, *src; /* arg_parse -- returns the number of characters parsed for this entry */ -static int arg_parse (str, entry) -char *str; -arg_info *entry; + static int +#ifdef KR_headers +arg_parse(str, entry) + char *str; + arg_info *entry; +#else +arg_parse(char *str, arg_info *entry) +#endif { int length = 0; @@ -407,7 +437,7 @@ arg_info *entry; while (*store) store++; - length = put_one_arg (arg_result_type (*entry), str, store++, + length = put_one_arg(arg_result_type (*entry), str, store++, arg_prefix (*entry), arg_string (*entry)); *store = (char *) NULL; @@ -418,11 +448,17 @@ arg_info *entry; } /* arg_parse */ -int put_one_arg (type, str, store, prefix, string) -int type; -char *str; -char **store; -char *prefix, *string; + static int +#ifdef KR_headers +put_one_arg(type, str, store, prefix, string) + int type; + char *str; + char **store; + char *prefix; + char *string; +#else +put_one_arg(int type, char *str, char **store, char *prefix, char *string) +#endif { int length = 0; long L; @@ -433,10 +469,10 @@ char *prefix, *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); - *store = copys(str); length = str ? strlen (str) : 0; break; case P_CHAR: @@ -466,11 +502,11 @@ char *prefix, *string; length = strlen (str); break; case P_FLOAT: - *((float *) store) = (float) atof (str); + *((float *) store) = (float) atof(str); length = strlen (str); break; case P_DOUBLE: - *((double *) store) = (double) atof (str); + *((double *) store) = (double) atof(str); length = strlen (str); break; default: @@ -484,9 +520,14 @@ char *prefix, *string; } /* put_one_arg */ -void init_store (table, entries) -arg_info *table; -int entries; + void +#ifdef KR_headers +init_store(table, entries) + arg_info *table; + int entries; +#else +init_store(arg_info *table, int entries) +#endif { int index; @@ -499,4 +540,3 @@ int entries; } /* if arg_count == P_INFINITE_ARGS */ } /* init_store */ - diff --git a/usr.bin/f2c/permission b/usr.bin/f2c/permission index 20d431e..cdee9a2 100644 --- a/usr.bin/f2c/permission +++ b/usr.bin/f2c/permission @@ -1,21 +1,3 @@ -From ches Tue Mar 6 09:06:22 EST 1990 -It think it probably is. I am told the line is 89% utilized. But the throughpu -t -is shared, so I wouldn't worry about it. ->From ehg Tue Mar 6 08:16 EST 1990 -Received: by coma; Tue Mar 6 08:17:21 1990 -From: pyxis!ehg -Date: Tue, 6 Mar 90 08:16 EST -To: coma!ches - -Thanks. Is it reasonable for people to ask for the 600KB f2c source over -uunet's dedicated line? I'm just trying to find out if there's a problem -before there's a disaster. ->From ches Tue Mar 6 07:16:18 EST 1990 -Inet has no dialers. All its calls go through the internet. The mcsun addresse -s -were uunet.uu.net!mcsun!..., which will travel to uunet via Internet and -then across the ocean on uunet's dedicated line. /**************************************************************** Copyright 1990 by AT&T Bell Laboratories and Bellcore. diff --git a/usr.bin/f2c/pread.c b/usr.bin/f2c/pread.c index 15d8b30..f9cef59 100644 --- a/usr.bin/f2c/pread.c +++ b/usr.bin/f2c/pread.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992, 1993, 1994 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 @@ -37,7 +37,7 @@ this software. #define TGULP 100 static void -trealloc() +trealloc(Void) { int k = tmax; tfirst = (int *)realloc((char *)tfirst, @@ -52,8 +52,12 @@ trealloc() } static void +#ifdef KR_headers badchar(c) - int c; + int c; +#else +badchar(int c) +#endif { fprintf(stderr, "unexpected character 0x%.2x = '%c' on line %ld of %s\n", @@ -62,7 +66,7 @@ badchar(c) } static void -bad_type() +bad_type(Void) { fprintf(stderr, "unexpected type \"%s\" on line %ld of %s\n", @@ -71,8 +75,13 @@ bad_type() } static void +#ifdef KR_headers badflag(tname, option) - char *tname, *option; + char *tname; + char *option; +#else +badflag(char *tname, char *option) +#endif { fprintf(stderr, "%s type from `f2c -%s` on line %ld of %s\n", tname, option, Plineno, Pfname); @@ -80,8 +89,12 @@ badflag(tname, option) } static void +#ifdef KR_headers detected(msg) - char *msg; + char *msg; +#else +detected(char *msg) +#endif { fprintf(stderr, "%sdetected on line %ld of %s\n", msg, Plineno, Pfname); @@ -90,8 +103,12 @@ detected(msg) #if 0 static void +#ifdef KR_headers checklogical(k) - int k; + int k; +#else +checklogical(int k) +#endif { static int lastmsg = 0; static int seen[2] = {0,0}; @@ -127,7 +144,12 @@ checklogical(k) #endif static void +#ifdef KR_headers checkreal(k) + int k; +#else +checkreal(int k) +#endif { static int warned = 0; static int seen[2] = {0,0}; @@ -146,8 +168,12 @@ checkreal(k) } static void +#ifdef KR_headers Pnotboth(e) - Extsym *e; + Extsym *e; +#else +Pnotboth(Extsym *e) +#endif { if (e->curno) return; @@ -159,9 +185,13 @@ Pnotboth(e) } static int +#ifdef KR_headers numread(pf, n) - register FILE *pf; - int *n; + register FILE *pf; + int *n; +#else +numread(register FILE *pf, int *n) +#endif { register int c, k; @@ -180,13 +210,18 @@ numread(pf, n) return c; } - static void argverify(), Pbadret(); + static void argverify Argdcl((int, Extsym*)); + static void Pbadret Argdcl((int ftype, Extsym *p)); static int +#ifdef KR_headers readref(pf, e, ftype) - register FILE *pf; - Extsym *e; - int ftype; + register FILE *pf; + Extsym *e; + int ftype; +#else +readref(register FILE *pf, Extsym *e, int ftype) +#endif { register int c, *t; int i, nargs, type; @@ -255,8 +290,12 @@ readref(pf, e, ftype) } static int +#ifdef KR_headers comlen(pf) - register FILE *pf; + register FILE *pf; +#else +comlen(register FILE *pf) +#endif { register int c; register char *s, *se; @@ -319,7 +358,7 @@ comlen(pf) } if (!L && !refread) return 0; - e = mkext(buf, cbuf); + e = mkext1(buf, cbuf); if (refread) return readref(pf, e, (int)L); if (e->extstg == STGUNKNOWN) { @@ -339,9 +378,13 @@ comlen(pf) } static int +#ifdef KR_headers Ptoken(pf, canend) - FILE *pf; - int canend; + FILE *pf; + int canend; +#else +Ptoken(FILE *pf, int canend) +#endif { register int c; register char *s, *se; @@ -417,7 +460,7 @@ Ptoken(pf, canend) } static int -Pftype() +Pftype(Void) { switch(Ptok[0]) { case 'C': @@ -484,9 +527,13 @@ Pftype() } static void +#ifdef KR_headers wanted(i, what) - int i; - char *what; + int i; + char *what; +#else +wanted(int i, char *what) +#endif { if (i != P_anum) { Ptok[0] = i; @@ -498,8 +545,12 @@ wanted(i, what) } static int +#ifdef KR_headers Ptype(pf) - FILE *pf; + FILE *pf; +#else +Ptype(FILE *pf) +#endif { int i, rv; @@ -584,16 +635,26 @@ Ptype(pf) rv = TYFTNLEN+100; break; case 'i': - if (!strcmp(Ptok+1, "nteger")) - rv = TYLONG; + if (!strncmp(Ptok+1, "nteger", 6)) { + if (!Ptok[7]) + rv = TYLONG; + else if (Ptok[7] == '1' && !Ptok[8]) + rv = TYINT1; + } break; case 'l': - if (!strcmp(Ptok+1, "ogical")) { - checklogical(1); - rv = TYLOGICAL; + if (!strncmp(Ptok+1, "ogical", 6)) { + if (!Ptok[7]) { + checklogical(1); + rv = TYLOGICAL; + } + else if (Ptok[7] == '1' && !Ptok[8]) + rv = TYLOGICAL1; } - else if (!strcmp(Ptok+1, "ogical1")) - rv = TYLOGICAL1; +#ifdef TYQUAD + else if (!strcmp(Ptok+1,"ongint")) + rv = TYQUAD; +#endif break; case 'r': if (!strcmp(Ptok+1, "eal")) @@ -604,7 +665,7 @@ Ptype(pf) rv = TYSHORT; else if (!strcmp(Ptok+1, "hortlogical")) { checklogical(0); - rv = TYLOGICAL; + rv = TYLOGICAL2; } break; case 'v': @@ -633,7 +694,7 @@ Ptype(pf) } static char * -trimunder() +trimunder(Void) { register char *s; register int n; @@ -654,9 +715,13 @@ trimunder() } static void +#ifdef KR_headers Pbadmsg(msg, p) - char *msg; - Extsym *p; + char *msg; + Extsym *p; +#else +Pbadmsg(char *msg, Extsym *p) +#endif { Pbad++; fprintf(stderr, "%s for %s (line %ld of %s):\n\t", msg, @@ -664,12 +729,14 @@ Pbadmsg(msg, p) p->arginfo->nargs = -1; } - char *Argtype(); - static void +#ifdef KR_headers Pbadret(ftype, p) - int ftype; - Extsym *p; + int ftype; + Extsym *p; +#else +Pbadret(int ftype, Extsym *p) +#endif { char buf1[32], buf2[32]; @@ -680,16 +747,19 @@ Pbadret(ftype, p) } static void +#ifdef KR_headers argverify(ftype, p) - int ftype; - Extsym *p; + int ftype; + Extsym *p; +#else +argverify(int ftype, Extsym *p) +#endif { Argtypes *at; register Atype *aty; int i, j, k; register int *t, *te; char buf1[32], buf2[32]; - int type_fixup(); at = p->arginfo; if (at->nargs < 0) @@ -759,9 +829,13 @@ argverify(ftype, p) } static void +#ifdef KR_headers newarg(ftype, p) - int ftype; - Extsym *p; + int ftype; + Extsym *p; +#else +newarg(int ftype, Extsym *p) +#endif { Argtypes *at; register Atype *aty; @@ -789,8 +863,12 @@ newarg(ftype, p) } static int +#ifdef KR_headers Pfile(fname) - char *fname; + char *fname; +#else +Pfile(char *fname) +#endif { char *s; int ftype, i; @@ -832,7 +910,7 @@ Pfile(fname) getname: if ((i = Ptoken(pf,0)) != P_anum) badchar(i); - p = mkext(trimunder(), Ptok); + p = mkext1(trimunder(), Ptok); if ((i = Ptoken(pf,0)) != '(') badchar(i); @@ -865,8 +943,12 @@ Pfile(fname) } void +#ifdef KR_headers read_Pfiles(ffiles) - char **ffiles; + char **ffiles; +#else +read_Pfiles(char **ffiles) +#endif { char **f1files, **f1files0, *s; int k; diff --git a/usr.bin/f2c/proc.c b/usr.bin/f2c/proc.c index ca3043e..656d9bb 100644 --- a/usr.bin/f2c/proc.c +++ b/usr.bin/f2c/proc.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1994, 1995 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 @@ -26,10 +26,22 @@ this software. #include "output.h" #include "p1defs.h" +/* round a up to the nearest multiple of b: + + a = b * floor ( (a + (b - 1)) / b )*/ + +#undef roundup +#define roundup(a,b) ( b * ( (a+b-1)/b) ) + #define EXNULL (union Expression *)0 -LOCAL dobss(), docomleng(), docommon(), doentry(), - epicode(), nextarg(), retval(); +static void dobss Argdcl((void)); +static void docomleng Argdcl((void)); +static void docommon Argdcl((void)); +static void doentry Argdcl((struct Entrypoint*)); +static void epicode Argdcl((void)); +static int nextarg Argdcl((int)); +static void retval Argdcl((int)); static char Blank[] = BLANKCOMMON; @@ -43,8 +55,12 @@ static char Blank[] = BLANKCOMMON; int prev_proc, proc_argchanges, proc_protochanges; void +#ifdef KR_headers changedtype(q) - Namep q; + Namep q; +#else +changedtype(Namep q) +#endif { char buf[200]; int qtype, type1; @@ -82,9 +98,13 @@ changedtype(q) } void +#ifdef KR_headers unamstring(q, s) - register Addrp q; - register char *s; + register Addrp q; + register char *s; +#else +unamstring(register Addrp q, register char *s) +#endif { register int k; register char *t; @@ -102,7 +122,7 @@ unamstring(q, s) } static void -fix_entry_returns() /* for multiple entry points */ +fix_entry_returns(Void) /* for multiple entry points */ { Addrp a; int i; @@ -144,15 +164,19 @@ fix_entry_returns() /* for multiple entry points */ } static void -putentries(outfile) /* put out wrappers for multiple entries */ - FILE *outfile; +#ifdef KR_headers +putentries(outfile) + FILE *outfile; +#else +putentries(FILE *outfile) +#endif + /* put out wrappers for multiple entries */ { char base[IDENT_LEN]; struct Entrypoint *e; Namep *A, *Ae, *Ae1, **Alp, *a, **a1, np; - chainp args, lengths, length_comp(); - void listargs(), list_arg_types(); - int i, k, mt, nL, type; + chainp args, lengths; + int i, k, mt, nL, t, type; extern char *dfltarg[], **dfltproc; e = entries; @@ -209,12 +233,17 @@ putentries(outfile) /* put out wrappers for multiple entries */ *Alp[np->argno] = np; } args = allargs; - for(a = A; a < Ae; a++, args = args->nextp) + for(a = A; a < Ae; a++, args = args->nextp) { + t = ((Namep)args->datap)->vtype; nice_printf(outfile, ", %s", (np = *a) ? np->cvarname : ((Namep)args->datap)->vclass == CLPROC - ? dfltproc[((Namep)args->datap)->vtype] + ? dfltproc[((Namep)args->datap)->vimpltype + ? (Castargs ? TYUNKNOWN : TYSUBR) + : t == TYREAL && forcedouble && !Castargs + ? TYDREAL : t] : dfltarg[((Namep)args->datap)->vtype]); + } for(; a < Ae1; a++) if (np = *a) nice_printf(outfile, ", %s_len", np->fvarname); @@ -240,8 +269,12 @@ putentries(outfile) /* put out wrappers for multiple entries */ } static void +#ifdef KR_headers entry_goto(outfile) - FILEP outfile; + FILE *outfile; +#else +entry_goto(FILE *outfile) +#endif { struct Entrypoint *e = entries; int k = 0; @@ -257,7 +290,8 @@ entry_goto(outfile) /* start a new procedure */ -newproc() + void +newproc(Void) { if(parstate != OUTSIDE) { @@ -270,7 +304,7 @@ newproc() } static void -zap_changes() +zap_changes(Void) { register chainp cp; register Argtypes *at; @@ -289,7 +323,8 @@ zap_changes() /* end of procedure. generate variables, epilogs, and prologs */ -endproc() + void +endproc(Void) { struct Labelblock *lp; Extsym *ext; @@ -338,11 +373,11 @@ endproc() /* End of declaration section of procedure. Allocate storage. */ -enddcl() + void +enddcl(Void) { register struct Entrypoint *ep; struct Entrypoint *ep0; - extern void freetemps(); chainp cp; extern char *err_proc; static char comblks[] = "common blocks"; @@ -388,9 +423,14 @@ enddcl() /* Main program or Block data */ + void +#ifdef KR_headers startproc(progname, class) -Extsym * progname; -int class; + Extsym *progname; + int class; +#else +startproc(Extsym *progname, int class) +#endif { register struct Entrypoint *p; @@ -418,9 +458,14 @@ int class; /* subroutine or function statement */ -Extsym *newentry(v, substmsg) - register Namep v; - int substmsg; + Extsym * +#ifdef KR_headers +newentry(v, substmsg) + register Namep v; + int substmsg; +#else +newentry(register Namep v, int substmsg) +#endif { register Extsym *p; char buf[128], badname[64]; @@ -453,12 +498,17 @@ Extsym *newentry(v, substmsg) return(p); } - + void +#ifdef KR_headers entrypt(class, type, length, entry, args) -int class, type; -ftnint length; -Extsym *entry; -chainp args; + int class; + int type; + ftnint length; + Extsym *entry; + chainp args; +#else +entrypt(int class, int type, ftnint length, Extsym *entry, chainp args) +#endif { register Namep q; register struct Entrypoint *p; @@ -512,7 +562,8 @@ chainp args; the procedure declaration. Handles multiple return value types, as well as cooercion into the proper value */ -LOCAL epicode() + LOCAL void +epicode(Void) { extern int lastwasbranch; @@ -538,8 +589,13 @@ LOCAL epicode() /* generate code to return value of type t */ -LOCAL retval(t) -register int t; + LOCAL void +#ifdef KR_headers +retval(t) + register int t; +#else +retval(register int t) +#endif { register Addrp p; @@ -576,8 +632,13 @@ register int t; /* Do parameter adjustments */ + void +#ifdef KR_headers procode(outfile) -FILE *outfile; + FILE *outfile; +#else +procode(FILE *outfile) +#endif { prolog(outfile, allargs); @@ -585,6 +646,16 @@ FILE *outfile; entry_goto(outfile); } + static void +#ifdef KR_headers +bad_dimtype(q) Namep q; +#else +bad_dimtype(Namep q) +#endif +{ + errstr("bad dimension type for %.70s", q->fvarname); + } + /* Finish bound computations now that all variables are declared. * This used to be in setbound(), but under -u the following incurred * an erroneous error message: @@ -594,13 +665,16 @@ FILE *outfile; */ static void +#ifdef KR_headers dim_finish(v) - Namep v; + Namep v; +#else +dim_finish(Namep v) +#endif { register struct Dimblock *p; register expptr q; register int i, nd; - extern expptr make_int_expr(); p = v->vdim; v->vdimfinish = 0; @@ -610,8 +684,7 @@ dim_finish(v) if (q = p->dims[i].dimexpr) { q = p->dims[i].dimexpr = make_int_expr(putx(fixtype(q))); if (!ONEOF(q->headblock.vtype, MSKINT|MSKREAL)) - errstr("bad dimension type for %.70s", - v->fvarname); + bad_dimtype(v); } if (q = p->basexpr) p->basexpr = make_int_expr(putx(fixtype(q))); @@ -619,8 +692,12 @@ dim_finish(v) } static void +#ifdef KR_headers duparg(q) - Namep q; + Namep q; +#else +duparg(Namep q) +#endif { errstr("duplicate argument %.80s", q->fvarname); } /* @@ -628,14 +705,19 @@ duparg(q) * keep track of return types and labels */ -LOCAL doentry(ep) -struct Entrypoint *ep; + LOCAL void +#ifdef KR_headers +doentry(ep) + struct Entrypoint *ep; +#else +doentry(struct Entrypoint *ep) +#endif { register int type; register Namep np; chainp p, p1; register Namep q; - Addrp mkarg(), rs; + Addrp rs; int it, k; extern char dflttype[26]; Extsym *entryname = ep->entryname; @@ -791,23 +873,41 @@ struct Entrypoint *ep; -LOCAL nextarg(type) -int type; -{ return(lastargslot++); } + LOCAL int +#ifdef KR_headers +nextarg(type) + int type; +#else +nextarg(int type) +#endif +{ + type = type; /* shut up warning */ + return(lastargslot++); + } - LOCAL + LOCAL void +#ifdef KR_headers dim_check(q) - Namep q; + Namep q; +#else +dim_check(Namep q) +#endif { register struct Dimblock *vdim = q->vdim; + register expptr nelt; - if(!vdim->nelt || !ISICON(vdim->nelt)) + if(!(nelt = vdim->nelt) || !ISCONST(nelt)) dclerr("adjustable dimension on non-argument", q); - else if (vdim->nelt->constblock.Const.ci <= 0) + else if (!ONEOF(nelt->headblock.vtype, MSKINT|MSKREAL)) + bad_dimtype(q); + else if (ISINT(nelt->headblock.vtype) + && nelt->constblock.Const.ci <= 0 + || nelt->constblock.Const.cd[0] <= 0) dclerr("nonpositive dimension", q); } -LOCAL dobss() + LOCAL void +dobss(Void) { register struct Hashentry *p; register Namep q; @@ -849,8 +949,8 @@ LOCAL dobss() } - -donmlist() + void +donmlist(Void) { register struct Hashentry *p; register Namep q; @@ -863,8 +963,13 @@ donmlist() /* iarrlen -- Returns the size of the array in bytes, or -1 */ -ftnint iarrlen(q) -register Namep q; + ftnint +#ifdef KR_headers +iarrlen(q) + register Namep q; +#else +iarrlen(register Namep q) +#endif { ftnint leng; @@ -882,8 +987,13 @@ register Namep q; return(leng); } + void +#ifdef KR_headers namelist(np) -Namep np; + Namep np; +#else +namelist(Namep np) +#endif { register chainp q; register Namep v; @@ -911,7 +1021,8 @@ Namep np; /* docommon -- called at the end of procedure declarations, before equivalences and the procedure body */ -LOCAL docommon() + LOCAL void +docommon(Void) { register Extsym *extptr; register chainp q, q1; @@ -991,8 +1102,13 @@ LOCAL docommon() /* copy_data -- copy the Namep entries so they are available even after the hash table is empty */ -copy_data (list) -chainp list; + void +#ifdef KR_headers +copy_data(list) + chainp list; +#else +copy_data(chainp list) +#endif { for (; list; list = list -> nextp) { Namep namep = ALLOC (Nameblock); @@ -1024,7 +1140,8 @@ chainp list; -LOCAL docomleng() + LOCAL void +docomleng(Void) { register Extsym *p; @@ -1044,15 +1161,20 @@ LOCAL docomleng() /* ROUTINES DEALING WITH AUTOMATIC AND TEMPORARY STORAGE */ + void +#ifdef KR_headers frtemp(p) -Addrp p; + Addrp p; +#else +frtemp(Addrp p) +#endif { /* put block on chain of temps to be reclaimed */ holdtemps = mkchain((char *)p, holdtemps); } void -freetemps() +freetemps(Void) { register chainp p, p1; register Addrp q; @@ -1076,14 +1198,19 @@ freetemps() /* allocate an automatic variable slot for each of nelt variables */ -Addrp autovar(nelt0, t, lengp, name) -register int nelt0, t; -expptr lengp; -char *name; + Addrp +#ifdef KR_headers +autovar(nelt0, t, lengp, name) + register int nelt0; + register int t; + expptr lengp; + char *name; +#else +autovar(register int nelt0, register int t, expptr lengp, char *name) +#endif { ftnint leng; register Addrp q; - char *temp_name (); register int nelt = nelt0 > 0 ? nelt0 : 1; extern char *av_pfix[]; @@ -1125,14 +1252,20 @@ char *name; /* Returns a temporary of the appropriate type. Will reuse existing temporaries when possible */ -Addrp mktmpn(nelt, type, lengp) -int nelt; -register int type; -expptr lengp; + Addrp +#ifdef KR_headers +mktmpn(nelt, type, lengp) + int nelt; + register int type; + expptr lengp; +#else +mktmpn(int nelt, register int type, expptr lengp) +#endif { ftnint leng; chainp p, oldp; register Addrp q; + extern int krparens; if(type==TYUNKNOWN || type==TYERROR) badtype("mktmpn", type); @@ -1152,6 +1285,8 @@ expptr lengp; * if a temporary of appropriate shape is on the templist, * remove it from the list and return it */ + if (krparens == 2 && ONEOF(type,M(TYREAL)|M(TYCOMPLEX))) + type++; for(oldp=CHNULL, p=templist[type]; p ; oldp=p, p=p->nextp) { q = (Addrp) (p->datap); @@ -1176,9 +1311,14 @@ expptr lengp; /* mktmp -- create new local variable; call it something like name lengp is taken directly, not copied */ -Addrp mktmp(type, lengp) -int type; -expptr lengp; + Addrp +#ifdef KR_headers +mktmp(type, lengp) + int type; + expptr lengp; +#else +mktmp(int type, expptr lengp) +#endif { Addrp rv; /* arrange for temporaries to be recycled */ @@ -1189,9 +1329,14 @@ expptr lengp; } /* mktmp0 omits frtemp() */ -Addrp mktmp0(type, lengp) -int type; -expptr lengp; + Addrp +#ifdef KR_headers +mktmp0(type, lengp) + int type; + expptr lengp; +#else +mktmp0(int type, expptr lengp) +#endif { Addrp rv; /* arrange for temporaries to be recycled */ @@ -1206,8 +1351,13 @@ expptr lengp; /* comblock -- Declare a new common block. Input parameters name the block; s will be NULL if the block is unnamed */ -Extsym *comblock(s) - register char *s; + Extsym * +#ifdef KR_headers +comblock(s) + register char *s; +#else +comblock(register char *s) +#endif { Extsym *p; register char *t; @@ -1217,7 +1367,7 @@ Extsym *comblock(s) /* Give the unnamed common block a unique name */ if(*s == 0) - p = mkext(Blank,Blank); + p = mkext1(s0 = Blank, Blank); else { s0 = s; t = cbuf; @@ -1228,13 +1378,14 @@ Extsym *comblock(s) *t++ = '_'; t[0] = '_'; t[1] = 0; - p = mkext(s0,cbuf); + p = mkext1(s0,cbuf); } if(p->extstg == STGUNKNOWN) p->extstg = STGCOMMON; else if(p->extstg != STGCOMMON) { - errstr("%.68s cannot be a common block name", s); + errstr("%.52s cannot be a common block: it is a subprogram.", + s0); return(0); } @@ -1244,9 +1395,14 @@ Extsym *comblock(s) /* incomm -- add a new variable to a common declaration */ + void +#ifdef KR_headers incomm(c, v) -Extsym *c; -Namep v; + Extsym *c; + Namep v; +#else +incomm(Extsym *c, Namep v) +#endif { if (!c) return; @@ -1269,10 +1425,15 @@ Namep v; -type. This function will not change any earlier definitions in v, in will only attempt to fill out more information give the other params */ + void +#ifdef KR_headers settype(v, type, length) -register Namep v; -register int type; -register ftnint length; + register Namep v; + register int type; + register ftnint length; +#else +settype(register Namep v, register int type, register ftnint length) +#endif { int type1; @@ -1342,9 +1503,14 @@ register ftnint length; /* lengtype -- returns the proper compiler type, given input of Fortran type and length specifier */ + int +#ifdef KR_headers lengtype(type, len) -register int type; -ftnint len; + register int type; + ftnint len; +#else +lengtype(register int type, ftnint len) +#endif { register int length = (int)len; switch(type) @@ -1422,21 +1588,16 @@ ret: /* setintr -- Set Intrinsic function */ + void +#ifdef KR_headers setintr(v) -register Namep v; + register Namep v; +#else +setintr(register Namep v) +#endif { int k; - if(v->vstg == STGUNKNOWN) - v->vstg = STGINTR; - else if(v->vstg!=STGINTR) - dclerr("incompatible use of intrinsic function", v); - if(v->vclass==CLUNKNOWN) - v->vclass = CLPROC; - if(v->vprocclass == PUNKNOWN) - v->vprocclass = PINTRINSIC; - else if(v->vprocclass != PINTRINSIC) - dclerr("invalid intrinsic declaration", v); if(k = intrfunct(v->fvarname)) { if ((*(struct Intrpacked *)&k).f4) if (noextflag) @@ -1448,7 +1609,18 @@ register Namep v; else { unknown: dclerr("unknown intrinsic function", v); + return; } + if(v->vstg == STGUNKNOWN) + v->vstg = STGINTR; + else if(v->vstg!=STGINTR) + dclerr("incompatible use of intrinsic function", v); + if(v->vclass==CLUNKNOWN) + v->vclass = CLPROC; + if(v->vprocclass == PUNKNOWN) + v->vprocclass = PINTRINSIC; + else if(v->vprocclass != PINTRINSIC) + dclerr("invalid intrinsic declaration", v); } @@ -1456,8 +1628,13 @@ register Namep v; /* setext -- Set External declaration -- assume that unknowns will become procedures */ + void +#ifdef KR_headers setext(v) -register Namep v; + register Namep v; +#else +setext(register Namep v) +#endif { if(v->vclass == CLUNKNOWN) v->vclass = CLPROC; @@ -1475,10 +1652,15 @@ register Namep v; /* create dimensions block for array variable */ + void +#ifdef KR_headers setbound(v, nd, dims) -register Namep v; -int nd; -struct Dims dims[ ]; + register Namep v; + int nd; + struct Dims *dims; +#else +setbound(register Namep v, int nd, struct Dims *dims) +#endif { register expptr q, t; register struct Dimblock *p; @@ -1500,6 +1682,23 @@ struct Dims dims[ ]; p->nelt = ICON(1); doin_setbound = 1; + if (noextflag) + for(i = 0; i <= nd; i++) + if (((q = dims[i].lb) && !ISINT(q->headblock.vtype)) + || ((q = dims[i].ub) && !ISINT(q->headblock.vtype))) { + sprintf(buf, "dimension %d of %s is not an integer.", + i+1, v->fvarname); + errext(buf); + break; + } + + for(i = 0; i <= nd; i++) { + if (((q = dims[i].lb) && !ISINT(q->headblock.vtype))) + dims[i].lb = mkconv(TYINT, q); + if (((q = dims[i].ub) && !ISINT(q->headblock.vtype))) + dims[i].ub = mkconv(TYINT, q); + } + for(i = 0; i <= nd; ++i) { if( (q = dims[i].ub) == NULL) @@ -1572,11 +1771,15 @@ struct Dims dims[ ]; } - -wr_abbrevs (outfile, function_head, vars) -FILE *outfile; -int function_head; -chainp vars; + void +#ifdef KR_headers +wr_abbrevs(outfile, function_head, vars) + FILE *outfile; + int function_head; + chainp vars; +#else +wr_abbrevs(FILE *outfile, int function_head, chainp vars) +#endif { for (; vars; vars = vars -> nextp) { Namep name = (Namep) vars -> datap; diff --git a/usr.bin/f2c/put.c b/usr.bin/f2c/put.c index cbe0b4a..6520ed5 100644 --- a/usr.bin/f2c/put.c +++ b/usr.bin/f2c/put.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1991, 1993, 1994 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 @@ -71,15 +71,13 @@ int ops2 [ ] = }; -setlog() -{ - typesize[TYLOGICAL] = typesize[tylogical]; - typealign[TYLOGICAL] = typealign[tylogical]; -} - - + void +#ifdef KR_headers putexpr(p) -expptr p; + expptr p; +#else +putexpr(expptr p) +#endif { /* Write the expression to the p1 file */ @@ -91,8 +89,14 @@ expptr p; -expptr putassign(lp, rp) -expptr lp, rp; + expptr +#ifdef KR_headers +putassign(lp, rp) + expptr lp; + expptr rp; +#else +putassign(expptr lp, expptr rp) +#endif { return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp))); } @@ -100,8 +104,14 @@ expptr lp, rp; -void puteq(lp, rp) -expptr lp, rp; + void +#ifdef KR_headers +puteq(lp, rp) + expptr lp; + expptr rp; +#else +puteq(expptr lp, expptr rp) +#endif { putexpr(mkexpr(OPASSIGN, lp, rp) ); } @@ -111,8 +121,14 @@ expptr lp, rp; /* put code for a *= b */ -expptr putsteq(a, b) -Addrp a, b; + expptr +#ifdef KR_headers +putsteq(a, b) + Addrp a; + Addrp b; +#else +putsteq(Addrp a, Addrp b) +#endif { return putx( fixexpr((Exprp) mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b)))); @@ -121,10 +137,15 @@ Addrp a, b; -Addrp mkfield(res, f, ty) -register Addrp res; -char *f; -int ty; + Addrp +#ifdef KR_headers +mkfield(res, f, ty) + register Addrp res; + char *f; + int ty; +#else +mkfield(register Addrp res, char *f, int ty) +#endif { res -> vtype = ty; res -> Field = f; @@ -132,11 +153,15 @@ int ty; } /* mkfield */ -Addrp realpart(p) -register Addrp p; + Addrp +#ifdef KR_headers +realpart(p) + register Addrp p; +#else +realpart(register Addrp p) +#endif { register Addrp q; - expptr mkrealcon(); if (p->tag == TADDR && p->uname_tag == UNAM_CONST @@ -155,11 +180,15 @@ register Addrp p; -expptr imagpart(p) -register Addrp p; + expptr +#ifdef KR_headers +imagpart(p) + register Addrp p; +#else +imagpart(register Addrp p) +#endif { register Addrp q; - expptr mkrealcon(); if( ISCOMPLEX(p->vtype) ) { @@ -184,8 +213,13 @@ register Addrp p; /* ncat -- computes the number of adjacent concatenation operations */ + int +#ifdef KR_headers ncat(p) -register expptr p; + register expptr p; +#else +ncat(register expptr p) +#endif { if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT) return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) ); @@ -198,8 +232,13 @@ register expptr p; /* lencat -- returns the length of the concatenated string. Each substring must have a static (i.e. compile-time) fixed length */ -ftnint lencat(p) -register expptr p; + ftnint +#ifdef KR_headers +lencat(p) + register expptr p; +#else +lencat(register expptr p) +#endif { if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT) return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) ); @@ -223,8 +262,13 @@ register expptr p; to by q when (q -> memno == litp -> litnum). */ -Addrp putconst(p) -register Constp p; + Addrp +#ifdef KR_headers +putconst(p) + register Constp p; +#else +putconst(register Constp p) +#endif { register Addrp q; struct Literal *litp, *lastlit; @@ -295,10 +339,7 @@ register Constp p; case TYLOGICAL1: case TYLOGICAL2: case TYLOGICAL: - type = tylogical; - goto lit_int_flavor; case TYLONG: - type = tyint; case TYSHORT: case TYINT1: #ifdef TYQUAD diff --git a/usr.bin/f2c/putpcc.c b/usr.bin/f2c/putpcc.c index d96e5e2..6d87d3c 100644 --- a/usr.bin/f2c/putpcc.c +++ b/usr.bin/f2c/putpcc.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 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 @@ -30,16 +30,20 @@ this software. #include "names.h" #include "p1defs.h" -Addrp realpart(); -LOCAL Addrp intdouble(), putcx1(), putcxeq (), putch1 (); -LOCAL putct1 (); - -expptr putcxop(); -LOCAL expptr putcall (), putmnmx (), putcheq(), putcat (); -LOCAL expptr putaddr(), putchcmp (), putpower(), putop(); -LOCAL expptr putcxcmp (); -expptr imagpart(); -ftnint lencat(); +static Addrp intdouble Argdcl((Addrp)); +static Addrp putcx1 Argdcl((tagptr)); +static tagptr putaddr Argdcl((tagptr)); +static tagptr putcall Argdcl((tagptr, Addrp*)); +static tagptr putcat Argdcl((tagptr, tagptr)); +static Addrp putch1 Argdcl((tagptr)); +static tagptr putchcmp Argdcl((tagptr)); +static tagptr putcheq Argdcl((tagptr)); +static void putct1 Argdcl((tagptr, Addrp, Addrp, ptr)); +static tagptr putcxcmp Argdcl((tagptr)); +static Addrp putcxeq Argdcl((tagptr)); +static tagptr putmnmx Argdcl((tagptr)); +static tagptr putop Argdcl((tagptr)); +static tagptr putpower Argdcl((tagptr)); #define FOUR 4 extern int ops2[]; @@ -51,9 +55,14 @@ extern int krparens; /* Puthead -- output the header information about subroutines, functions and entry points */ + void +#ifdef KR_headers puthead(s, class) -char *s; -int class; + char *s; + int class; +#else +puthead(char *s, int class) +#endif { if (headerdone == NO) { if (class == CLMAIN) @@ -63,9 +72,14 @@ int class; } } + void +#ifdef KR_headers putif(p, else_if_p) - register expptr p; - int else_if_p; + register expptr p; + int else_if_p; +#else +putif(register expptr p, int else_if_p) +#endif { register int k; int n; @@ -109,9 +123,13 @@ putif(p, else_if_p) } } - + void +#ifdef KR_headers putout(p) -expptr p; + expptr p; +#else +putout(expptr p) +#endif { p1_expr (p); @@ -120,11 +138,15 @@ expptr p; } - + void +#ifdef KR_headers putcmgo(index, nlab, labs) -expptr index; -int nlab; -struct Labelblock *labs[]; + expptr index; + int nlab; + struct Labelblock **labs; +#else +putcmgo(expptr index, int nlab, struct Labelblock **labs) +#endif { if(! ISINT(index->headblock.vtype) ) { @@ -136,8 +158,12 @@ struct Labelblock *labs[]; } static expptr +#ifdef KR_headers krput(p) - register expptr p; + register expptr p; +#else +krput(register expptr p) +#endif { register expptr e, e1; register unsigned op; @@ -164,8 +190,13 @@ krput(p) return p; } -expptr putx(p) - register expptr p; + expptr +#ifdef KR_headers +putx(p) + register expptr p; +#else +putx(register expptr p) +#endif { int opc; int k; @@ -349,8 +380,13 @@ putopp: -LOCAL expptr putop(p) -expptr p; + LOCAL expptr +#ifdef KR_headers +putop(p) + expptr p; +#else +putop(expptr p) +#endif { expptr lp, tp; int pt, lt, lt1; @@ -409,6 +445,8 @@ expptr p; p->exprblock.leftp = putx(p->exprblock.leftp); return p; } + if (pt < lt && ONEOF(lt,MSKINT|MSKREAL)) + break; frexpr(p->exprblock.vleng); free( (charptr) p ); p = lp; @@ -454,14 +492,22 @@ expptr p; if( ops2[p->exprblock.opcode] <= 0) badop("putop", p->exprblock.opcode); - p -> exprblock.leftp = putx (p -> exprblock.leftp); - if (p -> exprblock.rightp) - p -> exprblock.rightp = putx (p -> exprblock.rightp); + lp = p->exprblock.leftp = putx(p->exprblock.leftp); + if (p -> exprblock.rightp) { + tp = p->exprblock.rightp = putx(p->exprblock.rightp); + if (ISCONST(tp) && ISCONST(lp)) + p = fold(p); + } return p; } -LOCAL expptr putpower(p) -expptr p; + LOCAL expptr +#ifdef KR_headers +putpower(p) + expptr p; +#else +putpower(expptr p) +#endif { expptr base; Addrp t1, t2; @@ -521,8 +567,13 @@ expptr p; -LOCAL Addrp intdouble(p) -Addrp p; + LOCAL Addrp +#ifdef KR_headers +intdouble(p) + Addrp p; +#else +intdouble(Addrp p) +#endif { register Addrp t; @@ -537,8 +588,13 @@ Addrp p; /* Complex-type variable assignment */ -LOCAL Addrp putcxeq(p) -register expptr p; + LOCAL Addrp +#ifdef KR_headers +putcxeq(p) + register expptr p; +#else +putcxeq(register expptr p) +#endif { register Addrp lp, rp; expptr code; @@ -566,16 +622,26 @@ register expptr p; /* putcxop -- used to write out embedded calls to complex functions, and complex arguments to procedures */ -expptr putcxop(p) -expptr p; + expptr +#ifdef KR_headers +putcxop(p) + expptr p; +#else +putcxop(expptr p) +#endif { return (expptr)putaddr((expptr)putcx1(p)); } #define PAIR(x,y) mkexpr (OPCOMMA, (x), (y)) -LOCAL Addrp putcx1(p) -register expptr p; + LOCAL Addrp +#ifdef KR_headers +putcx1(p) + register expptr p; +#else +putcx1(register expptr p) +#endif { expptr q; Addrp lp, rp; @@ -583,7 +649,6 @@ register expptr p; int opcode; int ltype, rtype; long ts, tskludge; - expptr mkrealcon(); if(p == NULL) return(NULL); @@ -642,10 +707,14 @@ register expptr p; case TEXPR: if( ISCOMPLEX(p->exprblock.vtype) ) break; - resp = mktmp(TYDREAL, ENULL); + resp = mktmp(p->exprblock.vtype, ENULL); + /*first arg of above mktmp call was TYDREAL before 19950102 */ putout (putassign( cpexpr((expptr)resp), p)); return(resp); + case TERROR: + return NULL; + default: badtag("putcx1", p->tag); } @@ -759,7 +828,9 @@ register expptr p; break; case OPCONV: - if( ISCOMPLEX(lp->vtype) ) + if (!lp) + break; + if(ISCOMPLEX(lp->vtype) ) q = imagpart(lp); else if(rp != NULL) q = (expptr) realpart(rp); @@ -786,8 +857,13 @@ register expptr p; /* Only .EQ. and .NE. may be performed on COMPLEX data, other relations are not defined */ -LOCAL expptr putcxcmp(p) -register expptr p; + LOCAL expptr +#ifdef KR_headers +putcxcmp(p) + register expptr p; +#else +putcxcmp(register expptr p) +#endif { int opcode; register Addrp lp, rp; @@ -814,8 +890,13 @@ register expptr p; /* putch1 -- Forces constants into the literal pool, among other things */ -LOCAL Addrp putch1(p) -register expptr p; + LOCAL Addrp +#ifdef KR_headers +putch1(p) + register expptr p; +#else +putch1(register expptr p) +#endif { Addrp t; expptr e; @@ -876,8 +957,13 @@ register expptr p; /* putchop -- Write out a character actual parameter; that is, this is part of a procedure invocation */ -Addrp putchop(p) -expptr p; + Addrp +#ifdef KR_headers +putchop(p) + expptr p; +#else +putchop(expptr p) +#endif { p = putaddr((expptr)putch1(p)); return (Addrp)p; @@ -886,8 +972,13 @@ expptr p; -LOCAL expptr putcheq(p) -register expptr p; + LOCAL expptr +#ifdef KR_headers +putcheq(p) + register expptr p; +#else +putcheq(register expptr p) +#endif { expptr lp, rp; int nbad; @@ -922,8 +1013,13 @@ register expptr p; -LOCAL expptr putchcmp(p) -register expptr p; + LOCAL expptr +#ifdef KR_headers +putchcmp(p) + register expptr p; +#else +putchcmp(register expptr p) +#endif { expptr lp, rp; @@ -962,9 +1058,14 @@ register expptr p; */ -LOCAL expptr putcat(lhs0, rhs) - expptr lhs0; - register expptr rhs; + LOCAL expptr +#ifdef KR_headers +putcat(lhs0, rhs) + expptr lhs0; + register expptr rhs; +#else +putcat(expptr lhs0, register expptr rhs) +#endif { register Addrp lhs = (Addrp)lhs0; int n, tyi; @@ -1006,10 +1107,16 @@ LOCAL expptr putcat(lhs0, rhs) -LOCAL putct1(q, length_var, string_var, ip) -register expptr q; -register Addrp length_var, string_var; -int *ip; + LOCAL void +#ifdef KR_headers +putct1(q, length_var, string_var, ip) + register expptr q; + register Addrp length_var; + register Addrp string_var; + int *ip; +#else +putct1(register expptr q, register Addrp length_var, register Addrp string_var, int *ip) +#endif { int i; Addrp length_copy, string_copy; @@ -1045,8 +1152,13 @@ int *ip; /* putaddr -- seems to write out function invocation actual parameters */ -LOCAL expptr putaddr(p0) - expptr p0; + LOCAL expptr +#ifdef KR_headers +putaddr(p0) + expptr p0; +#else +putaddr(expptr p0) +#endif { register Addrp p; chainp cp; @@ -1071,18 +1183,28 @@ LOCAL expptr putaddr(p0) } LOCAL expptr -addrfix(e) /* fudge character string length if it's a TADDR */ - expptr e; +#ifdef KR_headers +addrfix(e) + expptr e; +#else +addrfix(expptr e) +#endif + /* fudge character string length if it's a TADDR */ { return e->tag == TADDR ? mkexpr(OPIDENTITY, e, ENULL) : e; } LOCAL int +#ifdef KR_headers typekludge(ccall, q, at, j) - int ccall; - register expptr q; - Atype *at; - int j; /* alternate type */ + int ccall; + register expptr q; + Atype *at; + int j; +#else +typekludge(int ccall, register expptr q, Atype *at, int j) +#endif + /* j = alternate type */ { register int i, k; extern int iocalladdr; @@ -1177,9 +1299,13 @@ typekludge(ccall, q, at, j) } char * +#ifdef KR_headers Argtype(k, buf) - int k; - char *buf; + int k; + char *buf; +#else +Argtype(int k, char *buf) +#endif { if (k < 100) { sprintf(buf, "%s variable", ftn_types[k]); @@ -1204,9 +1330,13 @@ Argtype(k, buf) } static void +#ifdef KR_headers atype_squawk(at, msg) - Argtypes *at; - char *msg; + Argtypes *at; + char *msg; +#else +atype_squawk(Argtypes *at, char *msg) +#endif { register Atype *a, *ae; warn(msg); @@ -1220,10 +1350,18 @@ atype_squawk(at, msg) static char inconsist[] = "inconsistent calling sequences for "; void +#ifdef KR_headers bad_atypes(at, fname, i, j, k, here, prev) - Argtypes *at; - char *fname, *here, *prev; - int i, j, k; + Argtypes *at; + char *fname; + int i; + int j; + int k; + char *here; + char *prev; +#else +bad_atypes(Argtypes *at, char *fname, int i, int j, int k, char *here, char *prev) +#endif { char buf[208], buf1[32], buf2[32]; @@ -1234,10 +1372,14 @@ bad_atypes(at, fname, i, j, k, here, prev) } int -type_fixup(at,a,k) - Argtypes *at; - Atype *a; - int k; +#ifdef KR_headers +type_fixup(at, a, k) + Argtypes *at; + Atype *a; + int k; +#else +type_fixup(Argtypes *at, Atype *a, int k) +#endif { register struct Entrypoint *ep; if (!infertypes) @@ -1252,11 +1394,20 @@ type_fixup(at,a,k) void +#ifdef KR_headers save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap) - chainp arglist; - Argtypes **at0, **at1; - int ccall, stg, nchargs, type, zap; - char *fname; + chainp arglist; + Argtypes **at0; + Argtypes **at1; + int ccall; + char *fname; + int stg; + int nchargs; + int type; + int zap; +#else +save_argtypes(chainp arglist, Argtypes **at0, Argtypes **at1, int ccall, char *fname, int stg, int nchargs, int type, int zap) +#endif { Argtypes *at; chainp cp; @@ -1305,14 +1456,18 @@ save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap) "%s%.90s:\n\there %d, previously %d args and string lengths.", inconsist, fname, i, nargs); atype_squawk(at, buf); - if (type) + if (type) { + t = init_ap[type]; goto newlist; + } return; } j = atypes->type; k = *t++; - if (j != k) + if (j != k && j-400 != k) { + cp = 0; goto badtypes; + } } for(cp = arglist; cp; atypes++, cp = cp->nextp) { if (++i > nargs) @@ -1354,13 +1509,15 @@ save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap) { badtypes: if (++nbad == 1) - bad_atypes(at, fname, i, j, k, "here ", - ", previously"); + bad_atypes(at, fname, i - nchargs, + j, k, "here ", ", previously"); else fprintf(stderr, "\targ %d: here %s, previously %s.\n", - i, Argtype(k,buf1), + i - nchargs, Argtype(k,buf1), Argtype(j,buf2)); + if (!cp) + break; continue; } /* We've subsequently learned the right type, @@ -1422,8 +1579,13 @@ save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap) } void -saveargtypes(p) /* for writing prototypes */ - register Exprp p; +#ifdef KR_headers +saveargtypes(p) + register Exprp p; +#else +saveargtypes(register Exprp p) +#endif + /* for writing prototypes */ { Addrp a; Argtypes **at0, **at1; @@ -1474,9 +1636,14 @@ saveargtypes(p) /* for writing prototypes */ expression. The return value is a pointer to a temporary holding the result of a COMPLEX or CHARACTER operation, or NULL. */ -LOCAL expptr putcall(p0, temp) - expptr p0; - Addrp *temp; + LOCAL expptr +#ifdef KR_headers +putcall(p0, temp) + expptr p0; + Addrp *temp; +#else +putcall(expptr p0, Addrp *temp) +#endif { register Exprp p = (Exprp)p0; chainp arglist; /* Pointer to actual arguments, if any */ @@ -1493,7 +1660,6 @@ LOCAL expptr putcall(p0, temp) parameter list, since we're calling a C library routine */ char *s; - extern struct Listblock *mklist(); type = p -> vtype; charsp = NULL; @@ -1682,8 +1848,13 @@ LOCAL expptr putcall(p0, temp) /* putmnmx -- Put min or max. p must point to an EXPR, not just a CONST */ -LOCAL expptr putmnmx(p) -register expptr p; + LOCAL expptr +#ifdef KR_headers +putmnmx(p) + register expptr p; +#else +putmnmx(register expptr p) +#endif { int op, op2, type; expptr arg, qp, temp; @@ -1809,8 +1980,12 @@ register expptr p; void +#ifdef KR_headers putwhile(p) - expptr p; + expptr p; +#else +putwhile(expptr p) +#endif { long where; int k, n; diff --git a/usr.bin/f2c/readme b/usr.bin/f2c/readme index ed88aaa..b8e5a67 100644 --- a/usr.bin/f2c/readme +++ b/usr.bin/f2c/readme @@ -1,10 +1,10 @@ Type "make" to check the validity of the f2c source and compile f2c. On a PC, you may need to compile xsum.c with -DMSDOS (i.e., with -MSDOS #defined). If your system does not understand ANSI/ISO C -syntax (i.e., if you have a K&R C compiler), compile xsum.c with --DKR_headers. (Eventually this will also be required of the f2c -source proper.) +MSDOS #defined). + +If your compiler does not understand ANSI/ISO C syntax (i.e., if +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". @@ -20,15 +20,21 @@ You may need to modify usignal.h if you are not running f2c on a UNIX system. Should you get the message "xsum0.out xsum1.out differ", see what lines -are different (`diff xsum0.out xsum1.out`) and ask netlib to send you -the files in question "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 from f2c/src +are different (`diff xsum0.out xsum1.out`) and ask netlib +(e.g., netlib@research.att.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". On some systems, the malloc and free in malloc.c let f2c run faster -than do the standard malloc and free. Other systems cannot tolerate -redefinition of malloc and free. If yours is such a system, you may -either modify the makefile appropriately, or simply execute +than do the standard malloc and free. Other systems may not tolerate +redefinition of malloc and free (though changes of 8 Nov. 1994 may +render this less of a problem than hitherto). If yours is such a +system, you may either modify the makefile appropriately (remove +"malloc.o" from the "OBJECTS =" assignment), or simply execute 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 @@ -66,9 +72,21 @@ message of the form Compiler error ... cannot open intermediate file ... On many systems, it is best to combine libF77 and libI77 into a single -library, say libf2c, as suggested in "readme from f2c". If you do this, -then you should adjust the definition of link_msg in sysdep.c -appropriately (e.g., replacing "-lF77 -lI77" by "-lf2c"). +library, say libf2c, as suggested in "readme from f2c". If you do not +do this, then you should adjust the definition of link_msg in sysdep.c +appropriately (e.g., replacing "-lf2c" by "-lF77 -lI77"). On Unix +systems, the easiest way to create libf2c.a is to make libF77/libF77.a +and libI77/libI77.a (after reading and heeding libF77/README and +libI77/README), and then to say + + cp libF77/libF77.a libf2c.a + ar ruv libf2c.a libI77/*.o + ranlib libf2c.a + +The last step, ranlib, may not be necessary on your system. On +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 . Some older C compilers object to typedef void (*foo)(); @@ -85,10 +103,43 @@ test by compiling lex.c with NO_EOF_CHAR_CHECK #defined, or can change control-Z to some other character by #defining EOF_CHAR to be the desired value. + +If your machine has IEEE, VAX, or IBM-mainframe arithmetic, but your +printf is inaccurate (e.g., with Symantec C++ version 6.0, +printf("%.17g",12.) prints 12.000000000000001), you can make f2c print +correctly rounded numbers by compiling with -DUSE_DTOA and adding +dtoa.o g_fmt.o to the makefile's OBJECTS = line, so it becomes + + OBJECTS = $(OBJECTSd) malloc.o dtoa.o g_fmt.o + +Also add the rule + + dtoa.o: dtoa.c + $(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c + +(without the initial tab) to the makefile, where IEEE... is one of +IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's +arithmetic. See the comments near the start of dtoa.c. + +The relevant source files, dtoa.c and g_fmt.c, are available +separately from netlib's fp directory. For example, you could +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). + +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 (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. +files. Changes first appear on netlib@research.att.com, and in due +time propagate to the other netlib sites that are kept current. diff --git a/usr.bin/f2c/sysdep.c b/usr.bin/f2c/sysdep.c index 81bc5af..29b1a05 100644 --- a/usr.bin/f2c/sysdep.c +++ b/usr.bin/f2c/sysdep.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1994 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 @@ -37,6 +37,8 @@ char *proto_fname = "proto_file"; char link_msg[] = "-lf2c -lm"; /* was "-lF77 -lI77 -lm -lc"; */ +char *outbuf = "", *outbtail; + #ifndef TMPDIR #ifdef MSDOS #define TMPDIR "" @@ -46,10 +48,23 @@ char link_msg[] = "-lf2c -lm"; /* was "-lF77 -lI77 -lm -lc"; */ #endif char *tmpdir = TMPDIR; +#ifndef MSDOS +#ifndef KR_headers +extern int getpid(void); +#endif +#endif void +#ifdef KR_headers Un_link_all(cdelete) + int cdelete; +#else +Un_link_all(int cdelete) +#endif { +#ifndef KR_headers + extern int unlink(const char *); +#endif if (!debugflag) { unlink(c_functions); unlink(initfname); @@ -62,7 +77,7 @@ Un_link_all(cdelete) } void -set_tmp_names() +set_tmp_names(Void) { int k; if (debugflag == 1) @@ -116,7 +131,13 @@ set_tmp_names() } char * -c_name(s,ft)char *s; +#ifdef KR_headers +c_name(s, ft) + char *s; + int ft; +#else +c_name(char *s, int ft) +#endif { char *b, *s0; int c; @@ -130,15 +151,21 @@ c_name(s,ft)char *s; infname = s0; Fatal("file name must end in .f or .F"); } - *s = ft; - b = copys(b); - *s = c; + strcpy(outbtail, b); + outbtail[s-b] = ft; + b = copys(outbuf); return b; } static void +#ifdef KR_headers killed(sig) + int sig; +#else +killed(int sig) +#endif { + sig = sig; /* shut up warning */ signal(SIGINT, SIG_IGN); #ifdef SIGQUIT signal(SIGQUIT, SIG_IGN); @@ -152,15 +179,27 @@ killed(sig) } static void +#ifdef KR_headers sig1catch(sig) + int sig; +#else +sig1catch(int sig) +#endif { + sig = sig; /* shut up warning */ if (signal(sig, SIG_IGN) != SIG_IGN) signal(sig, killed); } static void +#ifdef KR_headers flovflo(sig) + int sig; +#else +flovflo(int sig) +#endif { + sig = sig; /* shut up warning */ Fatal("floating exception during constant evaluation; cannot recover"); /* vax returns a reserved operand that generates an illegal operand fault on next instruction, @@ -170,8 +209,14 @@ flovflo(sig) } void +#ifdef KR_headers sigcatch(sig) + int sig; +#else +sigcatch(int sig) +#endif { + sig = sig; /* shut up warning */ sig1catch(SIGINT); #ifdef SIGQUIT sig1catch(SIGQUIT); @@ -184,11 +229,14 @@ sigcatch(sig) } -dofork() +dofork(Void) { #ifdef MSDOS Fatal("Only one Fortran input file allowed under MS-DOS"); #else +#ifndef KR_headers + extern int fork(void), wait(int*); +#endif int pid, status, w; extern int retcode; @@ -257,7 +305,7 @@ char *chr_fmt[Table_size] = { }; void -fmt_init() +fmt_init(Void) { static char *str1fmt[6] = { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" }; @@ -328,6 +376,22 @@ fmt_init() chr_fmt[11] = Ansi ? "\\v" : "\\13"; } + void +outbuf_adjust(Void) +{ + int n, n1; + char *s; + + n = n1 = strlen(outbuf); + if (*outbuf && outbuf[n-1] != '/') + n1++; + s = Alloc(n+64); + outbtail = s + n1; + strcpy(s, outbuf); + if (n != n1) + strcpy(s+n, "/"); + outbuf = s; + } /* Unless SYSTEM_SORT is defined, the following gives a simple @@ -341,8 +405,14 @@ fmt_init() #ifdef SYSTEM_SORT + int +#ifdef KR_headers dsort(from, to) - char *from, *to; + char *from; + char *to; +#else +dsort(char *from, char *to) +#endif { char buf[200]; sprintf(buf, "sort <%s >%s", from, to); @@ -351,15 +421,22 @@ dsort(from, to) #else static int -compare(a,b) - char *a, *b; +#ifdef KR_headers + compare(a,b) + char *a, *b; +#else + compare(const void *a, const void *b) +#endif { return strcmp(*(char **)a, *(char **)b); } +#ifdef KR_headers dsort(from, to) - char *from, *to; + char *from; + char *to; +#else +dsort(char *from, char *to) +#endif { - extern char *Alloc(); - struct Memb { struct Memb *next; int n; diff --git a/usr.bin/f2c/sysdep.h b/usr.bin/f2c/sysdep.h index aef7335..192e3a9 100644 --- a/usr.bin/f2c/sysdep.h +++ b/usr.bin/f2c/sysdep.h @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1991 by AT&T Bell Laboratories, Bellcore. +Copyright 1990, 1991, 1994 by AT&T Bell Laboratories, Bellcore. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby @@ -27,6 +27,10 @@ this software. */ #ifdef __STDC__ +#undef KR_headers +#endif + +#ifndef KR_headers #ifndef ANSI_Libraries #define ANSI_Libraries #endif @@ -37,12 +41,10 @@ this software. #ifdef __BORLANDC__ #define MSDOS -extern int ind_printf(), nice_printf(); #endif #ifdef __ZTC__ /* Zortech */ #define MSDOS -extern int ind_printf(...), nice_printf(...); #endif #ifdef MSDOS @@ -61,21 +63,16 @@ extern int ind_printf(...), nice_printf(...); #else char *calloc(), *malloc(), *memcpy(), *memset(), *realloc(); typedef int size_t; -#ifdef ANSI_Prototypes -extern double atof(const char *); -#else -extern double atof(); -#endif +#ifndef atol + long atol(); #endif #ifdef ANSI_Prototypes -extern char *gmem(int, int); -extern char *mem(int, int); -extern char *Alloc(int); -extern int* ckalloc(int); +extern double atof(const char *); +extern double strtod(const char*, char**); #else -extern char *Alloc(), *gmem(), *mem(); -int *ckalloc(); +extern double atof(), strtod(); +#endif #endif /* On systems like VMS where fopen might otherwise create diff --git a/usr.bin/f2c/tokens b/usr.bin/f2c/tokens index d97fb52..07b1881 100644 --- a/usr.bin/f2c/tokens +++ b/usr.bin/f2c/tokens @@ -97,3 +97,4 @@ SNE SENDDO SWHILE SSLASHD +SBYTE diff --git a/usr.bin/f2c/vax.c b/usr.bin/f2c/vax.c index e5a6572..57c4be9 100644 --- a/usr.bin/f2c/vax.c +++ b/usr.bin/f2c/vax.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1992, 1993, 1994 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 @@ -30,9 +30,14 @@ int regnum[] = { /* Put out a constant integer */ + void +#ifdef KR_headers prconi(fp, n) -FILEP fp; -ftnint n; + FILEP fp; + ftnint n; +#else +prconi(FILEP fp, ftnint n) +#endif { fprintf(fp, "\t%ld\n", n); } @@ -41,19 +46,28 @@ ftnint n; /* Put out a constant address */ + void +#ifdef KR_headers prcona(fp, a) -FILEP fp; -ftnint a; + FILEP fp; + ftnint a; +#else +prcona(FILEP fp, ftnint a) +#endif { fprintf(fp, "\tL%ld\n", a); } - + void +#ifdef KR_headers prconr(fp, x, k) - FILEP fp; - int k; - Constp x; + FILEP fp; + Constp x; + int k; +#else +prconr(FILEP fp, Constp x, int k) +#endif { char *x0, *x1; char cdsbuf0[64], cdsbuf1[64]; @@ -75,9 +89,14 @@ prconr(fp, x, k) } -char *memname(stg, mem) - int stg; - long mem; + char * +#ifdef KR_headers +memname(stg, mem) + int stg; + long mem; +#else +memname(int stg, long mem) +#endif { static char s[20]; @@ -107,12 +126,22 @@ char *memname(stg, mem) return(s); } +extern void addrlit Argdcl((Addrp)); + /* make_int_expr -- takes an arbitrary expression, and replaces all occurrences of arguments with indirection */ -expptr make_int_expr (e) -expptr e; + expptr +#ifdef KR_headers +make_int_expr(e) + expptr e; +#else +make_int_expr(expptr e) +#endif { + chainp listp; + Addrp ap; + if (e != ENULL) switch (e -> tag) { case TADDR: @@ -124,6 +153,13 @@ expptr e; e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp); e -> exprblock.rightp = make_int_expr (e -> exprblock.rightp); break; + case TLIST: + for(listp = e->listblock.listp; listp; listp = listp->nextp) + if ((ap = (Addrp)listp->datap) + && ap->tag == TADDR + && ap->uname_tag == UNAM_CONST) + addrlit(ap); + break; default: break; } /* switch */ @@ -137,8 +173,13 @@ expptr e; left-hand side of parameter adjustments. This is necessary to avoid error messages from cktype() */ -expptr prune_left_conv (e) -expptr e; + expptr +#ifdef KR_headers +prune_left_conv(e) + expptr e; +#else +prune_left_conv(expptr e) +#endif { struct Exprblock *leftp; @@ -159,7 +200,7 @@ expptr e; static FILE *comment_file; static void -write_comment() +write_comment(Void) { if (!wrote_comment) { wrote_comment = 1; @@ -168,7 +209,7 @@ write_comment() } static int * -count_args() +count_args(Void) { register int *ac; register chainp cp; @@ -185,20 +226,25 @@ count_args() } static int nu, *refs, *used; - static void awalk(); + static void awalk Argdcl((expptr)); static void +#ifdef KR_headers aawalk(P) - struct Primblock *P; + struct Primblock *P; +#else +aawalk(struct Primblock *P) +#endif { chainp p; expptr q; - for(p = P->argsp->listp; p; p = p->nextp) { - q = (expptr)p->datap; - if (q->tag != TCONST) - awalk(q); - } + if (P->argsp) + for(p = P->argsp->listp; p; p = p->nextp) { + q = (expptr)p->datap; + if (q->tag != TCONST) + awalk(q); + } if (P->namep->vtype == TYCHAR) { if (q = P->fcharp) awalk(q); @@ -208,8 +254,12 @@ aawalk(P) } static void +#ifdef KR_headers afwalk(P) - struct Primblock *P; + struct Primblock *P; +#else +afwalk(struct Primblock *P) +#endif { chainp p; expptr q; @@ -240,8 +290,12 @@ afwalk(P) } static void +#ifdef KR_headers awalk(e) - expptr e; + expptr e; +#else +awalk(expptr e) +#endif { Namep np; top: @@ -249,7 +303,7 @@ awalk(e) return; switch(e->tag) { default: - badtag("awalk", e); + badtag("awalk", e->tag); case TCONST: case TERROR: case TLIST: @@ -279,8 +333,12 @@ awalk(e) } static chainp +#ifdef KR_headers argsort(p0) - chainp p0; + chainp p0; +#else +argsort(chainp p0) +#endif { Namep *args, q, *stack; int i, nargs, nout, nst; @@ -338,7 +396,7 @@ argsort(p0) for(p = *da; p; p = p->nextp) if (!--refs[(q = (Namep)p->datap)->argno]) stack[nst++] = q; - frchain(*da); + frchain(da); } if (nout < nargs) for(i = 0; i < nargs; i++) @@ -349,16 +407,21 @@ argsort(p0) q->fvarname); *rvp = p = mkchain((char *)q, CHNULL); rvp = &p->nextp; - frchain(d[i]); + frchain(d+i); } done: free((char *)args); return rv; } + void +#ifdef KR_headers prolog(outfile, p) - FILE *outfile; - register chainp p; + FILE *outfile; + register chainp p; +#else +prolog(FILE *outfile, register chainp p) +#endif { int addif, addif0, i, nd, size; int *ac; @@ -499,5 +562,5 @@ prolog(outfile, p) if (ac) free((char *)ac); if (p0 != p1) - frchain(p1); + frchain(&p1); } /* prolog */ diff --git a/usr.bin/f2c/version.c b/usr.bin/f2c/version.c index e1fabf5..e82655b 100644 --- a/usr.bin/f2c/version.c +++ b/usr.bin/f2c/version.c @@ -1,2 +1,2 @@ -char F2C_version[] = "19931217"; -char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19931217\n"; +char F2C_version[] = "19950920"; +char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 19950920\n"; diff --git a/usr.bin/f2c/xsum.c b/usr.bin/f2c/xsum.c index 817da21..b87ace7 100644 --- a/usr.bin/f2c/xsum.c +++ b/usr.bin/f2c/xsum.c @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990, 1993 by AT&T Bell Laboratories and Bellcore. +Copyright 1990, 1993, 1994 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 @@ -21,10 +21,13 @@ arising out of or in connection with the use or performance of this software. ****************************************************************/ +#define _POSIX_SOURCE #include "stdio.h" #ifndef KR_headers #include "stdlib.h" +#include "sys/types.h" #include "fcntl.h" /* for declaration of open, O_RDONLY */ +#include "unistd.h" /* for read, close */ #endif #ifdef MSDOS #include "io.h" @@ -201,6 +204,7 @@ main(int argc, char **argv) static int rc; progname = *argv; + argc = argc; /* turn off "not used" warning */ s = *++argv; if (s && *s == '-') { switch(s[1]) { |
