diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/interp/apply.boot | 1 | ||||
-rw-r--r-- | src/interp/category.boot | 1 | ||||
-rw-r--r-- | src/interp/cattable.boot | 2 | ||||
-rw-r--r-- | src/interp/define.boot | 2 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 29 | ||||
-rw-r--r-- | src/interp/nrunfast.boot | 8 | ||||
-rw-r--r-- | src/interp/patches.lisp | 2 | ||||
-rw-r--r-- | src/interp/setq.lisp | 5 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 3 | ||||
-rw-r--r-- | src/interp/wi2.boot | 3 |
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 |