* interp/sys-utility.boot (constructorDB): New.

	* interp/daase.lisp (dbNiladic?): New.  Use it to access niladic
	property. of a constructor.
	* interp/database.boot: Import daase.
	(niladicContructorFromDB): Use it.
	* interp/define.boot (compDefineCategory): Don't write
	compilerInfo garbage.
	(compDefineFunctor1): Likewise.
	(compDefineCategory2): Set niladic property.
	(compDefineFunctor): Likewise.
	* interp/lisplib.boot (loadLib): Do not set niladic property.  It
	is now a side-effect of loading.
	(loadLibNoUpdate): Do not check for version.
	(makeConstructorAutoload): Do not set niladic property.
	(initializeLisplib): Do not emit code to check version.
	(mkCtorDBForm): New.
	(writeNiladic?): Likewise.
	(finalizeLisplib): Do not set niladic property.
	* interp/patches.lisp: Remove deadcode.
	* interp/sys-constants.boot  (MAJOR-VERSION): Remove.

17 files changed, 191 insertions, 146 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 76d2390c..c8b836a1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,26 @@
+2011-08-20  Gabriel Dos Reis  <gdr@cse.tamu.edu>
+
+	* interp/sys-utility.boot (constructorDB): New.
+	* interp/daase.lisp (dbNiladic?): New.  Use it to access niladic
+	property. of a constructor.
+	* interp/database.boot: Import daase.
+	(niladicContructorFromDB): Use it.
+	* interp/define.boot (compDefineCategory): Don't write
+	compilerInfo garbage.
+	(compDefineFunctor1): Likewise.
+	(compDefineCategory2): Set niladic property.
+	(compDefineFunctor): Likewise.
+	* interp/lisplib.boot (loadLib): Do not set niladic property.  It
+	is now a side-effect of loading.
+	(loadLibNoUpdate): Do not check for version.
+	(makeConstructorAutoload): Do not set niladic property.
+	(initializeLisplib): Do not emit code to check version.
+	(mkCtorDBForm): New.
+	(writeNiladic?): Likewise.
+	(finalizeLisplib): Do not set niladic property.
+	* interp/patches.lisp: Remove deadcode.
+	* interp/sys-constants.boot  (MAJOR-VERSION): Remove.
+
 2011-08-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* algebra/polycat.spad.pamphlet (UnivariatePolynomialCategory)
@@ -504,6 +527,11 @@
 
 2011-06-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* utils/storage.H (Memory::Arena): Extend.
+	(Memory::Factory): Add iterators.  Make bidirectional.
+
+2011-06-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/sf.spad.pamphlet (DoubleFloat) [nan?]: New export.
 	* algebra/clip.spad.pamphlet (TwoDimensionalPlotClipping): Use it
           instead of %fNan?.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 548a104f..5c10c62d 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -70,7 +70,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	cattable.$(FASLEXT)	posit.$(FASLEXT)	\
 	cformat.$(FASLEXT)	clam.$(FASLEXT)		\
 	clammed.$(FASLEXT)	nlib.$(FASLEXT)	        \
-	comp.$(FASLEXT)	                          	\
+	comp.$(FASLEXT)	        daase.$(FASLEXT)       	\
 	pathname.$(FASLEXT)	compat.$(FASLEXT)      	\
 	serror.$(FASLEXT)	ptrees.$(FASLEXT)	\
 	cparse.$(FASLEXT)	cstream.$(FASLEXT)	\
@@ -103,7 +103,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	preparse.$(FASLEXT)	bootlex.$(FASLEXT)	\
 	spad.$(FASLEXT)		spaderror.$(FASLEXT)	\
 	                       	termrw.$(FASLEXT)	\
-	trace.$(FASLEXT)	daase.$(FASLEXT)  	\
+	trace.$(FASLEXT)	                     	\
 	fortcall.$(FASLEXT) 	i-parser.$(FASLEXT) 	\
 	$(OCOBJS) $(BROBJS) $(INOBJS)
 
@@ -305,7 +305,7 @@ nrunfast.$(FASLEXT): c-util.$(FASLEXT)
 nruncomp.$(FASLEXT): profile.$(FASLEXT) simpbool.$(FASLEXT) functor.$(FASLEXT)
 nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
 define.$(FASLEXT): g-error.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT)
-database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
+database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) daase.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) \
 		c-util.$(FASLEXT)
 functor.$(FASLEXT): category.$(FASLEXT) interop.$(FASLEXT) lisplib.$(FASLEXT)
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index a7c1efa4..ce3b40a0 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -920,7 +920,7 @@ mathform2HtString form == escapeString
 
 niladicHack form ==
   form isnt [.,:.] => form
-  form is [x] and GETL(x,"NILADIC") => x
+  form is [x] and niladicConstructorFromDB x => x
   [niladicHack x for x in form]
 
 --============================================================================
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index ad849541..07d90cfc 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -229,6 +229,10 @@
  spare                      ; superstition
  ) ; database structure
 
+
+(defmacro |dbNiladic?| (db)
+  `(database-niladic ,db))
+
 ; there are only a small number of domains that have default domains.
 ; rather than keep this slot in every domain we maintain a list here.
 
@@ -572,13 +576,13 @@
 	(setq item (unsqueeze item))
 	(setq *allconstructors* (adjoin (first item) *allconstructors*))
 	(setq dbstruct (make-database))
-	(setf (get (car item) 'database) dbstruct)
+	(setf (|constructorDB| (car item)) dbstruct)
 	(setf (database-operationalist dbstruct) (second item))
 	(setf (database-constructormodemap dbstruct) (third item))
 	(setf (database-modemaps dbstruct) (fourth item))
 	(setf (database-object dbstruct) (fifth item))
 	(setf (database-constructorcategory dbstruct) (sixth item))
-	(setf (database-niladic dbstruct) (seventh item))
+	(setf (|dbNiladic?| dbstruct) (seventh item))
 	(setf (database-abbreviation dbstruct) (eighth item))
 	(setf (get (eighth item) 'abbreviationfor) (first item)) ;invert
 	(setf (database-cosig dbstruct) (ninth item))
@@ -629,13 +633,13 @@
       (setq constructors (read *browse-stream*))
       (dolist (item constructors)
 	(setq item (unsqueeze item))
-	(unless (setq dbstruct (get (car item) 'database))
+	(unless (setq dbstruct (|constructorDB| (car item)))
 	  (format t "browseOpen:~%")
 	  (format t "the browse database contains a contructor ~a~%" item)
 	  (format t "that is not in the interp.daase file. we cannot~%")
 	  (format t "get the database structure for this constructor and~%")
 	  (warn "will create a new one~%")
-	  (setf (get (car item) 'database) (setq dbstruct (make-database)))
+	  (setf (|constructorDB| (car item)) (setq dbstruct (make-database)))
 	  (setq *allconstructors* (adjoin item *allconstructors*)))
 	(setf (database-sourcefile dbstruct) (second item))
 	(setf (database-constructorform dbstruct) (third item))
@@ -744,9 +748,9 @@
 (defun setdatabase (constructor key value)
   (let (struct)
     (when (symbolp constructor)
-      (unless (setq struct (get constructor 'database))
+      (unless (setq struct (|constructorDB| constructor))
 	(setq struct (make-database))
-	(setf (get constructor 'database) struct))
+	(setf (|constructorDB| constructor) struct))
       (case key
 	    (abbreviation
 	     (setf (database-abbreviation struct) value)
@@ -776,36 +780,36 @@
 ; thus they occur first in the list of things to check
 	    (abbreviation
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-abbreviation struct))))
 	    (constructorkind
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-constructorkind struct))))
 	    (cosig
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-cosig struct))))
 	    (operation
 	     (setq stream *operation-stream*)
 	     (setq data (gethash constructor *operation-hash*)))
 	    (constructormodemap
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-constructormodemap struct))))
 	    (constructorcategory
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-constructorcategory struct))
 	       (when (null data) ;domain or package then subfield of constructormodemap
 		 (setq data (cadar (|getConstructorModemapFromDB| constructor))))))
 	    (operationalist
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-operationalist struct))))
 	    (modemaps
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-modemaps struct))))
 	    (hascategory
 	     (setq table  *hasCategory-hash*)
@@ -813,17 +817,17 @@
 	     (setq data (gethash constructor table)))
 	    (object
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-object struct))))
 	    (niladic
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
-	       (setq data (database-niladic struct))))
+	     (when (setq struct (|constructorDB| constructor))
+	       (setq data (|dbNiladic?| struct))))
 	    (constructor?
 	     (|fatalError| "GETDATABASE called with CONSTRUCTOR?"))
 	    (superdomain ; only 2 superdomains in the world
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-superdomain struct))))
 	    (constructor
 	     (when (setq data (get constructor 'abbreviationfor))))
@@ -831,41 +835,41 @@
 	      (setq data (cadr (assoc constructor *defaultdomain-list*))))
 	    (ancestors
 	     (setq stream *interp-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-ancestors struct))))
 	    (sourcefile
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-sourcefile struct))))
 	    (constructorform
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-constructorform struct))))
 	    (constructorargs
 	     (setq data (cdr (|getConstructorFormFromDB| constructor))))
 	    (attributes
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-attributes struct))))
 	    (predicates
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-predicates struct))))
 	    (documentation
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-documentation struct))))
 	    (parents
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-parents struct))))
 	    (users
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-users struct))))
 	    (dependents
 	     (setq stream *browse-stream*)
-	     (when (setq struct (get constructor 'database))
+	     (when (setq struct (|constructorDB| constructor))
 	       (setq data (database-dependents struct))))
 	    (otherwise  
 	     (warn "~%(GETDATABASE ~a ~a) failed~%" constructor key)))
@@ -898,7 +902,7 @@
 	      (object    
 	       (setf (database-object struct) data))
 	      (niladic   
-	       (setf (database-niladic struct) data))
+	       (setf (|dbNiladic?| struct) data))
 	      (abbreviation 
 	       (setf (database-abbreviation struct) data))
 	      (constructor 
@@ -1039,7 +1043,7 @@
 		     (setq oldmaps (|getOperationModemapsFromDB| key))
 		     (setq dbstruct (make-database))
 		     (setq *allconstructors* (adjoin key *allconstructors*))
-		     (setf (get key 'database) dbstruct) ; store the struct, side-effect it...
+		     (setf (|constructorDB| key) dbstruct) ; store the struct, side-effect it...
 		     (setf (database-constructorform dbstruct) constructorform)
 		     (setq *allOperations* nil)   ; force this to recompute
 		     (setf (database-object dbstruct) object)
@@ -1069,7 +1073,7 @@
 			   (fetchdata alist in "attributes"))
 		     (setf (database-predicates dbstruct)
 			   (fetchdata alist in "predicates"))
-		     (setf (database-niladic dbstruct)
+		     (setf (|dbNiladic?| dbstruct)
 			   (when (fetchdata alist in "NILADIC") t))
 		     (let ((super (fetchdata alist in "evalOnLoad2")))
 		       (setf (database-superdomain dbstruct)
@@ -1133,19 +1137,19 @@
   (withSpecialConstructors ()
    ; note: if item is not in *operationalist-hash* it will not be written
    ; UNION
-   (setf (get '|Union| 'database)
+   (setf (|constructorDB| '|Union|)
      (make-database :operationalist nil :constructorkind '|domain|))
    (push '|Union| *allconstructors*)
    ; RECORD
-   (setf (get '|Record| 'database)
+   (setf (|constructorDB| '|Record|)
     (make-database :operationalist nil :constructorkind '|domain|))
    (push '|Record| *allconstructors*)
    ; MAPPING
-   (setf (get '|Mapping| 'database)
+   (setf (|constructorDB| '|Mapping|)
     (make-database :operationalist nil :constructorkind '|domain|))
    (push '|Mapping| *allconstructors*)
    ; ENUMERATION
-   (setf (get '|Enumeration| 'database)
+   (setf (|constructorDB| '|Enumeration|)
     (make-database :operationalist nil :constructorkind '|domain|))
    (push '|Enumeration| *allconstructors*)
    )
@@ -1155,8 +1159,8 @@
  (let (d)
   (declare (special |$constructorList|))
   (do-symbols (symbol)
-   (when (get symbol 'database)
-    (setf (get symbol 'database) nil)))
+   (when (|constructorDB| symbol)
+    (setf (|constructorDB| symbol) nil)))
   (setq *hascategory-hash* (make-hash-table :test #'equal))
   (setq *operation-hash* (make-hash-table))
   (setq *allconstructors* nil)
@@ -1191,7 +1195,7 @@
   (write-categorydb)
   (dolist (con (|allConstructors|))
    (let (dbstruct)
-     (when (setq dbstruct (get con 'database))
+     (when (setq dbstruct (|constructorDB| con))
            (setf (database-cosig dbstruct)
                  (cons nil (mapcar #'|categoryForm?|
                                    (cddar (database-constructormodemap dbstruct)))))
@@ -1288,7 +1292,7 @@
   (finish-output out)
   (dolist (constructor (|allConstructors|))
    (let (struct)
-    (setq struct (get constructor 'database))
+    (setq struct (|constructorDB| constructor))
     (setq opalistpos (file-position out))
     (print (squeeze (database-operationalist struct)) out)
     (finish-output out)
@@ -1313,7 +1317,7 @@
 	  (print concategory out)
 	  (finish-output out))
       (setq categorypos nil))
-    (setq niladic (database-niladic struct))
+    (setq niladic (|dbNiladic?| struct))
     (setq abbrev (database-abbreviation struct))
     (setq cosig (database-cosig struct))
     (setq kind (database-constructorkind struct))
@@ -1355,7 +1359,7 @@
   (finish-output out)
   (dolist (constructor (|allConstructors|))
    (let (struct)
-    (setq struct (get constructor 'database))
+    (setq struct (|constructorDB| constructor))
      ; sourcefile is small. store the string directly
     (setq src (database-sourcefile struct))
     (setq formpos (file-position out))
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 72cb5fc7..0bd98389 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -38,6 +38,7 @@ import c_-util
 import clam
 import cattable
 import compat
+import daase
 namespace BOOT
 
 $getUnexposedOperations := true
@@ -132,6 +133,7 @@ getConstructorAttributesFromDB ctor ==
 
 niladicConstructorFromDB: %Constructor -> %Boolean
 niladicConstructorFromDB ctor ==
+  property(ctor,'LOADED) => dbNiladic? constructorDB ctor
   GETDATABASE(ctor,"NILADIC")
 
 constructorHasCategoryFromDB: %Pair(%Thing,%Thing) -> %List %Code
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 67802fc4..876d57e9 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1047,16 +1047,8 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     -- If we are only interested in the defaults, there is no point
     -- in writing out compiler info and load-time stuff for 
     -- the category which is assumed to have already been translated.
-    if not $compileDefaultsOnly then
-      lisplibWrite('"compilerInfo",
-        removeZeroOne ['SETQ,'$CategoryFrame,
-         ['put,['QUOTE,op'],'
-          (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
-            MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
-      --Equivalent to the following two lines, we hope
-      if null sargl then
-        evalAndRwriteLispForm('NILADIC,
-              ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
+    if not $compileDefaultsOnly and null sargl then
+      writeNiladic?(op',$libFile)
  
     -- 6. put modemaps into InteractiveModemapFrame
     $domainShell := eval [op',:[MKQ f for f in sargl]]
@@ -1085,11 +1077,13 @@ compDefineCategory(df,m,e,prefix,fal) ==
   $lisplibCategory: local := nil
   -- since we have so many ways to say state the kind of a constructor,
   -- make sure we do have some minimal internal coherence.
-  ctor := opOf second df
+  lhs := second df
+  ctor := opOf lhs
   kind := getConstructorKindFromDB ctor
   kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
-  $insideFunctorIfTrue or not $LISPLIB or $compileDefaultsOnly =>
+  $insideFunctorIfTrue or $LISPLIB = nil or $compileDefaultsOnly =>
     compDefineCategory1(df,m,e,prefix,fal)
+  dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil
   compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
 
 
@@ -1345,8 +1339,11 @@ compDefineFunctor(df,m,e,prefix,fal) ==
   $profileCompiler: local := true
   $profileAlist:    local := nil
   $mutableDomain: local := false
-  $compileExportsOnly or not $LISPLIB => 
+  $compileExportsOnly or $LISPLIB = nil => 
     compDefineFunctor1(df,m,e,prefix,fal)
+  lhs := second df
+  ctor := opOf lhs
+  dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil
   compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
  
 compDefineFunctor1(df is ['DEF,form,signature,nils,body],
@@ -1476,21 +1473,12 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
         $byteVec :local := nil
         $NRTslot1PredicateList :=
           [simpBool x for x in $NRTslot1PredicateList]
-        rwriteLispForm('loadTimeStuff,
+        LAM_,FILEACTQ('loadTimeStuff,
           ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
       $lisplibSlot1 := $NRTslot1Info
       $lisplibOperationAlist:= operationAlist
-    lisplibWrite('"compilerInfo",
-       removeZeroOne ['SETQ,'$CategoryFrame,
-        ['put,['QUOTE,op'],'
-         (QUOTE isFunctor),
-          ['QUOTE,operationAlist],['addModemap,['QUOTE,op'],['
-           QUOTE,parForm],['QUOTE,parSignature],true,['QUOTE,op'],
-            ['put,['QUOTE,op' ],'(QUOTE mode),
-             ['QUOTE,['Mapping,:parSignature]],'$CategoryFrame]]]],$libFile)
     if null argl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'NILADIC], true])
+      writeNiladic?(op',$libFile)
     -- Functors are incomplete during bootstrap
     if $bootStrapMode then
       evalAndRwriteLispForm('%incomplete,
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index cc766b57..b0966204 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -326,12 +326,6 @@ loadLib cname ==
           [[.,:sig],:.] := u
           [nil,:[categoryForm?(x) for x in rest sig]]
       nil
-  -- in following, add property value false or nil to possibly clear
-  -- old value
-  if null rest getConstructorFormFromDB cname then
-      property(cname,'NILADIC) := true
-    else
-      property(cname,'NILADIC) := nil
   property(cname,'LOADED) := fullLibName
   if $InteractiveMode then $CategoryFrame := $EmptyEnvironment
   stopTimingProcess 'load
@@ -341,18 +335,12 @@ loadLibNoUpdate(cname, libName, fullLibName) ==
   kind := getConstructorKindFromDB cname
   if $printLoadMsgs then
     sayKeyedMsg("S2IL0002",[namestring fullLibName,kind,cname])
-  if CATCH('VERSIONCHECK,loadModule(fullLibName,cname)) = -1
-    then 
-      writeString('"   wrong library version...recompile ")
-      PRINC(fullLibName)
-      TERPRI()
-      TOPLEVEL()
-    else
-     clearConstructorCache cname
-     installConstructor(cname,kind)
-     property(cname,'LOADED) := fullLibName
-     if $InteractiveMode then $CategoryFrame := $EmptyEnvironment
-     stopTimingProcess 'load
+  loadModule(fullLibName,cname)
+  clearConstructorCache cname
+  installConstructor(cname,kind)
+  property(cname,'LOADED) := fullLibName
+  if $InteractiveMode then $CategoryFrame := $EmptyEnvironment
+  stopTimingProcess 'load
   'T
  
 loadIfNecessary u == loadLibIfNecessary(u,true)
@@ -406,10 +394,6 @@ makeConstructorsAutoLoad() ==
   for cnam in allConstructors() repeat
     builtinCategoryName? cnam => nil
     property(cnam,'LOADED) := nil
---    fn:=getConstructorAbbreviationFromDB cnam
-    if niladicConstructorFromDB cnam
-     then property(cnam,'NILADIC) := 'T
-     else property(cnam,'NILADIC) := nil
     systemDependentMkAutoload(getConstructorAbbreviationFromDB cnam,cnam)
  
 systemDependentMkAutoload(fn,cnam) ==
@@ -554,8 +538,14 @@ initializeLisplib libName ==
   resetErrorCount()
   $libFile := writeLib1(libName,'ERRORLIB,$libraryDirectory)
   ADDOPTIONS('FILE,$libFile)
-  if pathnameTypeId(_/EDITFILE) is 'SPAD
-    then LAM_,FILEACTQ('VERSION,['_/VERSIONCHECK,_/MAJOR_-VERSION])
+
+mkCtorDBForm ctor ==
+  ['constructorDB,quoteForm ctor]
+
+writeNiladic?(ctor,file) ==
+  insn := ['%store,['dbNiladic?,mkCtorDBForm ctor],'%true]
+  LAM_,FILEACTQ('NILADIC,expandToVMForm insn)
+  lisplibWrite('"NILADIC",true,file)
 
 ++ If compilation produces an error, issue inform user and
 ++ return to toplevel reader.
@@ -597,8 +587,6 @@ finalizeLisplib libName ==
   lisplibWrite('"documentation",finalizeDocumentation(),$libFile)
   lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
   if $profileCompiler then profileWrite()
-  if $lisplibForm and null rest $lisplibForm then
-    property(first $lisplibForm,'NILADIC) := true
   leaveIfErrors libName
   true
 
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 1f4f913e..4ee13797 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -107,6 +107,7 @@
            (file-position stream pos))
           (t (file-position stream 0)
              (princ "                    " stream)
+	     (terpri stream)
              (setq indextable pos)))
     (values stream indextable)))
 
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index e49d0e7b..68d17fc9 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -192,45 +192,3 @@
   )
 )
 
-#+:akcl
-(defun print-xdr-stream (x y z) (format y "XDR:~A" (xdr-stream-name x)))
-#+:akcl
-(defstruct (xdr-stream
-                (:print-function  print-xdr-stream))
-           "A structure to hold XDR streams. The stream is printed out."
-           (handle ) ;; this is what is used for xdr-open xdr-read xdr-write
-           (name ))  ;; this is used for printing
-#+(and :gcl (not (or :dos :win32)))
-(defun |xdrOpen| (str dir) (make-xdr-stream :handle (system:xdr-open str) :name str))
-#+(and :gcl (or :dos :win32))
-(defun |xdrOpen| (str dir) (format t "xdrOpen called"))
-
-#+(and :akcl (not (or :dos :win32)))
-(defun |xdrRead| (xstr r) (system:xdr-read (xdr-stream-handle xstr) r) )
-#+(and :gcl (or :dos :win32))
-(defun |xdrRead| (str) (format t "xdrRead called"))
-
-#+(and :akcl (not (or :dos :win32)))
-(defun |xdrWrite| (xstr d) (system:xdr-write (xdr-stream-handle xstr) d) )
-#+(and :gcl (or :dos :win32))
-(defun |xdrWrite| (str) (format t "xdrWrite called"))
-
-;; here is a test for XDR
-;; (setq *print-array* T)
-;; (setq foo (open "xdrtest" :direction :output))
-;; (setq xfoo (|xdrOpen| foo))
-;; (|xdrWrite| xfoo "hello: This contains an integer, a float and a float array")
-;; (|xdrWrite| xfoo 42)
-;; (|xdrWrite| xfoo 3.14159)
-;; (|xdrWrite| xfoo (make-array 10 :element-type 'long-float :initial-element 2.78111D12))
-;; (close foo)
-;; (setq foo (open "xdrtest" :direction :input))
-;; (setq xfoo (|xdrOpen| foo))
-;; (|xdrRead| xfoo "")
-;; (|xdrRead| xfoo 0)
-;; (|xdrRead| xfoo 0.0)
-;; (|xdrRead| xfoo (make-array 10 :element-type 'long-float ))
-;; (setq *print-array* NIL)
-
-(defun /versioncheck (n) (unless (= n /MAJOR-VERSION) (throw 'versioncheck -1)))
-
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 3812d378..bc2366ec 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -74,11 +74,6 @@ $DoubleFloatEpsilon ==
 $timerTicksPerSecond == 
   INTERNAL_-TIME_-UNITS_-PER_-SECOND
 
-
-++ Internal magic coockie.
-_/MAJOR_-VERSION ==
-  2
-
 --
 -- Text formatting
 --
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 1b404d9b..c6859362 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -388,3 +388,8 @@ displayTextFile f ==
       writeLine(line,$OutputStream)
   finally
     stream ~= nil => closeStream stream
+
+--%
+macro constructorDB ctor ==
+  property(ctor,'DATABASE)
+  
diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase
index df370548..c81fd57e 100644
--- a/src/share/algebra/browse.daase
+++ b/src/share/algebra/browse.daase
@@ -1,5 +1,5 @@
 
-(2276906 . 3522680061)       
+(2276906 . 3522866252)       
 (-18 A S) 
 ((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result."))) 
 NIL 
diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase
index 84a6fa93..f1b9711a 100644
--- a/src/share/algebra/category.daase
+++ b/src/share/algebra/category.daase
@@ -1,5 +1,5 @@
 
-(205500 . 3522680065)        
+(205500 . 3522866257)        
 ((((-877)) . T)) 
 ((((-877)) . T)) 
 ((((-877)) . T)) 
diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase
index a15ed8f1..c49eeb83 100644
--- a/src/share/algebra/compress.daase
+++ b/src/share/algebra/compress.daase
@@ -1,5 +1,5 @@
 
-(30 . 3522680059)            
+(30 . 3522866251)            
 (4428 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain|
  ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join|
  |ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&|
diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase
index d1c344d0..86317845 100644
--- a/src/share/algebra/interp.daase
+++ b/src/share/algebra/interp.daase
@@ -1,5 +1,5 @@
 
-(3432426 . 3522680074)       
+(3432426 . 3522866267)       
 ((-1935 (((-114) (-1 (-114) |#2| |#2|) $) 86 T ELT) (((-114) $) NIL T ELT)) (-1933 (($ (-1 (-114) |#2| |#2|) $) 18 T ELT) (($ $) NIL T ELT)) (-4218 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-1255 (-558)) |#2|) 44 T ELT)) (-2510 (($ $) 80 T ELT)) (-4272 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $) 49 T ELT)) (-3839 (((-558) (-1 (-114) |#2|) $) 27 T ELT) (((-558) |#2| $) NIL T ELT) (((-558) |#2| $ (-558)) 96 T ELT)) (-3290 (((-661 |#2|) $) 13 T ELT)) (-3938 (($ (-1 (-114) |#2| |#2|) $ $) 64 T ELT) (($ $ $) NIL T ELT)) (-2160 (($ (-1 |#2| |#2|) $) 37 T ELT)) (-4388 (($ (-1 |#2| |#2|) $) NIL T ELT) (($ (-1 |#2| |#2| |#2|) $ $) 60 T ELT)) (-2517 (($ |#2| $ (-558)) NIL T ELT) (($ $ $ (-558)) 67 T ELT)) (-1468 (((-3 |#2| "failed") (-1 (-114) |#2|) $) 29 T ELT)) (-2158 (((-114) (-1 (-114) |#2|) $) 23 T ELT)) (-4230 ((|#2| $ (-558) |#2|) NIL T ELT) ((|#2| $ (-558)) NIL T ELT) (($ $ (-1255 (-558))) 66 T ELT)) (-2518 (($ $ (-558)) 76 T ELT) (($ $ (-1255 (-558))) 75 T ELT)) (-2157 (((-791) (-1 (-114) |#2|) $) 34 T ELT) (((-791) |#2| $) NIL T ELT)) (-1934 (($ $ $ (-558)) 69 T ELT)) (-3820 (($ $) 68 T ELT)) (-3950 (($ (-661 |#2|)) 73 T ELT)) (-4232 (($ $ |#2|) NIL T ELT) (($ |#2| $) NIL T ELT) (($ $ $) 87 T ELT) (($ (-661 $)) 85 T ELT)) (-4376 (((-877) $) 92 T ELT)) (-2159 (((-114) (-1 (-114) |#2|) $) 22 T ELT)) (-3454 (((-114) $ $) 95 T ELT)) (-3086 (((-114) $ $) 99 T ELT))) 
 (((-18 |#1| |#2|) (-10 -8 (-15 -3454 ((-114) |#1| |#1|)) (-15 -4376 ((-877) |#1|)) (-15 -3086 ((-114) |#1| |#1|)) (-15 -1933 (|#1| |#1|)) (-15 -1933 (|#1| (-1 (-114) |#2| |#2|) |#1|)) (-15 -2510 (|#1| |#1|)) (-15 -1934 (|#1| |#1| |#1| (-558))) (-15 -1935 ((-114) |#1|)) (-15 -3938 (|#1| |#1| |#1|)) (-15 -3839 ((-558) |#2| |#1| (-558))) (-15 -3839 ((-558) |#2| |#1|)) (-15 -3839 ((-558) (-1 (-114) |#2|) |#1|)) (-15 -1935 ((-114) (-1 (-114) |#2| |#2|) |#1|)) (-15 -3938 (|#1| (-1 (-114) |#2| |#2|) |#1| |#1|)) (-15 -4218 (|#2| |#1| (-1255 (-558)) |#2|)) (-15 -2517 (|#1| |#1| |#1| (-558))) (-15 -2517 (|#1| |#2| |#1| (-558))) (-15 -2518 (|#1| |#1| (-1255 (-558)))) (-15 -2518 (|#1| |#1| (-558))) (-15 -4388 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -4232 (|#1| (-661 |#1|))) (-15 -4232 (|#1| |#1| |#1|)) (-15 -4232 (|#1| |#2| |#1|)) (-15 -4232 (|#1| |#1| |#2|)) (-15 -4230 (|#1| |#1| (-1255 (-558)))) (-15 -3950 (|#1| (-661 |#2|))) (-15 -1468 ((-3 |#2| "failed") (-1 (-114) |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -4272 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -4230 (|#2| |#1| (-558))) (-15 -4230 (|#2| |#1| (-558) |#2|)) (-15 -4218 (|#2| |#1| (-558) |#2|)) (-15 -2157 ((-791) |#2| |#1|)) (-15 -3290 ((-661 |#2|) |#1|)) (-15 -2157 ((-791) (-1 (-114) |#2|) |#1|)) (-15 -2158 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2159 ((-114) (-1 (-114) |#2|) |#1|)) (-15 -2160 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -4388 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3820 (|#1| |#1|))) (-19 |#2|) (-1238)) (T -18)) 
 NIL 
diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase
index 16430dd8..463757e3 100644
--- a/src/share/algebra/operation.daase
+++ b/src/share/algebra/operation.daase
@@ -1,5 +1,5 @@
 
-(719417 . 3522680062)        
+(719417 . 3522866254)        
 (((*1 *2 *3 *4)
   (|partial| -12 (-5 *3 (-1288 *4)) (-4 *4 (-13 (-1070) (-658 (-558))))
    (-5 *2 (-1288 (-419 (-558)))) (-5 *1 (-1317 *4))))) 
diff --git a/src/utils/storage.H b/src/utils/storage.H
index 72b9eb1e..f2fdc8ae 100644
--- a/src/utils/storage.H
+++ b/src/utils/storage.H
@@ -42,6 +42,7 @@
 #include <new>
 #include <cmath>
 #include <string>
+#include <iterator>
 
 #include <open-axiom/config>
 
@@ -195,6 +196,28 @@ namespace OpenAxiom {
          size_t population() const;
 
       protected:
+         // +----+----+--+-----
+         // |    |    |  |
+         // +----+----+--+-----
+         // ^    ^    ^  ^
+         // |    |    |  `-- first allocatable T object
+         // |    |    `-- possible padding for proper T alignment
+         // |    `-- link to next storage pages
+         // `-- link to previous storage pages
+         enum {
+            link_size = sizeof(Storage*)
+         };
+
+         // The `previous' link in the chain of storage.
+         static Storage*& previous(Storage* s) {
+            return *static_cast<Storage**>(s->at_offset(0));
+         }
+
+         // The `next' link in the chain of storage.
+         static Storage*& next(Storage* s) {
+            return *static_cast<Storage**>(s->at_offset(link_size));
+         }
+
          // Address of the first object of type `T' in a storage.
          static T* first_object(Handle* h) {
             return static_cast<T*>(BlockStorage::begin(h));
@@ -264,6 +287,18 @@ namespace OpenAxiom {
          Factory() : Arena<T>(nominal_population()) { }
          ~Factory();
 
+         iterator begin() {
+            Storage* s = this->store;
+            while (Storage* p = Arena<T>::previous(s))
+               s = p;
+            return iterator(s, Arena<T>::first_object(s));
+         }
+
+         iterator end() {
+            Storage* s = this->store;
+            return iterator(s, static_cast<T*>(s->next_available()));
+         }
+
          // Allocate storage and value-construct an object of type `T'.
          T* make() {
             return new(this->allocate(1)) T();
@@ -307,6 +342,47 @@ namespace OpenAxiom {
          }
       }
 
+      template<typename T>
+      struct Factory<T>::iterator:
+         std::iterator<std::forward_iterator_tag, T> {
+
+         iterator& operator++() {
+            if (ptr < store->next_available()) {
+               ++ptr;
+               return *this;
+            }
+            store = Arena<T>::next(store);
+            ptr = Arena<T>::first_object(store);
+            return *this;
+         }
+         
+         iterator operator++(int) {
+            iterator t = *this;
+            ++*this;
+            return t;
+         }
+         
+         T* operator->() { return ptr; }
+
+         T& operator*() { return *ptr; }
+
+         friend bool operator==(iterator p, iterator q) {
+            return p.store == q.store and p.ptr == q.ptr;
+         }
+
+         friend bool operator!=(iterator p, iterator q) {
+            return not(p == q);
+         }
+         
+      private:
+         Storage* store;
+         T* ptr;
+         friend class Factory<T>;
+
+         iterator(Storage* s, T* p) : store(s), ptr(p) { }
+         
+      };
+
       // -----------------
       // -- FileMapping --
       // -----------------