Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:plunky:20110610133756

Diff

Diff from 1.15 to:

Annotations

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

Annotated File View

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