|
Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
defs.h File Reference#include "sysdep.h"
#include "ftypes.h"
#include "defines.h"
#include "machdefs.h"
Go to the source code of this file.
|
Data Structures |
struct | Dims |
struct | Addrblock |
union | Constant |
struct | Constblock |
struct | Dimblock |
struct | Equivblock |
struct | Eqvchain |
struct | Errorblock |
struct | Exprblock |
union | Expression |
struct | Impldoblock |
struct | Listblock |
struct | Literal |
struct | Argtypes |
struct | Atype |
struct | Chain |
struct | Ctlframe |
struct | Entrypoint |
struct | Extsym |
struct | Hashentry |
struct | Headblock |
struct | Intrpacked |
struct | Labelblock |
struct | Nameblock |
struct | Paramblock |
struct | Primblock |
struct | Rplblock |
Defines |
#define | MAXDIM 20 |
#define | MAXINCLUDES 10 |
#define | MAXLITERALS 200 |
#define | MAXCTL 20 |
#define | MAXHASH 401 |
#define | MAXSTNO 801 |
#define | MAXEXT 200 |
#define | MAXEQUIV 150 |
#define | MAXLABLIST 258 |
#define | MAXCONTIN 99 |
#define | endlabel ctlabels[0] |
#define | elselabel ctlabels[1] |
#define | dobodylabel ctlabels[1] |
#define | doposlabel ctlabels[2] |
#define | doneglabel ctlabels[3] |
#define | ccp ccp1.ccp0 |
#define | eqvleng eqvtop |
#define | letter(x) Letters[x] |
#define | hextoi(x) hextoi_tab[(x) & 0xff] |
#define | Argdcl(x) x |
#define | Void void |
Typedefs |
typedef Expression * | expptr |
typedef Expression * | tagptr |
typedef Chain * | chainp |
typedef Addrblock * | Addrp |
typedef Constblock * | Constp |
typedef Exprblock * | Exprp |
typedef Nameblock * | Namep |
typedef Extsym | Extsym |
Functions |
char *Alloc | Argdcl ((int)) |
char *Argtype | Argdcl ((int, char *)) |
void Fatal | Argdcl ((char *)) |
Impldoblock *mkiodo | Argdcl ((chainp, chainp)) |
tagptr Inline | Argdcl ((int, int, chainp)) |
Labelblock *execlab | Argdcl ((long)) |
Listblock *mklist | Argdcl ((chainp)) |
void add_extern_to_list | Argdcl ((Addrp, chainp *)) |
int addressable | Argdcl ((tagptr)) |
Addrp autovar | Argdcl ((int, int, tagptr, char *)) |
void backup | Argdcl ((char *, char *)) |
void bad_atypes | Argdcl ((Argtypes *, char *, int, int, int, char *, char *)) |
void badop | Argdcl ((char *, int)) |
void badthing | Argdcl ((char *, char *, int)) |
Addrp builtin | Argdcl ((int, char *, int)) |
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)) |
void changedtype | Argdcl ((Namep)) |
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)) |
void consconv | Argdcl ((int, Constp, Constp)) |
void consnegop | Argdcl ((Constp)) |
void cpn | Argdcl ((int, char *, 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 do_uninit_equivs | Argdcl ((FILEP, ptr)) |
void | doequiv (Void) |
int | dofork (Void) |
void | donmlist (Void) |
char *dtos | Argdcl ((double)) |
void elif_out | Argdcl ((FILEP, tagptr)) |
void | enddcl (Void) |
void | endio (Void) |
void | endioctl (Void) |
void | endproc (Void) |
void entrypt | Argdcl ((int, int, long, Extsym *, chainp)) |
void errl | Argdcl ((char *, long)) |
void exarif | Argdcl ((tagptr, struct Labelblock *, struct Labelblock *, struct Labelblock *)) |
void exassign | Argdcl ((Namep, struct Labelblock *)) |
void excall | Argdcl ((Namep, struct Listblock *, int, struct Labelblock **)) |
void exdo | Argdcl ((int, Namep, chainp)) |
void | exelse (Void) |
void | exendif (Void) |
void exequals | Argdcl ((struct Primblock *, tagptr)) |
void exgoto | Argdcl ((struct Labelblock *)) |
void exstop | Argdcl ((int, tagptr)) |
void extern_out | Argdcl ((FILEP, Extsym *)) |
void ffilecopy | Argdcl ((FILEP, FILEP)) |
void | fileinit (Void) |
int fixargs | Argdcl ((int, struct Listblock *)) |
tagptr fixexpr | Argdcl ((Exprp)) |
void | flline (Void) |
void | fmt_init (Void) |
void fmtname | Argdcl ((Namep, Addrp)) |
void frchain | Argdcl ((chainp *)) |
void | freetemps (Void) |
void freqchain | Argdcl ((struct Equivblock *)) |
void | frrpl (Void) |
void frtemp | Argdcl ((Addrp)) |
void | hashclear (Void) |
int in_vector | Argdcl ((char *, char **, int)) |
void incomm | Argdcl ((Extsym *, Namep)) |
void inferdcl | Argdcl ((Namep, int)) |
void | initkey (Void) |
long int lencat | Argdcl ((expptr)) |
long int lmax | Argdcl ((long, long)) |
long int wr_char_len | Argdcl ((FILEP, struct Dimblock *, int, int)) |
tagptr intrcall | Argdcl ((Namep, struct Listblock *, int)) |
void ioclause | Argdcl ((int, expptr)) |
int | iocname (Void) |
chainp length_comp | Argdcl ((struct Entrypoint *, int)) |
char *lexline | Argdcl ((ptr)) |
void list_arg_types | Argdcl ((FILEP, struct Entrypoint *, chainp, int, char *)) |
void list_init_data | Argdcl ((FILE **, char *, FILE *)) |
void listargs | Argdcl ((FILEP, struct Entrypoint *, int, chainp)) |
char *lit_name | Argdcl ((struct Literal *)) |
int main | Argdcl ((int, char **)) |
void make_param | Argdcl ((struct Paramblock *, tagptr)) |
void many | Argdcl ((char *, char, int)) |
void margin_printf | Argdcl ((FILEP, char *,...)) |
void | mem_init (Void) |
tagptr mkbitcon | Argdcl ((int, int, char *)) |
chainp mkchain | Argdcl ((char *, chainp)) |
tagptr mkexpr | Argdcl ((int, tagptr, tagptr)) |
Addrp mkfield | Argdcl ((Addrp, char *, int)) |
tagptr mklhs | Argdcl ((struct Primblock *, int)) |
tagptr mkprim | Argdcl ((Namep, struct Listblock *, chainp)) |
Addrp mktmpn | Argdcl ((int, int, tagptr)) |
void | new_endif (Void) |
long | newlabel (Void) |
void | newproc (Void) |
Addrp nextdata | Argdcl ((long *)) |
void | np_init (Void) |
int oneof_stg | Argdcl ((Namep, int, int)) |
tagptr opconv | Argdcl ((tagptr, int)) |
void out_addr | Argdcl ((FILEP, Addrp)) |
void out_call | Argdcl ((FILEP, int, int, tagptr, tagptr, tagptr)) |
void out_const | Argdcl ((FILEP, Constp)) |
void out_for | Argdcl ((FILEP, tagptr, tagptr, tagptr)) |
void | out_init (Void) |
void | outbuf_adjust (Void) |
void prcona | Argdcl ((FILEP, long)) |
void prconr | Argdcl ((FILEP, Constp, int)) |
void | procinit (Void) |
void prolog | Argdcl ((FILEP, chainp)) |
void protowrite | Argdcl ((FILEP, int, char *, struct Entrypoint *, chainp)) |
int put_one_arg | Argdcl ((int, char *, char **, char *, char *)) |
expptr putassign | Argdcl ((expptr, expptr)) |
void putcmgo | Argdcl ((tagptr, int, struct Labelblock **)) |
expptr putsteq | Argdcl ((Addrp, Addrp)) |
void | r8fix (Void) |
int rdlong | Argdcl ((FILEP, long *)) |
int rdname | Argdcl ((FILEP, ptr, char *)) |
void read_Pfiles | Argdcl ((char **)) |
void save_argtypes | Argdcl ((chainp, Argtypes **, Argtypes **, int, char *, int, int, int, int)) |
void | set_externs (Void) |
void | set_tmp_names (Void) |
void setbound | Argdcl ((Namep, int, struct Dims *)) |
void setdata | Argdcl ((Addrp, Constp, long)) |
void setimpl | Argdcl ((int, long, int, int)) |
void settype | Argdcl ((Namep, int, long)) |
void | start_formatting (Void) |
void | startioctl (Void) |
void startproc | Argdcl ((Extsym *, int)) |
void | startrw (Void) |
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 wr_abbrevs | Argdcl ((FILEP, int, chainp)) |
char *wr_ardecls | Argdcl ((FILE *, struct Dimblock *, long)) |
void wr_equiv_init | Argdcl ((FILEP, int, chainp *, int)) |
int | yylex (Void) |
int | yyparse (Void) |
Variables |
FILEP | infile |
FILEP | diagfile |
FILEP | textfile |
FILEP | asmfile |
FILEP | c_file |
FILEP | pass1_file |
FILEP | expr_file |
FILEP | initfile |
FILEP | blkdfile |
int | current_ftn_file |
int | maxcontin |
char * | blkdfname |
char * | initfname |
char * | sortfname |
long | headoffset |
char | main_alias [] |
char * | token |
int | maxtoklen |
int | toklen |
long | err_lineno |
long | lineno |
char * | infname |
int | needkwd |
Labelblock * | thislabel |
int | maxctl |
int | maxequiv |
int | maxstno |
int | maxhash |
int | maxext |
flag | nowarnflag |
flag | ftn66flag |
flag | no66flag |
flag | noextflag |
flag | zflag |
flag | shiftcase |
flag | undeftype |
flag | shortsubs |
flag | onetripflag |
flag | checksubs |
flag | debugflag |
int | nerr |
int | nwarn |
int | parstate |
flag | headerdone |
int | blklevel |
flag | saveall |
flag | substars |
int | impltype [] |
ftnint | implleng [] |
int | implstg [] |
int | tycomplex |
int | tyint |
int | tyioint |
int | tyreal |
int | tylog |
int | tylogical |
int | type_choice [] |
char * | typename [] |
int | typesize [] |
int | typealign [] |
int | proctype |
char * | procname |
int | rtvlabel [] |
Addrp | retslot |
Addrp | xretslot [] |
int | cxslot |
int | chslot |
int | chlgslot |
int | procclass |
ftnint | procleng |
int | nentry |
flag | multitype |
long | lastiolabno |
long | lastlabno |
int | lastvarno |
int | lastargslot |
int | argloc |
int | autonum [] |
int | retlabel |
int | ret0label |
int | dorange |
int | regnum [] |
Namep | regnamep [] |
int | maxregvar |
int | highregvar |
int | nregvar |
chainp | templist [] |
int | maxdim |
chainp | earlylabs |
chainp | holdtemps |
Entrypoint * | entries |
Rplblock * | rpllist |
Chain * | curdtp |
ftnint | curdtelt |
chainp | allargs |
int | nallargs |
int | nallchargs |
flag | toomanyinit |
flag | inioctl |
int | iostmt |
Addrp | ioblkp |
int | nioctl |
int | nequiv |
int | eqvstart |
int | nintnames |
chainp | chains |
Ctlframe * | ctls |
Ctlframe * | ctlstack |
Ctlframe * | lastctl |
Extsym * | extsymtab |
Extsym * | nextext |
Extsym * | lastext |
int | complex_seen |
int | dcomplex_seen |
Labelblock * | labeltab |
Labelblock * | labtabend |
Labelblock * | highlabtab |
Hashentry * | hashtab |
Hashentry * | lasthash |
Equivblock * | eqvclass |
Literal * | litpool |
int | maxliterals |
int | nliterals |
char | Letters [] |
int | forcedouble |
int | doin_setbound |
int | Ansi |
char | hextoi_tab [] |
char * | casttypes [] |
char * | ftn_types [] |
char * | protorettypes [] |
char * | usedcasts [] |
int | Castargs |
int | infertypes |
FILE * | protofile |
char | binread [] |
char | binwrite [] |
char | textread [] |
char | textwrite [] |
char * | ei_first |
char * | ei_last |
char * | ei_next |
char * | wh_first |
char * | wh_last |
char * | wh_next |
char * | halign |
char * | outbuf |
char * | outbtail |
flag | keepsubs |
flag | use_tyquad |
int | n_keywords |
char * | c_keywords [] |
tagptr | errnode (Void) |
Define Documentation
#define dobodylabel ctlabels[1]
|
|
#define doneglabel ctlabels[3]
|
|
#define doposlabel ctlabels[2]
|
|
#define elselabel ctlabels[1]
|
|
#define endlabel ctlabels[0]
|
|
Typedef Documentation
typedef struct Chain* chainp
|
|
typedef struct Extsym Extsym
|
|
Function Documentation
void wr_equiv_init Argdcl |
( |
(FILEP, int, chainp *, int) |
|
) |
|
|
char* wr_ardecls Argdcl |
( |
(FILE *, struct Dimblock *, long) |
|
) |
|
|
void unamstring Argdcl |
( |
(Addrp, char *) |
|
) |
|
|
void startproc Argdcl |
( |
(Extsym *, int) |
|
) |
|
|
void settype Argdcl |
( |
(Namep, int, long) |
|
) |
|
|
void setimpl Argdcl |
( |
(int, long, int, int) |
|
) |
|
|
void setbound Argdcl |
( |
(Namep, int, struct Dims *) |
|
) |
|
|
void read_Pfiles Argdcl |
( |
(char **) |
|
) |
|
|
int rdname Argdcl |
( |
(FILEP, ptr, char *) |
|
) |
|
|
int rdlong Argdcl |
( |
(FILEP, long *) |
|
) |
|
|
int put_one_arg Argdcl |
( |
(int, char *, char **, char *, char *) |
|
) |
|
|
void prconi Argdcl |
( |
(FILEP, long) |
|
) |
|
|
void putif Argdcl |
( |
(tagptr, int) |
|
) |
|
|
int oneof_stg Argdcl |
( |
(Namep, int, int) |
|
) |
|
|
Addrp nextdata Argdcl |
( |
(long *) |
|
) |
|
|
void p1putn Argdcl |
( |
(int, int, char *) |
|
) |
|
|
void nice_printf Argdcl |
( |
(FILEP, char *,...) |
|
) |
|
|
void many Argdcl |
( |
(char *, char, int) |
|
) |
|
|
int main Argdcl |
( |
(int, char **) |
|
) |
|
|
char* lit_name Argdcl |
( |
(struct Literal *) |
|
) |
|
|
void list_init_data Argdcl |
( |
(FILE **, char *, FILE *) |
|
) |
|
|
char* lexline Argdcl |
( |
(ptr) |
|
) |
|
|
void ioclause Argdcl |
( |
(int, expptr) |
|
) |
|
|
long int wr_char_len Argdcl |
( |
(FILEP, struct Dimblock *, int, int) |
|
) |
|
|
long int lmin Argdcl |
( |
(long, long) |
|
) |
|
|
void putexpr Argdcl |
( |
(expptr) |
|
) |
|
|
int in_vector Argdcl |
( |
(char *, char **, int) |
|
) |
|
|
void p1_big_addr Argdcl |
( |
(Addrp) |
|
) |
|
|
void frexchain Argdcl |
( |
(chainp *) |
|
) |
|
|
void p1_unary Argdcl |
( |
(Exprp) |
|
) |
|
|
int fixargs Argdcl |
( |
(int, struct Listblock *) |
|
) |
|
|
char *string_num Argdcl |
( |
(char *, long) |
|
) |
|
|
char* dtos Argdcl |
( |
(double) |
|
) |
|
|
void do_uninit_equivs Argdcl |
( |
(FILEP, ptr) |
|
) |
|
|
void def_start Argdcl |
( |
(FILEP, char *, char *, char *) |
|
) |
|
|
void out_end_for Argdcl |
( |
(FILEP) |
|
) |
|
|
void dclerr Argdcl |
( |
(char *, Namep) |
|
) |
|
|
char *memname Argdcl |
( |
(int, long) |
|
) |
|
|
void dataline Argdcl |
( |
(char *, long, int) |
|
) |
|
|
int eqn Argdcl |
( |
(int, char *, char *) |
|
) |
|
|
Addrp mkarg Argdcl |
( |
(int, int) |
|
) |
|
|
int cmpstr Argdcl |
( |
(char *, char *, long, long) |
|
) |
|
|
void clf Argdcl |
( |
(FILEP *, char *, int) |
|
) |
|
|
int cktype Argdcl |
( |
(int, int, int) |
|
) |
|
|
void wronginf Argdcl |
( |
(Namep) |
|
) |
|
|
void cast_args Argdcl |
( |
(int, chainp) |
|
) |
|
|
Addrp builtin Argdcl |
( |
(int, char *, int) |
|
) |
|
|
void badthing Argdcl |
( |
(char *, char *, int) |
|
) |
|
|
void warni Argdcl |
( |
(char *, int) |
|
) |
|
|
void bad_atypes Argdcl |
( |
(Argtypes *, char *, int, int, int, char *, char *) |
|
) |
|
|
void warn1 Argdcl |
( |
(char *, char *) |
|
) |
|
|
void p1_label Argdcl |
( |
(long) |
|
) |
|
|
void yyerror Argdcl |
( |
(char *) |
|
) |
|
|
void p1puts Argdcl |
( |
(int, char *) |
|
) |
|
|
void retval Argdcl |
( |
(int) |
|
) |
|
|
|
Definition at line 36 of file equiv.c.
References Primblock::argsp, Constant::ci, Constblock::Const, Expression::constblock, dclerr(), Equivblock::equivs, Equivblock::eqvbottom, eqvcommon(), eqveqv(), Eqvchain::eqvitem, Eqvchain::eqvnextp, Eqvchain::eqvoffset, Equivblock::eqvtop, Equivblock::eqvtype, Primblock::fcharp, freqchain(), frexpr(), i, iarrlen(), ICON, ISICON, Listblock::listp, lmax(), lmin(), mkchain(), Primblock::namep, Chain::nextp, NO, nsubs(), offset, STGBSS, STGCOMMON, STGEQUIV, STGUNKNOWN, suboffset(), type_pref, vardcl(), warni(), and YES.
Referenced by enddcl().
00037 {
00038 register int i;
00039 int inequiv;
00040
00041 int comno;
00042
00043
00044 int ovarno;
00045 ftnint comoffset;
00046 ftnint offset;
00047 ftnint leng;
00048 register struct Equivblock *equivdecl;
00049 register struct Eqvchain *q;
00050 struct Primblock *primp;
00051 register Namep np;
00052 int k, k1, ns, pref, t;
00053 chainp cp;
00054 extern int type_pref[];
00055 char *s;
00056
00057 for(i = 0 ; i < nequiv ; ++i)
00058 {
00059
00060
00061
00062 equivdecl = &eqvclass[i];
00063 equivdecl->eqvbottom = equivdecl->eqvtop = 0;
00064 comno = -1;
00065
00066
00067
00068 for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
00069 {
00070 offset = 0;
00071 if (!(primp = q->eqvitem.eqvlhs))
00072 continue;
00073 vardcl(np = primp->namep);
00074 if(primp->argsp || primp->fcharp)
00075 {
00076 expptr offp;
00077
00078
00079
00080 if(np->vdim!=NULL && np->vdim->ndim>1 &&
00081 nsubs(primp->argsp)==1 )
00082 {
00083 if(! ftn66flag)
00084 warni
00085 ("1-dim subscript in EQUIVALENCE, %d-dim declared",
00086 np -> vdim -> ndim);
00087 cp = NULL;
00088 ns = np->vdim->ndim;
00089 while(--ns > 0)
00090 cp = mkchain((char *)ICON(1), cp);
00091 primp->argsp->listp->nextp = cp;
00092 }
00093
00094 offp = suboffset(primp);
00095 if(ISICON(offp))
00096 offset = offp->constblock.Const.ci;
00097 else {
00098 dclerr
00099 ("nonconstant subscript in equivalence ",
00100 np);
00101 np = NULL;
00102 }
00103 frexpr(offp);
00104 }
00105
00106
00107
00108 frexpr((expptr)primp);
00109
00110 if(np && (leng = iarrlen(np))<0)
00111 {
00112 dclerr("adjustable in equivalence", np);
00113 np = NULL;
00114 }
00115
00116 if(np) switch(np->vstg)
00117 {
00118 case STGUNKNOWN:
00119 case STGBSS:
00120 case STGEQUIV:
00121 break;
00122
00123 case STGCOMMON:
00124
00125
00126
00127
00128 comno = np->vardesc.varno;
00129 comoffset = np->voffset + offset;
00130 break;
00131
00132 default:
00133 dclerr("bad storage class in equivalence", np);
00134 np = NULL;
00135 break;
00136 }
00137
00138 if(np)
00139 {
00140 q->eqvoffset = offset;
00141
00142
00143
00144
00145 equivdecl->eqvbottom =
00146 lmin(equivdecl->eqvbottom, -offset);
00147
00148
00149
00150
00151 equivdecl->eqvtop =
00152 lmax(equivdecl->eqvtop, leng-offset);
00153 }
00154 q->eqvitem.eqvname = np;
00155 }
00156
00157
00158
00159
00160 if(comno >= 0)
00161
00162
00163
00164
00165 eqvcommon(equivdecl, comno, comoffset);
00166 else for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
00167 {
00168 if(np = q->eqvitem.eqvname)
00169 {
00170 inequiv = NO;
00171 if(np->vstg==STGEQUIV)
00172 if( (ovarno = np->vardesc.varno) == i)
00173 {
00174
00175
00176
00177 if(np->voffset + q->eqvoffset != 0)
00178 dclerr
00179 ("inconsistent equivalence", np);
00180 }
00181 else {
00182 offset = np->voffset;
00183 inequiv = YES;
00184 }
00185
00186 np->vstg = STGEQUIV;
00187 np->vardesc.varno = i;
00188 np->voffset = - q->eqvoffset;
00189
00190 if(inequiv)
00191
00192
00193
00194 eqveqv(i, ovarno, q->eqvoffset + offset);
00195 }
00196 }
00197 }
00198
00199
00200
00201
00202 for(i = 0 ; i < nequiv ; ++i)
00203 {
00204 equivdecl = & eqvclass[i];
00205 if(equivdecl->eqvbottom!=0 || equivdecl->eqvtop!=0) {
00206
00207
00208
00209 k = TYCHAR;
00210 pref = 1;
00211 for(q = equivdecl->equivs ; q; q = q->eqvnextp)
00212 if ((np = q->eqvitem.eqvname)
00213 && !np->veqvadjust) {
00214 np->veqvadjust = 1;
00215 np->voffset -= equivdecl->eqvbottom;
00216 t = typealign[k1 = np->vtype];
00217 if (pref < type_pref[k1]) {
00218 k = k1;
00219 pref = type_pref[k1];
00220 }
00221 if(np->voffset % t != 0) {
00222 dclerr("bad alignment forced by equivalence", np);
00223 --nerr;
00224 }
00225 }
00226 equivdecl->eqvtype = k;
00227 }
00228 freqchain(equivdecl);
00229 }
00230 }
|
|
Definition at line 232 of file sysdep.c.
References Fatal(), and retcode.
Referenced by main().
00233 {
00234 #ifdef MSDOS
00235 Fatal("Only one Fortran input file allowed under MS-DOS");
00236 #else
00237 #ifndef KR_headers
00238 extern int fork(void), wait(int*);
00239 #endif
00240 int pid, status, w;
00241 extern int retcode;
00242
00243 if (!(pid = fork()))
00244 return 1;
00245 if (pid == -1)
00246 Fatal("bad fork");
00247 while((w = wait(&status)) != pid)
00248 if (w == -1)
00249 Fatal("bad wait code");
00250 retcode |= status >> 8;
00251 #endif
00252 return 0;
00253 }
|
|
Definition at line 378 of file proc.c.
References docomleng(), docommon(), doentry(), doequiv(), Entrypoint::entnextp, err_proc, frchain(), freetemps(), INEXEC, p1_label(), p1_line_number(), P1_PROCODE, p1put(), and revchain().
Referenced by endproc(), exequals(), and yyparse().
|
|
Definition at line 831 of file f2cdir/io.c.
References cpexpr(), execlab(), exendif(), exgoto(), exif(), frexpr(), ICON, ioendlab, ioerrlab, ioformatted, IOREAD, IOSTP, IOWRITE, mkexpr(), NAMEDIRECTED, OPGT, OPLT, OPNE, and p1_label().
Referenced by yyparse().
|
|
Definition at line 424 of file f2cdir/io.c.
References autovar(), Constant::ci, Constblock::Const, Expression::constblock, dofclose(), dofinquire(), dofmove(), dofopen(), endbit, ENULL, err, errbit, execlab(), fatali(), io_setup::fields, frexpr(), i, ICON, io_fields, io_stuff, IOBACKSPACE, ioblkp, IOCLOSE, IOENDFILE, ioendlab, ioerrlab, IOINQUIRE, IOOPEN, IOREAD, IOREWIND, IOSEND, IOSERR, ioset(), IOSIOSTAT, IOSTP, IOWRITE, ISICON, ISINT, jumplab, mktmp(), newiolabel(), NIOS, NO, p, skiplab, startrw(), TADDR, TYINT, TYIOINT, io_setup::type, V, and XERR.
Referenced by yyparse().
|
|
Definition at line 328 of file proc.c.
References CHNULL, convic(), copy_data(), dobss(), donmlist(), enddcl(), epicode(), err, errstr(), fix_entry_returns(), INDATA, Labelblock::labdefined, NO, procinit(), putentries(), start_formatting(), Labelblock::stateno, STGCOMMON, usedefsforcommon, wr_abbrevs(), and zap_changes().
Referenced by main(), newproc(), startproc(), and yyparse().
|
|
Definition at line 294 of file init.c.
References ALLOCN, ckalloc(), dfltproc, dflttype, fmt_init(), hextoi, hextoi_tab, i, infile, lastiolabno, lastlabno, lastvarno, Letters, main_alias, maxctl, maxequiv, maxext, maxhash, maxstno, maxtoklen, mem_init(), nerr, nliterals, np_init(), out_init(), token, and tyint.
Referenced by main().
00295 {
00296 register char *s;
00297 register int i, j;
00298
00299 lastiolabno = 100000;
00300 lastlabno = 0;
00301 lastvarno = 0;
00302 nliterals = 0;
00303 nerr = 0;
00304
00305 infile = stdin;
00306
00307 maxtoklen = 502;
00308 token = (char *)ckalloc(maxtoklen+2);
00309 memset(dflttype, tyreal, 26);
00310 memset(dflttype + 'i' - 'a', tyint, 6);
00311 memset(hextoi_tab, 16, sizeof(hextoi_tab));
00312 for(i = 0, s = "0123456789abcdef"; *s; i++, s++)
00313 hextoi(*s) = i;
00314 for(i = 10, s = "ABCDEF"; *s; i++, s++)
00315 hextoi(*s) = i;
00316 for(j = 0, s = "abcdefghijklmnopqrstuvwxyz"; i = *s++; j++)
00317 Letters[i] = Letters[i+'A'-'a'] = j;
00318
00319 ctls = ALLOCN(maxctl+1, Ctlframe);
00320 extsymtab = ALLOCN(maxext, Extsym);
00321 eqvclass = ALLOCN(maxequiv, Equivblock);
00322 hashtab = ALLOCN(maxhash, Hashentry);
00323 labeltab = ALLOCN(maxstno, Labelblock);
00324 litpool = ALLOCN(maxliterals, Literal);
00325 labarray = (struct Labelblock **)ckalloc(maxlablist*
00326 sizeof(struct Labelblock *));
00327 fmt_init();
00328 mem_init();
00329 np_init();
00330
00331 ctlstack = ctls++;
00332 lastctl = ctls + maxctl;
00333 nextext = extsymtab;
00334 lastext = extsymtab + maxext;
00335 lasthash = hashtab + maxhash;
00336 labtabend = labeltab + maxstno;
00337 highlabtab = labeltab;
00338 main_alias[0] = '\0';
00339 if (forcedouble)
00340 dfltproc[TYREAL] = dfltproc[TYDREAL];
00341
00342
00343
00344 out_init ();
00345 }
|
|
Definition at line 308 of file sysdep.c.
References chr_fmt, escapes, i, str_fmt, and Table_size.
Referenced by fileinit().
00309 {
00310 static char *str1fmt[6] =
00311 { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
00312 register int i, j;
00313 register char *s;
00314
00315
00316
00317 #ifdef non_ASCII
00318 i = 0;
00319 #else
00320 i = 127;
00321 #endif
00322 for(; i < Table_size; i++)
00323 str_fmt[i] = "\\%03o";
00324 #ifdef non_ASCII
00325 for(i = 32; i < 127; i++) {
00326 s = str0fmt[i];
00327 str_fmt[*(unsigned char *)s] = s;
00328 }
00329 str_fmt['"'] = "\\\"";
00330 #else
00331 if (Ansi == 1)
00332 str_fmt[7] = chr_fmt[7] = "\\a";
00333 #endif
00334
00335
00336
00337 #ifdef non_ASCII
00338 for(i = 0; i < 32; i++)
00339 chr_fmt[i] = chr0fmt[i];
00340 #else
00341 i = 127;
00342 #endif
00343 for(; i < Table_size; i++)
00344 chr_fmt[i] = "\\%o";
00345 #ifdef non_ASCII
00346 for(i = 32; i < 127; i++) {
00347 s = chr0fmt[i];
00348 j = *(unsigned char *)s;
00349 if (j == '\\')
00350 j = *(unsigned char *)(s+1);
00351 chr_fmt[j] = s;
00352 }
00353 #endif
00354
00355
00356
00357 for(i = 0; i < Table_size; i++)
00358 escapes[i] = i;
00359 for(s = "btnfr0", i = 0; i < 6; i++)
00360 escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
00361
00362
00363 if (Ansi)
00364 str1fmt[5] = "\\v";
00365 if ('\v' == 'v') {
00366 str1fmt[5] = "v";
00367 #ifndef non_ASCII
00368 escapes['v'] = 11;
00369 #endif
00370 }
00371 else
00372 escapes['v'] = '\v';
00373 for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
00374 str_fmt[j] = chr_fmt[j] = str1fmt[i++];
00375
00376 chr_fmt[11] = Ansi ? "\\v" : "\\13";
00377 }
|
|
Definition at line 1193 of file proc.c.
References Chain::datap, frexpr(), ICON, Chain::nextp, p, q, Addrblock::varleng, Addrblock::vleng, and Addrblock::vtype.
Referenced by enddcl(), and yyparse().
01194 {
01195 register chainp p, p1;
01196 register Addrp q;
01197 register int t;
01198
01199 p1 = holdtemps;
01200 while(p = p1) {
01201 q = (Addrp)p->datap;
01202 t = q->vtype;
01203 if (t == TYCHAR && q->varleng != 0) {
01204
01205 frexpr(q->vleng);
01206 q->vleng = ICON(q->varleng);
01207 }
01208 p1 = p->nextp;
01209 p->nextp = templist[t];
01210 templist[t] = p;
01211 }
01212 holdtemps = 0;
01213 }
|
|
Definition at line 348 of file init.c.
References Dimblock::baseoffset, Dimblock::basexpr, charptr, CLNAMELIST, Dimblock::dims, frchain(), free, frexpr(), i, Dimblock::ndim, Dimblock::nelt, p, and Hashentry::varp.
Referenced by procinit().
|
|
Definition at line 1274 of file lex.c.
References anum_buf, ckalloc(), comstart, EOF_CHAR, i, Keylist::keyname, letter, linestart, maxcont, sbuf, and send.
Referenced by main().
|
|
Definition at line 542 of file f2cdir/io.c.
References errstr(), i, ioc, iocname(), IOOPEN, M, NIOS, and NOEXT.
Referenced by iocname(), iosetip(), and yyparse().
00543 {
00544 register int i;
00545 int found, mask;
00546
00547 found = 0;
00548 mask = M(iostmt);
00549 for(i = 1 ; i <= NIOS ; ++i)
00550 if(!strcmp(ioc[i].iocname, token))
00551 if(ioc[i].iotype & mask)
00552 return(i);
00553 else {
00554 found = i;
00555 break;
00556 }
00557 if(found) {
00558 if (iostmt == IOOPEN && !strcmp(ioc[i].iocname, "name")) {
00559 NOEXT("open with \"name=\" treated as \"file=\"");
00560 for(i = 1; strcmp(ioc[i].iocname, "file"); i++);
00561 return i;
00562 }
00563 errstr("invalid control %s for statement", ioc[found].iocname);
00564 }
00565 else
00566 errstr("unknown iocontrol %s", token);
00567 return(IOSBAD);
00568 }
|
|
Definition at line 1382 of file output.c.
References OPBITAND, OPBITOR, OPBITXOR, opeqable, OPLSHIFT, OPMINUS, OPMOD, OPPLUS, OPSLASH, OPSTAR, and tr_tab.
Referenced by fileinit().
01383 {
01384 extern int tab_size;
01385 register char *s;
01386
01387 s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
01388 while(*s)
01389 tr_tab[*s++] = 3;
01390 tr_tab['>'] = 1;
01391
01392 opeqable[OPPLUS] = 1;
01393 opeqable[OPMINUS] = 1;
01394 opeqable[OPSTAR] = 1;
01395 opeqable[OPSLASH] = 1;
01396 opeqable[OPMOD] = 1;
01397 opeqable[OPLSHIFT] = 1;
01398 opeqable[OPBITAND] = 1;
01399 opeqable[OPBITXOR] = 1;
01400 opeqable[OPBITOR ] = 1;
01401
01402
01403
01404
01405 if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
01406 fl_fmt_string = Ansi == 1 ? "%sf" : "(float)%s";
01407
01408 if (db_fmt_string == NULL || *db_fmt_string == '\0')
01409 db_fmt_string = "%.17g";
01410
01411
01412
01413
01414
01415
01416 if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
01417 cm_fmt_string = "{%s,%s}";
01418 }
01419
01420 if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
01421 dcm_fmt_string = "{%s,%s}";
01422 }
01423
01424 tab_size = 4;
01425 }
|
void outbuf_adjust |
( |
Void |
|
) |
|
|
|
Definition at line 379 of file init.c.
References autonum, blklevel, charptr, chlgslot, chslot, CLUNKNOWN, cxslot, Chain::datap, dorange, ei_first, ei_last, ei_next, eqvstart, frchain(), free, frexchain(), frexpr(), hashclear(), headerdone, highregvar, i, inioctl, lastargslot, mem0_last, mem_first, mem_last, mem_next, multitype, nallargs, nallchargs, needkwd, nentry, nequiv, Chain::nextp, nintnames, NO, nregvar, NTYPES0, nwarn, OUTSIDE, parstate, procclass, procleng, procname, proctype, rtvlabel, saveall, setimpl(), Labelblock::stateno, STGBSS, substars, tyint, TYVOID, wh_first, wh_last, and wh_next.
Referenced by endproc(), and main().
00380 {
00381 register struct Labelblock *lp;
00382 struct Chain *cp;
00383 int i;
00384 struct memblock;
00385 extern struct memblock *curmemblock, *firstmemblock;
00386 extern char *mem_first, *mem_next, *mem_last, *mem0_last;
00387
00388 curmemblock = firstmemblock;
00389 mem_next = mem_first;
00390 mem_last = mem0_last;
00391 ei_next = ei_first = ei_last = 0;
00392 wh_next = wh_first = wh_last = 0;
00393 iob_list = 0;
00394 for(i = 0; i < 9; i++)
00395 io_structs[i] = 0;
00396
00397 parstate = OUTSIDE;
00398 headerdone = NO;
00399 blklevel = 1;
00400 saveall = NO;
00401 substars = NO;
00402 nwarn = 0;
00403 thislabel = NULL;
00404 needkwd = 0;
00405
00406 proctype = TYUNKNOWN;
00407 procname = "MAIN_";
00408 procclass = CLUNKNOWN;
00409 nentry = 0;
00410 nallargs = nallchargs = 0;
00411 multitype = NO;
00412 retslot = NULL;
00413 for(i = 0; i < NTYPES0; i++) {
00414 frexpr((expptr)xretslot[i]);
00415 xretslot[i] = 0;
00416 }
00417 cxslot = -1;
00418 chslot = -1;
00419 chlgslot = -1;
00420 procleng = 0;
00421 blklevel = 1;
00422 lastargslot = 0;
00423
00424 for(lp = labeltab ; lp < labtabend ; ++lp)
00425 lp->stateno = 0;
00426
00427 hashclear();
00428
00429
00430
00431
00432 frexchain(&new_vars);
00433 frexchain(&used_builtins);
00434 frchain(&assigned_fmts);
00435 frchain(&allargs);
00436 frchain(&earlylabs);
00437
00438 nintnames = 0;
00439 highlabtab = labeltab;
00440
00441 ctlstack = ctls - 1;
00442 for(i = TYADDR; i < TYVOID; i++) {
00443 for(cp = templist[i]; cp ; cp = cp->nextp)
00444 free( (charptr) (cp->datap) );
00445 frchain(templist + i);
00446 autonum[i] = 0;
00447 }
00448 holdtemps = NULL;
00449 dorange = 0;
00450 nregvar = 0;
00451 highregvar = 0;
00452 entries = NULL;
00453 rpllist = NULL;
00454 inioctl = NO;
00455 eqvstart += nequiv;
00456 nequiv = 0;
00457 dcomplex_seen = 0;
00458
00459 for(i = 0 ; i<NTYPES0 ; ++i)
00460 rtvlabel[i] = 0;
00461
00462 if(undeftype)
00463 setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
00464 else
00465 {
00466 setimpl(tyreal, (ftnint) 0, 'a', 'z');
00467 setimpl(tyint, (ftnint) 0, 'i', 'n');
00468 }
00469 setimpl(-STGBSS, (ftnint) 0, 'a', 'z');
00470 }
|
|
Definition at line 427 of file intr.c.
References Specblock::atype, Intrbits::dblcmplx, Intrbits::dblintrno, Fatal(), Intrblock::intrfname, INTRGEN, Intrbits::intrgroup, Intrbits::intrno, Intrbits::intrstuff, intrtab, Intrblock::intrval, Specblock::rtype, spectab, and Specblock::spxname.
Referenced by set_externs().
|
void set_externs |
( |
Void |
|
) |
|
|
|
Definition at line 220 of file Fmain.c.
References chars_per_wd, def_i2, dneg, err, errstr(), ftn_files, h0align, halign, hsize, htype, i, inqmask, M, Max_ftn_files, maxregvar, MAXREGVAR, no66flag, noextflag, ohalign, r8fix(), szleng, TYALIST, TYCILIST, TYCLLIST, tycomplex, TYICILIST, TYINLIST, tyioint, TYOLIST, tyreal, warni(), wordalign, and zflag.
Referenced by main().
00221 {
00222 static char *hset[3] = { 0, "integer", "doublereal" };
00223
00224
00225
00226 if (chars_per_wd > 0) {
00227 typesize[TYADDR] = typesize[TYLONG] = typesize[TYREAL] =
00228 typesize[TYLOGICAL] = chars_per_wd;
00229 typesize[TYINT1] = typesize[TYLOGICAL1] = 1;
00230 typesize[TYDREAL] = typesize[TYCOMPLEX] = chars_per_wd << 1;
00231 typesize[TYDCOMPLEX] = chars_per_wd << 2;
00232 typesize[TYSHORT] = typesize[TYLOGICAL2] = chars_per_wd >> 1;
00233 typesize[TYCILIST] = 5*chars_per_wd;
00234 typesize[TYICILIST] = 6*chars_per_wd;
00235 typesize[TYOLIST] = 9*chars_per_wd;
00236 typesize[TYCLLIST] = 3*chars_per_wd;
00237 typesize[TYALIST] = 2*chars_per_wd;
00238 typesize[TYINLIST] = 26*chars_per_wd;
00239 }
00240
00241 if (wordalign)
00242 typealign[TYDREAL] = typealign[TYDCOMPLEX] = typealign[TYREAL];
00243 if (!tyioint) {
00244 tyioint = TYSHORT;
00245 szleng = typesize[TYSHORT];
00246 def_i2 = "#define f2c_i2 1\n";
00247 inqmask = M(TYSHORT)|M(TYLOGICAL2);
00248 goto checklong;
00249 }
00250 else
00251 szleng = typesize[TYLONG];
00252 if (useshortints) {
00253
00254
00255 checklong:
00256 protorettypes[TYLOGICAL] = "shortlogical";
00257 casttypes[TYLOGICAL] = "K_fp";
00258 if (uselongints)
00259 err ("Can't use both long and short ints");
00260 else {
00261 tyint = tylogical = TYSHORT;
00262 tylog = TYLOGICAL2;
00263 }
00264 }
00265 else if (uselongints)
00266 tyint = TYLONG;
00267
00268 if (h0align) {
00269 if (tyint == TYLONG && wordalign)
00270 h0align = 1;
00271 ohalign = halign = hset[h0align];
00272 htype = h0align == 1 ? tyint : TYDREAL;
00273 hsize = typesize[htype];
00274 }
00275
00276 if (no66flag)
00277 noextflag = no66flag;
00278 if (noextflag)
00279 zflag = 0;
00280
00281 if (r8flag) {
00282 tyreal = TYDREAL;
00283 tycomplex = TYDCOMPLEX;
00284 r8fix();
00285 }
00286 if (forcedouble) {
00287 protorettypes[TYREAL] = "E_f";
00288 casttypes[TYREAL] = "E_fp";
00289 }
00290 else
00291 dneg = 0;
00292
00293 if (maxregvar > MAXREGVAR) {
00294 warni("-O%d: too many register variables", maxregvar);
00295 maxregvar = MAXREGVAR;
00296 }
00297
00298
00299
00300 {
00301 int bad, i, cur_max = Max_ftn_files;
00302
00303 for (i = bad = 0; i < cur_max && ftn_files[i]; i++)
00304 if (ftn_files[i][0] == '-') {
00305 errstr ("Invalid flag '%s'", ftn_files[i]);
00306 bad++;
00307 }
00308 if (bad)
00309 exit(1);
00310
00311 }
00312 }
|
void set_tmp_names |
( |
Void |
|
) |
|
|
|
Definition at line 80 of file sysdep.c.
References blkdfname, c_functions, ckalloc(), getpid(), initbname, initfname, p1_bakfile, p1_file, sortfname, and tmpdir.
Referenced by main().
00081 {
00082 int k;
00083 if (debugflag == 1)
00084 return;
00085 k = strlen(tmpdir) + 24;
00086 c_functions = (char *)ckalloc(7*k);
00087 initfname = c_functions + k;
00088 initbname = initfname + k;
00089 blkdfname = initbname + k;
00090 p1_file = blkdfname + k;
00091 p1_bakfile = p1_file + k;
00092 sortfname = p1_bakfile + k;
00093 {
00094 #ifdef MSDOS
00095 char buf[64], *s, *t;
00096 if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
00097 t = "";
00098 else {
00099
00100
00101
00102
00103 for(s = tmpdir, t = buf; *s; s++, t++)
00104 if ((*t = *s) == '/')
00105 *t = '\\';
00106 if (t[-1] != '\\')
00107 *t++ = '\\';
00108 *t = 0;
00109 t = buf;
00110 }
00111 sprintf(c_functions, "%sf2c_func", t);
00112 sprintf(initfname, "%sf2c_rd", t);
00113 sprintf(blkdfname, "%sf2c_blkd", t);
00114 sprintf(p1_file, "%sf2c_p1f", t);
00115 sprintf(p1_bakfile, "%sf2c_p1fb", t);
00116 sprintf(sortfname, "%sf2c_sort", t);
00117 #else
00118 long pid = getpid();
00119 sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
00120 sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
00121 sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
00122 sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
00123 sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
00124 sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
00125 #endif
00126 sprintf(initbname, "%s.b", initfname);
00127 }
00128 if (debugflag)
00129 fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
00130 initfname, blkdfname, p1_file, p1_bakfile, sortfname);
00131 }
|
void start_formatting |
( |
Void |
|
) |
|
|
|
Definition at line 87 of file format.c.
References CHNULL, do_format(), err, Extsym::extp, Fatal(), ffilecopy(), gflag1, last_was_label, nice_printf(), other_undefs(), out_and_free_statement(), prev_tab, scrub, sharp_line, STGCOMMON, this_proc_name, usedefsforcommon, and wr_abbrevs().
Referenced by endproc().
00088 {
00089 FILE *infile;
00090 static int wrote_one = 0;
00091 extern int usedefsforcommon;
00092 extern char *p1_file, *p1_bakfile;
00093
00094 this_proc_name[0] = '\0';
00095 last_was_label = 0;
00096 ei_next = ei_first;
00097 wh_next = wh_first;
00098
00099 (void) fclose (pass1_file);
00100 if ((infile = fopen (p1_file, binread)) == NULL)
00101 Fatal("start_formatting: couldn't open the intermediate file\n");
00102
00103 if (wrote_one)
00104 nice_printf (c_file, "\n");
00105
00106 while (!feof (infile)) {
00107 expptr this_expr;
00108
00109 this_expr = do_format (infile, c_file);
00110 if (this_expr) {
00111 out_and_free_statement (c_file, this_expr);
00112 }
00113 }
00114
00115 (void) fclose (infile);
00116
00117 if (last_was_label)
00118 nice_printf (c_file, ";\n");
00119
00120 prev_tab (c_file);
00121 gflag1 = sharp_line = 0;
00122 if (this_proc_name[0])
00123 nice_printf (c_file, "} /* %s */\n", this_proc_name);
00124
00125
00126
00127
00128 if (usedefsforcommon) {
00129 Extsym *ext;
00130 int did_one = 0;
00131
00132 for (ext = extsymtab; ext < nextext; ext++)
00133 if (ext -> extstg == STGCOMMON && ext -> used_here) {
00134 ext -> used_here = 0;
00135 if (!did_one)
00136 nice_printf (c_file, "\n");
00137 wr_abbrevs(c_file, 0, ext->extp);
00138 did_one = 1;
00139 ext -> extp = CHNULL;
00140 }
00141
00142 if (did_one)
00143 nice_printf (c_file, "\n");
00144 }
00145
00146 other_undefs(c_file);
00147
00148 wrote_one = 1;
00149
00150
00151
00152 if (debugflag && (pass1_file = fopen (p1_bakfile, binwrite)))
00153 if (infile = fopen (p1_file, binread)) {
00154 ffilecopy (infile, pass1_file);
00155 fclose (infile);
00156 fclose (pass1_file);
00157 }
00158
00159
00160
00161 scrub(p1_file);
00162
00163 if ((pass1_file = fopen (p1_file, binwrite)) == NULL)
00164 err ("start_formatting: couldn't reopen the pass1 file");
00165
00166 }
|
|
Definition at line 937 of file f2cdir/io.c.
References Expression::addrblock, ALLOC, Primblock::argsp, asg_addr(), autovar(), call1(), Constant::ci, CLNAMELIST, CLVAR, Constblock::Const, Expression::constblock, cpexpr(), endbit, ENULL, err, errbit, io_setup::fields, fixtype(), Labelblock::fmtlabused, fmtstmt(), FORMATTED, frexpr(), Expression::headblock, ICON, io_fields, io_stuff, ioblkp, ioformatted, IOREAD, ioroutine, ioset(), ioseta(), IOSFMT, IOSREC, IOSTDIN, IOSUNIT, ISCONST, ISICON, ISINT, isstatic(), jumplab, LISTDIRECTED, Addrblock::memno, Addrblock::memoffset, mkaddcon(), mklabel(), mkscalar(), MSKSTATIC, NAMEDIRECTED, Primblock::namep, Dimblock::nelt, new_iob_data(), NO, ONEOF, Expression::primblock, putiocall(), Labelblock::stateno, statstruct, STGINIT, TADDR, Expression::tag, Addrblock::tag, temp_name(), TPRIM, TYINT, TYIOINT, io_setup::type, UNAM_IDENT, UNFORMATTED, Addrblock::user, V, vardcl(), Nameblock::vclass, Addrblock::vclass, Nameblock::vdim, Nameblock::vlastdim, Addrblock::vleng, Nameblock::vstg, Addrblock::vstg, Headblock::vtype, Nameblock::vtype, Addrblock::vtype, XEND, XERR, XFMT, XIEND, XIFMT, XIRLEN, XIRNUM, XIUNIT, XREC, XUNIT, and YES.
Referenced by endioctl().
00938 {
00939 register expptr p;
00940 register Namep np;
00941 register Addrp unitp, fmtp, recp;
00942 register expptr nump;
00943 int iostmt1;
00944 flag intfile, sequential, ok, varfmt;
00945 struct io_setup *ios;
00946
00947
00948
00949 ok = YES;
00950 statstruct = YES;
00951
00952 intfile = NO;
00953 if(p = V(IOSUNIT))
00954 {
00955 if( ISINT(p->headblock.vtype) ) {
00956 int_unit:
00957 unitp = (Addrp) cpexpr(p);
00958 }
00959 else if(p->headblock.vtype == TYCHAR)
00960 {
00961 if (nioctl == 1 && iostmt == IOREAD) {
00962
00963 V(IOSFMT) = p;
00964 V(IOSUNIT) = p = (expptr) IOSTDIN;
00965 ioformatted = FORMATTED;
00966 goto int_unit;
00967 }
00968 intfile = YES;
00969 if(p->tag==TPRIM && p->primblock.argsp==NULL &&
00970 (np = p->primblock.namep)->vdim!=NULL)
00971 {
00972 vardcl(np);
00973 if(nump = np->vdim->nelt)
00974 {
00975 nump = fixtype(cpexpr(nump));
00976 if( ! ISCONST(nump) ) {
00977 statstruct = NO;
00978 np->vlastdim = 0;
00979 }
00980 }
00981 else
00982 {
00983 err("attempt to use internal unit array of unknown size");
00984 ok = NO;
00985 nump = ICON(1);
00986 }
00987 unitp = mkscalar(np);
00988 }
00989 else {
00990 nump = ICON(1);
00991 unitp = (Addrp ) fixtype(cpexpr(p));
00992 }
00993 if(! isstatic((expptr)unitp) )
00994 statstruct = NO;
00995 }
00996 else {
00997 err("unit specifier not of type integer or character");
00998 ok = NO;
00999 }
01000 }
01001 else
01002 {
01003 err("bad unit specifier");
01004 ok = NO;
01005 }
01006
01007 sequential = YES;
01008 if(p = V(IOSREC))
01009 if( ISINT(p->headblock.vtype) )
01010 {
01011 recp = (Addrp) cpexpr(p);
01012 sequential = NO;
01013 }
01014 else {
01015 err("bad REC= clause");
01016 ok = NO;
01017 }
01018 else
01019 recp = NULL;
01020
01021
01022 varfmt = YES;
01023 fmtp = NULL;
01024 if(p = V(IOSFMT))
01025 {
01026 if(p->tag==TPRIM && p->primblock.argsp==NULL)
01027 {
01028 np = p->primblock.namep;
01029 if(np->vclass == CLNAMELIST)
01030 {
01031 ioformatted = NAMEDIRECTED;
01032 fmtp = (Addrp) fixtype(p);
01033 V(IOSFMT) = (expptr)fmtp;
01034 if (skiplab)
01035 jumplab = 0;
01036 goto endfmt;
01037 }
01038 vardcl(np);
01039 if(np->vdim)
01040 {
01041 if( ! ONEOF(np->vstg, MSKSTATIC) )
01042 statstruct = NO;
01043 fmtp = mkscalar(np);
01044 goto endfmt;
01045 }
01046 if( ISINT(np->vtype) )
01047 {
01048 statstruct = NO;
01049 varfmt = YES;
01050 fmtp = asg_addr(p);
01051 goto endfmt;
01052 }
01053 }
01054 p = V(IOSFMT) = fixtype(p);
01055 if(p->headblock.vtype == TYCHAR
01056
01057
01058 || p->tag == TADDR && ISINT(p->addrblock.vtype))
01059 {
01060 if( ! isstatic(p) )
01061 statstruct = NO;
01062 fmtp = (Addrp) cpexpr(p);
01063 }
01064 else if( ISICON(p) )
01065 {
01066 struct Labelblock *lp;
01067 lp = mklabel(p->constblock.Const.ci);
01068 if (fmtstmt(lp) > 0)
01069 {
01070 fmtp = (Addrp)mkaddcon(lp->stateno);
01071
01072 lp->fmtlabused = 1;
01073 varfmt = NO;
01074 }
01075 else
01076 ioformatted = UNFORMATTED;
01077 }
01078 else {
01079 err("bad format descriptor");
01080 ioformatted = UNFORMATTED;
01081 ok = NO;
01082 }
01083 }
01084 else
01085 fmtp = NULL;
01086
01087 endfmt:
01088 if(intfile) {
01089 if (ioformatted==UNFORMATTED) {
01090 err("unformatted internal I/O not allowed");
01091 ok = NO;
01092 }
01093 if (recp) {
01094 err("direct internal I/O not allowed");
01095 ok = NO;
01096 }
01097 }
01098 if(!sequential && ioformatted==LISTDIRECTED)
01099 {
01100 err("direct list-directed I/O not allowed");
01101 ok = NO;
01102 }
01103 if(!sequential && ioformatted==NAMEDIRECTED)
01104 {
01105 err("direct namelist I/O not allowed");
01106 ok = NO;
01107 }
01108
01109 if( ! ok ) {
01110 statstruct = NO;
01111 return;
01112 }
01113
01114
01115
01116
01117
01118
01119 if (intfile) {
01120 ios = io_stuff + iostmt;
01121 iostmt1 = IOREAD;
01122 }
01123 else {
01124 ios = io_stuff;
01125 iostmt1 = 0;
01126 }
01127 io_fields = ios->fields;
01128 if(statstruct)
01129 {
01130 ioblkp = ALLOC(Addrblock);
01131 ioblkp->tag = TADDR;
01132 ioblkp->vtype = ios->type;
01133 ioblkp->vclass = CLVAR;
01134 ioblkp->vstg = STGINIT;
01135 ioblkp->memno = ++lastvarno;
01136 ioblkp->memoffset = ICON(0);
01137 ioblkp -> uname_tag = UNAM_IDENT;
01138 new_iob_data(ios,
01139 temp_name("io_", lastvarno, ioblkp->user.ident)); }
01140 else if(!(ioblkp = io_structs[iostmt1]))
01141 io_structs[iostmt1] = ioblkp =
01142 autovar(1, ios->type, ENULL, "");
01143
01144 ioset(TYIOINT, XERR, ICON(errbit));
01145 if(iostmt == IOREAD)
01146 ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
01147
01148 if(intfile)
01149 {
01150 ioset(TYIOINT, XIRNUM, nump);
01151 ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
01152 ioseta(XIUNIT, unitp);
01153 }
01154 else
01155 ioset(TYIOINT, XUNIT, (expptr) unitp);
01156
01157 if(recp)
01158 ioset(TYIOINT, XREC, (expptr) recp);
01159
01160 if(varfmt)
01161 ioseta( intfile ? XIFMT : XFMT , fmtp);
01162 else
01163 ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
01164
01165 ioroutine[0] = 's';
01166 ioroutine[1] = '_';
01167 ioroutine[2] = iostmt==IOREAD ? 'r' : 'w';
01168 ioroutine[3] = "ds"[sequential];
01169 ioroutine[4] = "ufln"[ioformatted];
01170 ioroutine[5] = "ei"[intfile];
01171 ioroutine[6] = '\0';
01172
01173 putiocall( call1(TYINT, ioroutine, cpexpr((expptr)ioblkp) ));
01174
01175 if(statstruct)
01176 {
01177 frexpr((expptr)ioblkp);
01178 statstruct = NO;
01179 ioblkp = 0;
01180 }
01181 }
|
void unclassifiable |
( |
Void |
|
) |
|
|
|
Definition at line 1678 of file lex.c.
References errstr(), lastch, MYQUOTE, and sbuf.
Referenced by yyparse().
01679 {
01680 register char *s, *se;
01681
01682 s = sbuf;
01683 se = lastch;
01684 if (se < sbuf)
01685 return;
01686 lastch = s - 1;
01687 if (++se - s > 10)
01688 se = s + 10;
01689 for(; s < se; s++)
01690 if (*s == MYQUOTE) {
01691 se = s;
01692 break;
01693 }
01694 *se = 0;
01695 errstr("unclassifiable statement (starts \"%s\")", sbuf);
01696 }
|
|
Definition at line 501 of file lex.c.
References analyz(), crunch(), fatali(), FIRSTTOKEN, flush_comments(), getcds(), gettok(), lastch, lexstate, NEWSTMT, nextch, nxtstno, OTHERTOKEN, parlev, putlineno(), RETEOS, retval(), SEOF, STEOF, stkey, stno, and yystno.
Referenced by yyparse().
|
Variable Documentation
|