nooptwithg
[intercal:intercal.git] / src / perpet.c
1 /****************************************************************************
2
3 NAME
4    perpet.c -- main routine for C-INTERCAL compiler.
5
6 DESCRIPTION
7    This is where all the dirty work begins and ends.
8
9 LICENSE TERMS
10     Copyright (C) 1996 Eric S. Raymond
11
12     This program is free software; you can redistribute it and/or modify
13     it under the terms of the GNU General Public License as published by
14     the Free Software Foundation; either version 2 of the License, or
15     (at your option) any later version.
16
17     This program is distributed in the hope that it will be useful,
18     but WITHOUT ANY WARRANTY; without even the implied warranty of
19     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20     GNU General Public License for more details.
21
22     You should have received a copy of the GNU General Public License
23     along with this program; if not, write to the Free Software
24     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25
26 ****************************************************************************/
27 /*LINTLIBRARY */
28 #include "config.h" /* AIS: Generated by autoconf */
29 #include <stdio.h>
30 #include <stdlib.h>
31 #ifdef HAVE_UNISTD_H
32 # include <unistd.h>
33 #endif
34 #include <string.h>
35 #include <signal.h>
36 #include <time.h>
37 #include <assert.h>
38 #include "ick.h"
39 #include "feh.h"
40 #include "parser.h"
41 #include "sizes.h"
42 #include "ick_lose.h"
43 #include "uncommon.h"
44
45 /* AIS: split ICKDATADIR from ICKLIBDIR */
46 #ifndef ICKINCLUDEDIR
47 #define ICKINCLUDEDIR "/usr/local/include"
48 #endif
49 #ifndef ICKDATADIR
50 #define ICKDATADIR "/usr/local/share"
51 #endif
52 #ifndef ICKLIBDIR
53 #define ICKLIBDIR "/usr/local/lib"
54 #endif
55 #ifndef ICKBINDIR
56 #define ICKBINDIR "/usr/local/bin"
57 #endif
58 #ifndef CC
59 #define CC "gcc"
60 #endif
61
62 #define ARGSTRING "abcdefghlmoptuvwxyCEFHOPUX@"
63
64 #ifdef USE_YYRESTART
65 /* function supplied by lex */
66 extern void yyrestart(FILE*);
67
68 #endif /* USE_YYRESTART */
69
70 /* function created by yacc */
71 extern int yyparse(void);
72
73 int yydebug;
74
75 /* compilation options */
76 ick_bool compile_only;  /* just compile into C, don't run the linker */
77 ick_bool ick_traditional;       /* insist on strict INTERCAL-72 conformance */
78 ick_bool nocompilerbug; /* disable error IE774 */
79 int yukdebug;           /* AIS: Use the yuk debugger. */
80 int yukprofile;         /* AIS: Use the yuk profiler. */
81 int useprintflow=0;     /* AIS: Add +printflow support. */
82 extern int ick_coreonerr;   /* AIS: Dump core on IE778. (defined in ick_lose.c) */
83 int multithread;        /* AIS: Allow multithreading and backtracking. */
84 int variableconstants;  /* AIS: Allow anything on the left of an assignment. */
85 int createsused=0;      /* AIS: Allow the use of CREATE. */
86 int useickec;           /* AIS: Link together INTERCAL and C. */
87 static int nosyslib=0;  /* AIS: Don't link syslib under any circumstances. */
88 static int cdebug;      /* AIS: Pass -g to our C compiler, and leave C code. */
89 int optdebug;           /* AIS: Debug the optimizer. Value is 0, 1, 2, or 3. */
90 int flowoptimize;       /* AIS: Do flow optimizations (in INTERCAL!). */
91 int coopt;              /* AIS: The constant-output optimization. This should
92                            mean that INTERCAL will beat any other language at
93                            many benchmark programs (!) */
94 extern int ick_printfopens; /* AIS: Print messages whenever attempting to open a
95                                file: from uncommon.c */
96 extern int ick_checkforbugs;/* AIS: Try to find possible bugs in the source code */
97 int pickcompile;        /* AIS: Compile for PIC? */
98 /*@-exportlocal@*/      /* AIS: relevant to the lexer */
99 int clclex;             /* AIS: 1 means use CLC-INTERCAL meanings for @, ? */
100 /*@=exportlocal@*/
101 int ick_clcsemantics;       /* AIS: CLC semantics for I/O, abstaining GIVE UP, &c*/
102 static int outtostdout;        /* AIS: Output on stdout rather than the output file */
103
104 /* AIS: Autodetected compilation options */
105 int compucomecount=0;   /* Computed COME FROM count */
106 int compucomesused=0;   /* Are computed COME FROMs used? */
107 int gerucomesused=0;    /* Is COME FROM gerund used? */
108 int nextfromsused=0;    /* Is NEXT FROM used? */
109 int opoverused=0;       /* Is operand overloading used? */
110 /*@null@*/ node* firstslat=0;      /* The first slat expression in the program */
111 /*@null@*/ node* prevslat=0;       /* The last slat expression used so far */
112
113 static ick_bool dooptimize;     /* do optimizations? (controlled by -O) */
114 static ick_bool ick_clockface;  /* set up output to do IIII for IV */
115
116 #define SKELETON  "ick-wrap.c"
117 #define PSKELETON "pickwrap.c"
118 #define SYSLIB    "syslib"
119
120 /* numeric base defaults, exported to other files */
121
122 #define DEFAULT_BASE 2
123 #define DEFAULT_SMALL_DIGITS 16
124 #define DEFAULT_LARGE_DIGITS 32
125 #define DEFAULT_MAX_SMALL 0xffffL
126 #define DEFAULT_MAX_LARGE 0xffffffffL
127
128 int ick_Base;
129 int ick_Small_digits;
130 int ick_Large_digits;
131 unsigned int ick_Max_small;
132 unsigned int ick_Max_large;
133
134 int ick_lineno; /* after yyparse, this is the total number of statements */
135
136 /* currently supported numeric bases, not exported */
137 static int maxbase = 7;
138 static int smallsizes[8] = {0, 0, 16, 10, 8, 6, 6, 5};
139 static unsigned int maxsmalls[8] =
140 {0, 0, 65535, 59048, 65535, 15624, 46655, 16806};
141
142 /*@observer@*/ static char *compiler;
143
144 atom *oblist = NULL, *obdex;
145 int obcount = 0;
146 int nonespots, ntwospots, ntails, nhybrids;
147 int nmeshes; /* AIS */
148
149 tuple *tuples = NULL;
150 int tuplecount = 0;
151
152 tuple *optuple = NULL; /* AIS: Tuple being optimized */
153
154 extern assoc varstores[]; /* AIS: Need to know this for PIC compilation */
155
156 #ifndef HAVE_UNISTD_H
157 /* AIS: We don't have unistd.h, so we can't use getopt. Write our own version
158    that's less general but good enough. */
159 int optind=1;
160 int optopt;
161 int getopt(int argc, char * const *argv, const char *options)
162 {
163   if(optind>argc) return EOF; /* Out of command line */
164   if(!argv[optind]) return EOF; /* Out of command line */
165   while(!strcmp(argv[optind],"-"))
166   {
167     optind++; /* Go to ick_next argument */
168     if(!argv[optind]) return EOF;
169   }
170   if(*(argv[optind])!='-') return EOF; /* this arg is not an option */
171   optopt=argv[optind][1];
172   memmove(argv[optind]+1,argv[optind]+2,strlen(argv[optind]+1));
173   if(optopt=='-') {optind++; return EOF;} /* -- means end of options */
174   if(strchr(options, optopt)) return optopt; /* valid option */
175   return '?'; /* invalid option */
176 }
177 #endif
178
179 static int myfgetc(FILE* in)
180 {
181   char c;
182   (void) fread(&c,1,1,in);
183   if(feof(in)) return EOF;
184   return (int)c;
185 }
186
187 static RETSIGTYPE abend(int signim)
188 {
189   /*@-noeffect@*/ (void) signim; /*@=noeffect@*/
190   ick_lose(IE778, iyylineno, (char *)NULL);
191 }
192 static void print_usage(char *prog, char *options)
193 {
194   fprintf(stderr,"Usage: %s [-%s] <file> [<file> ...]\n",prog,options);
195   fprintf(stderr,"\t-b\t:reduce the probability of E774 to zero\n");
196   fprintf(stderr,"\t-c\t:compile INTERCAL to C, but don't compile C\n");
197   fprintf(stderr,"\t-d\t:print yacc debugging information (implies -c)\n");
198   fprintf(stderr,"\t-e\t:link together INTERCAL and C files as one program\n");
199   fprintf(stderr,"\t\t (without this option, all INTERCAL files produce\n");
200   fprintf(stderr,"\t\t separate output files; with it, the first file given\n");
201   fprintf(stderr,"\t\t must be the only INTERCAL file) (prevents -mypPf)\n");
202   fprintf(stderr,"\t-E\t:never include the system library (prevents -P)\n");
203   fprintf(stderr,"\t-t\t:ick_traditional mode, accept only INTERCAL-72\n");
204   fprintf(stderr,"\t-C\t:ick_clockface output (e.g. use IIII instead of IV)\n");
205   fprintf(stderr,"\t-O\t:optimize expresssions in generated code\n");
206   /* AIS: Changed the help message for the previous line (because the
207      function of -O has changed). I wrote the next group of options. */
208   fprintf(stderr,"\t-f\t:optimize control flow in generated code "
209           "(prevents -yp)\n");
210 #ifdef HAVE_PROG_SH
211 # ifdef HAVE_SYS_INTERPRETER
212   fprintf(stderr,"\t-F\t:optimize everything in generated code for\n"
213           "\t\t speed, regardless of how slow the compiler becomes or how\n"
214           "\t\t large the object file becomes. Implies -fO, "
215           "prevents -cdeghpyH\n");
216 # else
217   fprintf(stderr,"\t-F\t:unsupported on computers without #! support\n");
218 # endif
219 #else
220   fprintf(stderr,"\t-F\t:unsupported on computers without sh or bash\n");
221 #endif
222   fprintf(stderr,"\t-h\t:print optimizer debugging information "
223           "(implies -cO)\n");
224   fprintf(stderr,"\t-H\t:print verbose optimizer debugging information "
225           "(implies -cO)\n");
226   fprintf(stderr,"\t-hH\t:print optimizer debugging information in a\n"
227           "\t\t different form (implies -cO)\n");
228 #ifdef HAVE_UNISTD_H
229   fprintf(stderr,"\t-y\t:run the yuk debugger on the code (prevents -fme)\n");
230   fprintf(stderr,"\t-p\t:run the yuk profiler on the code (prevents -fme)\n");
231 #else
232   fprintf(stderr,"\t-y\t:unsupported on computers without <unistd.h>\n");
233   fprintf(stderr,"\t-p\t:unsupported on computers without <unistd.h>\n");
234 #endif
235   fprintf(stderr,"\t-w\t:add support for the +printflow option\n");
236   fprintf(stderr,"\t-m\t:allow multithreading and backtracking\n"
237           "\t\t (prevents -ype, implies -w)\n");
238   fprintf(stderr,"\t-a\t:allow the use of CREATE (prevents -P)\n");
239   fprintf(stderr,"\t-v\t:allow anything on the left of an assignment. This "
240           "is required\n\t\t if you want operand overloading to change "
241           "meshes.\n\t\t (prevents -fFOP)\n");
242   fprintf(stderr,"\t-P\t:compile PIC-INTERCAL rather than INTERCAL\n");
243   fprintf(stderr,"\t\t (prevents -amFvxeE, implies -cfO)\n");
244   fprintf(stderr,"\t-o\t:output to stdout rather than .c (implies -c)\n");
245   fprintf(stderr,"\t-X\t:interpret ambiguous syntax as Princeton not\n"
246           "\t\t Atari (i.e. CLC-INTERCAL not C-INTERCAL)\n");
247   fprintf(stderr,"\t-x\t:use CLC-INTERCAL rules for I/O and abstaining\n"
248           "\t\t from a GIVE UP by label (prevents -P)\n");
249   fprintf(stderr,"\t-u\t:print a message whenever the compiler tries to "
250           "open a file\n");
251   fprintf(stderr,"\t-U\t:dump core on IE778 after printing an error\n");
252   fprintf(stderr,"\t-g\t:compile to both debuggable executable and C\n");
253   fprintf(stderr,"\t-l\t:attempt to report likely bugs "
254           "and nonportabilities (implies -O)\n");
255   /* AIS: End of options I added. */
256   fprintf(stderr,"\t<file>\tINTERCAL source file (use extension .i\n");
257   fprintf(stderr,"\t\tfor base 2 or .3i, etc., for base 3, etc.).\n");
258 }
259
260 /* AIS: Determine whether an environment variable exists (this is used to
261    find a temp directory) */
262 int isenv(char* e)
263 {
264   char* x=getenv(e);
265   return x != NULL && *x != '\0';
266 }
267
268 /*@-redef@*/
269 int main(int argc, char *argv[])
270 /*@=redef@*/
271 {
272   /*@-nestedextern@*/
273   extern int    optind;         /* set by getopt */
274   /*@=nestedextern@*/
275   char  buf[BUFSIZ], buf2[BUFSIZ], *chp, yukcmdstr[BUFSIZ], path[BUFSIZ];
276   tuple *tp;
277   atom  *op;
278   int           c, i;
279   /*@-shadow@*/ /* no it doesn't, cesspool isn't linked to perpet */
280   char  *includedir, *libdir, *ick_datadir;
281   /*@=shadow@*/
282   /* AIS: removed getenv(), added ick_datadir */
283   char        *cooptsh; /* AIS */
284   FILE  *ifp, *ofp;
285   int           maxabstain, /* nextcount, AIS */ bugline;
286   ick_bool        needsyslib, firstfile;
287   int         oldoptind;
288 #ifdef HAVE_UNISTD_H
289   int         oldstdin; /* AIS: for keeping track of where stdin was */
290 #endif
291
292   if (!(includedir = getenv("ICKINCLUDEDIR")))
293     includedir = ICKINCLUDEDIR;
294   if (!(libdir = getenv("ICKLIBDIR")))
295     libdir = ICKLIBDIR;
296   if (!(ick_datadir = getenv("ICKDATADIR"))) /* AIS */
297     ick_datadir = ICKDATADIR;
298 /*
299   AIS: nothing actually uses this at the moment,
300   commenting it out for future use
301
302   if (!(bindir = getenv("ICKBINDIR")))
303   bindir = ICKBINDIR;
304 */
305   if (!(compiler = getenv("CC")))
306     compiler = CC;
307
308   /* getopt is POSIX, and I provide my own version if the POSIX version
309      isn't found, so the unrecog warning is a false positive. */
310   /*@-unrecog@*/
311   while ((c = getopt(argc, argv, ARGSTRING)) != EOF)
312     /*@=unrecog@*/
313   {
314     switch (c)
315     {
316     case 'b':
317       nocompilerbug = ick_TRUE;
318       break;
319
320     case 'c':
321       compile_only = ick_TRUE;
322       /* AIS */ coopt = ick_FALSE;
323       break;
324
325     case 'o': /* AIS */
326       compile_only = ick_TRUE;
327       outtostdout = ick_TRUE;
328       coopt = ick_FALSE;
329       break;
330
331     case 'd':
332       yydebug = compile_only = ick_TRUE;
333       /* AIS */ coopt = ick_FALSE;
334       break;
335
336     case 'e': /* AIS */
337       useickec = ick_TRUE;
338       multithread = pickcompile = coopt = yukdebug = yukprofile = ick_FALSE;
339       break;
340
341     case 'E': /* AIS */
342       nosyslib = ick_TRUE;
343       pickcompile = ick_FALSE;
344       break;
345
346     case 'C':
347       ick_clockface = ick_TRUE;
348       break;
349
350     case 't':
351       ick_traditional = ick_TRUE;
352       if(multithread) ick_lose(IE111, 1, (char*) NULL); /* AIS */
353       if(pickcompile) ick_lose(IE111, 1, (char*) NULL); /* AIS */
354       break;
355
356     case 'O':
357       dooptimize = ick_TRUE;
358       variableconstants = ick_FALSE; /* AIS */
359       break;
360
361     case 'f': /* By AIS */
362       flowoptimize = ick_TRUE;
363       yukdebug = yukprofile = ick_FALSE;
364       variableconstants = ick_FALSE;
365       break;
366
367     case 'F': /* By AIS */
368       coopt = flowoptimize = dooptimize = ick_TRUE;
369       variableconstants = useickec = ick_FALSE;
370       yukdebug = yukprofile = yydebug = outtostdout =
371         compile_only = cdebug = ick_FALSE;
372       if(pickcompile) ick_lose(IE256, 1, (char*) NULL);
373       break;
374
375     case 'h': /* By AIS */
376       optdebug|=1;
377       compile_only=dooptimize=ick_TRUE;
378       coopt=ick_FALSE;
379       break;
380
381     case 'H': /* By AIS */
382       optdebug|=2;
383       compile_only=dooptimize=ick_TRUE;
384       coopt=ick_FALSE;
385       break;
386
387     case 'y': /* By AIS */
388 #ifdef HAVE_UNISTD_H
389       yukdebug=ick_TRUE;
390       multithread=flowoptimize=coopt=useickec=ick_FALSE;
391 #endif
392       break;
393
394     case 'p': /* By AIS */
395 #ifdef HAVE_UNISTD_H
396       yukprofile=ick_TRUE;
397       multithread=flowoptimize=coopt=useickec=ick_FALSE;
398 #endif
399       break;
400
401     case 'w': /* By AIS */
402       useprintflow = ick_TRUE;
403       break;
404
405     case 'm': /* By AIS */
406       multithread=ick_TRUE;
407       yukprofile=ick_FALSE;
408       yukdebug=ick_FALSE;
409       useickec=ick_FALSE;
410       if(ick_traditional) ick_lose(IE111, 1, (char*) NULL);
411       break;
412
413     case 'a': /* By AIS */
414       createsused=ick_TRUE;
415       pickcompile=ick_FALSE;
416       break;
417
418     case 'v': /* By AIS */
419       variableconstants=ick_TRUE;
420       dooptimize=ick_FALSE;
421       flowoptimize=ick_FALSE;
422       coopt=ick_FALSE;
423       pickcompile=ick_FALSE;
424       break;
425
426     case 'l': /* By AIS */
427       ick_checkforbugs=ick_TRUE;
428       dooptimize=ick_TRUE;
429       break;
430
431     case 'U': /* By AIS */
432       ick_coreonerr=ick_TRUE;
433       break;
434
435     case 'u': /* By AIS */
436       ick_printfopens=ick_TRUE;
437       break;
438
439     case 'P': /* By AIS */
440       pickcompile=ick_TRUE;
441       multithread=coopt=variableconstants=createsused=ick_FALSE;
442       ick_clcsemantics=useickec=nosyslib=ick_FALSE;
443       compile_only=ick_TRUE;
444       dooptimize=flowoptimize=ick_TRUE; /* needed for PICs */
445       break;
446
447     case 'X': /* By AIS */
448       clclex=ick_TRUE;
449       break;
450
451     case 'x': /* By AIS */
452       ick_clcsemantics=ick_TRUE;
453       pickcompile=ick_FALSE;
454       break;
455
456     case 'g': /* By AIS */
457       cdebug=ick_TRUE;
458       coopt=ick_FALSE;
459       break;
460
461     case '?':
462     default:
463     case '@':
464       print_usage(argv[0], ARGSTRING);
465       exit(EXIT_FAILURE);
466       /*@-unreachable@*/ break; /*@=unreachable@*/
467     }
468   }
469
470   (void) signal(SIGSEGV, abend);
471 #ifdef SIGBUS
472   (void) signal(SIGBUS, abend);
473 #endif /* SIGBUS */
474     
475   if (!nocompilerbug) {
476 #ifdef USG
477     srand48(time(NULL) + getpid());
478 #else
479     srand((unsigned)time(NULL));
480 #endif /* UNIX */
481   }
482
483   /* AIS: New function for enhanced file-finding */
484   ifp = ick_findandfopen(pickcompile?PSKELETON:SKELETON,
485                          ick_datadir, "r", argv[0]);
486   if(!ifp) ick_lose(IE999, 1, (char *)NULL);
487
488   /* now substitute in tokens in the skeleton */
489
490   /* AIS: This doesn't actually seem to do anything, and buf is
491      uninitialised at this point, so it's actually dangerous
492      because it's undefined behaviour.
493      buf[strlen(buf) - 2] = '\0'; */
494
495   /* AIS: Save the old stdin, if we can */
496 #ifdef HAVE_UNISTD_H
497   oldstdin=dup(0);
498 #endif
499
500   oldoptind=optind; /* AIS */
501   for (firstfile = ick_TRUE; optind < argc; optind++, firstfile = ick_FALSE)
502   {
503     /* AIS: Read as binary to pick up Latin-1 and UTF-8 better */
504     if (/* AIS */ strrchr(argv[optind],'.') != NULL &&
505       freopen(argv[optind], "rb", stdin) == (FILE *)NULL)
506       ick_lose(IE777, 1, (char *)NULL);
507     else
508     {
509       /* strip off the file extension */
510       if(!(chp = strrchr(argv[optind],'.')))
511       {
512         if(useickec && firstfile == ick_FALSE) /* By AIS */
513         {
514           /* the filename indicates a request for an expansion library,
515              along the same lines as CLC-INTERCAL's preloads. Search for
516              it in the usual places, then make a copy in a temp directory
517              and substitute that on the command line. */
518           char* tempfn="%s.c";
519           FILE* fromcopy;
520           FILE* tocopy;
521           int c2;
522 #ifndef HAVE_SNPRINTF
523           (void) sprintf(buf2, "%s.c", argv[optind]);
524 #else
525           (void) snprintf(buf2, sizeof buf2, "%s.c", argv[optind]);
526 #endif
527           fromcopy = ick_findandfopen(buf2,ick_datadir,"rb",argv[0]);
528           if(!fromcopy) /* same error as for syslib */
529             ick_lose(IE127, 1, (char*) NULL);
530 #if __DJGPP__
531           /* Look for a temp directory to store a copy of the C file,
532              the resulting .cio, .o files, etc. */
533           if(isenv("TMP")) tempfn="/dev/env/TMP/%s.c";
534           if(isenv("TEMP")) tempfn="/dev/env/TEMP/%s.c";
535           if(isenv("TMPDIR")) tempfn="/dev/env/TMPDIR/%s.c";
536           if(isenv("ICKTEMP")) tempfn="/dev/env/ICKTEMP/%s.c";
537 #else
538           tempfn="/tmp/%s.c"; /* always valid on POSIX */
539 #endif
540           /*@-formatconst@*/ /* all possibilities are fine */
541 #ifndef HAVE_SNPRINTF
542           (void) sprintf(buf2, tempfn, argv[optind]);
543 #else
544           (void) snprintf(buf2, sizeof buf2, tempfn, argv[optind]);
545 #endif
546           /*@=formatconst@*/
547           if((tocopy = fopen(buf2,"wb")) == NULL)
548             ick_lose(IE888, 1, (char*) NULL);
549
550           for(;;)
551           {
552             c2=fgetc(fromcopy);
553             if(c2==EOF) break;
554             (void) fputc(c2,tocopy);
555           }
556           (void) fclose(fromcopy); (void) fclose(tocopy);
557           /*@+onlytrans@*/
558           /* this is a memory leak that will need sorting out later,
559              thus the explicit turn-warning-on */
560           argv[optind]=malloc(sizeof(buf2)+1);
561           /*@=onlytrans@*/
562           if(!(argv[optind]))
563             ick_lose(IE888, 1, (char*) NULL);
564           strcpy(argv[optind],buf2);
565           *(strrchr(argv[optind],'.')) = '\0';
566           continue;
567         }
568
569         ick_lose(IE998, 1, (char *)NULL);
570       }
571       *chp++ = '\0';
572
573       if(useickec && (!strcmp(chp,"c") || !strcmp(chp,"cio"))) /* AIS */
574       {
575         if(firstfile != ick_FALSE) /* need exactly 1 INTERCAL file */
576           ick_lose(IE998, 1, (char *)NULL);
577         break; /* don't process C or cio files further yet */
578       }
579
580       if(useickec && firstfile == ick_FALSE) /* AIS */
581         ick_lose(IE998, 1, (char *)NULL);
582
583       /* wwp: reset the base variables to defaults, because if the  */
584       /* sourcefile has extension .i they will not be reset in the  */
585       /* following chunk of code. but i don't want to modify the    */
586       /* following chunk of code because i think it is very clever; */
587       /* grabs the base on the ick_first pass, then validates the rest  */
588       /* of the extension on the second.                            */
589       ick_Base = DEFAULT_BASE;
590       ick_Small_digits = DEFAULT_SMALL_DIGITS;
591       ick_Large_digits = DEFAULT_LARGE_DIGITS;
592       ick_Max_small = (unsigned)DEFAULT_MAX_SMALL;
593       ick_Max_large = (unsigned)DEFAULT_MAX_LARGE;
594
595       /* determine the file type from the extension */
596       while (strcmp(chp,"i"))
597       {
598         ick_Base = (int)strtol(chp,&chp,10);
599         if (ick_Base < 2 || ick_Base > maxbase)
600           ick_lose(IE998, 1, (char *)NULL);
601         else if (ick_traditional && ick_Base != 2)
602           ick_lose(IE111, 1, (char *)NULL);
603         else if (pickcompile && ick_Base != 2)
604           ick_lose(IE256, 1, (char *)NULL); /* AIS */
605         ick_Small_digits = smallsizes[ick_Base];
606         ick_Large_digits = 2 * ick_Small_digits;
607         ick_Max_small = maxsmalls[ick_Base];
608         if (ick_Max_small == 0xffff)
609           ick_Max_large = (unsigned)0xffffffffLU;
610         else
611           ick_Max_large = (ick_Max_small + 1) * (ick_Max_small + 1) - 1;
612       }
613
614       /* zero out tuple and oblist storage */
615       treset();
616       politesse = 0;
617       /* JH: default to no op-overusage and no computed come from */
618       opoverused = 0;
619       compucomesused = compucomecount = 0;
620       gerucomesused = 0; /* AIS: you forgot this one */
621       /* AIS: ensure that at least one variable exists, to prevent
622          NULL pointers later on */
623       (void) intern(ick_ONESPOT, 1); /* mention .1 */
624
625       /* reset the lex/yacc environment */
626       if (!firstfile)
627       {
628 #ifdef NEED_YYRESTART
629         yyrestart(stdin);
630 #endif /* NEED_YYRESTART */
631         iyylineno = 1;
632       }
633
634       /* compile tuples from current input source */
635       (void) yyparse();
636
637       if(variableconstants)
638       {
639         /* AIS: Up to 4 extra meshes may be needed by feh.c. */
640         (void) intern(MESH, 0xFFFFFFFFLU);
641         (void) intern(MESH, 0xFFFFLU);
642         (void) intern(MESH, 0xAAAAAAAALU);
643         (void) intern(MESH, 0x55555555LU);
644       }
645
646
647       /*
648        * Miss Manners lives.
649        */
650       if (ick_lineno > 2)
651       {
652         if (politesse == 0 || (ick_lineno - 1) / politesse >= 5)
653           ick_lose(IE079, iyylineno, (char *)NULL);
654         else if (ick_lineno / politesse < 3)
655           ick_lose(IE099, iyylineno, (char *)NULL);
656       }
657
658       /*
659        * check if we need to magically include the system library
660        */
661       needsyslib = ick_FALSE;
662       if(!pickcompile) /* AIS: We never need syslib when compiling
663                           for PIC, because it's preoptimized. */
664       {
665         for (tp = tuples; tp->type; tp++)
666         {
667           /*
668            * If some label in the (1000)-(2000) range is defined,
669            * then clearly the syslib is already there, so we
670            * can stop searching and won't need the syslib.
671            */
672           if (tp->label >= 1000 && tp->label <= 1999) {
673             needsyslib = ick_FALSE;
674             break;
675           }
676           /*
677            * If some label in the (1000)-(2000) range is being
678            * called, we might need the system library.
679            */
680           if (tp->type == NEXT && tp->u.target >= 1000 &&
681               tp->u.target <= 1999)
682             needsyslib = ick_TRUE;
683         }
684       }
685       if(nosyslib) needsyslib = ick_FALSE; /* AIS */
686       if (needsyslib)
687       { /* AIS: modified to use ick_findandfreopen */
688         if (ick_Base == 2)    /* see code for opening the skeleton */
689 #ifndef HAVE_SNPRINTF
690           (void) sprintf(buf2, "%s.i", SYSLIB);
691 #else
692         (void) snprintf(buf2, sizeof buf2, "%s.i", SYSLIB);
693 #endif
694         else
695 #ifndef HAVE_SNPRINTF
696           (void) sprintf(buf2, "%s.%di", SYSLIB, ick_Base);
697 #else
698         (void) snprintf(buf2, sizeof buf2, "%s.%di", SYSLIB, ick_Base);
699 #endif
700         if (ick_findandfreopen(buf2, ick_datadir, "r", argv[0], stdin) == NULL)
701           ick_lose(IE127, 1, (char*) NULL);
702 #ifdef USE_YYRESTART
703         yyrestart(stdin);
704 #endif /* USE_YYRESTART */
705         (void) yyparse();
706         textlinecount=iyylineno;
707       }
708
709       /*
710        * Now propagate type information up the expression tree.
711        * We need to do this because the unary-logical operations
712        * are sensitive to the type widths of their operands, so
713        * we have to generate different code depending on the
714        * deducible type of the operand.
715        */
716       for (tp = tuples; tp->type; tp++)
717       {
718         if (tp->type == GETS || tp->type == RESIZE
719             || tp->type == WRITE_IN || tp->type == READ_OUT
720             || tp->type == FROM || tp->type == MANYFROM
721             || tp->type == FORGET || tp->type == RESUME
722             || tp->type == COMPUCOME || tp->type == UNKNOWN)
723           typecast(tp->type == MANYFROM ? tp->u.node->lval : tp->u.node);
724         if (tp->type == WRITE_IN) coopt = 0; /* AIS: may as well do
725                                                 this here */
726       }
727
728       codecheck();      /* check for compile-time errors */
729       /* AIS: And importantly, sort out line number references */
730
731       /* perform optimizations */
732       if (dooptimize)
733         for (tp = tuples; tp->type; tp++)
734         {
735           /* AIS: Allow breaching of the only specification on tuples
736              at this point; I've checked that tuples isn't reallocated
737              during the block, so this is fine. */
738           /*@-onlytrans@*/
739           optuple = tp;
740           /*@=onlytrans@*/
741           if (tp->type == GETS || tp->type == RESIZE
742               || tp->type == FORGET || tp->type == RESUME
743               || tp->type == FROM || tp->type == COMPUCOME)
744             optimize(tp->u.node);
745           if (tp->type == MANYFROM) optimize(tp->u.node->lval);
746         } /* AIS: Added FROM and MANYFROM support. */
747
748       /* AIS: perform flow optimizations */
749       if (flowoptimize) optimizef();
750
751       /* decide if and where to place the compiler bug */
752 #ifdef USG
753       if (!nocompilerbug && lrand48() % 10 == 0)
754         bugline = (int)(lrand48() % ick_lineno);
755 #else
756       if (!nocompilerbug && rand() % 10 == 0)
757         bugline = rand() % ick_lineno;
758 #endif
759       else
760         bugline = -1;
761
762       /* set up the generated C output file name */
763       (void) strcpy(buf, argv[optind]);
764       (void) strcat(buf, ".c");
765       /* AIS: ofp holds fopened storage if !outtostdout, and local-copy
766          storage if outtostdout, and this is not a bug, although it
767          confuses Splint. */
768       /*@-branchstate@*/
769       if(outtostdout) ofp=stdout; /* AIS */
770       else if((ofp = ick_debfopen(buf, "w")) == (FILE *)NULL)
771         ick_lose(IE888, 1, (char *)NULL);
772       /*@=branchstate@*/
773
774       (void) fseek(ifp,0L,0);   /* rewind skeleton file */
775
776       /* AIS: Before changing argv[0], locate coopt.sh. */
777       cooptsh = ick_findandtestopen("coopt.sh", ick_datadir, "rb", argv[0]);
778       /* AIS: and calculate yukcmdstr. */
779 #ifndef HAVE_SNPRINTF
780       (void) sprintf(yukcmdstr,"%s%s" EXEEXT " %s %s",
781                      strchr(argv[optind],'/')||strchr(argv[optind],'\\')?
782                      "":"./",argv[optind],ick_datadir,argv[0]);
783 #else
784       (void) snprintf(yukcmdstr, sizeof yukcmdstr, "%s%s" EXEEXT " %s %s",
785                      strchr(argv[optind],'/')||strchr(argv[optind],'\\')?
786                      "":"./",argv[optind],ick_datadir,argv[0]);
787 #endif
788
789       /* AIS: Remove the filename from argv[0], leaving only a directory.
790          If this would leave it blank, change argv[0] to '.'.
791          This is so gcc can find the includes/libraries the same way that
792          ick_findandfreopen does. */
793       /* JH: use a copy of argv[0] for the path, to ensure argv[0] is
794        * available for the next round
795        */
796       strcpy(path,argv[0]);
797       if(strchr(path,'/')) *(strrchr(path,'/')) = '\0';
798       else strcpy(path,".");
799
800 #ifndef HAVE_SNPRINTF
801       (void) sprintf(buf2,
802 #if 0
803                      0); /* unconfuse Emacs' autoindenter */
804 #endif
805 #else
806       (void) snprintf(buf2, sizeof buf2,
807 #endif
808                       "%s %s%s-I%s -I%s -I%s/../include -L%s -L%s -L%s/../lib -O%c -o %s"
809 #ifdef __DJGPP__
810                       EXEEXT " -lick%s%s","",
811 #else
812                       EXEEXT " -lick%s%s",compiler,
813 #endif
814 #ifdef HAVE_CLOCK_GETTIME /* implies -lrt is available */
815                       buf, yukdebug||yukprofile?" -lyuk -lrt ":" ",
816 #else
817                       buf, yukdebug||yukprofile?" -lyuk ":" ",
818 #endif
819                       includedir, path, path, libdir, path, path,
820                       cdebug?'0':coopt?'3':'2', /* AIS: If coopting, optimize as much as possible
821                                                     JH: [d]on't optimise when compiling with debugger support */
822                       argv[optind], multithread?"mt":"", cdebug?" -g":"");
823       /* AIS: Possibly link in the debugger yuk and/or libickmt.a here. */
824       /* AIS: Added -g support. */
825       /* AIS: Added argv[0] (now path) to the -I, -L settings. */
826                      
827       textlinecount=0; /* AIS: If there are no files, there's
828                           no need to free any textlines */
829       while ((c = myfgetc(ifp)) != EOF)
830         if (c != (int)'$')
831           (void) fputc(c, ofp);
832         else switch(myfgetc(ifp))
833              {
834              case 'A':  /* source name stem */
835                (void) fputs(argv[optind], ofp);
836                break;
837
838              case 'B':  /* # of statements */
839                (void) fprintf(ofp, "%d", ick_lineno);
840                break;
841
842              case 'C':  /* initial abstentions */
843                /* AIS: Modified to check for coopt, pickcompile */
844                maxabstain = 0;
845                for (tp = tuples; tp->type; tp++)
846                  if (((tp->exechance <= 0 || tp->exechance >= 101)
847                       && tp - tuples + 1 > maxabstain)
848                      || coopt || pickcompile)
849                    maxabstain = tp - tuples + 1;
850                if (maxabstain)
851                {
852                  if(!pickcompile) (void) fprintf(ofp, " = {");
853                  for (tp = tuples; tp < tuples + maxabstain; tp++)
854                  {
855                    if(tp->exechance != 100 && tp->exechance != -100)
856                    { /* AIS: The double-oh-seven operator prevents
857                         coopt working. However, syslib contains a
858                         double-oh-seven. feh.c has checked that that
859                         isn't referenced; if it isn't, we can allow
860                         one double-oh-seven if syslib was
861                         automagically inclulded. */
862                      if(needsyslib) needsyslib = 0; else coopt = 0;
863                    }
864                    if(!pickcompile)
865                    {
866                      if (tp->exechance > 0)
867                      {
868                        (void) fprintf(ofp, "0, ");
869                        tp->initabstain=0; /* AIS: -f might not be
870                                              given, so we can't rely
871                                              on dekludge.c doing
872                                              this */
873                      }
874                      else {
875                        (void) fprintf(ofp, "1, ");
876                        tp->exechance = -tp->exechance;
877                        tp->initabstain=1; /* AIS: As above */
878                        /* AIS: If the line was ick_abstained, we need to
879                           swap ONCEs and AGAINs on it round, to suit
880                           the code degenerator. */
881                        if(tp->onceagainflag == onceagain_ONCE)
882                          tp->onceagainflag = onceagain_AGAIN;
883                        else if(tp->onceagainflag == onceagain_AGAIN)
884                          tp->onceagainflag = onceagain_ONCE;
885                      }
886                      if(tp->exechance >= 101)
887                      {
888                        /* AIS: This line has a MAYBE */
889                        tp->maybe = 1;
890                        tp->exechance /= 100;
891                      }
892                      else tp->maybe = 0;
893                    }
894                    else /* AIS: hardcoded abstain bits for PICs */
895                    {
896                      if(!tp->abstainable) continue;
897                      if(tp->exechance > 0)
898                        (void) fprintf(ofp, "ICK_INT1 ICKABSTAINED(%d)=0;\n",tp-tuples);
899                      else
900                        (void) fprintf(ofp, "ICK_INT1 ICKABSTAINED(%d)=1;\n",tp-tuples);
901                    }
902                  }
903                  if(!pickcompile) (void) fprintf(ofp, "}");
904                }
905                break;
906
907              case 'D':  /* linetypes ick_array for abstention handling */
908                maxabstain = 0;
909                for (tp = tuples; tp->type; tp++)
910                  if (tp->type == ENABLE || tp->type == DISABLE || tp->type == MANYFROM)
911                    maxabstain++;
912                if (maxabstain || /* AIS */ gerucomesused)
913                {
914                  /* AIS: Changed to use enablersm1 */
915                  /*(void) fprintf(ofp, "#define UNKNOWN\t\t0\n");*/
916                  i = 0;
917                  for (;i < (int)(sizeof(enablersm1)/sizeof(char *));i++)
918                    (void) fprintf(ofp,
919                                   "#define %s\t%d\n",
920                                   enablersm1[i], i);
921
922                  (void) fprintf(ofp, "int linetype[] = {\n");
923                  for (tp = tuples; tp->type; tp++)
924                    if(tp->ppnewtype) /* AIS */
925                      (void) fprintf(ofp,"    %s,\n",
926                                     enablers[tp->ppnewtype - GETS]);
927                    else if(tp->preproc) /* AIS */
928                      (void) fprintf(ofp,"    PREPROC,\n");
929                    else if (tp->type >= GETS && tp->type <= FROM)
930                      /* AIS: FROM added */
931                      (void) fprintf(ofp,
932                                     "    %s,\n",
933                                     enablers[tp->type - GETS]);
934                    else
935                      /* AIS: I didn't change this code, but relied on
936                         it when implementing just-in-case compilation;
937                         SPLATTERED and UNKNOWN (the two types of
938                         syntax error, unsalvageable and salvageable
939                         respectively) both become UNKNOWN in the
940                         linetypes array. */
941                      (void) fprintf(ofp, " UNKNOWN,\n");
942                  (void) fprintf(ofp, "};\n"); } break;
943
944              case 'E':  /* extern to intern map */
945                if(!pickcompile)
946                {
947                  (void) fprintf(ofp,"int ick_Base = %d;\n",ick_Base);
948                  (void) fprintf(ofp,"int ick_Small_digits = %d;\n",
949                                 ick_Small_digits);
950                  (void) fprintf(ofp,"int ick_Large_digits = %d;\n",
951                                 ick_Large_digits);
952                  (void) fprintf(ofp,"unsigned int ick_Max_small = 0x%x;\n",
953                                 ick_Max_small);
954                  (void) fprintf(ofp,"unsigned int ick_Max_large = 0x%x;\n",
955                                 ick_Max_large);
956                  if (yukprofile || yukdebug || multithread || useickec)
957                  { /* AIS: yuk.c, multithreading require all these to exist */
958                    if(!nonespots) nonespots = 1;
959                    if(!ntwospots) ntwospots = 1;
960                    if(!ntails) ntails = 1;
961                    if(!nhybrids) nhybrids = 1;
962                  }
963                  else if(opoverused)
964                  {
965                    /* AIS: The operand-overloading code requires onespot and
966                       twospot variables to exist. */
967                    if(!nonespots) nonespots = 1;
968                    if(!ntwospots) ntwospots = 1;
969                  }
970                  /* AIS:I de-staticed all these so they could be accessed by
971                     yuk and cesspool, and added all the mentions of yuk and
972                     multithread. Then I changed it so the variables would be
973                     allocated dynamically, to speed up multithreading. (It's
974                     an O(1) change to the speed of ordinary programs, so I
975                     thought I could get away with it. The order is wrt the
976                     number of lines in the program. The change is O(n) wrt
977                     the number of variables, but again I hope that doesn't
978                     matter, and I won't get the entire INTERCAL community
979                     angry with me for daring to implement an extension that
980                     slows down existing programs.) */
981                  if (variableconstants) /* AIS */
982                  {
983                    int temp=0;
984                    (void) fprintf(ofp, "ick_type32 meshes[%d] = {",nmeshes);
985                    while(temp<nmeshes)
986                    {
987                      (void) fprintf(ofp, "%luLU, ", varextern((unsigned long)temp,MESH));
988                      temp++;
989                    }
990                    (void) fprintf(ofp, "};\n");
991                  }
992
993                  if (nonespots)
994                  {
995                    (void) fprintf(ofp,
996                                   "ick_type16* ick_onespots;\n");
997                    (void) fprintf(ofp,
998                                   "ick_bool* ick_oneforget;\n");
999                    if(yukprofile || yukdebug)
1000                    {
1001                      (void) fprintf(ofp,
1002                                     "ick_type16 oneold[%d];\n",
1003                                     nonespots);
1004                      (void) fprintf(ofp,
1005                                     "signed char onewatch[%d];\n",
1006                                     nonespots);
1007                    }
1008                    if(multithread)
1009                    {
1010                      (void) fprintf(ofp,
1011                                     "int onespotcount = %d;\n",
1012                                     nonespots);
1013                    }
1014                    if(multithread || opoverused) /* AIS */
1015                    {
1016                      int temp=nonespots;
1017                      (void) fprintf(ofp,
1018                                     "ick_overop* ick_oo_onespots = 0;\n");
1019                      if(opoverused)
1020                        while(temp--)
1021                          (void) fprintf(ofp,
1022                                         "ick_type32 og1spot%d(ick_type32 t)\n{\n  (void)t;\n  return ick_onespots[%d];\n}\n"
1023                                         "void os1spot%d(ick_type32 val, void(*f)())\n{\n  (void)f;\n  ick_assign((void*)"
1024                                         "(ick_onespots+%d), ick_ONESPOT, ick_oneforget[%d], val);\n}\n",temp,temp,temp,temp,temp);
1025                    }
1026                  }
1027                  if (ntwospots)
1028                  {
1029                    (void) fprintf(ofp,
1030                                   "ick_type32* ick_twospots;\n");
1031                    (void) fprintf(ofp,
1032                                   "ick_bool* ick_twoforget;\n");
1033                    if(yukprofile || yukdebug)
1034                    {
1035                      (void) fprintf(ofp,
1036                                     "ick_type32 twoold[%d];\n",
1037                                     ntwospots);
1038                      (void) fprintf(ofp,
1039                                     "signed char twowatch[%d];\n",
1040                                     ntwospots);
1041                    }
1042                    if(multithread)
1043                    {
1044                      (void) fprintf(ofp,
1045                                     "int twospotcount = %d;\n",
1046                                     ntwospots);
1047                    }
1048                    if(multithread || opoverused) /* AIS */
1049                    {
1050                      int temp=ntwospots;
1051                      (void) fprintf(ofp,
1052                                     "ick_overop* ick_oo_twospots = 0;\n");
1053                      if(opoverused)
1054                        while(temp--)
1055                          (void) fprintf(ofp,
1056                                         "ick_type32 og2spot%d(ick_type32 t)\n{\n  (void)t;\n  return ick_twospots[%d];\n}\n"
1057                                         "void os2spot%d(ick_type32 val, void(*f)())\n{\n  (void)f;\n  ick_assign((void*)"
1058                                         "(ick_twospots+%d), ick_TWOSPOT, ick_twoforget[%d], val);\n}\n",temp,temp,temp,temp,temp);
1059                    }
1060                  }
1061                  if (ntails)
1062                  {
1063                    (void) fprintf(ofp,
1064                                   "ick_array* ick_tails;\n");
1065                    (void) fprintf(ofp,
1066                                   "ick_bool* ick_tailforget;\n");
1067                    if(multithread)
1068                    {
1069                      (void) fprintf(ofp,
1070                                     "int tailcount = %d;\n",
1071                                     ntails);
1072                    }
1073                  }
1074                  if (nhybrids)
1075                  {
1076                    (void) fprintf(ofp,
1077                                   "ick_array* ick_hybrids;\n");
1078                    (void) fprintf(ofp,
1079                                   "ick_bool* ick_hyforget;\n");
1080                    if(multithread)
1081                    {
1082                      (void) fprintf(ofp,
1083                                     "int hybridcount = %d;\n",
1084                                     nhybrids);
1085                    }
1086                  }
1087                  if (yydebug || compile_only)
1088                  {
1089                    assert(oblist != NULL);
1090                    for (op = oblist; op < obdex; op++)
1091                      if(op->type!=MESH) /* AIS: Added this check */
1092                        (void) fprintf(ofp, " /* %s %lu -> %lu */\n",
1093                                       nameof(op->type, vartypes),
1094                                       op->extindex,
1095                                       op->intindex);
1096                  }
1097                  if (yukdebug || yukprofile)
1098                  { /* AIS: drop intern to extern map into the program */
1099                    (void) fprintf(ofp, "\nyukvar yukvars[]={\n");
1100                    assert(oblist != NULL);
1101                    for (op = oblist; op < obdex; op++)
1102                      if(op->type!=MESH) /* AIS: Added this check */
1103                        (void) fprintf(ofp,"    {%s,%lu,%lu},\n",
1104                                       nameof(op->type, vartypes),
1105                                       op->extindex,
1106                                       op->intindex);
1107                    (void) fprintf(ofp,"    {YUKEND,0,0}};\n");
1108                  }
1109                  else if(useickec)
1110                  { /* AIS: likewise, but with different identifiers */
1111                    (void) fprintf(ofp, "\nick_ec_var ick_ec_vars[]={\n");
1112                    assert(oblist != NULL);
1113                    for (op = oblist; op < obdex; op++)
1114                      if(op->type!=MESH)
1115                        (void) fprintf(ofp,"    {%s,%lu,%lu},\n",
1116                                       nameof(op->type, vartypes),
1117                                       op->extindex,
1118                                       op->intindex);
1119                    (void) fprintf(ofp,"    {ICK_EC_VARS_END,0,0}};\n");
1120                  }
1121                }
1122                else
1123                {
1124                  /* Compiling for PIC */
1125                  /* Arrays not supported on PICs */
1126                  if(ntails || nhybrids)
1127                    ick_lose(IE256, iyylineno, (char*) NULL);
1128                  /* and neither are variable constants */
1129                  if(variableconstants)
1130                    ick_lose(IE256, iyylineno, (char*) NULL);
1131                  assert(oblist != NULL);
1132                  for (op = oblist; op < obdex; op++)
1133                  {
1134                    (void) fprintf(ofp, " /* %s %lu -> %lu */\n",
1135                                   nameof(op->type, vartypes),
1136                                   op->extindex,
1137                                   op->intindex);
1138                    (void) fprintf(ofp, "#define %s%lu %s[%lu]\n",
1139                                   nameof(op->type, vartypes),
1140                                   op->extindex,
1141                                   nameof(op->type, varstores),
1142                                   op->intindex);
1143                    if(op->ignorable)
1144                      (void) fprintf(ofp, "ICK_INT1 ignore%s%lu = 0;\n",
1145                                     nameof(op->type, varstores),
1146                                     op->intindex);
1147                  }
1148                  (void) fprintf(ofp, "#include \"pick1.h\"\n");
1149                  if(nonespots)
1150                  {
1151                    (void) fprintf(ofp,
1152                                   "ICK_INT16 ick_onespots[%d];\n"
1153                                   "ICK_INT16 onespotsstash[%d];\n",
1154                                   nonespots,
1155                                   nonespots);
1156                    if(opoverused) /* AIS */
1157                    {
1158                      int temp=nonespots;
1159                      (void) fprintf(ofp,"ick_overop* ick_oo_onespots;\n");
1160                      while(temp--)
1161                        (void) fprintf(ofp,
1162                                       "ick_type32 og1spot%d(ick_type32 t)\n{\n  (void)t;\n  return ick_onespots[%d];\n}\n"
1163                                       "void os1spot%d(ick_type32 val,void(*f)())\n{\n  (void)f;\n  if(!ignoreonespots%d)"
1164                                       " ick_onespots[%d]=val;\n}\n",temp,temp,temp,temp,temp);
1165                    }
1166                  }
1167                  if(ntwospots)
1168                  {
1169                    (void) fprintf(ofp,
1170                                   "ICK_INT32 ick_twospots[%d];\n"
1171                                   "ICK_INT32 twospotsstash[%d];\n",
1172                                   ntwospots,
1173                                   ntwospots);
1174                    if(opoverused) /* AIS */
1175                    {
1176                      int temp=ntwospots;
1177                      (void) fprintf(ofp,"ick_overop* ick_oo_twospots;\n");
1178                      while(temp--)
1179                        (void) fprintf(ofp,
1180                                       "ick_type32 og2spot%d(ick_type32 t)\n{\n  (void)t;\n  return ick_twospots[%d];\n}\n"
1181                                       "void os2spot%d(ick_type32 val,void(*f)())\n{\n  (void)f;\n  if(!ignoretwospots%d)"
1182                                       " ick_twospots[%d]=val;\n}\n",temp,temp,temp,temp,temp);
1183                    }
1184                  }
1185                  (void) fprintf(ofp, "#include \"pick2.h\"\n");
1186                }
1187                break;
1188
1189              case 'F':  /* set options from command line */
1190                if (ick_clockface)
1191                  (void) fprintf(ofp, "ick_clockface(ick_TRUE);\n");
1192                if (ick_clcsemantics) /* AIS */
1193                  (void) fprintf(ofp, "ick_setclcsemantics(ick_TRUE);\n");
1194                break;
1195
1196              case 'G':  /* degenerated code */
1197                for (tp = tuples, i = 0; tp->type; tp++, i++)
1198                {
1199                  emit(tp, ofp);
1200                  if (i == bugline)
1201                    (void) fprintf(ofp, "    ick_lose(IE774, ick_lineno, "
1202                                   "(char *)NULL);\n");
1203                }
1204                break;
1205
1206              case 'H':  /* COMPUCOME, and dispatching for resumes */
1207                /* AIS: Added COMPUCOME here. This line must be fully guarded
1208                   to prevent a longjmp to an uninitialised buffer (it's
1209                   guarded by a ick_lose() in ick-wrap.c.) Also checks for
1210                   multithread; programs that mix normal and computed COME
1211                   FROM need to use the same conventions for both, so even
1212                   if no computed COME FROMs are used, the normal ones need
1213                   this line so that COME FROMs can be handled consistently.*/
1214                if(compucomesused || multithread)
1215                {
1216                  (void) fprintf(ofp, "CCFL: ; CCF%d: longjmp(ick_cjb,1);\n",
1217                                 compucomecount);
1218                }
1219                break;
1220
1221              case 'J':  /* # of source file lines */
1222                (void) fprintf(ofp, "%d", iyylineno);
1223                break;
1224
1225              case 'K':       /* AIS: yuk information (or not) */
1226                if(yukdebug||yukprofile)
1227                {
1228                  (void) fprintf(ofp, "#include \"yuk.h\"\n\n");
1229                  (void) fprintf(ofp, "char* textlines[] = {\n");
1230                  emittextlines(ofp); /* from feh.c */
1231                  (void) fprintf(ofp, "\"\"};\n\n");
1232                  (void) fprintf(ofp, "char* yukexplain[] = {\n");
1233                  for (tp = tuples; tp->type; tp++)
1234                  {
1235                    if (tp->type == GETS || tp->type == FORGET || tp->type == RESUME
1236                        || tp->type == FROM || tp->type == COMPUCOME
1237                        || tp->type == MANYFROM)
1238                    {
1239                      (void) fprintf(ofp, "\"");
1240                      explexpr(tp->type == MANYFROM ? tp->u.node->lval :
1241                               tp->type == GETS ? tp->u.node->rval : tp->u.node, ofp);
1242                      (void) fprintf(ofp, "\",\n");
1243                    }
1244                    else (void) fprintf(ofp, "0,");
1245                  }
1246                  (void) fprintf(ofp, "0};\n\n");
1247                  (void) fprintf(ofp, "int lineofaboff[] = {\n");
1248                  for (tp = tuples; tp->type; tp++)
1249                  {
1250                    fprintf(ofp,"%d,",tp->ick_lineno);
1251                  }
1252                  (void) fprintf(ofp, "-1};\n\n");
1253                  (void) fprintf(ofp, "int yukopts = %d;\n", yukprofile+yukdebug*2);
1254                  (void) fprintf(ofp, "yptimer ypexectime[%d];\n", ick_lineno);
1255                  (void) fprintf(ofp, "ypcounter ypexecount[%d];\n",ick_lineno);
1256                  (void) fprintf(ofp, "ypcounter ypabscount[%d];\n",ick_lineno);
1257                }
1258                break;
1259
1260              case 'L': /* AIS: increase Emacs compatibility */
1261                (void) fprintf(ofp,
1262                               "/* -*- mode:c; compile-command:\"%s%s%s\" -*- */",
1263 #ifdef __DJGPP__
1264                               compiler," ",
1265 #else
1266                               "","",
1267 #endif
1268                               buf2);
1269                break;
1270
1271              case 'M': /* AIS: place new features defines in program */
1272                /* This is needed even in a non-multithread program, to let
1273                   the header files know it's non-multithread */
1274                (void) fprintf(ofp, "#define MULTITHREAD %d\n", multithread);
1275                /* Likewise, to let the header files know whether it
1276                   overloads operands (I don't think this is used at
1277                   the moment, though) */
1278                (void) fprintf(ofp, "#define OPOVERUSED %d\n",opoverused);
1279                /* and whether to use the ICK_EC code */
1280                if(useickec)
1281                  (void) fprintf(ofp, "#define ICK_EC 1\n");
1282                break;
1283
1284              case 'N':  /* allocate variables */
1285                /* AIS:I de-staticed all these so they could be accessed by
1286                   yuk and cesspool, and added all the mentions of yuk and
1287                   multithread. Then I changed it so the variables would be
1288                   allocated dynamically, to speed up multithreading (it's
1289                   an O(1) change to the speed of ordinary programs, so I
1290                   thought I could get away with it). At this point, the
1291                   'E' case must already have been done. calloc sets all
1292                   the integer values to 0, as before. In the case of
1293                   arrays, it will not zero pointers, but the number-of-
1294                   dimensions value will become 0, which can serve as a
1295                   'deallocated' flag. */
1296                if (nonespots)
1297                {
1298                  if(!pickcompile) /* AIS */
1299                  {
1300                    (void) fprintf(ofp,
1301                                   "    ick_onespots = calloc("
1302                                   "%d, sizeof *ick_onespots);\n",
1303                                   nonespots);
1304                    (void) fprintf(ofp,
1305                                   "    ick_oneforget = calloc("
1306                                   "%d, sizeof *ick_oneforget);\n",
1307                                   nonespots);
1308                  }
1309                  if(opoverused)
1310                  {
1311                    int temp=nonespots;
1312                    (void) fprintf(ofp,
1313                                   "    ick_oo_onespots=malloc(%d*sizeof*ick_oo_onespots);\n",temp);
1314                    while(temp--)
1315                      (void) fprintf(ofp,
1316                                     "    ick_oo_onespots[%d].get=og1spot%d;\n    ick_oo_onespots[%d].set=os1spot%d;\n",
1317                                     temp,temp,temp,temp);
1318                  }
1319                }
1320                if (ntwospots)
1321                {
1322                  if(!pickcompile)
1323                  {
1324                    (void) fprintf(ofp,
1325                                   "    ick_twospots = calloc("
1326                                   "%d, sizeof *ick_twospots);\n",
1327                                   ntwospots);
1328                    (void) fprintf(ofp,
1329                                   "    ick_twoforget = calloc("
1330                                   "%d, sizeof *ick_twoforget);\n",
1331                                   ntwospots);
1332                  }
1333                  if(opoverused)
1334                  {
1335                    int temp=ntwospots;
1336                    (void) fprintf(ofp,
1337                                   "    ick_oo_twospots=malloc(%d*sizeof*ick_oo_twospots);\n",temp);
1338                    while(temp--)
1339                      (void) fprintf(ofp,
1340                                     "    ick_oo_twospots[%d].get=og2spot%d;\n    ick_oo_twospots[%d].set=os2spot%d;\n",
1341                                     temp,temp,temp,temp);
1342                  }
1343                }
1344                if (ntails&&!pickcompile)
1345                {
1346                  (void) fprintf(ofp,
1347                                 "    ick_tails = calloc("
1348                                 "%d, sizeof *ick_tails);\n",
1349                                 ntails);
1350                  (void) fprintf(ofp,
1351                                 "    ick_tailforget = calloc("
1352                                 "%d, sizeof *ick_tailforget);\n",
1353                                 ntails);
1354                }
1355                if (nhybrids&&!pickcompile)
1356                {
1357                  (void) fprintf(ofp,
1358                                 "    ick_hybrids = calloc("
1359                                 "%d, sizeof *ick_hybrids);\n",
1360                                 nhybrids);
1361                  (void) fprintf(ofp,
1362                                 "    ick_hyforget = calloc("
1363                                 "%d, sizeof *ick_hyforget);\n",
1364                                 nhybrids);
1365                }
1366                break;
1367              case 'O': /* AIS; for GERUCOME and operand overloading */
1368                if(gerucomesused || nextfromsused)
1369                  fprintf(ofp,"unsigned truelineno = 0;\n");
1370                if(opoverused)
1371                  fprintf(ofp,"%s trueval;\n",
1372                          pickcompile?"ICK_INT32":"ick_type32");
1373                break;
1374              case 'P': /* AIS: for operand overloading */
1375                if(opoverused)
1376                  emitslatproto(ofp);
1377                break;
1378              case 'Q': /* AIS: for operand overloading */
1379                if(opoverused)
1380                  emitslat(ofp);
1381                break;
1382              }
1383
1384       if(!outtostdout) (void) fclose(ofp);
1385
1386 #ifndef __DJGPP__
1387       /* OK, now sic the C compiler on the results */
1388       if (!compile_only&&!yukdebug&&!yukprofile&&!useickec)
1389       {
1390         /* AIS: buf2 now assigned elsewhere so $L works */
1391         (void) system(buf2);
1392         /* AIS: no unlink if cdebug */ if(!cdebug) (void) unlink(buf);
1393       }
1394       else if(!compile_only&&!useickec)
1395       { /* AIS: run, then delete all output but yuk.out */
1396         /* Note that the output must be deleted for copyright
1397            reasons (so as not to GPL a non-GPL file automatically) */
1398         (void) system(buf2);
1399 #ifdef HAVE_UNISTD_H
1400         (void) dup2(oldstdin,0); /* restore stdin */
1401 #endif
1402         (void) system(yukcmdstr);
1403         (void) unlink(buf);
1404         (void) unlink(argv[optind]);
1405       }
1406 #else /* we are using DJGPP */
1407       /* OK, now sic the C compiler on the results */
1408       if (!compile_only&&!useickec)
1409       {
1410         /* AIS: buf2 now assigned elsewhere so $L works */
1411         /* AIS: This changes somewhat for DJGPP, due to the
1412            command-line cap. It creates a temporary file
1413            with the arguments needed to give gcc. */
1414         FILE* rsp;
1415         /* Use current dir as temp if needed */
1416         char* tempfn="gcc @ickgcc.rsp";
1417         /* Four tries are used to find a temp directory.
1418            ICKTEMP is the preferred environment variable to check;
1419            if, as expected, this isn't set, try TMPDIR (which DJGPP
1420            sets to its own temp directory, at least when running under
1421            bash), TEMP and TMP (in that order). DJGPP offers /dev/env
1422            as a method of accessing environment variables in filenames.*/
1423         if(isenv("TMP")) tempfn="gcc @/dev/env/TMP/ickgcc.rsp";
1424         if(isenv("TEMP")) tempfn="gcc @/dev/env/TEMP/ickgcc.rsp";
1425         if(isenv("TMPDIR")) tempfn="gcc @/dev/env/TMPDIR/ickgcc.rsp";
1426         if(isenv("ICKTEMP")) tempfn="gcc @/dev/env/ICKTEMP/ickgcc.rsp";
1427         rsp=ick_debfopen(tempfn+5,"w");
1428         fprintf(rsp,"%s\n",buf2);
1429         fclose(rsp);
1430         system(tempfn);
1431         remove(tempfn+5);
1432         if(yukdebug || yukprofile)
1433         {
1434 #ifdef HAVE_UNISTD_H
1435           dup2(oldstdin,0); /* restore stdin */
1436 #endif
1437 #ifndef HAVE_SNPRINTF
1438           sprintf(buf2,"%s" EXEEXT,argv[optind]);
1439 #else
1440           snprintf(buf2,"%s" EXEEXT,argv[optind]);
1441 #endif
1442           system(yukcmdstr);
1443           remove(buf);
1444           remove(buf2);
1445         }
1446         else if(!cdebug)
1447         {
1448           remove(buf);
1449         }
1450       }
1451 #endif
1452 #ifdef HAVE_PROG_SH
1453 # ifdef HAVE_SYS_INTERPRETER
1454       if(coopt) /* AIS */
1455       {
1456         /* The constant-output optimizer is a form of post-processor.
1457            IMPORTANT NOTE: This MUST NOT be run if the input program
1458            takes any input or is affected in any way by the state of
1459            the system, as the degenerated program may be wrong. At the
1460            moment, the only INTERCAL command that takes input is
1461            WRITE IN. Double-oh-sevens screw this up, too. */
1462         if(cooptsh)
1463         {
1464 #ifndef HAVE_SNPRINTF
1465           (void) sprintf(buf2,"sh %s %s", cooptsh, argv[optind]);
1466 #else
1467           (void) snprintf(buf2, sizeof buf2,
1468                           "sh %s %s", cooptsh, argv[optind]);
1469 #endif
1470           (void) system(buf2); /* replaces the output executable if
1471                                   neccesary */
1472         }
1473       }
1474 # endif
1475 #endif
1476     }
1477   }
1478   (void) fclose(ifp);
1479
1480   if(!compile_only && useickec) /* AIS */
1481   {
1482     FILE* cioin;
1483     FILE* cioallec;
1484     char* buf2ptr;
1485     long remspace;
1486     char* tempfn="ickectmp.c";
1487 #if __DJGPP__
1488     /* Look for a temp directory, as above. */
1489     if(isenv("TMP")) tempfn="/dev/env/TMP/ickectmp.c";
1490     if(isenv("TEMP")) tempfn="/dev/env/TEMP/ickectmp.c";
1491     if(isenv("TMPDIR")) tempfn="/dev/env/TMPDIR/ickectmp.c";
1492     if(isenv("ICKTEMP")) tempfn="/dev/env/ICKTEMP/ickectmp.c";
1493 #else
1494     tempfn="/tmp/ickectmp.c"; /* always a valid temporary folder on POSIX */
1495 #endif
1496     cioallec=ick_debfopen(tempfn,"w");
1497     if(cioallec == NULL)
1498       ick_lose(IE888, -1, (char*) NULL);
1499     (void) fprintf(cioallec,"void ick_doresume(unsigned short,int);\n");
1500     (void) fprintf(cioallec,"extern int ick_global_checkmode;\n");
1501     (void) fprintf(cioallec,"void ick_allecfuncs(void)\n{\n");
1502
1503     /* Here, we run the C preprocessor on the files in question, then our
1504        own preprocessor, and finally link all the files together into one
1505        executable. */
1506     for(optind=oldoptind; optind < argc; optind++)
1507     {
1508 #ifndef HAVE_SNPRINTF
1509       (void) sprintf(buf2,
1510 #if 0
1511         ); /* for Emacs' autoindenter */
1512 #endif
1513 #else
1514       (void) snprintf(buf2, sizeof buf2,
1515 #endif
1516                       "%s -E -I%s -I%s -I%s/../include %s.c > %s.cio",
1517                       compiler, includedir, path, path, argv[optind], argv[optind]);
1518       if(argv[optind][strlen(argv[optind])+2]=='\0' /* it was a .c or .i file */
1519          ||argv[optind][strlen(argv[optind])+3]!='o') /* it was a .2-7i file */
1520         (void) system(buf2); /* run the C preprocessor */
1521       buf2ptr = strrchr(buf2,'>'); /* get the .cio's filename */
1522       cioin=NULL;
1523       /* Do our preprocessing, by editing the file in place using rb+. */
1524       if(buf2ptr != NULL && buf2ptr[1] != '\0' && buf2ptr[2] != '\0')
1525         cioin=ick_debfopen(buf2ptr+2,"rb+");
1526       if(cioin)
1527       {
1528         int inchar=fgetc(cioin);
1529         int toparencount=0;
1530         /* The ppnums are replacements for strings in the .cio file.
1531            The choice of 65538 means that we don't clash with any
1532            line numbers in the program, but do clash with the other
1533            C-INTERCAL preprocessor (that handles WHILE); that isn't a
1534            problem because external calls are inconsistent with
1535            multithreading anyway. */
1536         long ppnum1=65538L*2L;
1537         long ppnum2=65538L*2L;
1538         long ppnum3=65538L*2L;
1539         long ppnum6=65538L*2L;
1540         long ciopos=0L;
1541         /*@+charintliteral@*/ /* literal chars are ints */
1542         while(inchar != EOF)
1543         {
1544           if(inchar=='I')
1545           {
1546             /* Look for the ICK_EC_PP_ string that indicates preprocessing
1547                is needed. This method of doing it works as long as the
1548                ICK_EC_PP_ string is never preceded by something which looks
1549                like part of the same string, but luckily, it never is. */
1550             if((inchar=fgetc(cioin))!='C') continue;
1551             if((inchar=fgetc(cioin))!='K') continue;
1552             if((inchar=fgetc(cioin))!='_') continue;
1553             if((inchar=fgetc(cioin))!='E') continue;
1554             if((inchar=fgetc(cioin))!='C') continue;
1555             if((inchar=fgetc(cioin))!='_') continue;
1556             if((inchar=fgetc(cioin))!='P') continue;
1557             if((inchar=fgetc(cioin))!='P') continue;
1558             if((inchar=fgetc(cioin))!='_') continue;
1559             inchar=fgetc(cioin);
1560             toparencount=0;
1561             if(inchar=='0')
1562             {
1563               fprintf(cioallec,"#undef X\n");
1564               fprintf(cioallec,"#define X ");
1565               while(fputc(fgetc(cioin),cioallec) != ')') toparencount++;
1566             }
1567             (void) fseek(cioin,ciopos,SEEK_SET);
1568             switch(inchar)
1569             {
1570             case '0': /* a function exists */
1571               fprintf(cioin,"            ");
1572               fprintf(cioallec,"\nvoid X(void); X();\n"
1573                       "if(ick_global_checkmode==5) ick_doresume(1,-1);\n");
1574               while(toparencount--) (void) fputc(' ',cioin);
1575               break;
1576             case '1':
1577               fprintf(cioin,"%-11ld",ppnum1++/2);
1578               break;
1579             case '2':
1580               fprintf(cioin,"%-11ld",ppnum2++/2);
1581               break;
1582             case '3':
1583               fprintf(cioin,"%-11ld",ppnum3++/2);
1584               break;
1585             case '4':
1586               fprintf(cioin,"%-11d",optind);
1587               break;
1588             case '6':
1589               fprintf(cioin,"%-11ld",ppnum6++/2);
1590               break;
1591             default:
1592               ick_lose(IE778, -1, (char*) NULL);
1593             }
1594             (void) fseek(cioin,0L,SEEK_CUR); /* synch the file */
1595           }
1596           ciopos=ftell(cioin);
1597           inchar=fgetc(cioin);
1598         }
1599         /*@=charintliteral@*/
1600         (void) fclose(cioin);
1601       }
1602     }
1603     fprintf(cioallec,"if(ick_global_checkmode==2)\n");
1604     fprintf(cioallec,"  ick_global_checkmode=4;\n");
1605     fprintf(cioallec,"};\n");
1606     (void) fclose(cioallec);
1607
1608     /* This command line needs some explanation, and is specific to gcc and
1609        GNU ld. The -x causes gcc to interpret the .cio files as C; the
1610        -Wl,-z,muldefs is an instruction to GNU ld, telling it to link in the
1611        first main found and ignore the others.  (That way, there can be a
1612        main function in each .cio, but the .cios can be linked in any order,
1613        with the right main function foremost each time.)
1614     */
1615 #ifdef HAVE_SNPRINTF
1616     (void) snprintf(buf2, sizeof buf2,
1617 #else
1618                     (void) sprintf(buf2,
1619 #endif
1620 #define XSTR(x) #x
1621 #define IHSH XSTR(ICK_HAVE_STDINT_H)
1622 "%s -L%s -L%s -L%s/../lib -O2 -o %s" EXEEXT "%s "
1623 #ifndef __DJGPP__
1624 "-Wl,-z,muldefs "
1625 #endif
1626 "-DICK_HAVE_STDINT_H=%s -x c %s", compiler, libdir,
1627 path, path, argv[oldoptind], cdebug?" -g":"", IHSH, tempfn);
1628 #if 0
1629       ); /* for Emacs' autoindenter */
1630 #endif
1631     remspace = (long)(sizeof buf2 - strlen(buf2) - 1);
1632     for(optind=oldoptind; optind < argc; optind++)
1633     {
1634       remspace -= strlen(argv[optind]) - 5; /* 5 for <space>.cio */
1635       if(remspace <= 0)
1636         ick_lose(IE666, -1, (char*)NULL);
1637       strcat(buf2," ");
1638       strcat(buf2,argv[optind]);
1639       strcat(buf2,".cio");
1640     }
1641     remspace -= strlen(" -lickec");
1642     if(remspace <= 0)
1643       ick_lose(IE666, -1, (char*)NULL);
1644     strcat(buf2," -lickec");
1645     (void) system(buf2);
1646     (void) remove(tempfn);
1647   }
1648
1649   /* AIS: Free malloc'd memory. */
1650   if(textlines)
1651   {
1652     /* Marking what textlines points to as only would be the 'right'
1653        way to do this (because it is only), but I can't figure out the
1654        syntax to do it, so instead I'm supressing the warning that comes
1655        up because it isn't marked as only. */
1656     /*@-unqualifiedtrans@*/
1657     while(textlinecount--) free(textlines[textlinecount]);
1658     free(textlines);
1659     /*@=unqualifiedtrans@*/
1660   }
1661
1662 #ifdef HAVE_UNISTD_H
1663   (void) close(oldstdin); /* AIS */
1664 #endif
1665   /* This point is the very end of the program. So it's correct for
1666      normal DO NOT FREE UNDER ANY CIRCUMSTANCES globals to be free
1667      at this point, so supressing the warning given as a result. */
1668   /*@-globstate@*/
1669   return 0;
1670   /*@=globstate@*/
1671 }
1672
1673 /* perpet.c ends here */
1674