Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:ragge:20090209155948

Diff

Diff from 1.14 to:

Annotations

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

Annotated File View

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