%------------------------------------------------------------- Spindle Build --
% This takes a .M3CONF file generated by the compiler and constructs a
% package.conf file which lists the object files in an extension in
% a correct initialization order. It also remembers the order in the
% GLOB_ORDER variable so that a glob file can be built in the same
% order.

% HISTORY
% 25-Sep-96  Marc Fiuczynski (mef) at the University of Washington
%	Split out from IX86_SPIN and ALPHA_SPIN

# taken from the quake.ints template.
# Quake is weak on integers but since it is turing complete, they can
# be emulated painfully

INC_NEXT = ["1","2","3","4","5","6","7","8","9","0"]
DEC_NEXT = ["9","0","1","2","3","4","5","6","7","8"]
INT_POS = ["5","4","3","2","1","0"]

proc init_int() is
  return ["0","0","0","0","0","0"]
end

proc inc_int(x) is
  local carry = " "

  foreach i in INT_POS
    if carry
      x[i] = INC_NEXT[x[i]]
      if equal(x[i],"0")
        carry = " "
      else
        carry = ""
      end
    end
  end
end

proc dec_int(x) is
  local carry = " "

  foreach i in INT_POS
    if carry
      x[i] = DEC_NEXT[x[i]]
      if equal(x[i],"9")
        carry = " "
      else
        carry = ""
      end
    end
  end
end

# 
proc int_to_string(x) is
  if not (equal (x[4],"0") and equal (x[3],"0") and equal (x[2],"0") and equal (x[1],"0") and equal (x[0],"0"))
    if not (equal (x[3],"0") and equal (x[2],"0") and equal (x[1],"0") and equal (x[0],"0"))
      if not (equal (x[2],"0") and equal (x[1],"0") and equal (x[0],"0"))
        if not (equal (x[1],"0") and equal (x[0],"0"))
          if not (equal (x[0],"0"))
            return x[0] & x[1] & x[2] & x[3] & x[4] & x[5]
          end
          return x[1] & x[2] & x[3] & x[4] & x[5]
        end				
        return x[2] & x[3] & x[4] & x[5]
      end
      return x[3] & x[4] & x[5]
    end
    return x[4] & x[5]
  end
  return x[5]
end

proc array_length(x) is
  local l = init_int()

  foreach i in x
    inc_int(l)
  end
  return l
end

proc iterate(iter,procVar,index,array_or_table,arg1,arg2,arg3) is
    foreach i in array_or_table
	procVar(index,array_or_table,arg1,arg2,arg3)
	iter(index)
    end    
end

proc ConfFileIter(index,initOrder,objTable,userObjs,globorder) is
    local i = initOrder{int_to_string(index)}
    local fileName = i[0] & i[1]
    if objTable contains fileName and not userObjs contains fileName
    	write(PACKAGE, "/", BUILD_DIR, "/", fileName, CR)
	globorder += fileName
    end
end

proc M3ConfFileIter(index,initOrder,objTable,newindex,unused2) is
    local j = int_to_string(index)
    local i = initOrder{j}
    local fileName = i[0] & i[1]
    if objTable contains fileName
	local k = int_to_string(newindex)
    	write("Objects{\"",k,"\"} = [\"",i[0],"\",\"",i[1],"\"]",CR)
	inc_int(newindex)
    end
end

GLOB_ORDER = []
readonly proc GenerateConfFile() is
    local OBJECTS_TABLE = {}
    local USER_OBJS = {}
    local Filename = PACKAGE_DIR & "/" & BUILD_DIR & "/" & PACKAGE & ".conf"
    local quakeconf = PACKAGE_DIR & "/" & BUILD_DIR & "/.M3CONF"
    include(quakeconf)

    GLOB_ORDER = []

    foreach object in COMPILE_OBJECTS
	OBJECTS_TABLE{object} = ""
    end
    foreach object in SIEG_USER_OBJS 
	USER_OBJS {object} = ""
    end

    > Filename in
	# The InitOrder quake table is generated by m3linker/src/MxGen.m3.
	local i = init_int()

	iterate(inc_int,ConfFileIter,i,InitOrder,OBJECTS_TABLE,USER_OBJS,GLOB_ORDER)

	% The .o objects are not included in the .M3CONF file,
	% so we add them in as the last files in the initialization 
	% order.
	foreach object in NON_M3_OBJECTS 
	  local fileName = object & NON_M3_OBJECTS{object}
	  if not USER_OBJS contains fileName
	    write(PACKAGE, "/", BUILD_DIR, "/", fileName, CR)
	    GLOB_ORDER += fileName
	  end
	end
    end

    % now write it out so it can be read back into quake
    >> quakeconf in

	write ("# Added by templates/ALPHA_SPIN",CR)
	write ("ObjectPath = \"",PACKAGE_DIR,SL,BUILD_DIR, SL,"\"",CR) 
        write ("Objects = {}",CR)
	i = init_int()
	local newindex = init_int()
	iterate(inc_int,M3ConfFileIter,i,InitOrder,OBJECTS_TABLE,newindex,"")
	
	% The .o objects are not included in the .M3CONF file,
	% so we add them in as the last files in the initialization 
	% order.
	foreach object in NON_M3_OBJECTS 
	  local file = object
	  local ext  = NON_M3_OBJECTS{object}
     	  write("Objects{\"",int_to_string(newindex),"\"} = [\"",file,"\",\"",ext,"\"]",CR)
	  inc_int(newindex)
	end

        write ("ImportedDomains = [", CR)
	first = "true"
	foreach domain in IMPORTED_DOMAINS 
	    if not first 
	      write(" ,")
	    end
	    write(" \"", IMPORTED_DOMAINS{domain},"\"",  CR)
	    first = ""
	end
	write("] ", CR)

    end

end

# This procedure writes a SPIN shell script which can create and link a domain.
# They look something like this:
# domain create myDomain
# domain addfile Important.io
# domain addfile Important.mo
# ... add other object files which are part of the domain...
#
# domain link myDomain myDomain
# domain link myDomain SpinPublic
# ... link to other imported domains ...
# 
# domain run myDomain

readonly proc GenerateDomainScript() is
    local Filename = PACKAGE_DIR & "/" & BUILD_DIR & "/" & PACKAGE & ".rc"
    local userdir = normalize(THISTREE&"/user",PACKAGE_DIR)

    > Filename in
        write("# This script file automatically generated by SPINCOMMON template", CR)
        write(CR, "domain quiet ", CR)
        write(CR, "domain create ", PACKAGE, CR, CR)

	foreach file in GLOB_ORDER
	    write("domain addfile ", PACKAGE, " ")
	    write("~/spin/user/", userdir, "/", BUILD_DIR, "/", file, CR)
    	end

	write(CR, "domain link ", PACKAGE, " ", PACKAGE, CR)

	# This relies on the way IMPORTED_DOMAINS is set up by the
	# DomainImport procedure
	foreach domain in IMPORTED_DOMAINS 
	    write("domain link ", PACKAGE, " ", IMPORTED_DOMAINS{domain}, CR)
	end

	write("domain run ", PACKAGE, CR)
    end
end

# This procedure writes a C file which can be statically linked to 
# the SPIN kernel and will make the calls to dynamically link a domain.

proc generateExtensionCodehooks() is
end

readonly proc GenerateExtensionCode() is
    local Filename = PACKAGE_DIR & "/" & BUILD_DIR & "/extend_" & PACKAGE & ".c"

    > Filename in
        write("/* This file automatically generated by SPINCOMMON template", CR)
        write("   Returns 1 on success, 0 on failure.", CR)
        write("*/", CR)

	generateExtensionCodehooks()

        write(CR, PACKAGE, "_extension()", CR, "{", CR)
	write("\textern unsigned long encap_", PACKAGE, "_list[];", CR)
	write("\tint i;", CR)
	write("\tlong domain, d;", CR, CR)

	write("\tdomain = USyscall_DomainCreate(\"", PACKAGE, "\");", CR)
	write("\tfor (i=0; encap_",PACKAGE,"_list[i+1]; ++i)",CR)
	write("\t\tUSyscall_DomainLoad(domain, encap_", PACKAGE, "_list[i],", CR)
	write("\t\t\tencap_", PACKAGE, "_list[i+1]-encap_", PACKAGE, 
	      "_list[i]);", CR, CR)
	

	# This relies on the way IMPORTED_DOMAINS is set up by the
	# DomainImport procedure
	foreach domain in IMPORTED_DOMAINS 
	    write("\tif (!(d=USyscall_DomainLookup(\"", IMPORTED_DOMAINS{domain},
	          "\"))) return 0;", CR)
	    write("\tUSyscall_DomainLink(domain,d);", CR)
	end

	write(CR, "\tUSyscall_DomainLink(domain,domain);", CR)
	write("\treturn USyscall_DomainInitialize(domain);", CR)
	write("}", CR, CR)
    end
end

% Extension performs the final steps to make an extension out of the
% files that are in the COMPILE_OBJECTS array. The "options" argument
% is a table, in order that we can use the quake "contains" expression.
% Extension does the following:
% 	Call Domain() to construct the ..InterfaceDefs.. files which
%	will export the symbols from this domain.
%	Compile the object files with the Library() call.
%       Generate a conf file in good modula-3 initialization order.
%	If you specify the "glob" option it will build a single object
%	file combining all of the files in the domain.
%	If you specify the "bootstrap" option it will build the glob
%	file and create the bootstrap module which links this domains
%	to the ones that it imports.
%	Finally, it creates the .M3DOMAINS file which describes the
%	domain at compile time to other extensions which want to 
%	import it.
readonly proc Extension(options) is
    local DomainName = PACKAGE
    local spindle_glob = format ("%s.glob",EXTENSION_NAME)
    local glob_cmd = format("@- ld -T 0 -expect_unresolved \"*\" -o %s",spindle_glob)

    % An unnamed extension cannot export any symbols to other
    % domains. This is fine for small test extensions.
    if not equal(EXTENSION_NAME, "") 
	Domain(EXTENSION_NAME)
    end

    m3_option("-GenConfFile .M3CONF")
    m3_option("-Y3@true@")
    m3_option("-Y4@touch@")

    Library(DomainName)

    GenerateConfFile()

    GenerateDomainScript()

    GenerateExtensionCode()

    if options contains "glob" or options contains "bootstrap"
        if equal(EXTENSION_NAME, "") 
	    write("You must provide a name for an extension")
	    write(" with a glob or bootstrap option.\nUse the")
	    write(" Package() command to set the name\n")    

	    return
	end

	if stale (spindle_glob, GLOB_ORDER)
	    write ("Linking ", spindle_glob, CR)
	    exec (glob_cmd, GLOB_ORDER)
        end

	if options contains "bootstrap"
	    % save old m3 options
	    local OLD_M3OPTIONS = M3OPTIONS
	    m3_option("-SpinRelax")
	    gen_bootstrap_glob(EXTENSION_NAME)
	    M3OPTIONS = OLD_M3OPTIONS
	end
    end

    gen_domain_file()
end

readonly proc PackageLocation(p, dir) is
    override(p, dir)
end

readonly proc PackageImport(p) is
    import(p)
end

%-------------------------------------------------------------------------
% Checks interface records to tell you if some functions are declared by
% an interface but not defined by a module
readonly proc check_interface_records(x) is
  args = ["-o", x]
  if defined("_all")
    write ("Checking interface records of ",x,".",CR) 
    before_do_m3_hooks()
    generate_tfile()
    local sources = arglist("-F", [M3SEARCH_TABLES, COMPILE_SOURCES,
				   IMPORT_LIBS, OTHER_LIBS_L])
    exec("@" & M3, M3_CONFIG, "-make", M3OPTIONS, args, sources)
    write ("Track down the uninitialized interface records",CR)
    write ("if an 'incomplete program' fatal error occurs.",CR)
  end
end


%-------------------------------------------- domain management routines ---

IMPORTED_DOMAINS 	= {}                     % imported domains
IMPORTED_PKG	 	= {}                     % imported pkg
readonly M3DOMAINS	= ".M3DOMAINS"

readonly proc DomainLink(domainname,p) is
	local domainpackagename = format("%s%s%s",p,domainname,BUILD_DIR)
	IMPORTED_DOMAINS{domainpackagename} = domainname
end

readonly proc DomainImport(domainname,subdir,p,overrides) is
	override_subdir(subdir,p,overrides)
	DomainImport_version (p, domainname, BUILD_DIR)
end

readonly proc DomainImport_version (p, domainname, version) is
	local domainexport = M3EXPORTS & "." & domainname
	local domainpackagename = format("%s%s%s",p,domainname,version)
	local dn = format ("%s%s%s%s%s", Pkg(p), SL, version, SL, M3DOMAINS)
	if equal (p, BUILD_PACKAGE)
	    error (format ("cannot import Domain into itself: \"%s\"%s%s", p, CR, CR))
	end
	if not IMPORTED_PKG contains p
		IMPORTED_PKG{p} = version
		M3include (dn, M3DOMAINS, version, p)
	end	
	if not IMPORTED_DOMAINS contains domainpackagename
		local fn = format ("%s%s%s%s%s", Pkg(p), SL, version, SL, domainexport)
		IMPORTED_DOMAINS{domainpackagename} = domainname
		M3include (fn, domainexport, version, p)
	end
end


########################################################################
#
# SPIN Domain creation support.
#

# dummy functions to be implemented by spin specific code
proc build_domain_interface(modules) is
end

proc authinterface (I, module, vis) is
end

DOMAINTABLE = {}	# -> table of all created domains.
TYPETABLE = {}		# -> table mapping symbol names to data and Text.
CSYMTABLE = {}          # -> remember all of the C symbols exported.
UNSAFEDOMAINS = {}      # interfaces exporting C symbols are unsafe.
VISIBILITY = {}		# have to remember visibility between DomainCreate
			# and Domain calls
TRANSLATIONTABLE = {}	# -> table to support the renaming of symbols.

readonly proc DomainSymbolName(sym) is
	if TRANSLATIONTABLE contains sym 
		return TRANSLATIONTABLE{sym}
	else
		return ""
	end
end

readonly proc DomainTypeName(sym) is
	if TYPETABLE contains sym 
		return TYPETABLE{sym}
	else
		return ""
	end
end

readonly proc _genericDomainCreate(domain,vis) is
	if not DOMAINTABLE contains domain
		DOMAINTABLE{domain} = []     # empty domain array
		VISIBILITY{domain} = "VISIBLE"
	else
		write("WARNING: Domain ", domain, " already created.",CR)
	end
end

readonly proc GenericDomainCreate(domain) is
	_genericDomainCreate(domain,VISIBLE)
end

	
readonly proc genericDomainCreate(domain) is
	_genericDomainCreate(domain,HIDDEN)
end


readonly proc DomainCreate(domain) is
	GenericDomainCreate(domain)
end

readonly proc domainCreate(domain) is
	genericDomainCreate(domain)
end

readonly proc _domainexport(thedomain,sym,symtype,symname) is 
	local modules = []
	local foo = ""

	if TRANSLATIONTABLE contains sym
		if not equal (TRANSLATIONTABLE{sym},symname)
			write ("PANIC: Symbol name mapping table already contains symbol ", sym , " as ", TRANSLATIONTABLE{sym}, CR)
#		else
#			write ("WARNING: duplicate ", sym, " as ", TRANSLATIONTABLE{sym}, " in translation table.", CR)
		end
	else
		TRANSLATIONTABLE{sym} = symname
	end


	if DOMAINTABLE contains thedomain 
		DOMAINTABLE{thedomain} += sym # add a table element to the domain array

		if TYPETABLE contains sym 
			if not equal(TYPETABLE{sym},symtype)
				write("PANIC: symbol ", sym, " already defined as type ", TYPETABLE{sym},CR)
#			else
#				write("WARNING: duplicate ", sym, " as ", TYPETABLE{sym}," in type table.", CR)
			end
		else 
			TYPETABLE{sym} = symtype
		end
#		write("Added ",sym, " as " , symtype, " to ", thedomain,CR)
#		modules = DOMAINTABLE{thedomain}
#		write("Modules in ", thedomain, " are ")
#		foreach iface in modules
#			write("[",iface, " as ", TYPETABLE{iface}, "]" )
#		end
#		write (CR)

	else
		write("Unknown domain ", domain, ".  Please use DomainCreate() first.",CR)
	end
end

readonly proc _domainexportCsymbol(thedomain,sym,symtype,symname) is 
	local modules = []
	local foo = ""

	if TRANSLATIONTABLE contains sym
		if not equal (TRANSLATIONTABLE{sym},symname)
			write ("PANIC: Symbol name mapping table already contains symbol ", sym , " as ", TRANSLATIONTABLE{sym}, CR)
#		else
#			write ("WARNING: duplicate ", sym, " as ", TRANSLATIONTABLE{sym}, " in translation table.", CR)
		end
	else
		TRANSLATIONTABLE{sym} = symname
		CSYMTABLE{sym} = symname
	end


	if DOMAINTABLE contains thedomain 
		UNSAFEDOMAINS{thedomain} = "true"
		DOMAINTABLE{thedomain} += sym # add a table element to the domain array

		if TYPETABLE contains sym 
			if not equal(TYPETABLE{sym},symtype)
				write("PANIC: symbol ", sym, " already defined as type ", TYPETABLE{sym},CR)
#			else
#				write("WARNING: duplicate ", sym, " as ", TYPETABLE{sym}," in type table.", CR)
			end
		else 
			TYPETABLE{sym} = symtype
		end
	else
		write("Unknown domain ", domain, ".  Please use DomainCreate() first.",CR)
	end
end

DOMAIN_INTERFACE_SOURCES = {}
readonly proc DomainExport(thedomain, I) is
	local sym = I
	local iface = I & ".i3"
	if INTERFACE_SOURCES contains iface
		_domainexport(thedomain, sym, "scData", sym)
		DOMAIN_INTERFACE_SOURCES{sym} = iface
	else
		write("PANIC: Unknown interface: ", I, CR)
	end
end

readonly proc DomainExportUnsafe(thedomain, I) is
	UNSAFEDOMAINS{thedomain} = "true"
	DomainExport(thedomain,I)
end

readonly proc DomainExportText(thedomain, I) is
	write ("DOMAIN_EXPORT_TEXT", CR)
	local sym = I
	_domainexport(thedomain, sym, "scText", sym)
end

readonly proc DomainExportData(thedomain, I) is
	write ("DOMAIN_EXPORT_DATA", CR)
	local sym = I
	_domainexport(thedomain, sym, "scData", sym)
end

readonly proc compressDomain(domain) is
	local t = {}
	if DOMAINTABLE contains domain
		foreach i in DOMAINTABLE{domain}
			t{i} = ""
		end
		DOMAINTABLE{domain} = [t]
	end
end

readonly proc Domain(domain) is 
	local tmp =  M3EXPORTS & "." & domain
	local isources = {}
	local modules = []
	proc gen_unit_domain_map(s, t) is
		foreach e in s
		  local u = s{e}
		  if is_local(u)
		    local loc = unit_loc(u)
		    write ("_map_add_", t, "(\"", escape(e),
		              "\", \"", escape(loc_pkg(loc)),
		              "\", \"", escape(loc_subdir(loc)),
		              "\", \"", unit_visibility(u), "\")", CR)
		  end
		end
	end


	if DOMAINTABLE contains domain 
		compressDomain(domain)
		modules = DOMAINTABLE{domain}
	else
		write("Whoops, something went south.",CR)
	end
	build_domain_interface(modules)

	if UNSAFEDOMAINS contains domain
		unsafeauthinterface(domain,VISIBILITY{domain})
	else
		authinterface(domain,VISIBILITY{domain})
	end

	foreach iface in modules 
		foreach sym in iface
			if DOMAIN_INTERFACE_SOURCES contains sym
				local unit = DOMAIN_INTERFACE_SOURCES{sym}
				
				% output the unit map
				if INTERFACE_SOURCES contains unit
#					write("INFO: Found ", sym, " interface in " , domain, " domain.", CR)
					isources{unit} = INTERFACE_SOURCES{unit}
				else
					write("PANIC: didn't find ", unit, " in INTERFACE_SOURCES.",CR)
				end
			end
		end
	end
	> tmp in
		gen_unit_domain_map(isources, "interface")
	end
end

readonly proc gen_domain_file() is
 > M3DOMAINS in
    write ("_define_lib(\"", BUILD_LIB, "\")", CR)
    % copy forward overrides
    foreach ov in PKG_OVERRIDES
      write("override(\"", escape(ov), "\", \"",
             escape(PKG_OVERRIDES{ov}), "\")", CR)
    end

    % copy forward package imports
    foreach im in IMPORTS
      local version = IMPORTS{im}
      write("import_version(\"", escape(im), "\", \"",
             escape(version), "\")", CR)
    end

    % copy forward domain package imports
    foreach im in IMPORTED_PKG
      local version = IMPORTED_PKG{im}
      write("import_version(\"", escape(im), "\", \"",
             escape(version), "\")", CR)
    end

    % output the library imports
    foreach l in M3LIBS
      local u = M3LIBS{l}
      if is_local(u)
        local loc = unit_loc(u)
        write("_import_m3lib(\"", escape(l), "\", \"", escape(loc_pkg(loc)),
                  "\", \"", escape(loc_subdir(loc)), "\")", CR)
      end
    end

    % dump the rest, including the _import_template() calls
    foreach x in TFILE_ARGS
      write(escape(x))
    end

#    gen_unit_map(INTERFACE_SOURCES, "interface")
    gen_unit_map(GENERIC_INTERFACE_SOURCES, "generic_interface")
    gen_unit_map(GENERIC_MODULE_SOURCES, "generic_module")
 end
end

S_INPUTS  = {}  		 % local assembler files & their objects
readonly proc derived_s (x) is
  local fn = x & ".s"
  S_SOURCES{fn} = [Location(BUILD_PACKAGE, BUILD_DIR), HIDDEN, LOCAL]
  S_INPUTS {x} = fn
  H_DIRS{"."} = "."
  COMPILE_SOURCES += fn
  DERIVED_SOURCES{fn} = fn
  pgm_object(x, OBJ_ext)
  deriveds(x, s_extensions)
  deriveds(fn, no_extension)
end

%-------------------------------------------------- Simple build procedures ---
% EXTENSION_NAME is set by the Package procedure and used by the new definitions
% of Module and Interface.

EXTENSION_NAME = ""

readonly proc Package(x) is
  EXTENSION_NAME = x
  DomainCreate(x)
end

proc interface_hooks(x,vis) is
  if not equal(EXTENSION_NAME, "")
    if equal(VISIBLE,vis)
      DomainExport(EXTENSION_NAME, x)
    end
  end
end
