xref: /netbsd/external/bsd/pcc/dist/pcc/f77/fcom/defs.h (revision 6550d01e)
1 /*	Id: defs.h,v 1.22 2008/12/24 17:40:41 sgk Exp 	*/
2 /*	$NetBSD: defs.h,v 1.1.1.3 2010/06/03 18:57:46 plunky Exp $	*/
3 /*
4  * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
5  *
6  * Redistribution and use in source and binary forms, with or without
7  * modification, are permitted provided that the following conditions
8  * are met:
9  *
10  * Redistributions of source code and documentation must retain the above
11  * copyright notice, this list of conditions and the following disclaimer.
12  * Redistributions in binary form must reproduce the above copyright
13  * notice, this list of conditionsand the following disclaimer in the
14  * documentation and/or other materials provided with the distribution.
15  * All advertising materials mentioning features or use of this software
16  * must display the following acknowledgement:
17  * 	This product includes software developed or owned by Caldera
18  *	International, Inc.
19  * Neither the name of Caldera International, Inc. nor the names of other
20  * contributors may be used to endorse or promote products derived from
21  * this software without specific prior written permission.
22  *
23  * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
24  * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27  * DISCLAIMED.  IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
28  * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
30  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
31  * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
32  * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
33  * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34  * POSSIBILITY OF SUCH DAMAGE.
35  */
36 #include <stdio.h>
37 #include <ctype.h>
38 #include <stdlib.h>
39 
40 #define VL 6
41 #define XL 8
42 
43 #define MAXINCLUDES 10
44 #define MAXLITERALS 20
45 #define MAXCTL 20
46 #define MAXHASH 401
47 #define MAXSTNO 1000
48 #define MAXEXT 200
49 #define MAXEQUIV 150
50 #define MAXLABLIST 100
51 
52 typedef struct bigblock *bigptr;
53 typedef union chainedblock *chainp;
54 
55 extern FILE *infile;
56 extern FILE *diagfile;
57 extern long int headoffset;
58 
59 extern char token [ ];
60 extern int toklen;
61 extern int lineno;
62 extern char *infname;
63 extern int needkwd;
64 extern struct labelblock *thislabel;
65 
66 extern int mflag, tflag;
67 
68 extern flag profileflag;
69 extern flag optimflag;
70 extern flag quietflag;
71 extern flag nowarnflag;
72 extern flag ftn66flag;
73 extern flag shiftcase;
74 extern flag undeftype;
75 extern flag shortsubs;
76 extern flag onetripflag;
77 extern flag checksubs;
78 extern flag debugflag;
79 extern int nerr;
80 extern int nwarn;
81 extern int ndata;
82 
83 extern int parstate;
84 extern flag headerdone;
85 extern int blklevel;
86 extern flag saveall;
87 extern flag substars;
88 extern int impltype[ ];
89 extern int implleng[ ];
90 extern int implstg[ ];
91 
92 extern int tyint;
93 extern int tylogical;
94 extern ftnint typesize[];
95 extern int typealign[];
96 extern int procno;
97 extern int proctype;
98 extern char * procname;
99 extern int rtvlabel[ ];
100 extern int fudgelabel;	/* to confuse the pdp11 optimizer */
101 extern struct bigblock *typeaddr;
102 extern struct bigblock *retslot;
103 extern int cxslot;
104 extern int chslot;
105 extern int chlgslot;
106 extern int procclass;
107 extern ftnint procleng;
108 extern int nentry;
109 extern flag multitype;
110 extern int blklevel;
111 extern int lastlabno;
112 extern int lastvarno;
113 extern int lastargslot;
114 extern int argloc;
115 extern ftnint autoleng;
116 extern ftnint bssleng;
117 extern int retlabel;
118 extern int ret0label;
119 extern int dorange;
120 extern int regnum[ ];
121 extern bigptr regnamep[ ];
122 extern int maxregvar;
123 extern int highregvar;
124 
125 extern chainp templist;
126 extern chainp holdtemps;
127 extern chainp entries;
128 extern chainp rpllist;
129 extern chainp curdtp;
130 extern ftnint curdtelt;
131 extern flag toomanyinit;
132 
133 extern flag inioctl;
134 extern int iostmt;
135 extern struct bigblock *ioblkp;
136 extern int nioctl;
137 extern int nequiv;
138 extern int nintnames;
139 extern int nextnames;
140 
141 struct chain
142 	{
143 	chainp nextp;
144 	bigptr datap;
145 	};
146 
147 extern chainp chains;
148 
149 struct ctlframe
150 	{
151 	unsigned ctltype:8;
152 	unsigned dostepsign:8;
153 	int ctlabels[4];
154 	int dolabel;
155 	struct bigblock *donamep;
156 	bigptr domax;
157 	bigptr dostep;
158 	};
159 #define endlabel ctlabels[0]
160 #define elselabel ctlabels[1]
161 #define dobodylabel ctlabels[1]
162 #define doposlabel ctlabels[2]
163 #define doneglabel ctlabels[3]
164 extern struct ctlframe ctls[ ];
165 extern struct ctlframe *ctlstack;
166 extern struct ctlframe *lastctl;
167 
168 struct extsym
169 	{
170 	char extname[XL];
171 	unsigned extstg:4;
172 	unsigned extsave:1;
173 	unsigned extinit:1;
174 	chainp extp;
175 	ftnint extleng;
176 	ftnint maxleng;
177 	};
178 
179 extern struct extsym extsymtab[ ];
180 extern struct extsym *nextext;
181 extern struct extsym *lastext;
182 
183 struct labelblock
184 	{
185 	int labelno;
186 	unsigned blklevel:8;
187 	unsigned labused:1;
188 	unsigned labinacc:1;
189 	unsigned labdefined:1;
190 	unsigned labtype:2;
191 	ftnint stateno;
192 	};
193 
194 extern struct labelblock labeltab[ ];
195 extern struct labelblock *labtabend;
196 extern struct labelblock *highlabtab;
197 
198 struct entrypoint
199 	{
200 	chainp nextp;
201 	struct extsym *entryname;
202 	chainp arglist;
203 	int entrylabel;
204 	int typelabel;
205 	ptr enamep;
206 	};
207 
208 struct primblock
209 	{
210 	struct bigblock *namep;
211 	struct bigblock *argsp;
212 	bigptr fcharp;
213 	bigptr lcharp;
214 	};
215 
216 
217 struct hashentry
218 	{
219 	int hashval;
220 	struct bigblock *varp;
221 	};
222 extern struct hashentry hashtab[ ];
223 extern struct hashentry *lasthash;
224 
225 struct intrpacked	/* bits for intrinsic function description */
226 	{
227 	unsigned f1:3;
228 	unsigned f2:4;
229 	unsigned f3:7;
230 	};
231 
232 struct nameblock
233 	{
234 	char varname[VL];
235 	unsigned vdovar:1;
236 	unsigned vdcldone:1;
237 	unsigned vadjdim:1;
238 	unsigned vsave:1;
239 	unsigned vprocclass:3;
240 	unsigned vregno:4;
241 	union	{
242 		int varno;
243 		chainp vstfdesc;	/* points to (formals, expr) pair */
244 		struct intrpacked intrdesc;	/* bits for intrinsic function */
245 		} vardesc;
246 	struct dimblock *vdim;
247 	int voffset;
248 	};
249 
250 
251 struct paramblock
252 	{
253 	char varname[VL];
254 	bigptr paramval;
255 	} ;
256 
257 
258 struct exprblock
259 	{
260 	unsigned opcode:6;
261 	bigptr leftp;
262 	bigptr rightp;
263 	};
264 
265 struct dcomplex {
266 	double dreal, dimag;
267 };
268 
269 union constant
270 	{
271 	char *ccp;
272 	ftnint ci;
273 	double cd[2];
274 	struct dcomplex dc;
275 	};
276 
277 struct constblock
278 	{
279 	union constant fconst;
280 	};
281 
282 
283 struct listblock
284 	{
285 	chainp listp;
286 	};
287 
288 
289 
290 struct addrblock
291 	{
292 	int memno;
293 	bigptr memoffset;
294 	unsigned istemp:1;
295 	unsigned ntempelt:10;
296 	};
297 
298 
299 
300 struct errorblock
301 	{
302 	int pad;
303 	};
304 
305 
306 struct dimblock
307 	{
308 	int ndim;
309 	bigptr nelt;
310 	bigptr baseoffset;
311 	bigptr basexpr;
312 	struct
313 		{
314 		bigptr dimsize;
315 		bigptr dimexpr;
316 		} dims[1];
317 	};
318 
319 
320 struct impldoblock  /* XXXX */
321 	{
322 #define	isactive vtype
323 #define isbusy vclass
324 	struct bigblock *varnp;
325 	struct bigblock *varvp;
326 	bigptr implb;
327 	bigptr impub;
328 	bigptr impstep;
329 	ftnint impdiff;
330 	ftnint implim;
331 	chainp datalist;
332 	};
333 
334 
335 struct rplblock	/* name replacement block */
336 	{
337 	chainp nextp;
338 	struct bigblock *rplnp;
339 	ptr rplvp;
340 	struct bigblock *rplxp;
341 	int rpltag;
342 	};
343 
344 
345 
346 struct equivblock
347 	{
348 	ptr equivs;
349 	unsigned eqvinit:1;
350 	long int eqvtop;
351 	long int eqvbottom;
352 	} ;
353 #define eqvleng eqvtop
354 
355 extern struct equivblock eqvclass[ ];
356 
357 
358 struct eqvchain
359 	{
360 	chainp nextp;
361 	ptr eqvitem;
362 	long int eqvoffset;
363 	} ;
364 
365 union chainedblock
366 	{
367 	struct chain chain;
368 	struct entrypoint entrypoint;
369 	struct rplblock rplblock;
370 	struct eqvchain eqvchain;
371 	};
372 
373 
374 struct bigblock {
375 	unsigned tag:4;
376 	unsigned vtype:4;
377 	unsigned vclass:4;
378 	unsigned vstg:4;
379 	bigptr vleng;
380 	union {
381 		struct exprblock _expr;
382 		struct addrblock _addr;
383 		struct constblock _const;
384 		struct errorblock _error;
385 		struct listblock _list;
386 		struct primblock _prim;
387 		struct nameblock _name;
388 		struct paramblock _param;
389 		struct impldoblock _impldo;
390 	} _u;
391 #define	b_expr		_u._expr
392 #define	b_addr		_u._addr
393 #define	b_const		_u._const
394 #define	b_error		_u._error
395 #define	b_list		_u._list
396 #define	b_prim		_u._prim
397 #define	b_name		_u._name
398 #define	b_param		_u._param
399 #define	b_impldo	_u._impldo
400 };
401 
402 struct literal
403 	{
404 	short littype;
405 	short litnum;
406 	union	{
407 		ftnint litival;
408 		double litdval;
409 		struct	{
410 			char litclen;	/* small integer */
411 			char litcstr[XL];
412 			} litcval;
413 		} litval;
414 	};
415 
416 extern struct literal litpool[ ];
417 extern int nliterals;
418 
419 
420 
421 
422 
423 /* popular functions with non integer return values */
424 #define	expptr bigptr
425 #define	tagptr bigptr
426 
427 ptr cpblock(int ,void *);
428 
429 ptr ckalloc(int);
430 char *varstr(int, char *), *nounder(int, char *), *varunder(int, char *);
431 char *copyn(int, char *), *copys(char *);
432 chainp hookup(chainp, chainp), mkchain(bigptr, chainp);
433 ftnint convci(int, char *), iarrlen(struct bigblock *q);
434 ftnint lmin(ftnint, ftnint), lmax(ftnint, ftnint);
435 ftnint simoffset(expptr *);
436 char *memname(int, int), *convic(ftnint), *setdoto(char *);
437 double convcd(int, char *);
438 struct extsym *mkext(char *),
439 	*newentry(struct bigblock *),
440 	*comblock(int, char *s);
441 struct bigblock *mkname(int, char *);
442 struct labelblock *mklabel(ftnint);
443 struct bigblock *addrof(expptr), *call1(int, char *, expptr),
444 	*call2(int, char *, expptr, expptr),
445 	*call3(int, char *, expptr, expptr, expptr),
446 	*call4(int, char *, expptr, expptr, expptr, expptr);
447 struct bigblock *call0(int, char *), *mkexpr(int, bigptr, bigptr);
448 struct bigblock *callk(int, char *, bigptr);
449 
450 struct bigblock *builtin(int, char *), *fmktemp(int, bigptr),
451 	*mktmpn(int, int, bigptr), *nextdata(ftnint *, ftnint *),
452 	*autovar(int, int, bigptr), *mklhs(struct bigblock *),
453 	*mkaddr(struct bigblock *), *putconst(struct bigblock *),
454 	*memversion(struct bigblock *);
455 struct bigblock *mkscalar(struct bigblock *np);
456 struct bigblock *realpart(struct bigblock *p);
457 struct bigblock *imagpart(struct bigblock *p);
458 
459 struct bigblock *mkintcon(ftnint), *mkbitcon(int, int, char *),
460 	*mklogcon(int), *mkaddcon(int), *mkrealcon(int, double),
461 	*mkstrcon(int, char *), *mkcxcon(bigptr,bigptr);
462 bigptr mkconst(int t);
463 
464 bigptr mklist(chainp p);
465 bigptr mkiodo(chainp, chainp);
466 
467 
468 bigptr mkconv(int, bigptr),
469 	mkfunct(struct bigblock *), fixexpr(struct bigblock *),
470 	fixtype(bigptr);
471 
472 
473 bigptr cpexpr(bigptr), mkprim(bigptr, struct bigblock *, bigptr, bigptr);
474 struct bigblock *mkarg(int, int);
475 struct bigblock *errnode(void);
476 void initkey(void), prtail(void), puteof(void), done(int);
477 void fileinit(void), procinit(void), endproc(void), doext(void), preven(int);
478 int inilex(char *), yyparse(void), newlabel(void), lengtype(int, int);
479 void err(char *, ...), warn(char *, ...), fatal(char *, ...), enddcl(void);
480 void p2pass(char *s), frexpr(bigptr), execerr(char *, ...);
481 void setimpl(int, ftnint, int, int), setlog(void), newproc(void);
482 void prdbginfo(void), impldcl(struct bigblock *p);
483 void putbracket(void), enddcl(void), doequiv(void);
484 void puthead(char *), startproc(struct extsym *, int);
485 void dclerr(char *s, struct bigblock *v), putforce(int, bigptr);
486 void entrypt(int, int, ftnint, struct extsym *, chainp);
487 void settype(struct bigblock *, int, int), putlabel(int);
488 void putbranch(struct bigblock *p), goret(int), putrbrack(int);
489 void prolog(struct entrypoint *, struct bigblock *), prendproc(void);
490 void prlocvar(char *, ftnint), prext(char *, ftnint, int);
491 void vardcl(struct bigblock *v), frchain(chainp *p);
492 void frtemp(struct bigblock *p), incomm(struct extsym *, struct bigblock *);
493 void setintr(struct bigblock * v), setext(struct bigblock * v);
494 struct uux { expptr lb, ub; };
495 void setbound(struct bigblock *, int, struct uux []);
496 void setfmt(struct labelblock *lp), frdata(chainp), frrpl(void),
497 	dataval(struct bigblock *, struct bigblock *),
498 	consnegop(struct bigblock *p), exdo(int, chainp), exelse(void),
499 	exendif(void), exif(bigptr), exelif(bigptr),
500 	exequals(struct bigblock *, bigptr),
501 	exassign(struct bigblock *, struct labelblock *),
502 	exarif(bigptr, struct labelblock *, struct labelblock *,
503 	    struct labelblock *);
504 
505 
506 
507 int intrfunct(char s[VL]), eqn(int, char *, char *);
508 int fmtstmt(struct labelblock *lp);
509 int cktype(int, int, int);
510 int yylex(void), inregister(struct bigblock *);
511 int inilex(char *), iocname(void);
512 int maxtype(int, int), flog2(ftnint), hextoi(int);
513 int cmpstr(char *, char *, ftnint, ftnint);
514 int enregister(struct bigblock *np);
515 int conssgn(bigptr p);
516 int fixargs(int, struct bigblock *);
517 int addressable(bigptr p);
518 
519 void prlabel(int);
520 void prconi(FILE *, int, ftnint);
521 void prcona(ftnint);
522 void prconr(FILE *, int, double);
523 void prarif(bigptr, int, int, int);
524 void putstr(char *, ftnint);
525 NODE *putex1(bigptr p);
526 void puteq(bigptr, bigptr);
527 void popstack(chainp *p);
528 void consconv(int, union constant *, int, union constant *);
529 void yyerror(char *s);
530 void enddo(int);
531 void doinclude(char *);
532 void flline(void);
533 void startioctl(void);
534 void endioctl(void), endio(void), ioclause(int, bigptr), doio(chainp);
535 void excall(struct bigblock *, struct bigblock *, int, struct labelblock *[]);
536 void exreturn(expptr p);
537 void exstop(int, expptr);
538 void exgoto(struct labelblock *);
539 void exasgoto(bigptr);
540 void putcmgo(expptr, int, struct labelblock *[]);
541 void putexpr(expptr p);
542 void putif(expptr, int);
543 void putgoto(int);
544 void deregister(struct bigblock *np);
545 NODE *putx(expptr p);
546 void cpn(int, char *, char *);
547 void prcmgoto(expptr, int, int, int);
548 char *lexline(ftnint *n);
549 bigptr suboffset(struct bigblock *p);
550 struct bigblock *intraddr(struct bigblock *np);
551 struct bigblock *intrcall(bigptr, bigptr, int);
552 void setloc(int);
553 void prnloc(char *name);
554 void fprint(bigptr p, int indx);
555 void ckfree(void *p);
556 
557 #undef expptr
558 #undef tagptr
559 
560 #define	err1 err
561 #define err2 err
562 #define	warn1 warn
563 #define	fatal1 fatal
564