Home | History | Annotate | Line # | Download | only in fcom 
      1 /*	Id: main.c,v 1.17 2012/03/22 18:51:40 plunky Exp 	*/
      2 /*	$NetBSD: main.c,v 1.1.1.5 2012/03/26 14:27:08 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 char xxxvers[] = "\nFORTRAN 77 PASS 1, VERSION 1.16,  3 NOVEMBER 1978\n";
     37 
     38 #include <unistd.h>
     39 
     40 #include "defines.h"
     41 #include "defs.h"
     42 
     43 void mkdope(void);
     44 
     45 int ndebug;
     46 int b2debug, c2debug, e2debug, f2debug, g2debug, o2debug;
     47 int r2debug, s2debug, t2debug, u2debug, x2debug;
     48 int kflag;
     49 int xdeljumps, xtemps, xssa, xdce;
     50 
     51 int mflag, tflag;
     52 
     53 char *ftitle = "<unknown>";
     54 
     55 #if 1 /* RAGGE */
     56 FILE *initfile, *sortfile;
     57 int dodata(char *file);
     58 LOCAL int nch   = 0;
     59 #endif
     60 
     61 static void
     62 usage(void)
     63 {
     64 	fprintf(stderr, "usage: fcom [qw:UuOdpC1I:Z:]\n");
     65 	exit(1);
     66 }
     67 
     68 int
     69 main(int argc, char **argv)
     70 {
     71 	int ch;
     72 	int k, retcode;
     73 
     74 	infile = stdin;
     75 	diagfile = stderr;
     76 #if 1 /* RAGGE */
     77 	char file[] = "/tmp/initfile.XXXXXX";
     78 	char buf[100];
     79 	close(mkstemp(file));
     80 	sprintf(buf, "sort > %s", file);
     81 	initfile = popen(buf, "w");
     82 #endif
     83 
     84 
     85 #define DONE(c)	{ retcode = c; goto finis; }
     86 
     87 	while ((ch = getopt(argc, argv, "qw:UuOdpC1I:Z:X:")) != -1)
     88 		switch (ch) {
     89 		case 'q':
     90 			quietflag = YES;
     91 			break;
     92 
     93 		case 'w':
     94 			if(optarg[0]=='6' && optarg[1]=='6') {
     95 				ftn66flag = YES;
     96 			} else
     97 				nowarnflag = YES;
     98 			break;
     99 
    100 		case 'U':
    101 			shiftcase = NO;
    102 			break;
    103 
    104 		case 'u':
    105 			undeftype = YES;
    106 			break;
    107 
    108 		case 'O':
    109 			optimflag = YES;
    110 #ifdef notyet
    111 			xdeljumps = 1;
    112 			xtemps = 1;
    113 #endif
    114 			break;
    115 
    116 		case 'd':
    117 			debugflag = YES;
    118 			break;
    119 
    120 		case 'p':
    121 			profileflag = YES;
    122 			break;
    123 
    124 		case 'C':
    125 			checksubs = YES;
    126 			break;
    127 
    128 		case '1':
    129 			onetripflag = YES;
    130 			break;
    131 
    132 		case 'I':
    133 			if(*optarg == '2')
    134 				tyint = TYSHORT;
    135 			else if(*optarg == '4') {
    136 				shortsubs = NO;
    137 				tyint = TYLONG;
    138 			} else if(*optarg == 's')
    139 				shortsubs = YES;
    140 			else
    141 				fatal1("invalid flag -I%c\n", *optarg);
    142 			tylogical = tyint;
    143 			break;
    144 
    145 		case 'Z':	/* pass2 debugging */
    146 			while (*optarg)
    147 				switch (*optarg++) {
    148 				case 'b': /* basic block and SSA building */
    149 					++b2debug;
    150 					break;
    151 				case 'c': /* code printout */
    152 					++c2debug;
    153 					break;
    154 				case 'e': /* print tree upon pass2 enter */
    155 					++e2debug;
    156 					break;
    157 				case 'f': /* instruction matching */
    158 					++f2debug;
    159 					break;
    160 				case 'g':
    161 					++g2debug;
    162 					break;
    163 				case 'n':
    164 					++ndebug;
    165 					break;
    166 				case 'o':
    167 					++o2debug;
    168 					break;
    169 				case 'r': /* register alloc/graph coloring */
    170 					++r2debug;
    171 					break;
    172 				case 's': /* shape matching */
    173 					++s2debug;
    174 					break;
    175 				case 't':
    176 					++t2debug;
    177 					break;
    178 				case 'u': /* Sethi-Ullman debugging */
    179 					++u2debug;
    180 					break;
    181 				case 'x':
    182 					++x2debug;
    183 					break;
    184 				default:
    185 					fprintf(stderr, "unknown Z flag '%c'\n",
    186 					    optarg[-1]);
    187 					exit(1);
    188 				}
    189 			break;
    190 
    191 		case 'X':	/* pass1 debugging */
    192 			while (*optarg)
    193 				switch (*optarg++) {
    194 				case 'm': /* memory allocation */
    195 					++mflag;
    196 					break;
    197 				case 't': /* tree debugging */
    198 					tflag++;
    199 					break;
    200 				default:
    201 					usage();
    202 				}
    203 			break;
    204 
    205 		default:
    206 			usage();
    207 		}
    208 	argc -= optind;
    209 	argv += optind;
    210 
    211 	mkdope();
    212 	initkey();
    213 	if (argc > 0) {
    214 		if (inilex(copys(argv[0])))
    215 			DONE(1);
    216 		if (!quietflag)
    217 			fprintf(diagfile, "%s:\n", argv[0]);
    218 		if (argc != 1)
    219 			if (freopen(argv[1], "w", stdout) == NULL) {
    220 				fprintf(stderr, "open output file '%s':",
    221 				    argv[1]);
    222 				perror(NULL);
    223 				exit(1);
    224 			}
    225 	} else {
    226 		inilex(copys(""));
    227 	}
    228 	fileinit();
    229 	procinit();
    230 	if((k = yyparse())) {
    231 		fprintf(diagfile, "Bad parse, return code %d\n", k);
    232 		DONE(1);
    233 	}
    234 	if(nerr > 0)
    235 		DONE(1);
    236 	if(parstate != OUTSIDE) {
    237 		warn("missing END statement");
    238 		endproc();
    239 	}
    240 	doext();
    241 	preven(ALIDOUBLE);
    242 	prtail();
    243 	puteof();
    244 	DONE(0);
    245 
    246 
    247 finis:
    248 	pclose(initfile);
    249 	retcode |= dodata(file);
    250 	unlink(file);
    251 	done(retcode);
    252 	return(retcode);
    253 }
    254 
    255 #define USEINIT ".data\t2"
    256 #define LABELFMT "%s:\n"
    257 
    258 static void
    259 prcha(FILEP fp, int *s)
    260 {
    261 
    262 fprintf(fp, ".byte 0%o,0%o\n", s[0], s[1]);
    263 }
    264 
    265 static void
    266 prskip(FILEP fp, ftnint k)
    267 {
    268 fprintf(fp, "\t.space\t%ld\n", k);
    269 }
    270 
    271 
    272 static void
    273 prch(int c)
    274 {
    275 static int buff[SZSHORT];
    276 
    277 buff[nch++] = c;
    278 if(nch == SZSHORT)
    279         {
    280         prcha(stdout, buff);
    281         nch = 0;
    282         }
    283 }
    284 
    285 
    286 static int
    287 rdname(int *vargroupp, char *name)
    288 {
    289 register int i, c;
    290 
    291 if( (c = getc(sortfile)) == EOF)
    292         return(NO);
    293 *vargroupp = c - '0';
    294 
    295 for(i = 0 ; i<XL ; ++i)
    296         {
    297         if( (c = getc(sortfile)) == EOF)
    298                 return(NO);
    299         if(c != ' ')
    300                 *name++ = c;
    301         }
    302 *name = '\0';
    303 return(YES);
    304 }
    305 
    306 static int
    307 rdlong(ftnint *n)
    308 {
    309 register int c;
    310 
    311 for(c = getc(sortfile) ; c!=EOF && isspace(c) ; c = getc(sortfile) );
    312         ;
    313 if(c == EOF)
    314         return(NO);
    315 
    316 for(*n = 0 ; isdigit(c) ; c = getc(sortfile) )
    317         *n = 10* (*n) + c - '0';
    318 return(YES);
    319 }
    320 
    321 static void
    322 prspace(ftnint n)
    323 {
    324 register ftnint m;
    325 
    326 while(nch>0 && n>0)
    327         {
    328         --n;
    329         prch(0);
    330         }
    331 m = SZSHORT * (n/SZSHORT);
    332 if(m > 0)
    333         prskip(stdout, m);
    334 for(n -= m ; n>0 ; --n)
    335         prch(0);
    336 }
    337 
    338 static ftnint
    339 doeven(ftnint tot, int align)
    340 {
    341 ftnint new;
    342 new = roundup(tot, align);
    343 prspace(new - tot);
    344 return(new);
    345 }
    346 
    347 
    348 int
    349 dodata(char *file)
    350 {
    351 	char varname[XL+1], ovarname[XL+1];
    352 	flag erred;
    353 	ftnint offset, vlen, type;
    354 	register ftnint ooffset, ovlen;
    355 	ftnint vchar;
    356 	int size, align;
    357 	int vargroup;
    358 	ftnint totlen;
    359 
    360 	erred = NO;
    361 	ovarname[0] = '\0';
    362 	ooffset = 0;
    363 	ovlen = 0;
    364 	totlen = 0;
    365 	nch = 0;
    366 	ftitle = file;
    367 
    368 	if( (sortfile = fopen(file, "r")) == NULL)
    369 		fatal1(file);
    370 #if 0
    371 	pruse(asmfile, USEINIT);
    372 #else
    373 	printf("\t%s\n", USEINIT);
    374 #endif
    375 	while (rdname(&vargroup, varname) && rdlong(&offset) &&
    376 	    rdlong(&vlen) && rdlong(&type) ) {
    377 		size = typesize[type];
    378 		if( strcmp(varname, ovarname) ) {
    379 			prspace(ovlen-ooffset);
    380 			strcpy(ovarname, varname);
    381 			ooffset = 0;
    382 			totlen += ovlen;
    383 			ovlen = vlen;
    384 			if(vargroup == 0)
    385 				align = (type==TYCHAR ? SZLONG :
    386 				    typealign[type]);
    387 			else
    388 				align = ALIDOUBLE;
    389 			totlen = doeven(totlen, align);
    390 			if(vargroup == 2) {
    391 #if 0
    392 				prcomblock(asmfile, varname);
    393 #else
    394 				printf(LABELFMT, varname);
    395 #endif
    396 			} else {
    397 #if 0
    398 				fprintf(asmfile, LABELFMT, varname);
    399 #else
    400 				printf(LABELFMT, varname);
    401 #endif
    402 			}
    403 		}
    404 		if(offset < ooffset) {
    405 			erred = YES;
    406 			err("overlapping initializations");
    407 		}
    408 		if(offset > ooffset) {
    409 			prspace(offset-ooffset);
    410 			ooffset = offset;
    411 		}
    412 		if(type == TYCHAR) {
    413 			if( ! rdlong(&vchar) )
    414 				fatal("bad intermediate file format");
    415 			prch( (int) vchar );
    416 		} else {
    417 			putc('\t', stdout);
    418 			while	( putc( getc(sortfile), stdout)  != '\n')
    419 				;
    420 		}
    421 		if( (ooffset += size) > ovlen) {
    422 			erred = YES;
    423 			err("initialization out of bounds");
    424 		}
    425 	}
    426 
    427 	prspace(ovlen-ooffset);
    428 	totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) );
    429 	return(erred);
    430 }
    431 
    432 void
    433 done(k)
    434 int k;
    435 {
    436 static int recurs	= NO;
    437 
    438 if(recurs == NO)
    439 	{
    440 	recurs = YES;
    441 	}
    442 exit(k);
    443 }
    444