* interp/c-util.boot (instantiationArgs): New.

	(domainDirectory): Likewise.
	(domainLookupFunction): Likewise.
	(domainOperatorTable): Likewise.
	(domainAttributes): Likewise.
	(domainPredicates): Likewise.
	(domainData): Likewise.
	* interp/buildom.boot: Use new domain accessors.
	* interp/functor.boot: Likewise.
	* interp/interop.boot: Likewise.
	* interp/nruncomp.boot: Likewise.
	* interp/nrunfast.boot: Likewise.

8 files changed, 65 insertions, 28 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 1c3822e3..8a0aad99 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2011-08-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/c-util.boot (instantiationArgs): New.
+	(domainDirectory): Likewise.
+	(domainLookupFunction): Likewise.
+	(domainOperatorTable): Likewise.
+	(domainAttributes): Likewise.
+	(domainPredicates): Likewise.
+	(domainData): Likewise.
+	* interp/buildom.boot: Use new domain accessors.
+	* interp/functor.boot: Likewise.
+	* interp/interop.boot: Likewise.
+	* interp/nruncomp.boot: Likewise.
+	* interp/nrunfast.boot: Likewise.
+
 2011-08-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/ast.boot (shoeCompTran1): Translate extended vector-forms.
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in
index bb7f11e7..6ad6e102 100644
--- a/src/algebra/Makefile.in
+++ b/src/algebra/Makefile.in
@@ -520,13 +520,17 @@ strap-1/%.$(FASLEXT): %.spad strap-1/.started
 	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \
 		cp $*.NRLIB/code.$(FASLEXT) $@ && \
 		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-1/$*-.$(FASLEXT); else : ; fi
+			strap-1/$*-.$(FASLEXT); else : ; fi && \
+		if test x@oa_keep_files@ = xyes; then \
+			cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi
 
 strap-2/%.$(FASLEXT): %.spad strap-2/.started
 	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \
 		cp $*.NRLIB/code.$(FASLEXT) $@ && \
 		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-2/$*-.$(FASLEXT); else : ; fi
+			strap-2/$*-.$(FASLEXT); else : ; fi && \
+		if test x@oa_keep_files@ = xyes; then \
+			cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi
 
 
 SPADFILES= \
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 514a6312..dd01f4a1 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -175,7 +175,7 @@ lookupInDomainAndDefaults(op,sig,domain,dollar,useDefaults) ==
 
 
 basicLookup(op,sig,domain,dollar) ==
-  item := domainRef(domain,1)
+  item := domainDirectory domain
   cons? item and first item in '(lookupInDomain lookupInTable) => 
     lookupInDomainVector(op,sig,domain,dollar)
   ----------new world code follows------------
@@ -332,16 +332,14 @@ Record(:args) ==
   dom := newShell(nargs + 10)
   -- JHD added an extra slot to cache EQUAL methods
   canonicalForm(dom) := ["Record", :srcArgs]
-  domainRef(dom,1) :=
+  domainDirectory(dom) :=
     ["lookupInTable",dom,
 	[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	  ["~=",[[$Boolean,"$","$"],:0]], 
             ["hash",[[$SingleInteger,"$"],:0]],
                ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
-  domainRef(dom,2) := nil
   domainRef(dom,3) := ["RecordCategory",:instantiationArgs dom]
   domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
-  domainRef(dom,5) := nil
   for i in $FirstParamSlot.. for a in args repeat
     domainRef(dom,i) := third a
   domainRef(dom,$FirstParamSlot + nargs) := [function RecordEqual, :dom]
@@ -405,16 +403,14 @@ Union(:args) ==
   nargs := #args
   dom := newShell (nargs + 9)
   canonicalForm(dom) := ["Union", :srcArgs]
-  domainRef(dom,1) :=
+  domainDirectory(dom) :=
     ["lookupInTable",dom,
        [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	 ["~=",[[$Boolean,"$","$"],:0]],
            ["hash", [[$SingleInteger,"$"],:0]],
               ["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]]
-  domainRef(dom,2) := nil
   domainRef(dom,3) := ["UnionCategory",:instantiationArgs dom]
   domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
-  domainRef(dom,5) := nil
   for i in $FirstParamSlot.. for a in args repeat
     domainRef(dom,i) := a
   domainRef(dom,$FirstParamSlot + nargs) := [function UnionEqual, :dom]
@@ -474,16 +470,14 @@ Mapping(:args) ==
   nargs := #args
   dom := newShell(nargs + 9)
   canonicalForm(dom) := ["Mapping", :srcArgs]
-  domainRef(dom,1) :=
+  domainDirectory(dom) :=
     ["lookupInTable",dom,
        [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	 ["~=",[[$Boolean,"$","$"],:0]],
            ["hash", [[$SingleInteger,"$"],:0]],
               ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
-  domainRef(dom,2) := nil
   domainRef(dom,3) := $SetCategory
   domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
-  domainRef(dom,5) := nil
   for i in $FirstParamSlot.. for a in args repeat
     domainRef(dom,i) := a
   domainRef(dom,$FirstParamSlot + nargs) := [function MappingEqual, :dom]
@@ -516,7 +510,7 @@ Enumeration(:"args") ==
   dom := newShell(2 * nargs + 9)
   -- JHD added an extra slot to cache EQUAL methods
   canonicalForm(dom) := ["Enumeration",:args]
-  domainRef(dom,1) :=
+  domainDirectory(dom) :=
     ["lookupInTable",dom,
 	[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	  ["~=",[[$Boolean,"$","$"],:0]],
@@ -526,10 +520,8 @@ Enumeration(:"args") ==
                   :[[arg,[["$"],:oldConstantSlodCode(nargs+3+i)]]
                       for arg in args for i in 0..]
                           ]]
-  domainRef(dom,2) := nil
   domainRef(dom,3) := ["EnumerationCategory",:instantiationArgs dom]
   domainRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
-  domainRef(dom,5) := nil
   for i in $FirstParamSlot.. for a in args repeat
     domainRef(dom,i) := a
   domainRef(dom,$FirstParamSlot + nargs) := [function EnumEqual, :dom]
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index f7fd2dc4..db2c8554 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -73,6 +73,10 @@ macro instantiationCtor d ==
 macro instantiationArgs d ==
   canonicalForm(d).args
 
+++ Return the number of arguments used to instantiate a domain object.  
+macro instantiationArity d ==
+  # instantiationArgs d
+
 ++ Return the list of operations exported by a category object
 macro categoryExports d ==
   categoryRef(d,1)
@@ -85,11 +89,33 @@ macro categoryAttributes d ==
 macro categoryHierarchy c ==
   categoryRef(c,4)
 
+++ Reference a 3-list
+++   [lookupFunction,thisDomain,optable]
+++ necessary for function lookup in a domain:
+macro domainDirectory d ==
+  domainRef(d,1)
+
+++ Reference the lookup function of a domain object
+macro domainLookupFunction d ==
+  first domainDirectory d
+  
+++ Reference the operator-code table of a domain object.  
+macro domainOperatorTable d ==
+  third domainDirectory d
+
+++ Reference the list of (attribute, predIndex) pairs for this domain.
+macro domainAttributes d ==
+  domainRef(d,2)
+  
 ++ Return the predicate values associated with the domain object.
 ++ This is an integer interpreted as bit vector
 macro domainPredicates d ==
   domainRef(d,3)
 
+++ Return a 3-element dotted list of address data for a domain.
+macro domainData d ==
+  domainRef(d,4)
+
 --%
 
 ++ List of category constructors that do not have entries in the 
@@ -268,7 +294,7 @@ declareUnusedParameters x == (augment x; x) where
 
 devaluate d ==
   not vector? d => d
-  QVSIZE d > 5 and vectorRef(d,3) is ['Category] => canonicalForm d
+  categoryObject? d => canonicalForm d
   QVSIZE d > 0 =>
     d' := canonicalForm d
     isFunctor d' => d'
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 94619b9d..8c6fc79c 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -351,7 +351,7 @@ SetDomainSlots124(vec,names,vals) ==
   l := pairList(names,vals)
   vectorRef(vec,1) := sublisProp(l,vectorRef(vec,1))
   vectorRef(vec,2) := sublisProp(l,vectorRef(vec,2))
-  l:= [[a,:devaluate b] for a in names for b in vals]
+  l := [[a,:devaluate b] for a in names for b in vals]
   vectorRef(vec,4) := applySubst(l,vectorRef(vec,4))
   vectorRef(vec,1) := applySubst(l,vectorRef(vec,1))
  
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 6c009c64..28408072 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -521,7 +521,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
   nil
 
 hashNewLookupInCategories(op,sig,dom,dollar) ==
-  slot4 := vectorRef(dom,4)
+  slot4 := domainData dom
   catVec := second slot4
   # catVec = 0 => nil                      --early exit if no categories
   integer? KDR catVec.0 =>
@@ -658,7 +658,7 @@ HasCategory(domain,catform') ==
   catform:= devaluate catform'
   integer? domainRef(domain,3) => newHasCategory(domain,catform)
   domain0 := canonicalForm domain -- handles old style domains, Record, Union etc.
-  slot4 := domainRef(domain,4)
+  slot4 := domainData domain
   catlist := slot4.1
   member(catform,catlist) or
    opOf(catform) in '(Object Type) or  --temporary hack
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 873b9429..527b5bf5 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -424,10 +424,10 @@ stuffDomainSlots dollar ==
   for i in (6 + # rest domname)..maxIndex template
     | item := vectorRef(template,i) repeat
       stuffSlot(dollar,i,item)
-  vectorRef(dollar,1) := LIST(lookupFunction,dollar,infovec.1)
-  vectorRef(dollar,2) := infovec.2
+  domainDirectory(dollar) := LIST(lookupFunction,dollar,infovec.1)
+  domainAttributes(dollar) := infovec.2
   proto4 := infovec.3
-  vectorRef(dollar,4) := 
+  domainData(dollar) := 
     vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4]   --old style
     bitVector := domainPredicates dollar
     predvec := first proto4
@@ -443,7 +443,7 @@ getLookupFun infovec ==
 
 makeSpadConstant [fn,dollar,slot] ==
   val := FUNCALL(fn,dollar)
-  u := vectorRef(dollar,slot)
+  u := domainRef(dollar,slot)
   u.first := function IDENTITY
   u.rest := val
   val
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 23614946..b679ec8b 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -61,12 +61,12 @@ initNewWorld() ==
   $doNotCompressHashTableIfTrue := true
  
 getDomainByteVector dom == 
-  CDDR domainRef(dom,4)
+  CDDR domainData dom
 
 ++ Return the sequence of categories `dom' belongs to, as a vector
 ++ of lazy category forms.
 getDomainCategoriesVector dom ==
-  second domainRef(dom,4)
+  second domainData dom
 
 ++ Same as getDomainCategoriesVector except that we return a list of
 ++ input forms for the categories.
@@ -266,7 +266,7 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
 --       Category Default Lookup (from goGet or lookupInAddChain)
 --=======================================================
 newLookupInCategories(op,sig,dom,dollar) ==
-  slot4 := domainRef(dom,4)
+  slot4 := domainData dom 
   catVec := second slot4
   # catVec = 0 => nil                      --early exit if no categories
   integer? KDR canonicalForm catVec =>
@@ -338,7 +338,7 @@ newLookupInCategories1(op,sig,dom,dollar) ==
   if $monitorNewWorld then sayBrightly concat('"----->",
     form2String devaluate dom,'"-----> searching default packages for ",op)
   predvec := domainPredicates dom
-  slot4 := domainRef(dom,4)
+  slot4 := domainData dom
   packageVec := first slot4
   catVec := second slot4
   --the next three lines can go away with new category world
@@ -493,7 +493,7 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
 
 lookupInDomainByName(op,domain,arg) ==
   arg isnt [.,:.] => nil
-  opvec := domainRef(domain,1) . 2
+  opvec := domainOperatorTable domain
   numvec := getDomainByteVector domain
   predvec := domainPredicates domain
   max := maxIndex opvec