Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:plunky:20120322185140

Diff

Diff from 1.17 to:

Annotations

Annotate by Age | Author | Mixed | None
/fisheye/browse/pcc/pcc/f77/fcom/main.c

Annotated File View

plunky
1.17
1 /*      $Id: main.c,v 1.17 2012/03/22 18:51:40 plunky Exp $     */
ragge
1.2
2 /*
3  * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
4  *
5  * Redistribution and use in source and binary forms, with or without
6  * modification, are permitted provided that the following conditions
7  * are met:
8  *
9  * Redistributions of source code and documentation must retain the above
10  * copyright notice, this list of conditions and the following disclaimer.
11  * Redistributions in binary form must reproduce the above copyright
12  * notice, this list of conditionsand the following disclaimer in the
13  * documentation and/or other materials provided with the distribution.
14  * All advertising materials mentioning features or use of this software
15  * must display the following acknowledgement:
16  *      This product includes software developed or owned by Caldera
17  *      International, Inc.
18  * Neither the name of Caldera International, Inc. nor the names of other
19  * contributors may be used to endorse or promote products derived from
20  * this software without specific prior written permission.
21  *
22  * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
23  * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
24  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26  * DISCLAIMED.  IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
27  * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30  * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
31  * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
32  * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
33  * POSSIBILITY OF SUCH DAMAGE.
34  */
35 char xxxvers[] = "\nFORTRAN 77 PASS 1, VERSION 1.16,  3 NOVEMBER 1978\n";
ragge
1.1
36
ragge
1.5
37 #include <unistd.h>
ragge
1.4
38
39 #include "defines.h"
ragge
1.2
40 #include "defs.h"
ragge
1.1
41
ragge
1.5
42 void mkdope(void);
43
plunky
1.17
44 int ndebug;
45 int b2debugc2debuge2debugf2debugg2debugo2debug;
46 int r2debugs2debugt2debugu2debugx2debug;
47 int kflag;
plunky
1.16
48 int xdeljumpsxtempsxssaxdce;
ragge
1.5
49
ragge
1.11
50 int mflagtflag;
51
plunky
1.15
52 char *ftitle = "<unknown>";
53
ragge
1.9
54 #if 1 /* RAGGE */
55 FILE *initfile, *sortfile;
56 int dodata(char *file);
57 LOCAL int nch   = 0;
58 #endif
59
ragge
1.6
60 static void
61 usage(void)
62 {
sgk
1.13
63         fprintf(stderr"usage: fcom [qw:UuOdpC1I:Z:]\n");
ragge
1.6
64         exit(1);
65 }
ragge
1.3
66
ragge
1.2
67 int
ragge
1.3
68 main(int argcchar **argv)
ragge
1.1
69 {
ragge
1.5
70         int ch;
71         int kretcode;
ragge
1.1
72
ragge
1.8
73         infile = stdin;
74         diagfile = stderr;
ragge
1.9
75 #if 1 /* RAGGE */
76         char file[] = "/tmp/initfile.XXXXXX";
77         char buf[100];
78         close(mkstemp(file));
79         sprintf(buf"sort > %s"file);
80         initfile = popen(buf"w");
81 #endif
82
ragge
1.8
83
ragge
1.1
84 #define DONE(c) { retcode = c; goto finis; }
85
sgk
1.13
86         while ((ch = getopt(argcargv"qw:UuOdpC1I:Z:X:")) != -1)
ragge
1.5
87                 switch (ch) {
sgk
1.13
88                 case 'q':
89                         quietflag = YES;
90                         break;
91
ragge
1.1
92                 case 'w':
ragge
1.5
93                         if(optarg[0]=='6' && optarg[1]=='6') {
ragge
1.1
94                                 ftn66flag = YES;
ragge
1.5
95                         } else
ragge
1.1
96                                 nowarnflag = YES;
97                         break;
98
99                 case 'U':
100                         shiftcase = NO;
101                         break;
102
103                 case 'u':
104                         undeftype = YES;
105                         break;
106
107                 case 'O':
108                         optimflag = YES;
ragge
1.7
109 #ifdef notyet
110                         xdeljumps = 1;
111                         xtemps = 1;
ragge
1.5
112 #endif
ragge
1.1
113                         break;
114
115                 case 'd':
116                         debugflag = YES;
117                         break;
118
119                 case 'p':
120                         profileflag = YES;
121                         break;
122
123                 case 'C':
124                         checksubs = YES;
125                         break;
126
127                 case '1':
128                         onetripflag = YES;
129                         break;
130
131                 case 'I':
ragge
1.5
132                         if(*optarg == '2')
ragge
1.1
133                                 tyint = TYSHORT;
ragge
1.5
134                         else if(*optarg == '4') {
ragge
1.1
135                                 shortsubs = NO;
136                                 tyint = TYLONG;
ragge
1.5
137                         } else if(*optarg == 's')
ragge
1.1
138                                 shortsubs = YES;
139                         else
ragge
1.5
140                                 fatal1("invalid flag -I%c\n", *optarg);
ragge
1.1
141                         tylogical = tyint;
142                         break;
143
plunky
1.17
144                 case 'Z':       /* pass2 debugging */
ragge
1.5
145                         while (*optarg)
146                                 switch (*optarg++) {
plunky
1.17
147                                 case 'b'/* basic block and SSA building */
148                                         ++b2debug;
149                                         break;
150                                 case 'c'/* code printout */
151                                         ++c2debug;
152                                         break;
153                                 case 'e'/* print tree upon pass2 enter */
154                                         ++e2debug;
155                                         break;
ragge
1.5
156                                 case 'f'/* instruction matching */
157                                         ++f2debug;
158                                         break;
plunky
1.17
159                                 case 'g':
160                                         ++g2debug;
ragge
1.5
161                                         break;
plunky
1.17
162                                 case 'n':
163                                         ++ndebug;
ragge
1.5
164                                         break;
plunky
1.17
165                                 case 'o':
166                                         ++o2debug;
ragge
1.5
167                                         break;
plunky
1.17
168                                 case 'r'/* register alloc/graph coloring */
169                                         ++r2debug;
ragge
1.5
170                                         break;
171                                 case 's'/* shape matching */
172                                         ++s2debug;
173                                         break;
plunky
1.17
174                                 case 't':
175                                         ++t2debug;
176                                         break;
ragge
1.5
177                                 case 'u'/* Sethi-Ullman debugging */
plunky
1.17
178                                         ++u2debug;
179                                         break;
180                                 case 'x':
181                                         ++x2debug;
ragge
1.5
182                                         break;
183                                 default:
184                                         fprintf(stderr"unknown Z flag '%c'\n",
185                                             optarg[-1]);
186                                         exit(1);
187                                 }
188                         break;
189
plunky
1.17
190                 case 'X':       /* pass1 debugging */
ragge
1.11
191                         while (*optarg)
192                                 switch (*optarg++) {
plunky
1.17
193                                 case 'm'/* memory allocation */
194                                         ++mflag;
195                                         break;
ragge
1.11
196                                 case 't'/* tree debugging */
197                                         tflag++;
198                                         break;
199                                 default:
200                                         usage();
201                                 }
202                         break;
ragge
1.5
203
ragge
1.1
204                 default:
ragge
1.6
205                         usage();
ragge
1.1
206                 }
ragge
1.5
207         argc -= optind;
208         argv += optind;
ragge
1.1
209
ragge
1.5
210         mkdope();
211         initkey();
ragge
1.6
212         if (argc > 0) {
213                 if (inilex(copys(argv[0])))
214                         DONE(1);
sgk
1.13
215                 if (!quietflag)
216                         fprintf(diagfile"%s:\n"argv[0]);
ragge
1.6
217                 if (argc != 1)
218                         if (freopen(argv[1], "w"stdout) == NULL) {
219                                 fprintf(stderr"open output file '%s':",
220                                     argv[1]);
221                                 perror(NULL);
222                                 exit(1);
223                         }
224         } else {
225                 inilex(copys(""));
226         }
ragge
1.5
227         fileinit();
228         procinit();
229         if((k = yyparse())) {
230                 fprintf(diagfile"Bad parse, return code %d\n"k);
231                 DONE(1);
ragge
1.1
232         }
ragge
1.5
233         if(nerr > 0)
234                 DONE(1);
235         if(parstate != OUTSIDE) {
236                 warn("missing END statement");
237                 endproc();
ragge
1.1
238         }
ragge
1.5
239         doext();
240         preven(ALIDOUBLE);
241         prtail();
ragge
1.1
242         puteof();
ragge
1.5
243         DONE(0);
ragge
1.1
244
245
246 finis:
ragge
1.9
247         pclose(initfile);
248         retcode |= dodata(file);
249         unlink(file);
ragge
1.1
250         done(retcode);
251         return(retcode);
252 }
253
ragge
1.9
254 #define USEINIT ".data\t2"
255 #define LABELFMT "%s:\n"
256
257 static void
258 prcha(FILEP fpint *s)
259 {
260
261 fprintf(fp".byte 0%o,0%o\n"s[0], s[1]);
262 }
263
264 static void
265 prskip(FILEP fpftnint k)
266 {
267 fprintf(fp"\t.space\t%ld\n"k);
268 }
269
270
271 static void
272 prch(int c)
273 {
274 static int buff[SZSHORT];
275
276 buff[nch++] = c;
277 if(nch == SZSHORT)
278         {
279         prcha(stdoutbuff);
280         nch = 0;
281         }
282 }
283
284
285 static int
286 rdname(int *vargrouppchar *name)
287 {
288 register int ic;
289
290 if( (c = getc(sortfile)) == EOF)
291         return(NO);
292 *vargroupp = c - '0';
293
294 for(i = 0 ; i<XL ; ++i)
295         {
296         if( (c = getc(sortfile)) == EOF)
297                 return(NO);
298         if(c != ' ')
299                 *name++ = c;
300         }
301 *name = '\0';
302 return(YES);
303 }
304
305 static int
306 rdlong(ftnint *n)
307 {
308 register int c;
309
310 for(c = getc(sortfile) ; c!=EOF && isspace(c) ; c = getc(sortfile) );
311         ;
312 if(c == EOF)
313         return(NO);
314
315 for(*n = 0 ; isdigit(c) ; c = getc(sortfile) )
316         *n = 10* (*n) + c - '0';
317 return(YES);
318 }
319
320 static void
321 prspace(ftnint n)
322 {
323 register ftnint m;
324
325 while(nch>0 && n>0)
326         {
327         --n;
328         prch(0);
329         }
330 m = SZSHORT * (n/SZSHORT);
331 if(m > 0)
332         prskip(stdoutm);
333 for(n -= m ; n>0 ; --n)
334         prch(0);
335 }
336
337 static ftnint
338 doeven(ftnint totint align)
339 {
340 ftnint new;
341 new = roundup(totalign);
342 prspace(new - tot);
343 return(new);
344 }
345
346
347 int
348 dodata(char *file)
349 {
350         char varname[XL+1], ovarname[XL+1];
351         flag erred;
352         ftnint offsetvlentype;
353         register ftnint ooffsetovlen;
354         ftnint vchar;
355         int sizealign;
356         int vargroup;
357         ftnint totlen;
358
359         erred = NO;
360         ovarname[0] = '\0';
361         ooffset = 0;
362         ovlen = 0;
363         totlen = 0;
364         nch = 0;
plunky
1.15
365         ftitle = file;
ragge
1.9
366
367         if( (sortfile = fopen(file"r")) == NULL)
368                 fatal1(file);
369 #if 0
370         pruse(asmfileUSEINIT);
371 #else
372         printf("\t%s\n"USEINIT);
373 #endif
374         while (rdname(&vargroupvarname) && rdlong(&offset) &&
375             rdlong(&vlen) && rdlong(&type) ) {
376                 size = typesize[type];
377                 ifstrcmp(varnameovarname) ) {
378                         prspace(ovlen-ooffset);
379                         strcpy(ovarnamevarname);
380                         ooffset = 0;
381                         totlen += ovlen;
382                         ovlen = vlen;
383                         if(vargroup == 0)
384                                 align = (type==TYCHAR ? SZLONG :
385                                     typealign[type]);
386                         else
387                                 align = ALIDOUBLE;
388                         totlen = doeven(totlenalign);
389                         if(vargroup == 2) {
390 #if 0
391                                 prcomblock(asmfilevarname);
392 #else
393                                 printf(LABELFMTvarname);
394 #endif
395                         } else {
396 #if 0
397                                 fprintf(asmfileLABELFMTvarname);
398 #else
399                                 printf(LABELFMTvarname);
400 #endif
401                         }
402                 }
403                 if(offset < ooffset) {
404                         erred = YES;
405                         err("overlapping initializations");
406                 }
407                 if(offset > ooffset) {
408                         prspace(offset-ooffset);
409                         ooffset = offset;
410                 }
411                 if(type == TYCHAR) {
412                         if( ! rdlong(&vchar) )
413                                 fatal("bad intermediate file format");
414                         prch( (intvchar );
415                 } else {
416                         putc('\t'stdout);
417                         while   ( putcgetc(sortfile), stdout)  != '\n')
418                                 ;
419                 }
420                 if( (ooffset += size) > ovlen) {
421                         erred = YES;
422                         err("initialization out of bounds");
423                 }
424         }
425
426         prspace(ovlen-ooffset);
427         totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) );
428         return(erred);
429 }
ragge
1.1
430
ragge
1.3
431 void
ragge
1.1
432 done(k)
433 int k;
434 {
435 static int recurs       = NO;
436
437 if(recurs == NO)
438         {
439         recurs = YES;
440         }
441 exit(k);
442 }
FishEye: Open Source License registered to PCC.
Your maintenance has expired. You can renew your license at http://www.atlassian.com/fisheye/renew
Atlassian FishEye, CVS analysis. (Version:1.6.3 Build:build-336 2008-11-04) - Administration - Page generated 2014-09-02 15:57 +0200