* Copyright (c) 1980 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
static char *sccsid
= "@(#)init.c 5.1 (Berkeley) 85/06/07";
* Initializations for f77 compiler, pass 1.
* University of Utah CS Dept modification history:
* $Header: init.c,v 2.1 84/07/19 12:03:26 donn Exp $
* Revision 2.1 84/07/19 12:03:26 donn
* Changed comment headers for UofU.
* Revision 1.3 84/02/28 21:07:53 donn
* Added Berkeley changes for call argument temporaries fix.
* Fixed incorrect check of 'cdatafile' when 'cchkfile' is opened. -- Donn
FILEP infile
= { stdin
};
FILEP diagfile
= { stderr
};
struct Labelblock
*thislabel
= NULL
;
flag debugflag
[MAXDEBUGFLAG
] = { NO
};
= { 1, SZADDR
, SZSHORT
, SZLONG
, SZLONG
, 2*SZLONG
,
2*SZLONG
, 4*SZLONG
, SZLONG
, 1, 1, 1};
= { 1, ALIADDR
, ALISHORT
, ALILONG
, ALILONG
, ALIDOUBLE
,
ALILONG
, ALIDOUBLE
, ALILONG
, 1, 1, 1};
int proctype
= TYUNKNOWN
;
int procclass
= CLUNKNOWN
;
struct Ctlframe
*ctlstack
;
struct Ctlframe
*lastctl
;
Namep regnamep
[MAXREGVAR
];
struct Extsym
*extsymtab
;
struct Equivblock
*eqvclass
;
struct Hashentry
*hashtab
;
struct Hashentry
*lasthash
;
struct Labelblock
*labeltab
;
struct Labelblock
*labtabend
;
struct Labelblock
*highlabtab
;
struct Rplblock
*rpllist
= NULL
;
struct Chain
*curdtp
= NULL
;
chainp argtemplist
= CHNULL
;
chainp activearglist
= CHNULL
;
struct Entrypoint
*entries
= NULL
;
struct Literal litpool
[MAXLITERALS
];
char cdatafname
[44] = "";
char vdatafname
[44] = "";
sprintf(cdatafname
, "/tmp/fortcd.%d", pid
);
sprintf(cchkfname
, "/tmp/fortcc.%d", pid
);
sprintf(vdatafname
, "/tmp/fortvd.%d", pid
);
sprintf(vchkfname
, "/tmp/fortvc.%d", pid
);
cdatafile
= open(cdatafname
, O_CREAT
| O_RDWR
, 0600);
fatalstr("cannot open tmp file %s", cdatafname
);
cchkfile
= open(cchkfname
, O_CREAT
| O_RDWR
, 0600);
fatalstr("cannot open tmp file %s", cchkfname
);
pruse(initfile
, USEINIT
);
ctls
= ALLOCN(maxctl
, Ctlframe
);
extsymtab
= ALLOCN(maxext
, Extsym
);
eqvclass
= ALLOCN(maxequiv
, Equivblock
);
hashtab
= ALLOCN(maxhash
, Hashentry
);
labeltab
= ALLOCN(maxstno
, Labelblock
);
lastext
= extsymtab
+ maxext
;
lasthash
= hashtab
+ maxhash
;
labtabend
= labeltab
+ maxstno
;
register struct Dimblock
*q
;
register struct Hashentry
*hp
;
register struct Labelblock
*lp
;
vdatafile
= open(vdatafname
, O_CREAT
| O_RDWR
, 0600);
fatalstr("cannot open tmp file %s", vdatafname
);
vchkfile
= open(vchkfname
, O_CREAT
| O_RDWR
, 0600);
fatalstr("cannot open tmp file %s", vchkfname
);
pruse(asmfile
, USECONST
);
for(lp
= labeltab
; lp
< labtabend
; ++lp
)
for(hp
= hashtab
; hp
< lasthash
; ++hp
)
for(i
= 0 ; i
< q
->ndim
; ++i
)
frexpr(q
->dims
[i
].dimsize
);
frexpr(q
->dims
[i
].dimexpr
);
if(p
->vclass
== CLNAMELIST
)
frchain( &(p
->varxptr
.namelist
) );
for(cp
= templist
; cp
; cp
= cp
->nextp
)
free( (charptr
) (cp
->datap
) );
for (cp
= argtemplist
; cp
; cp
= cp
->nextp
)
free((char *) (cp
->datap
));
for(i
= 0 ; i
<NTYPES
; ++i
)
setimpl(TYUNKNOWN
, (ftnint
) 0, 'a', 'z');
setimpl(TYREAL
, (ftnint
) 0, 'a', 'z');
setimpl(tyint
, (ftnint
) 0, 'i', 'n');
setimpl(-STGBSS
, (ftnint
) 0, 'a', 'z'); /* set class */
setimpl(type
, length
, c1
, c2
)
sprintf(buff
, "characters out of order in implicit:%c-%c", c1
, c2
);
for(i
= c1
; i
<=c2
; ++i
)
type
= lengtype(type
, (int) length
);
if((type
!= TYCHAR
) && (tyint
!=TYSHORT
))
for(i
= c1
; i
<=c2
; ++i
)
implleng
[i
-'a'] = length
;