
#
# define DEBUG DEBUG
# define LDBUG          /* etext set incorrectly */
char copyright1[] = "Copyright 1986-1989 Hans-Juergen Boehm, Alan J. Demers, Kumar Srikantan, Vernon Lee, and Lucy Hederman.\n";
char copyright2[] = "Copyright (c) 1990-1993 by Xerox Corporation.  All rights reserved.\n";
char copyright3[] = "This material is provided as is, with no warranty expressed or implied.  Any use is at your own risk.\n";

/*
 * Russell compiler -- Passes 1 through 5
 * 
 *  Pass 1 :
 *     initial syntax analysis
 *  
 *  Pass 2 :
 *     symbol table generation
 *
 *  Pass 3 :
 *     minor tree massaging
 *
 *  Pass 4:
 *     signature deduction and checking
 *
 *  Pass 5c:
 *     Vax code generation
 *
 *  Pass5d:
 *     Intermediate code generation (run instead of pass5c)
 *
 * Input: 
 *  ifile: preprocessor output
 *      stdin is reopened as ifile
 *
 * Output :
 *  ofile: VAX assembly code or intermediate code.
 *  sigfile: contains signature of program (-c flag only)
 *  optfile: contains the concatenation of optimization info from
 *           files mentioned in "extern" expressions
 *
 * Diagnostics :
 *  written to stderr
 *
 * Compiler control messages :
 *  written to stderr
 *
 *
 * Calling Sequence:
 * Rc [-BDSidaMcLPTGfVxXhOOOfF] actual_ifile ifile ofile [sigfile] [optfile]
 *          sigfile should appear only with -c
 *          optfile should appear only with -OO
 *          actual_ifile is the name of the original input file.
 *                  It is never opened, but is used to build function names
 *
 * Flags:
 *      B   - Debugging flag. Turn on bad allocation debug.
 *      D   - Debugging flag. Turn on yydebug.
 *      S   - Debugging. Catch signals and flush buffers before aborting.
 *      i   - Just build the syntax tree, and write out the final core image
 *            on rc.x .  rc.x is in a.out format.  The parse tree produced by
 *            rc.x for any RUSSELL program will then be inserted
 *            in place of the denotation represented by <cntrl b> in the
 *            first program.  Compilation then proceeds as normal. This allows 
 *            building initialized RUSSELL compilers which know about a 
 *            certain standard prologue.
 *              Boolean and Integer should be defined in the standard Prologue.
 *            Boolean must be defined as a parameter.  The initial occurrence
 *            of the identifier Boolean must be as the first identifier in a
 *            list of parameters having the same signature. (Generally it will
 *            be the only element of such a list. )
 *              This is of course both machine and operating system dependent.
 *            It is intended to work only with
 *            Berkeley VAX UNIX. (Which form is used depends on macros de-
 *            fined in parm.h.) An old style a.out file is produced on the VAX.
 *      d -   Same as i except produces a demand loadable file on the VAX.
 *            This requires that the old version of Rc also be demand 
 *            loadable.
 *      a -   Generate abstract syntax rather than VAX code.
 *            (obsolete, no longer implemented.)
 *      M -   allocate all variables in memory. (Opposite of R)
 *      c -   Generate code only for the user supplied (not initial env.)
 *            code.  Set things up so that it can be called from another
 *            Russell program.  Write signature information onto sigfile.
 *      p -   infile is preprocessor output.
 *      L -   Allow functions with trailing var Void argument to violate
 *            import rule.
 *      P -   Generate code to count function calls
 *      T -   Generate trace code
 *      G -   Generate general intermediate code
 *      V -   Verbose - print call graph info on stdout
 *      N -   No use of Callcc
 *      f -   It is not possible to update the stack pointer SP
 *            HINT ONS is however assumed to be understood by the code
 *            generator.
 *      F -   Same as f, but in addition BSF functions can't access GF
 *            and GAR instructions must precede first nested procedure call.
 *            HINT ONS is not assumed to be understood.
 *      R -   use registers for identifier bindings
 *      O -   optimize at the expense of compilation time and possibly
 *            execution space
 *      OO -  also prepare to run intermediate code optimizer
 *      OOO - unroll loops once
 *      X -   compile an externally callable type.
 * 	x -   Generate code for Xerox Portable Common Runtime.
 *      h -   heap allocate variables and activation records, unless the
 *            variables would otherwise be in registers.
 */

# include <stdio.h>
# include <stdlib.h>
# include <string.h>
# include <a.out.h>
# include "parm.h"
# include "arith.h"

extern void GC_init();
unsigned yyinfnm;  /* string table pointer */
int yyline;
extern int addposition(unsigned,int);
extern int yyvline;
extern char tokenbuf[1000];
extern int yylex();
extern int yyunlex(int);
extern int yyparse();
extern int yycolno;


typedef long NODE;          /* Not really, but dont want to include */
			    /* streedefs here.                      */

# define NIL ((NODE *)0)

/*  Flag args. */
boolean BADflag;
boolean initflag;
boolean dloadflag;
boolean aflag;
boolean Mflag;
boolean cflag;
boolean pflag;
boolean Lflag;
boolean Pflag;
boolean Tflag;
boolean Gflag;
boolean Vflag;
boolean Nflag;
boolean fflag;
boolean Fflag;
boolean Rflag;
boolean Oflag;
boolean OOflag;
boolean OOOflag;
boolean Xflag;
boolean xflag;
boolean hflag;
long max_int_regs;
long max_addr_regs;

char * entry_name;  /* "" for regular compilations.  Used for -c */

extern int GC_dont_gc;

/*
 *  Input and output file names and declarations.
 */
char *ifname;
char *ofname;
char *sigfname;
char *optfname;
char *actual_ifname;
FILE *ofile;
FILE *sigfile;
FILE *optfile;

/*
 *  In-line code production for type constructions
 */

char * Vspcl_to_inline();
char * Gspcl_to_inline();
char * (* spcl_to_inline)();

/*
 *  Input translation for in-line specifications
 */
char * Vinline_cnvt(s)
char *s;
{ return(s); }

char * Ginline_cnvt();

char * (* inline_cnvt)();

/*
 *  Yacc flags 
 */
extern int yynerrs;
extern int yydebug;

/*
 *  Current file name, line number
 */
extern int yyline;

/*
 * end of text symbol used in writing out initialized compiler
 */

extern etext;

/*
 * Syntax tree produced by pass 0.
 */
extern NODE * stxtree;
extern NODE * insrtptr;

main(argc,argv)
int argc;
char **argv;
{   int argn;   /* arg number currently being processed. */

#   ifdef VERBOSE
	fprintf(stderr, "Starting up\n");
#   endif
    if (insrtptr == NIL) {
	/* Not a pre-initialized compiler */
/*        GC_dont_gc = TRUE; */
	GC_init();
    }
    /* Initialize flags */
	dloadflag = initflag = BADflag = aflag = yydebug = FALSE;
    /* Initialize file name pointers. */
	ifname = ofname = sigfname = optfname = actual_ifname = (char *)0;
    for (argn = 1; argn < argc; argn++) {
        switch ( argv[argn][0] ) {
            case '-' :
                {   char *flagp;
                    for (flagp = &(argv[argn][1]); *flagp != '\0'; flagp++) {
                        switch (*flagp) {
                            case 'B':
                                BADflag++;
                                break;
                            case 'D':
                                yydebug++;
                                break;
			    case 'S':
				catchsigs();
                                break;
                            case 'i':
                                initflag = TRUE;
                                break;
                            case 'd':
                                initflag = TRUE;
                                dloadflag = TRUE;
				break;
			    case 'a':
				aflag = TRUE;
				break;
			    case 'M':
				Mflag = TRUE;
                                break;
                            case 'c':
                                cflag = TRUE;
                                break;
                            case 'p':
                                pflag = TRUE;
                                break;
                            case 'L':
                                Lflag = TRUE;
                                break;
                            case 'P':
                                Pflag = TRUE;
                                break;
                            case 'T':
                                Tflag = TRUE;
				break;
			    case 'G':
				Gflag = TRUE;
				break;
			    case 'V':
				Vflag = TRUE;
				break;
			    case 'N':
				Nflag = TRUE;
				break;
			    case 'f':
				fflag = TRUE;
				break;
			    case 'F':
				fflag = TRUE;
				Fflag = TRUE;
				break;
			    case 'R':
				Rflag = TRUE;
				break;
			    case 'O':
				if (OOflag) {
				    OOOflag = TRUE;
				} else if (Oflag) {
				    OOflag = TRUE;
				} else {
				    Oflag = TRUE;
				}
				break;
			    case 'X':
				Xflag = TRUE;
				break;
			    case 'x':
			        xflag = TRUE;
			        break;
			    case 'h':
				hflag = TRUE;
				break;
                            default:
				dbgmsg("Rc: illegal flag option: %c\n", *flagp);
                                abort();
                        }
                    }
                }

            case '\0' :
                break;

	    default:
		if ( actual_ifname == (char *)0 ) {
		    actual_ifname = argv[argn];
		} else if ( ifname == (char *)0 ) {
                    ifname = argv[argn];
		} else if (ofname == (char *)0) {
                    ofname = argv[argn];
		} else if (sigfname == ((char *)0) && cflag) {
		    sigfname = argv[argn];
		} else if (optfname == ((char *)0) && OOflag) {
		    optfname = argv[argn];
		} else {
		    fprintf(stderr, "Rc: Too many args\n");
		    exit(1);
		}
                break;
        }
    }

    if (ofname == ((char *)0)) {
	fprintf(stderr, "Rc: Too few arguments\n");
	exit(1);
    }
    if (cflag && sigfname == ((char *)0)) {
	fprintf(stderr, "Rc: Missing file name for signature info\n");
	exit(1);
    }
    if (OOflag && optfname == ((char *)0)) {
	fprintf(stderr, "Rc: Missing file name for optimization info\n");
	exit(1);
    }

    if (Xflag && !Gflag) {
	fprintf(stderr, "Vax code generator cannot be used with -X\n");
	exit(1);
    }

    printf("DJD actual_ifname = %s\n",actual_ifname);
    printf("DJD ifname = %s\n",ifname);
    printf("DJD ofname = %s\n",ofname);


    /* Set up max_..._regs appropriately */
	max_int_regs = 0;
	max_addr_regs = 0;
	if (Mflag && Rflag) {
	    fprintf (stderr, "-M contradicts -R, ignoring both\n");
	    Mflag = Rflag = FALSE;
	}
#       ifdef SUN
	    if (!Mflag) {
#             ifdef GEN_C
		/* Regs ~ C variables.  There is no point in not using */
		/* all we can.                                         */
		  Rflag = TRUE;
#             else
		/* Try to allocate 3 int variable and 1 ptr variable */
		/* to regs. This leaves a few for temporaries.       */
		max_int_regs = 3;
		max_addr_regs = 1;
#             endif
	    }
#       endif
#       ifdef RT
	    if (!Mflag) {
		/* Leave the decisions to the register allocator.  It does */
		/* MUCH better than we can here.                           */
		Rflag = TRUE;
	    }
#       endif
	    //DJD get this far
    exit(0);
    // stuck in loop next
    /* Initialize */
	if (insrtptr == NIL /* no previous initialization has taken place */) {
	    initids();
	    if (Gflag) {
		init_RIC_table();
	    }
	}
	// DJD Loop before here
    /* open input file */
        if ( freopen( ifname, "r", stdin ) == NULL ) {
            fprintf(stderr, "Can't open %s\n", ifname);
            exit(1);
        }

    if (OOflag) {
      /* Open file for optimization info */
	optfile = fopen(optfname, "w");
	if (optfile == NULL) {
	    fprintf(stderr, "Can't open %s\n", optfname);
	    exit(1);
	}
    }
    /* Set up entry_name */
      if (cflag || Xflag) {
	int ifname_len = strlen(actual_ifname);
	char * p;

	entry_name = (char *) malloc(ifname_len+1);
	strcpy(entry_name, actual_ifname);
	if (entry_name[ifname_len-2] == '.') {
	    entry_name[ifname_len - 2] = '\0';
	}
	/* Replace all slashes by periods. */
	  for (p = entry_name; *p != '\0'; p++) {
	    if (*p == '/') {
		*p = '.';
	    }
	  }
      } else {
        entry_name = "";
      }
    
    /* Set up correct line number, file name */
      if (!pflag) {
        yyinfnm = stt_enter(ifname, strlen(ifname)+1);
        yyline = 0;
        addposition(yyinfnm, yyline);
      }

    if (!Gflag) { Rflag = FALSE; }

    /* Set up correct input translation for in-line code */
      if (Gflag) {
	inline_cnvt = Ginline_cnvt;
      } else {
	inline_cnvt = Vinline_cnvt;
      }

    /*
     * Build syntax tree (pass 1).
     */
#       ifdef VERBOSE
	    fprintf(stderr, "Calling yyparse\n");
#	endif
	yyparse();


    if( yynerrs != 0 )
        exit(1);

    if( initflag ) {
        /* write out current core image (except for stack) as a loadable file */
                /* and quit */
            int rcxdescr;  /* output file descriptor */
            struct exec hdr;  /* header for file */
            unsigned sbrkval; /* least unused location */
	    long symtsize = 4; /* size of empty string table */
	    long end_text;
	    long page_size;
#           ifdef SUN
		long begin_data = roundup(((long) (&etext)), SEGSIZ);
#           endif

            /* make sure stdout buffer is empty in core image */
                fflush(stdout);

	    if ( (rcxdescr = creat((Gflag? "Grc.x" : "rc.x"),0755)) == -1 ) {
		fprintf(stderr, "Can't create %s\n",
			(Gflag? "Grc.x" : "rc.x"));
                exit(1);
            }
	    /* initialize hdr */
#               ifdef SUN
		    page_size = PAGSIZ;
#               else
#                   ifdef PYRAMID
			page_size = 2048;
#                   else
#                       ifdef RT
			    page_size = 2048;
#                       else
                            page_size = 1024;
#                       endif
#                   endif
#               endif
		sbrkval = (long) sbrk(0);
		if (dloadflag) {
#                   ifdef SUN
#                     ifdef LDBUG
			end_text = roundup((((long) &etext)-32), page_size);
			/* This is a kludge to avoid what looks like a    */
			/* SUN 3.0 ld bug.  It appears that etext is off  */
			/* by 32.                                         */
#                     else
			end_text = roundup(((long) &etext), page_size);
#                     endif
#                   else
			end_text = roundup(((long) &etext), page_size);
#                   endif
		} else {
		    end_text = (long) &etext;
		}
#               ifdef SUN
		    if (!dloadflag) {
			fprintf(stderr, "Use -d instead of -i\n");
			exit(1);
		    }
		    hdr.a_text = end_text - page_size;
#               else
		    hdr.a_text = end_text;
#               endif
		if (dloadflag) {
#                   ifdef VERBOSE
			fprintf(stderr,
				"Generating demand paged core image\n");
#                   endif
		    /* generate demand paged output */
			//		    hdr.a_magic = ZMAGIC;
		} else {
#                   ifdef VERBOSE
			fprintf(stderr,
				"Generating core image\n");
#                   endif
			//		    hdr.a_magic = OMAGIC;
		}
#               ifdef SUN
		    hdr.a_machtype = MACH_TYPE;
		    hdr.a_data = sbrkval - begin_data;
#               else
#                 ifdef RT
		    hdr.a_data = sbrkval - 0x10000000;
#                 else
		    /* Contiguous text and data segments */
		    hdr.a_data = sbrkval - end_text;
#                 endif
#               endif
		if (dloadflag) hdr.a_data = roundup(hdr.a_data,page_size);
		hdr.a_bss = 0;
		hdr.a_syms = 0;
#               ifdef SUN
		    hdr.a_entry = page_size + sizeof(struct exec);
#               else
		    hdr.a_entry = 0;
#               endif
		hdr.a_trsize = hdr.a_drsize = 0; /* no relocation */
	    /* Write the file */
		write(rcxdescr, &hdr, sizeof (struct exec));
#               ifdef SUN
		    /* Write text segment */
		      if (write(rcxdescr, hdr.a_entry,
				(end_text - hdr.a_entry)) == -1) {
			fprintf(stderr, "Couldn't write text segment\n");
			perror("Rc");
#                       ifdef UNDEFINED
			    fprintf(stderr,
			            "Descriptor:%X, start:%X, size:%X\n",
				    rcxdescr, hdr.a_entry,
				    end_text - hdr.a_entry);
#                       endif
			exit(* ((char *) 0x80000000));
		      }
		    /* Write new data segment */
		      if (write(rcxdescr, begin_data,
				sbrkval - begin_data) == -1) {
			fprintf(stderr, "Couldn't write data segment\n");
			perror("Rc");
			exit(1);
		      }
#               else
		    if (dloadflag)
			lseek(rcxdescr, page_size, 0);
#                   ifdef RT
		      if (write(rcxdescr, (char *) 0, end_text) == -1) {
			fprintf(stderr, "Couldn't write text segment\n");
			perror("Rc");
			exit(1);
		      }
		      if (write(rcxdescr, (char *)0x10000000,
					  sbrkval - 0x10000000)
			  == -1) {
			fprintf(stderr, "Couldn't write data segment\n");
			perror("Rc");
			exit(1);
		      }
#                   else
		      if (write(rcxdescr, (char *) 0, sbrkval) == -1) {
			fprintf(stderr, "Couldn't write initialized file\n");
			perror("Rc");
			exit(1);
		      }
#                   endif
#               endif
		/* Write an empty string table */
#                 ifdef SUN
		    lseek(rcxdescr,
			  hdr.a_data + hdr.a_text,
			  0);
#                 else
		    lseek(rcxdescr,
			  (dloadflag? page_size : sizeof (struct exec))
			  + hdr.a_data + hdr.a_text,
			  0);
#                 endif
		  write(rcxdescr, &symtsize, sizeof (long));
	     exit(0);
        }


    /*  printf("*** End of Russell parse       \n"); */
    build_Idtable();

    if( yynerrs != 0 )
	exit(1);

    /*
     *  Pass2 - build symbol table
     */ 
#	ifdef VERBOSE
	    fprintf(stderr, "Building symbol table\n");
#	endif
	build_symtab( stxtree );
	if (yynerrs != 0) exit(2);

    /*
     *  Pass3 - number tree nodes and fix up tree
     */

#	ifdef VERBOSE
	    fprintf(stderr, "Fixing up syntax tree\n");
#	endif
	fixup (stxtree);
	if (yynerrs != 0) exit(3);


    if (yydebug)
	prtree(stxtree);

    GC_dont_gc = FALSE;		/* Garbage collection may be useful during */
				/* signature checking.                     */


    /*
     *  Pass4 - signature deduction and checking
     */
	/* Set up the correct routine for in_line code */
	    if (Gflag) {
		spcl_to_inline = Gspcl_to_inline;
	    } else {
		spcl_to_inline = Vspcl_to_inline;
	    }

#	ifdef VERBOSE
	    fprintf(stderr, "Checking signatures\n");
#	endif
	tl_checksigs(stxtree);
        if (yynerrs != 0) exit(1);

    if (yydebug)
	prtree(stxtree);


    /*
     *  Pass 5 - abstract syntax tree or code generation
     */

#	ifdef VERBOSE
	    fprintf(stderr, "Generating code\n");
#	endif
	ofile = fopen(ofname, "w");
        if ( ofile == NULL ) {
            fprintf(stderr, "Can't create output file (%s)\n", ofname);
            exit(8);
	}
	if (aflag)
	    /* generate abstract syntax only */
		fprintf(stderr,
                        "Abstract syntax generation no longer implemented\n");
	else {
	    extern NODE * bld_den_seq_f();
	    extern NODE * signature_f();
	    extern NODE * first_elmnt();

	    /* generate vax or intermediate code */
                if (cflag) {
		    /* Partial compilation - need to write out signature */
		    /* and external file info                            */
		    if (Gflag) {
		      Ggeneratepcode( ofile, stxtree,
				      first_elmnt(bld_den_seq_f(insrtptr)) );
		    } else {
		      Vgeneratepcode( ofile, stxtree,
				      first_elmnt(bld_den_seq_f(insrtptr)) );
		    }
                    if (yynerrs > 0) exit(1);
                    sigfile = fopen(sigfname, "w");
                    if (sigfile == NULL) {
                        fprintf(stderr, "Can't open %s\n", sigfname);
                        exit(1);
		    }
		    /* Write &etext to allow checking of compiler version */
	                putw(&etext, sigfile);

		    /* Copy object file list to signature file */
		    /* Terminate with empty line               */
			{
			    extern FILE * objfilelist;
			    int c;

			    /* Probably still open for writing. */
			    /* Close and reopen                 */
				if (objfilelist != NULL) {
				    fclose(objfilelist);
				}
				objfilelist = fopen(OBJFILELIST, "r");
			    if (objfilelist != NULL) {
				while ((c = getc(objfilelist)) != EOF) {
				    putc(c, sigfile);
				}
			    }
			    putc('\n', sigfile);
			}
		    sig_out(sigfile, signature_f(insrtptr));
		    fclose(sigfile);
		} else if (Xflag) {
		    /* Generate externally callable versions of all   */
		    /* functions in a type expression.                */
		      GgenerateXcode( ofile, stxtree,
				      first_elmnt(bld_den_seq_f(insrtptr)) );
		} else {
		    if (Gflag) {
		      Ggeneratecode( ofile, stxtree );
		    } else {
		      Vgeneratecode( ofile, stxtree );
		    }
                    if (yynerrs > 0) exit(1);
                }
	}
	fflush( ofile );
    exit(0);
}
