Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:sgk:20081224193606

Diff

Diff from 1.18 to:

Annotations

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

Annotated File View

sgk
1.18
1 /*      $Id: f77.c,v 1.18 2008/12/24 19:36:06 sgk Exp $ */
ragge
1.1
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
sgk
1.15
36 char xxxvers[] = "FORTRAN 77 DRIVER, VERSION 1.11,   28 JULY 1978\n";
ragge
1.2
37
38 #include <sys/wait.h>
39
ragge
1.1
40 #include <stdio.h>
41 #include <ctype.h>
42 #include <signal.h>
ragge
1.2
43 #include <unistd.h>
44 #include <string.h>
45 #include <stdlib.h>
ragge
1.4
46 #include <stdarg.h>
ragge
1.6
47 #include <errno.h>
ragge
1.2
48
ragge
1.6
49 #include "ccconfig.h"
ragge
1.2
50
ragge
1.11
51 typedef FILE *FILEP;
52 typedef int flag;
53 typedef void *ptr;
54 #define YES 1
55 #define NO 0
ragge
1.1
56
ragge
1.7
57 FILEP diagfile;
58
ragge
1.1
59 static int pid;
60 static int sigivalue    = 0;
61 static int sigqvalue    = 0;
62
ragge
1.5
63 #ifndef FCOM
64 #define FCOM            "fcom"
65 #endif
66
ragge
1.6
67 #ifndef ASSEMBLER
68 #define ASSEMBLER       "as"
69 #endif
70
71 #ifndef LINKER
72 #define LINKER          "ld"
73 #endif
74
ragge
1.5
75 static char *fcom       = LIBEXECDIR "/" FCOM ;
ragge
1.6
76 static char *asmname    = ASSEMBLER ;
77 static char *ldname     = LINKER ;
78 static char *startfiles[] = STARTFILES;
79 static char *endfiles[] = ENDFILES;
80 static char *dynlinker[] = DYNLINKER;
81 static char *crt0file = CRT0FILE;
ragge
1.1
82 static char *macroname  = "m4";
83 static char *shellname  = "/bin/sh";
84 static char *aoutname   = "a.out" ;
ragge
1.12
85 static char *libdir     = LIBDIR ;
ragge
1.6
86 static char *liblist[] = F77LIBLIST;
ragge
1.1
87
88 static char *infname;
89 static char asmfname[15];
90 static char prepfname[15];
91
ragge
1.6
92 #define MAXARGS 100
93 int ffmax;
94 static char *ffary[MAXARGS];
ragge
1.1
95 static char eflags[30]  = "";
96 static char rflags[30]  = "";
97 static char lflag[3]    = "-x";
98 static char *eflagp     = eflags;
99 static char *rflagp     = rflags;
100 static char **loadargs;
101 static char **loadp;
ragge
1.9
102 static int oflag;
ragge
1.1
103
104 static flag loadflag    = YES;
105 static flag saveasmflag = NO;
106 static flag profileflag = NO;
107 static flag optimflag   = NO;
108 static flag debugflag   = NO;
109 static flag verbose     = NO;
110 static flag fortonly    = NO;
111 static flag macroflag   = NO;
112
ragge
1.2
113 char *setdoto(char *), *lastchar(char *), *lastfield(char *);
114 ptr ckalloc(int);
115 void intrupt(int);
116 void enbint(void (*k)(int));
117 void crfnames(void);
ragge
1.4
118 static void fatal1(char *, ...);
sgk
1.13
119 void done(int), texec(char *, char **);
sgk
1.18
120 static char *copyn(intchar *);
ragge
1.2
121 int dotchar(char *), unreadable(char *), sys(char *), dofort(char *);
ragge
1.6
122 int nodup(char *), dopass2(void);
ragge
1.2
123 int await(int);
124 void rmf(char *), doload(char *[], char *[]), doasm(char *);
125 void clf(FILEP *p);
ragge
1.6
126 static int callsys(char f[], char *v[]);
sgk
1.17
127 static void errorx(char *fmt, ...);
ragge
1.6
128
129
130 static void
131 addarg(char **aryint *numchar *arg)
132 {
133         ary[(*num)++] = arg;
134         if ((*num) == MAXARGS) {
135                 fprintf(stderr"argument array too small\n");
136                 exit(1);
137         }
138 }
ragge
1.2
139
140 int
141 main(int argcchar **argv)
ragge
1.1
142 {
ragge
1.6
143         int icstatus;
144         register char *s;
145         char fortfile[20], *t;
146         char buff[100];
147
ragge
1.7
148         diagfile = stderr;
149
ragge
1.6
150         sigivalue = (intsignal(SIGINTSIG_IGN) & 01;
151         sigqvalue = (intsignal(SIGQUITSIG_IGN) & 01;
152         enbint(intrupt);
ragge
1.1
153
ragge
1.6
154         pid = getpid();
155         crfnames();
ragge
1.1
156
ragge
1.6
157         loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) );
158         loadp = loadargs;
ragge
1.1
159
ragge
1.6
160         --argc;
161         ++argv;
ragge
1.1
162
ragge
1.6
163         while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0') {
164                 for(s = argv[0]+1 ; *s ; ++s)
165                         switch(*s) {
166                         case 'T':  /* use special passes */
167                                 switch(*++s) {
ragge
1.1
168                                 case '1':
ragge
1.5
169                                         fcom = s+1goto endfor;
ragge
1.1
170                                 case 'a':
171                                         asmname = s+1goto endfor;
172                                 case 'l':
173                                         ldname = s+1goto endfor;
174                                 case 'm':
175                                         macroname = s+1goto endfor;
176                                 default:
177                                         fatal1("bad option -T%c", *s);
178                                 }
ragge
1.6
179                                 break;
180
181                         case 'w'/* F66 warn or no warn */
182                                 addarg(ffary, &ffmaxs-1);
183                                 break;
ragge
1.1
184
sgk
1.16
185                         case 'q':
186                                 /*
187                                  * Suppress printing of procedure names during
188                                  * compilation.
189                                  */
190                                 addarg(ffary, &ffmaxs-1);
191                                 break;
192
ragge
1.6
193                         copyfflag:
194                         case 'u':
195                         case 'U':
196                         case 'M':
197                         case '1':
198                         case 'C':
199                                 addarg(ffary, &ffmaxs-1);
200                                 break;
ragge
1.1
201
ragge
1.6
202                         case 'O':
203                                 optimflag = YES;
204                                 addarg(ffary, &ffmaxs-1);
205                                 break;
ragge
1.1
206
ragge
1.6
207                         case 'm':
208                                 if(s[1] == '4')
209                                         ++s;
210                                 macroflag = YES;
211                                 break;
ragge
1.1
212
ragge
1.6
213                         case 'S':
214                                 saveasmflag = YES;
ragge
1.1
215
ragge
1.6
216                         case 'c':
217                                 loadflag = NO;
218                                 break;
ragge
1.1
219
ragge
1.6
220                         case 'v':
221                                 verbose = YES;
222                                 break;
ragge
1.1
223
ragge
1.6
224                         case 'd':
225                                 debugflag = YES;
226                                 goto copyfflag;
ragge
1.1
227
ragge
1.6
228                         case 'p':
229                                 profileflag = YES;
230                                 goto copyfflag;
ragge
1.1
231
ragge
1.6
232                         case 'o':
233                                 if(!strcmp(s"onetrip")) {
234                                         addarg(ffary, &ffmaxs-1);
235                                         goto endfor;
ragge
1.1
236                                 }
ragge
1.9
237                                 oflag = 1;
ragge
1.6
238                                 aoutname = *++argv;
239                                 --argc;
240                                 break;
ragge
1.1
241
ragge
1.6
242                         case 'F':
243                                 fortonly = YES;
244                                 loadflag = NO;
245                                 break;
ragge
1.1
246
ragge
1.6
247                         case 'I':
248                                 if(s[1]=='2' || s[1]=='4' || s[1]=='s')
249                                         goto copyfflag;
250                                 fprintf(diagfile"invalid flag -I%c\n"s[1]);
251                                 done(1);
252
253                         case 'l':       /* letter ell--library */
254                                 s[-1] = '-';
255                                 *loadp++ = s-1;
256                                 goto endfor;
ragge
1.1
257
ragge
1.6
258                         case 'E':       /* EFL flag argument */
259                                 while(( *eflagp++ = *++s))
260                                         ;
261                                 *eflagp++ = ' ';
262                                 goto endfor;
263                         case 'R':
264                                 while(( *rflagp++ = *++s ))
265                                         ;
266                                 *rflagp++ = ' ';
267                                 goto endfor;
268                         default:
269                                 lflag[1] = *s;
sgk
1.18
270                                 *loadp++ = copyn(strlen(lflag), lflag);
ragge
1.6
271                                 break;
272                         }
ragge
1.1
273 endfor:
274         --argc;
275         ++argv;
276         }
277
ragge
1.6
278         if (verbose)
279                 fprintf(stderrxxxvers);
280
281         if (argc == 0)
282                 errorx("No input files");
283
ragge
1.4
284 #ifdef mach_pdp11
ragge
1.1
285         if(nofloating)
286                 *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT);
287         else
288 #endif
289
ragge
1.6
290         for(i = 0 ; i<argc ; ++i)
291                 switch(c =  dotchar(infname = argv[i]) ) {
ragge
1.1
292                 case 'r':       /* Ratfor file */
293                 case 'e':       /* EFL file */
294                         ifunreadable(argv[i]) )
295                                 break;
296                         s = fortfile;
297                         t = lastfield(argv[i]);
ragge
1.2
298                         while(( *s++ = *t++))
ragge
1.1
299                                 ;
300                         s[-2] = 'f';
301
ragge
1.6
302                         if(macroflag) {
ragge
1.2
303                                 sprintf(buff"%s %s >%s"macronameinfnameprepfname);
ragge
1.6
304                                 if(sys(buff)) {
ragge
1.1
305                                         rmf(prepfname);
306                                         break;
ragge
1.6
307                                 }
ragge
1.1
308                                 infname = prepfname;
ragge
1.6
309                         }
ragge
1.1
310
311                         if(c == 'e')
312                                 sprintf(buff"efl %s %s >%s"eflagsinfnamefortfile);
313                         else
314                                 sprintf(buff"ratfor %s %s >%s"rflagsinfnamefortfile);
315                         status = sys(buff);
316                         if(macroflag)
317                                 rmf(infname);
ragge
1.6
318                         if(status) {
ragge
1.1
319                                 loadflag = NO;
320                                 rmf(fortfile);
321                                 break;
ragge
1.6
322                         }
ragge
1.1
323
ragge
1.6
324                         if( ! fortonly ) {
ragge
1.1
325                                 infname = argv[i] = lastfield(argv[i]);
326                                 *lastchar(infname) = 'f';
327         
328                                 ifdofort(argv[i]) )
329                                         loadflag = NO;
330                                 else    {
331                                         ifnodup(t = setdoto(argv[i])) )
332                                                 *loadp++ = t;
333                                         rmf(fortfile);
334                                 }
ragge
1.6
335                         }
ragge
1.1
336                         break;
337
338                 case 'f':       /* Fortran file */
339                 case 'F':
340                         ifunreadable(argv[i]) )
341                                 break;
342                         ifdofort(argv[i]) )
343                                 loadflag = NO;
344                         else ifnodup(t=setdoto(argv[i])) )
345                                 *loadp++ = t;
346                         break;
347
348                 case 'c':       /* C file */
349                 case 's':       /* Assembler file */
350                         ifunreadable(argv[i]) )
351                                 break;
352                         fprintf(diagfile"%s:\n"argv[i]);
353                         sprintf(buff"cc -c %s"argv[i] );
354                         ifsys(buff) )
355                                 loadflag = NO;
356                         else
357                                 ifnodup(t = setdoto(argv[i])) )
358                                         *loadp++ = t;
359                         break;
360
361                 case 'o':
362                         ifnodup(argv[i]) )
363                                 *loadp++ = argv[i];
364                         break;
365
366                 default:
367                         if( ! strcmp(argv[i], "-o") )
368                                 aoutname = argv[++i];
369                         else
370                                 *loadp++ = argv[i];
371                         break;
372                 }
373
ragge
1.6
374         if(loadflag)
375                 doload(loadargsloadp);
376         done(0);
377         return 0;
ragge
1.1
378 }
ragge
1.6
379
sgk
1.15
380 #define ADD(x)  addarg(params, &nparms, (x))
381
ragge
1.2
382 int
ragge
1.6
383 dofort(char *s)
384 {
385         int nparmsi;
386         char *params[MAXARGS];
387
388         nparms = 0;
sgk
1.15
389         ADD(FCOM);
ragge
1.6
390         for (i = 0i < ffmaxi++)
sgk
1.15
391                 ADD(ffary[i]);
392         ADD(s);
393         ADD(asmfname);
394         ADD(NULL);
ragge
1.6
395
396         infname = s;
397         if (callsys(fcomparams))
398                 errorx("Error.  No assembly.");
399         doasm(s);
ragge
1.1
400
ragge
1.8
401         if (saveasmflag == NO)
402                 rmf(asmfname);
ragge
1.6
403         return(0);
ragge
1.1
404 }
405
406
ragge
1.2
407 void
ragge
1.6
408 doasm(char *s)
ragge
1.1
409 {
ragge
1.6
410         char *obj;
411         char *params[MAXARGS];
412         int nparms;
ragge
1.1
413
ragge
1.10
414         if (oflag && loadflag == NO)
ragge
1.9
415                 obj = aoutname;
416         else
417                 obj = setdoto(s);
ragge
1.1
418
ragge
1.6
419         nparms = 0;
sgk
1.15
420         ADD(asmname);
421         ADD("-o");
422         ADD(obj);
423         ADD(asmfname);
424         ADD(NULL);
ragge
1.1
425
ragge
1.6
426         if (callsys(asmnameparams))
sgk
1.13
427                 fatal1("assembler error");
ragge
1.1
428         if(verbose)
429                 fprintf(diagfile"\n");
430 }
431
432
433
ragge
1.2
434 void
ragge
1.6
435 doload(char *v0[], char *v[])
ragge
1.1
436 {
ragge
1.6
437         int nparmsi;
438         char *params[MAXARGS];
439         char **p;
440
441         nparms = 0;
442         ADD(ldname);
443         ADD("-X");
444         ADD("-d");
445         for (i = 0dynlinker[i]; i++)
446                 ADD(dynlinker[i]);
447         ADD("-o");
448         ADD(aoutname);
449         ADD(crt0file);
450         for (i = 0startfiles[i]; i++)
451                 ADD(startfiles[i]);
452         *v = NULL;
453         for(p = v0; *p ; p++)
454                 ADD(*p);
ragge
1.12
455         if (libdir)
456                 ADD(libdir);
ragge
1.6
457         for(p = liblist ; *p ; p++)
458                 ADD(*p);
459         for (i = 0endfiles[i]; i++)
460                 ADD(endfiles[i]);
sgk
1.15
461         ADD(NULL);
ragge
1.1
462
ragge
1.6
463         if (callsys(ldnameparams))
ragge
1.1
464                 fatal1("couldn't load %s"ldname);
465
ragge
1.6
466         if(verbose)
467                 fprintf(diagfile"\n");
ragge
1.1
468 }
ragge
1.6
469
ragge
1.1
470 /* Process control and Shell-simulating routines */
471
ragge
1.6
472 /*
473  * Execute f[] with parameter array v[].
474  * Copied from cc.
475  */
ragge
1.2
476 int
ragge
1.6
477 callsys(char f[], char *v[])
ragge
1.1
478 {
ragge
1.6
479         int tstatus = 0;
480         pid_t p;
481         char *s;
482
ragge
1.12
483         if (debugflag || verbose) {
ragge
1.6
484                 fprintf(stderr"%s "f);
485                 for (t = 1v[t]; t++)
486                         fprintf(stderr"%s "v[t]);
487                 fprintf(stderr"\n");
488         }
489
490         if ((p = fork()) == 0) {
491 #ifdef notyet
492                 if (Bflag) {
493                         size_t len = strlen(Bflag) + 8;
494                         char *a = malloc(len);
495                         if (a == NULL) {
496                                 error("callsys: malloc failed");
497                                 exit(1);
ragge
1.1
498                         }
ragge
1.6
499                         if ((s = strrchr(f'/'))) {
500                                 strlcpy(aBflaglen);
501                                 strlcat(aslen);
502                                 execv(av);
ragge
1.1
503                         }
504                 }
ragge
1.6
505 #endif
506                 execvp(fv);
507                 if ((s = strrchr(f'/')))
508                         execvp(s+1v);
509                 fprintf(stderr"Can't find %s\n"f);
510                 _exit(100);
511         } else {
512                 if (p == -1) {
513                         printf("Try again\n");
514                         return(100);
515                 }
516         }
517         while (waitpid(p, &status0) == -1 && errno == EINTR)
518                 ;
519         if (WIFEXITED(status))
520                 return (WEXITSTATUS(status));
521         if (WIFSIGNALED(status))
522                 done(1);
523         fatal1("Fatal error in %s"f);
524         return 0/* XXX */
525 }
526
527
528 int
529 sys(char *str)
530 {
531         register char *s, *t;
532         char *argv[100], path[100];
533         char *inname, *outname;
534         int append = 0;
ragge
1.12
535         int wait_pid;
ragge
1.6
536         int argc;
537
538
539         if(debugflag)
540                 fprintf(diagfile"%s\n"str);
541         inname  = NULL;
542         outname = NULL;
543         argv[0] = shellname;
544         argc = 1;
545
546         t = str;
547         whileisspace((int)*t) )
ragge
1.1
548                 ++t;
ragge
1.6
549         while(*t) {
550                 if(*t == '<')
551                         inname = t+1;
552                 else if(*t == '>') {
553                         if(t[1] == '>') {
554                                 append = YES;
555                                 outname = t+2;
556                         } else  {
557                                 append = NO;
558                                 outname = t+1;
559                         }
560                 } else
561                         argv[argc++] = t;
562                 while( !isspace((int)*t) && *t!='\0' )
ragge
1.1
563                         ++t;
ragge
1.6
564                 if(*t) {
565                         *t++ = '\0';
566                         whileisspace((int)*t) )
567                                 ++t;
ragge
1.1
568                 }
569         }
570
ragge
1.6
571         if(argc == 1)   /* no command */
572                 return(-1);
573         argv[argc] = 0;
574
575         s = path;
576         t = "/usr/bin/";
577         while(*t)
578                 *s++ = *t++;
579         for(t = argv[1] ; (*s++ = *t++) ; )
580                 ;
ragge
1.12
581         if((wait_pid = fork()) == 0) {
ragge
1.6
582                 if(inname)
583                         freopen(inname"r"stdin);
584                 if(outname)
585                         freopen(outname, (append ? "a" : "w"), stdout);
586                 enbint(SIG_DFL);
587
588                 texec(path+9argv);  /* command */
589                 texec(path+4argv);  /*  /bin/command */
590                 texec(path  , argv);  /* /usr/bin/command */
ragge
1.1
591
ragge
1.6
592                 fatal1("Cannot load %s",path+9);
ragge
1.1
593         }
594
ragge
1.12
595         returnawait(wait_pid) );
ragge
1.1
596 }
597
598 /* modified version from the Shell */
ragge
1.2
599 void
ragge
1.6
600 texec(char *fchar **av)
ragge
1.1
601 {
602
ragge
1.6
603         execv(fav+1);
ragge
1.1
604
ragge
1.6
605         if (errno==ENOEXEC) {
606                 av[1] = f;
607                 execv(shellnameav);
sgk
1.13
608                 fatal1("No shell!");
ragge
1.1
609         }
ragge
1.6
610         if (errno==ENOMEM)
611                 fatal1("%s: too large"f);
ragge
1.1
612 }
613
ragge
1.6
614 /*
615  * Cleanup and exit with value k.
616  */
ragge
1.2
617 void
ragge
1.6
618 done(int k)
ragge
1.1
619 {
ragge
1.6
620         static int recurs       = NO;
ragge
1.1
621
ragge
1.6
622         if(recurs == NO) {
623                 recurs = YES;
sgk
1.13
624                 if (saveasmflag == NO)
625                         rmf(asmfname);
ragge
1.1
626         }
ragge
1.6
627         exit(k);
ragge
1.1
628 }
629
630
ragge
1.2
631 void
ragge
1.1
632 enbint(k)
ragge
1.2
633 void (*k)(int);
ragge
1.1
634 {
635 if(sigivalue == 0)
636         signal(SIGINT,k);
637 if(sigqvalue == 0)
638         signal(SIGQUIT,k);
639 }
640
641
642
ragge
1.2
643 void
644 intrupt(int a)
ragge
1.1
645 {
646 done(2);
647 }
648
649
ragge
1.2
650 int
ragge
1.12
651 await(wait_pid)
652 int wait_pid;
ragge
1.1
653 {
654 int wstatus;
655
656 enbint(SIG_IGN);
ragge
1.12
657 while ( (w = wait(&status)) != wait_pid)
ragge
1.1
658         if(w == -1)
sgk
1.13
659                 fatal1("bad wait code");
ragge
1.1
660 enbint(intrupt);
661 if(status & 0377)
662         {
663         if(status != SIGINT)
664                 fprintf(diagfile"Termination code %d"status);
665         done(3);
666         }
667 return(status>>8);
668 }
669
670 /* File Name and File Manipulation Routines */
671
ragge
1.2
672 int
ragge
1.6
673 unreadable(char *s)
ragge
1.1
674 {
ragge
1.6
675         FILE *fp;
ragge
1.1
676
ragge
1.6
677         if((fp = fopen(s"r"))) {
678                 fclose(fp);
679                 return(NO);
680         } else {
681                 fprintf(diagfile"Error: Cannot read file %s\n"s);
682                 loadflag = NO;
683                 return(YES);
ragge
1.1
684         }
685 }
686
687
ragge
1.2
688 void
ragge
1.1
689 clf(p)
690 FILEP *p;
691 {
692 if(p!=NULL && *p!=NULL && *p!=stdout)
693         {
694         if(ferror(*p))
sgk
1.13
695                 fatal1("writing error");
ragge
1.1
696         fclose(*p);
697         }
698 *p = NULL;
699 }
700
701
ragge
1.2
702 void
sgk
1.13
703 crfnames(void)
ragge
1.1
704 {
sgk
1.13
705         sprintf(asmfname,  "fort%d.%s"pid"s");
706         sprintf(prepfname"fort%d.%s"pid"p");
ragge
1.1
707 }
708
709
710
ragge
1.2
711 void
ragge
1.1
712 rmf(fn)
713 register char *fn;
714 {
715 if(!debugflag && fn!=NULL && *fn!='\0')
716         unlink(fn);
717 }
718
719
ragge
1.2
720 int
ragge
1.1
721 dotchar(s)
722 register char *s;
723 {
724 for( ; *s ; ++s)
725         if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
726                 returns[1] );
727 return(NO);
728 }
729
730
731
732 char *lastfield(s)
733 register char *s;
734 {
735 register char *t;
736 for(t = s; *s ; ++s)
737         if(*s == '/')
738                 t = s+1;
739 return(t);
740 }
741
742
743
744 char *lastchar(s)
745 register char *s;
746 {
747 while(*s)
748         ++s;
749 return(s-1);
750 }
751
752 char *setdoto(s)
753 register char *s;
754 {
755 *lastchar(s) = 'o';
756 returnlastfield(s) );
757 }
758
759
760 ptr ckalloc(n)
761 int n;
762 {
ragge
1.2
763 ptr p;
ragge
1.1
764
ragge
1.2
765 if( (p = calloc(1, (unsignedn) ))
ragge
1.1
766         return(p);
767
sgk
1.13
768 fatal1("out of memory");
ragge
1.1
769 /* NOTREACHED */
ragge
1.2
770 return NULL;
ragge
1.1
771 }
772
773
sgk
1.18
774 static char *
775 copyn(int nchar *s)
ragge
1.1
776 {
sgk
1.18
777         char *p, *q;
ragge
1.1
778
sgk
1.18
779         p = q = (char *)ckalloc(n + 1);
780         while(n-- > 0)
781                 *q++ = *s++;
782         return (p);
ragge
1.1
783 }
784
785
ragge
1.2
786 int
ragge
1.1
787 nodup(s)
788 char *s;
789 {
790 register char **p;
791
792 for(p = loadargs ; p < loadp ; ++p)
793         if( !strcmp(*ps) )
794                 return(NO);
795
796 return(YES);
797 }
798
799
sgk
1.17
800 static void
ragge
1.6
801 errorx(char *fmt, ...)
802 {
803         va_list ap;
804
805         va_start(apfmt);
806         vfprintf(diagfilefmtap);
807         fprintf(diagfile"\n");
808         va_end(ap);
ragge
1.1
809
ragge
1.6
810         if (debugflag)
811                 abort();
812         done(1);
813 }
ragge
1.1
814
815
ragge
1.4
816 static void
817 fatal1(char *fmt, ...)
ragge
1.1
818 {
ragge
1.4
819         va_list ap;
820
821         va_start(apfmt);
822         fprintf(diagfile"Compiler error in file %s: "infname);
823         vfprintf(diagfilefmtap);
824         fprintf(diagfile"\n");
825         va_end(ap);
826
827         if (debugflag)
828                 abort();
829         done(1);
ragge
1.1
830 }
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 16:01 +0200