Revert previous accidental commit.

10 files changed, 41 insertions, 15 deletions

diff --git a/src/interp/apply.boot b/src/interp/apply.boot
index 1faf163b..3da4dd8e 100644
--- a/src/interp/apply.boot
+++ b/src/interp/apply.boot
@@ -220,6 +220,7 @@ compApplyModemap(form,modemap,$e,sl) ==
 --+ information which is no longer valid; thus ignore this index and
 --+ store the signature instead.
 
+--$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) =>
   f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
     [genDeltaEntry [op,:modemap],lt',$bindings]
   [f,lt',$bindings]
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 304b943f..c6a411bb 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -451,6 +451,7 @@ JoinInner(l,$e) ==
           if ancindex
              then ($NewCatVec.ancindex:= bname; reallynew:= nil)
              else
+               -- check for $NRTflag until massive algebra recompilation
               if originalVector and (condition=true) then
                 $NewCatVec:= CatEval bname
                 copied:= nil
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index c69bb136..0da1a93f 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -459,7 +459,7 @@ updateCategoryTable(cname,kind) ==
     updateCategoryTableForDomain(cname,getConstrCat(
       GETDATABASE(cname,'CONSTRUCTORCATEGORY)))
 --+
-  kind = 'domain =>
+  kind = 'domain and $NRTflag = true =>
     updateCategoryTableForDomain(cname,getConstrCat(
       GETDATABASE(cname,'CONSTRUCTORCATEGORY)))
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 725a8bcf..945b4cc4 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -400,7 +400,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
     $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
     $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
     -- the above optimizes the calls to local domains
-    $template: local:= nil --stored in the lisplib
+    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
     $functionLocations: local := nil --locations of defined functions in source
     -- generate slots for arguments first, then for $NRTaddForm in compAdd
     for x in argl repeat NRTgetLocalIndex x
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index b0eeb807..d986a708 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -391,7 +391,9 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   domainShell := GETREFV ($NRTbase + $NRTdeltaLength)
   for i in 0..4 repeat domainShell.i := $domainShell.i
     --we will clobber elements; copy since $domainShell may be a cached vector
-  $template := GETREFV ($NRTbase + $NRTdeltaLength)
+  $template :=
+    $NRTvec = true => GETREFV ($NRTbase + $NRTdeltaLength)
+    nil
   $catvecList:= [domainShell,:[emptyVector for u in CADR domainShell.4]]
   $catNames := ['$] -- for DescendCode -- to be changed below for slot 4
   $maximalViews:= nil
@@ -410,16 +412,19 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   storeOperationCode:= DescendCode(code,true,nil,first $catNames)
   outsideFunctionCode:= NRTaddDeltaCode()
   storeOperationCode:= NRTputInLocalReferences storeOperationCode
-  NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode
+  if $NRTvec = true then
+    NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode
   codePart2:=
-    argStuffCode :=
-      [[$setelt,'$,i,v] for i in $NRTbase.. for v in $FormalMapVariableList
-	for arg in rest $definition]
-    if MEMQ($NRTaddForm,$locals) then
-       addargname := $FormalMapVariableList.(POSN1($NRTaddForm,$locals))
-       argStuffCode := [[$setelt,'$,5,addargname],:argStuffCode]
-    [['stuffDomainSlots,'$],:argStuffCode,
-       :predBitVectorCode2,storeOperationCode]
+    $NRTvec = true =>
+      argStuffCode :=
+        [[$setelt,'$,i,v] for i in $NRTbase.. for v in $FormalMapVariableList
+          for arg in rest $definition]
+      if MEMQ($NRTaddForm,$locals) then
+         addargname := $FormalMapVariableList.(POSN1($NRTaddForm,$locals))
+         argStuffCode := [[$setelt,'$,5,addargname],:argStuffCode]
+      [['stuffDomainSlots,'$],:argStuffCode,
+         :predBitVectorCode2,storeOperationCode]
+    [:outsideFunctionCode,storeOperationCode]
 
   $CheckVectorList := NRTcheckVector domainShell
 --CODE: part 1
@@ -589,7 +594,9 @@ NRTsetVector4a(sig,form,cond) ==
 
 NRTmakeSlot1 domainShell ==
   opDirectName := INTERN STRCONC(PNAME first $definition,'";opDirect")
-  fun := '(function lookupInCompactTable)
+  fun :=
+    $NRTmakeCompactDirect => '(function lookupInCompactTable)
+    '(function lookupInTable)
   [($QuickCode=>'QSETREFV;'SETELT), '$,1, ['LIST,fun,'$,opDirectName]]
 
 NRTmakeSlot1Info() ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 5903b539..d791335a 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -36,14 +36,20 @@ import '"c-util"
 )package "BOOT"
 
 ++
-$doNotCompressHashTableIfTrue := true
+$doNotCompressHashTableIfTrue := false
 
 --=======================================================================
 --                     Basic Functions
 --=======================================================================
 initNewWorld() ==
+  $NRTflag := true
+  $NRTvec := true
+  $NRTmakeCompactDirect := true
   $NRTquick := true
+  $NRTmakeShortDirect := true
+  $newWorld := true
   $monitorNewWorld := false
+  $consistencyCheck := false
   $spadLibFT := 'NRLIB
   $NRTmonitorIfTrue := false
   $updateCatTableIfTrue := false
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 6b993ceb..21f12ec1 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -221,6 +221,8 @@
 (define-function '|isLowerCaseLetter| #'LOWER-CASE-P)
 (define-function '|isUpperCaseLetter| #'UPPER-CASE-P)
 (define-function '|isLetter| #'ALPHA-CHAR-P)
+;; reset from /spad/lisp/setq.lisp
+(setq |$consistencyCheck| ()) ;; prevents wasting time checking consistency
 
 
 #+(or :CCL (and :lucid :ibm/370))
diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp
index 84f053d7..8ea2c57a 100644
--- a/src/interp/setq.lisp
+++ b/src/interp/setq.lisp
@@ -74,6 +74,7 @@
 (SETQ |$displayParserOutput| 'T)
 
 (SETQ |$insideReadRulesIfTrue| NIL)
+(SETQ |$consistencyCheck| 'T)
 (SETQ |$useUndo| NIL)
 (SETQ |$ruleSetsInitialized| NIL)
 
@@ -82,7 +83,10 @@
 
 (SETQ |$htPrecedenceTable| NIL)
 
+(SETQ |$NRTmakeCompactDirect| NIL)
 (SETQ |$NRTquick| NIL)
+(SETQ |$NRTmakeShortDirect| NIL)
+(SETQ |$newWorld| NIL)
 (SETQ |$returnNowhereFromGoGet| NIL)
 
 (SETQ |$insideCanCoerceFrom| NIL)
@@ -170,6 +174,7 @@
 (SETQ |$prefix| NIL)
 (SETQ |$formalArgList| ())
 
+(SETQ |$NRTflag| T)
 (SETQ |$NRTaddForm| NIL)
 (SETQ |$NRTdeltaList| NIL)
 (SETQ |$NRTdeltaLength| 0)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index c72ab519..1cd31a55 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -82,6 +82,9 @@ $compCount := 0
 $compUniquelyIfTrue := false
 
 ++
+$consistencyCheck := true
+
+++
 $ConstructorCache := MAKE_-HASHTABLE "ID"
 
 ++
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 5e9ed89a..45fa17f3 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -131,7 +131,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
     $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
     $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
     -- the above optimizes the calls to local domains
-    $template: local:= nil --stored in the lisplib
+    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
     $functionLocations: local := nil --locations of defined functions in source
     -- generate slots for arguments first, then for $NRTaddForm in compAdd
     for x in argl repeat NRTgetLocalIndex x
@@ -651,6 +651,7 @@ compApplyModemap(form,modemap,$e,sl) ==
 --+ information which is no longer valid; thus ignore this index and
 --+ store the signature instead.
  
+--$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) =>
   f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
     [genDeltaEntry [op,:modemap],lt',$bindings]
   markImport mc