/****************************************************************************

NAME
   perpetrate.c -- main routine for C-INTERCAL compiler.

DESCRIPTION
   This is where all the dirty work begins and ends.

****************************************************************************/
/*LINTLIBRARY */
#ifdef QDOS
#include <stdlib.h>
#include <string.h>
#endif
#include <stdio.h>
#include <signal.h>
#include "ick.h"
#include "y.tab.h"
#include "lose.h"

#ifndef ICKINCLUDEDIR
#define ICKINCLUDEDIR "/usr/local/include"
#endif
#ifndef ICKLIBDIR
#define ICKLIBDIR "/usr/local/lib"
#endif
#ifndef CC
#define CC "cc"
#endif

#ifdef QDOS
char _prog_name[] = "ick";
#endif

/* compilation options */
bool dooptimize;	/* do optimizations? (controlled by -O) */
bool clockface; 	/* set up output to do IIII for IV */
bool compile_only;	/* just compile into C, don't run the linker */
bool traditional;		/* insist on strict INTERCAL-72 conformance */

#ifndef QDOS
#define SKELETON	"ick-wrap.c"
#else
#define SKELETON	"ick-wrap_c"
#endif

/* numeric base defaults, exported to other files */
int Base = 2;
int Small_digits = 16;
int Large_digits = 32;
unsigned int Max_small = 0xffff;
unsigned int Max_large = 0xffffffff;

int lineno;	/* current source line number; lose() uses it */

/* currently supported numeric bases, not exported */
static int maxbase = 7;
static int smallsizes[8] = {0, 0, 16, 10, 8, 6, 6, 5};
static unsigned int maxsmalls[8] =
  {0, 0, 65535, 59048, 65535, 15624, 46655, 16806};

static char *compiler;

atom oblist[MAXVARS], *obdex;
int nonespots, ntwospots, ntails, nhybrids;

tuple tuples[MAXLINES];

static void abend(signim)
int signim;
{
    lose(E778, yylineno, (char *)NULL);
}

main(argc, argv)
int	argc;
char	*argv[];
{
    extern char *optarg;	/* set by getopt */
    extern int	optind; 	/* set by getopt */
    char	buf[BUFSIZ], buf2[BUFSIZ], *chp, *strrchr();
    tuple	*tp;
    atom	*op;
    int c;
#ifndef QDOS
    char	*includedir, *libdir, *getenv();
#else
    char	includedir[50], libdir[50];
#endif
    FILE	*ifp, *ofp;
    int 	maxabstain;
    extern void print_usage();

#ifndef QDOS
    if (!(includedir = getenv("ICKINCLUDEDIR")))
      includedir = ICKINCLUDEDIR;
    if (!(libdir = getenv("ICKLIBDIR")))
      libdir = ICKLIBDIR;
#else
    if (getenv("ICKINCLUDEDIR") == NULL) {
       (void) strcat(includedir, getenv("PROG_USE"));
       (void) strcat(includedir, "include_");
       }
    else (void) strcpy(includedir, getenv("ICKINCLUDEDIR"));

    if (getenv("ICKLIBDIR") == NULL) {
       (void) strcat(libdir, getenv("PROG_USE"));
       (void) strcat(libdir, "lib_");
       }
    else (void) strcpy(libdir, getenv("ICKLIBDIR"));
#endif
    if (!(compiler = getenv("CC")))
      compiler = CC;

    while ((c = getopt(argc, argv, "cdtOC@")) != EOF)
    {
	switch (c)
	{
	case 'c':
	    compile_only = 1;
	    break;

	case 'd':
	    yydebug = compile_only = 1;
	    break;

	case 'C':
	    clockface = TRUE;
	    break;

	case 't':
	    traditional = 1;
	    break;

	case 'O':
	    dooptimize = TRUE;
	    break;

	case '?':
	default:
	case '@':
	    print_usage(argv[0],"cdtCO");
	    exit(1);
	    break;
	}
    }

    (void) signal(SIGSEGV, abend);
    (void) signal(SIGBUS, abend);

#ifndef QDOS
    (void) sprintf(buf2,"%s/%s",includedir,SKELETON);
#else
    (void) sprintf(buf2,"%s%s",includedir,SKELETON);
#endif

    /* now substitute in tokens in the skeleton */
    if ((ifp = fopen(buf2, "r")) == (FILE *)NULL)
	lose(E999, 0, (char *)NULL);
    buf[strlen(buf) - 2] = '\0';

    for (; optind < argc; optind++)
    {
	if (freopen(argv[optind], "r", stdin) == (FILE *)NULL)
	    lose(E777, 0, (char *)NULL);
	else
	{
	    /* strip off the file extension */
#ifndef QDOS
	    if(!(chp = strrchr(argv[optind],'.')))
#else
	    if(!(chp = strrchr(argv[optind],'_')))
#endif
	    {
		lose(E998, 0, (char *)NULL);
	    }
	    *chp++ = '\0';

	    /* determine the file type from the extension */
	    while (strcmp(chp,"i"))
	    {
		long strtol();
		Base = strtol(chp,&chp,10);
		if (Base < 2 || Base > maxbase)
		    lose(E998, 0, (char *)NULL);
		else if (traditional && Base != 2)
		    lose(E111, 0, (char *)NULL);
		Small_digits = smallsizes[Base];
		Large_digits = 2 * Small_digits;
		Max_small = maxsmalls[Base];
		if (Max_small == 0xffff)
		    Max_large = 0xffffffff;
		else
		    Max_large = (Max_small + 1) * (Max_small + 1) - 1;
	    }

	    /* zero out tuple and oblist storage */
	    treset();
	    politesse = 0;

	    /* compile tuples from current input source */
	    yyparse();	

	    /*
	     * Miss Manners lives.
	     */
	    if (politesse == 0 || yylineno / politesse > 5)
		lose(E079, 0, (char *)NULL);
	    else if (yylineno / politesse < 3)
		lose(E099, 0, (char *)NULL);

	    /* 
	     * Now propagate type information up the expression tree.
	     * We need to do this because the unary-logical operations
	     * are sensitive to the type widths of their operands, so
	     * we have to generate different code depending on the
	     * deducible type of the operand.
	     */
	    for (tp = tuples; tp < tuples + lineno; tp++)
		if (tp->type == GETS || tp->type == RESIZE
		    || tp->type == FORGET || tp->type == RESUME)
		    typecast(tp->u.node);

	    codecheck();	/* check for compile-time errors */

	    /* perform optimizations */
	    if (dooptimize)
		for (tp = tuples; tp < tuples + lineno; tp++)
		    if (tp->type == GETS || tp->type == RESIZE
			|| tp->type == FORGET || tp->type == RESUME)
			optimize(tp->u.node);

	    /* set up the generated C output file name */
	    (void) strcpy(buf, argv[optind]);
#ifndef QDOS
	    (void) strcat(buf, ".c");
#else
	    (void) strcat(buf, "_c");
#endif
	    if ((ofp = fopen(buf, "w")) == (FILE *)NULL)
		lose(E888, 0, (char *)NULL);
	    
	    fseek(ifp,0L,0);	/* rewind skeleton file */

	    while ((c = fgetc(ifp)) != EOF)
		if (c != '$')
		    (void) fputc(c, ofp);
		else switch(fgetc(ifp))
		{
		case 'A':	/* source name stem */
		    (void) fputs(argv[optind], ofp);
		    break;

		case 'B':	/* # of source lines */
		    (void) fprintf(ofp, "%d", lineno);
		    break;

		case 'C':	/* initial abstentions */
		    maxabstain = 0;
		    for (tp = tuples; tp < tuples + lineno; tp++)
			if (tp->exechance <= 0 && tp - tuples + 1 > maxabstain)
			    maxabstain = tp - tuples + 1;
		    if (maxabstain)
		    {
			(void) fprintf(ofp, " = {");
			for (tp = tuples; tp < tuples + maxabstain; tp++)
			    if (tp->exechance > 0)
				(void) fprintf(ofp, "0, ");
			    else {
				(void) fprintf(ofp, "1, ");
				tp->exechance = -tp->exechance;
			    }
			(void) fprintf(ofp, "}");
		    }
		    break;

		case 'D':	/* extern to intern map */
		    (void) fprintf(ofp,"int Base = %d;\n",Base);
		    (void) fprintf(ofp,"int Small_digits = %d;\n",
				   Small_digits);
		    (void) fprintf(ofp,"int Large_digits = %d;\n",
				   Large_digits);
		    (void) fprintf(ofp,"unsigned int Max_small = 0x%x;\n",
				   Max_small);
		    (void) fprintf(ofp,"unsigned int Max_large = 0x%x;\n",
				   Max_large);
		    if (nonespots)
		    {
			(void) fprintf(ofp,
				       "static type16 onespots[%d];\n",
				       nonespots);
			(void) fprintf(ofp,
				       "static bool oneforget[%d];\n",
				       nonespots);
		    }
		    if (ntwospots)
		    {
			(void) fprintf(ofp,
				       "static type32 twospots[%d];\n",
				       ntwospots);
			(void) fprintf(ofp,
				       "static bool twoforget[%d];\n",
				       ntwospots);
		    }
		    if (ntails)
		    {
			(void) fprintf(ofp,
				       "static array tails[%d];\n",
				       ntails);
			(void) fprintf(ofp,
				       "static bool tailforget[%d];\n",
				       ntails);
		    }
		    if (nhybrids)
		    {
			(void) fprintf(ofp,
				       "static array hybrids[%d];\n",
				       nhybrids);
			(void) fprintf(ofp,
				       "static bool hyforget[%d];\n",
				       nhybrids);
		    }
		    if (yydebug | compile_only)
			for (op = oblist; op < obdex; op++)
			    (void) fprintf(ofp, " /* %s %d -> %d */\n",
					   nameof(op->type, vartypes),
					   op->extindex,
					   op->intindex);
		    break;

		case 'E':
		    if (clockface)
			(void) fprintf(ofp, "clockface(TRUE);");
		    break;

		case 'F':	/* degenerated code */
		    for (tp = tuples; tp < tuples + lineno; tp++)
			emit(tp, ofp);
		    break;

		case 'G':
		    for (tp = tuples; tp < tuples + lineno; tp++)
			if (tp->type == NEXT)
			    (void) fprintf(ofp,
					   "\tcase %d: goto N%d; break;\n",
					   tp - tuples + 1, tp - tuples + 1);
		    break;
		}

	    (void) fclose(ofp);

	    /* OK, now sic the C compiler on the results */
	    if (!compile_only)
	    {
		(void) sprintf(buf2,
#ifndef QDOS
			       "%s %s -I%s -L%s -lick -o %s",
#else
			       "%s %s -I%s -L%s -Qwarn=2 -bufp200k -lick -o %s",
#endif
			       compiler, buf, includedir, libdir,
			       argv[optind]);
#ifdef QDOS
		if (( getenv("TMP") == NULL) && (getenv("TEMP") == NULL)) {
		    (void) puts("\nick: EEK - I notice that neither the TMP or \
the TEMP enivronmental variables");
		    (void) puts("\tare set. I may decide to crash and burn later.");
		    }
		else
		   (void) puts("\n\t\tI do hope that the kettle is on...\n");
#endif
		(void) system(buf2);
		(void) unlink(buf);
	    }
	}
    }
    (void) fclose(ifp);
}

static void
print_usage(prog,options)
char *prog, *options;
{
    fprintf(stderr,"Usage: %s [-%s] <file> [<file> ... ]\n",prog,options);
    fprintf(stderr,"\t-c\t:compile INTERCAL to C, but don't compile C\n");
    fprintf(stderr,"\t-d\t:print debugging information (implies -c)\n");
    fprintf(stderr,"\t-t\t:traditional mode, accept only INTERCAL-72\n");
    fprintf(stderr,"\t-C\t:clockface output (e.g. use IIII instead of IV)\n");
    fprintf(stderr,"\t-O\t:attempt to optimize generated code\n");
#ifndef QDOS
    fprintf(stderr,"\t<file>\tINTERCAL source file(s) (use extension .i)\n");
#else
    fprintf(stderr,"\t<file>\tINTERCAL source file(s) (use extension _i)\n");
#endif
    fprintf(stderr,"\t\teach file produces a separate output program.\n");
}

/* perpetrate.c ends here */