###############################################################################
#
#	File:     main.icn
#
#	Subject:  russell language main program
#
#	Author:   Dennis J Darland
#
#	Date:     October - Novmber, 2015
#
###############################################################################
#
# Copyright 1986-1989 Hans-Juergen Boehm, Alan J. Demers, Kumar Srikantan,
# Vernon Lee, and Lucy Hederman.
# Copyright Digital Equipment Corporation & INRIA 1988, 1989.
# Copyright (c) 1990-1993 by Xerox Corporation.  All rights reserved.
#
# This material is provided as is, with no warranty expressed or implied.
# Any use is at your own risk.
# 
# Permission is hereby granted to copy this compiler for any non-commercial
# purpose, provided the above notices are retained on all copies.  Further
# restrictions apply to the DEC/INRIA BigNum package.  These are stated in
# the file runtime/BigNum/doc/bnbody.tex.
#
# This work uses the BigNum package developed jointly by INRIA and
# Digital PRL.  It has been modified by Hans-J. Boehm in August 1990
# and February 1993 at Xerox PARC.  When you receive this software,
# please send mail to librarian@prl.dec.com to inform them that you
# have a copy of the package.
###############################################################################
#
#   NOTE From Dennis J. Darland (11/2/2015)
#
#   I obtained the "c" language source code for "russell" copyrighted above
#   in the 1990's. I have made efforts to get it to work over the years, but
#   always failed. It has many hardware and OS dependancies. Now (October 2015
#   forward, I am tring to port to the language "Unicon". Practically every
#   line of code will need to be changed, as someing as simple as the
#   assignment operator is different. Also I will not use the BigNum package
#   mentioned above. Also I am doing this not for profit, and am sharing
#   freely. I am not at all confident that I will get it working well, but
#   believe in open source, so am sharing my work as I make progress.
#   Unicon is also much more portable.
#
###############################################################################


$include "defs.icn"
$include "global_vars.icn"
procedure main(args)
    local flagp,arg,arg_cnt,spcl_to_inline, it, dump_file, dump_file_sav
    &trace := 100000
    &dump := 1
    yyvline := 9999
    globals_init()
    open_my_files()
    rpt_info("Hello Russell!")
#   Initialize flags */
    dloadflag := initflag := BADflag := aflag := yydebug := FALSE
#    Initialize file name pointers. */
    ifname := ofname := sigfname := optfname := actual_ifname := ""
# Process Command Line Arguments
    arg_cnt := 0 # for after "-'s" - file names
    every(arg := !args) do {
	write("arg = ", arg)
	write("arg[1:2] = ", arg[1:2])
        case arg[1:2] of { # case 1
	    "-" : {  # -
		       write("case - ")
		       flagp := arg[2:0]
		       write("flagp = ",flagp)
		       case flagp of {   #case 2
			   "B": BADflag +:= 1
			   "D": yydebug +:= 1
			   "S": catchsigs()
			   "i": initflag := TRUE
			   "d":  {initflag := TRUE
				  dloadflag := TRUE
			      }
			   "a":  aflag := TRUE
			   "M":   Mflag := TRUE
			   "c":   cflag := TRUE
			   "p":   pflag := TRUE
			   "L":   Lflag := TRUE
			   "P":   Pflag := TRUE
			   "T":   Tflag := TRUE
			   "G":    Gflag := TRUE
			   "V":   Vflag := TRUE
			   "N":   Nflag := TRUE
			   "f":   fflag := TRUE
			   "F": { fflag := TRUE
				  Fflag := TRUE }
			   "R":  Rflag := TRUE
			   "O": {
			       if (OOflag = TRUE) then
				   OOOflag := TRUE
			       else if (Oflag = TRUE) then
				   OOflag := TRUE
			       else 
				   Oflag := TRUE
			   }
			   "X": Xflag := TRUE
			   "x": xflag := TRUE
			   "h": hflag := TRUE
			   default: {
			       write("illegal flag")
			   }
		       } 
		   }
	    default: {
		arg_cnt +:= 1
		write("arg_cnt = " || arg_cnt || " arg = " || arg)
		case integer(arg_cnt) of {
		    1: actual_ifname := arg 
		    2: ifname := arg
		    3: ofname := arg
		    4: if (cflag = TRUE) then sigfname := arg else if (OOflag = TRUE) then  optfname := arg 
		    5: if (OOflag = TRUE) then  optfname := arg 
		}
	
		}
	    }
	} # case 1
	# every
    rpt_opts()
    if (ofname == "") then {
	write(&errout, "Rc: Too few arguments\n")
	exit(1)
    }
    
    if (cflag = TRUE & sigfname == "") then {
	write(&errout, "Rc: Missing file name for signature info\n")
	exit(1)
    }
    if (OOflag = TRUE & optfname == "") then {
	write(&errout, "Rc: Missing file name for optimization info\n")
	exit(1)
    }
    
    if (Xflag = TRUE & Gflag ~= TRUE) then {
	write(&errout, "Vax code generator cannot be used with -X\n")
	exit(1)
    }
    
    if (Mflag = TRUE & Rflag = TRUE ) then {
	write (&errout, "-M contradicts -R, ignoring both\n")
	Mflag := Rflag := FALSE
    }


#  Initialize 
    if (/insrtptr ) then # no previous initialization has taken place 
    {
	initids()
	if (Gflag = TRUE) then {
	    init_RIC_table()
	}
    }

######################Parse init.r (cntrl-b) to create insrtptr ##############

    initflag := TRUE
#     open input file 
    if not(infile:= open("init.r","r")) then stop("cannot open ifname = init.r")
    # Set up correct line number, file name 
#    if (pflag = FALSE) then {
    yyinfnm := stt_enter("init.r", 6)
    yyline := 0
#        addposition(yyinfnm, yyline)
#    }

    if (Gflag = FALSE) then { Rflag := FALSE }

    # Set up correct input translation for in-line code 
    inline_cnvt := Ginline_cnvt
#
#      Build syntax tree (pass 1).
#
    if (VERBOSE = 1) then
	yyinfo("Calling yyparse")
    nodes_made_cnt := 0 
    lists_made_cnt := 0 

    yyparse()
##############################################################################
# CHECK insrtptr
    insrtptr :=  stxtree
# CHECK insrtptr
    pos_no := 1
    if \insrtptr then {
	visited := set()
	dump_file := open("nodetreehtml/dump" || pos_no || "_index_" || insrtptr.unique_id || ".html","w")
	head_html(dump_file,insrtptr)
	proc_dump_tree(dump_file,dump_file_sav,pos_no,"root","root",insrtptr)
	end_html(dump_file,insrtptr)
	close(dump_file)
	
    }
###############################################################################
    if( yynerrs ~= 0 ) then
        rpt_err("Parse Failed")
    
#######################now parse input file ##################################
    initflag := FALSE
#     open input file 
    if not(infile:= open(ifname,"r")) then stop("cannot open ifname = " || ifname)
    if (OOflag & optfname ~== "") then
	if not(optfile:= open(optfname,"w")) then stop("cannot open optfname = " || optfname)
# Set up entry_name 
    if (cflag | Xflag) then {
	
	entry_name := actual_ifname[0:-2]
	# Replace all slashes by periods. 
	map(entry_name,"/",".")
    } else {
        entry_name := "";
    }
    
    # Set up correct line number, file name 
#    if (pflag = FALSE) then {
    yyinfnm := stt_enter(ifname, *ifname)
    yyline := 0
#        addposition(yyinfnm, yyline)
#    }

    if (Gflag = FALSE) then { Rflag := FALSE }

    # Set up correct input translation for in-line code 
    inline_cnvt := Ginline_cnvt
#
#      Build syntax tree (pass 1).
#
    if (VERBOSE = 1) then
	yyinfo("Calling yyparse")
    nodes_made_cnt := 0 
    lists_made_cnt := 0 

    it := 1
    while it <= NLEVELS do {
	rpt_info("pend[" || it || "] = " || dump_info(pend[it]))
	it +:= 1
    }

    yyparse()

    if( yynerrs ~= 0 ) then
        rpt_err("Parse Failed")

    yyinfo("*** End of Russell parse")
############################################################################
# CHECK insrtptr
    pos_no := 2
    if \stxtree then {
	visited := set()
	dump_file := open("nodetreehtml/dump" || pos_no || "_index_" || stxtree.unique_id || ".html","w")
	head_html(dump_file,stxtree)
	proc_dump_tree(dump_file,dump_file_sav,pos_no,"root","root",stxtree)
	end_html(dump_file,stxtree)
#	close(dump_file)
    }
###############################################################################
    build_Idtable()
    write(symfile,"After build_Idtable() (pass1?) in main")
    list_Idtable()
    if( yynerrs ~= 0 ) then
	exit(1)

    #
    #  Pass2 - build symbol table
    # 
    yyinfo( "Building symbol table")

    sym2_table := build_symtab( stxtree )
    write(symfile,"After build_symtab() (Pass2) in main")
    list_Idtable()
    if (yynerrs ~= 0) then exit(2)
    list_ids(stxtree)
    #
    #  Pass3 - number tree nodes and fix up tree
    #
    
    yyinfo("Fixing up syntax tree")

    fixup(stxtree)
    if (yynerrs ~= 0) then exit(3)
############################################################################
# CHECK insrtptr
    pos_no := 3
    if \stxtree then {
	visited := set()
	dump_file := open("nodetreehtml/dump" || pos_no || "_index_" || stxtree.unique_id || ".html","w")
	head_html(dump_file,stxtree)
	proc_dump_tree(dump_file,dump_file_sav,pos_no,"root","root",stxtree)
	end_html(dump_file,stxtree)
	close(dump_file)
    }
###############################################################################
    #
    # Pass4 - signature deduction and checking
    #
    # Set up the correct routine for in_line code
    spcl_to_inline := Gspcl_to_inline
    yyinfo("Checking signatures")
    tl_checksigs(stxtree)
    if (yynerrs ~= 0) then exit(1)

############################################################################
# CHECK insrtptr
    pos_no := 4
    if \stxtree then {
	visited := set()
	dump_file := open("nodetreehtml/dump" || pos_no || "_index_" || stxtree.unique_id || ".html","w")
	head_html(dump_file,stxtree)
	proc_dump_tree(dump_file,dump_file_sav,pos_no,"root","root",stxtree)
	end_html(dump_file,stxtree)
	close(dump_file)
    }
###############################################################################
    #
    #  Pass 5 - abstract syntax tree or code generation
    #
    yyinfo("Generating code")
    if not(ofile := open(ofname,"w")) then stop("cannot open ofname = " || ofname)
    # generate vax or intermediate code 
    # Partial compilation - need to write out signature 
    # and external file info                            
    Ggeneratepcode( ofile, stxtree,first_elmnt(bld_den_seq_f(insrtptr)) )
    if (yynerrs > 0) then exit(1)
    if not(sigfile := open("sigfname","w")) then stop("cannot open sigfname = " || sigfname)

    # Copy object file list to signature file 
    # Terminate with empty line               

    # Probably still open for writing. 
    # Close and reopen                 
    if (\objfilelist) then {
	close(objfilelist)
    }
#DJDSTOP
    if not(objfilelist := open(OBJFILELIST,"r")) then stop("cannot open OBJFILELIST = " || OBJFILELIST)
    if (\objfilelist) then {
	while (line := read(objfilelist)) do {
	    write( sigfile, line)
	}
	write( sigfile,"")
    }
    sig_out(sigfile, signature_f(insrtptr))
    close(sigfile)
    Ggeneratecode( ofile, stxtree )
    if (yynerrs > 0) then exit(1)
    close( ofile )
#DJDSTART
    list_Idtable()
    rpt_stats()
    exit(0)
end


