From da9f79f1d47983d726e90858f85b074dc88d0866 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 7 Apr 2008 10:34:36 +0000
Subject: 	* interp/compiler.boot (compWithMappingMode): Use
 getShellEntry. 	* interp/define.boot (compDefineFunctor1): Use
 setShellEntry. 	(canCacheLocalDomain): Likewise. 
 (compilerCases): Likewise. 	(doIt): Likewise. 	* interp/functor.boot
 (setVector0): Likewise. 	(setVector3): Likewise. 
 (setVector4part4): Likewise. 	(setVector5): Likewise. 
 (mkVectorWithDeferral): Likewise. 	(DescendCodeAdd1): Likewise. 
 (DescendCode): Likewise. 	(ConsantCreator): Likewise. 
 (SetFunctionSlots): Likewise. 	(CheckVector): Likewise. 	*
 interp/g-opt.boot (optCall): Use getShellEntry. 	(optSpecialCall):
 Likewise. 	* interp/i-util.boot (devaluate): Likewise. 	*
 interp/nruncomp.boot (buildFunctor): Use setShellEntry. 
 (NRTsetVector4a): Likewise. 	(NRTputInLocalReferences): Use getShellEntry. 
 (NRTputInHead): Likewise. 	* interp/nrunopt.boot (augmentPredVector): Use
 setShellEntry. 	* interp/nruntime.boot (getShellEntry): New. 
 (setShellEntry): Likewise. 	* interp/package.boot (processPackage): Use
 getShellEntry. 	(PackageDescendCode): Use setShellEntry. 	*
 interp/sys-globals.boot ($QuickCode): Remove. 	* interp/template.boot
 (NRTdescendCodeTran): Use setShellEntry. 	* interp/types.boot (%Void):
 New. 	(%Shell): New. 	* interp/wi2.boot (compDefineFunctor1): Use
 setShellEntry.

---
 src/interp/compiler.boot    |  5 ++---
 src/interp/define.boot      | 14 ++++++--------
 src/interp/functor.boot     | 30 ++++++++++++++++--------------
 src/interp/g-opt.boot       |  6 +++---
 src/interp/i-util.boot      |  5 +++--
 src/interp/nruncomp.boot    |  8 ++++----
 src/interp/nrunopt.boot     |  2 +-
 src/interp/nruntime.boot    | 10 ++++++++++
 src/interp/package.boot     |  5 +++--
 src/interp/sys-globals.boot |  3 ---
 src/interp/template.boot    |  2 +-
 src/interp/types.boot       |  2 ++
 src/interp/wi2.boot         |  6 ++----
 13 files changed, 53 insertions(+), 45 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 236f1d34..b70fafab 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -254,8 +254,8 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
       vec:=[first v,:vec]
       rest v = 1 =>
                 --Only used once
-        slist:=[[first v,($QuickCode => 'QREFELT;'ELT),"$$",i],:slist]
-      scode:=[['SETQ,first v,[($QuickCode => 'QREFELT;'ELT),"$$",i]],:scode]
+        slist:=[[first v,"getShellEntry","$$",i],:slist]
+      scode:=[['SETQ,first v,["getShellEntry","$$",i]],:scode]
       locals:=[first v,:locals]
     body:=
       slist => SUBLISNQ(slist,CDDR expandedFunction)
@@ -1484,7 +1484,6 @@ compileSpad2Cmd args ==
 
     -- following are for )quick option for code generation
     $QuickLet   : local := true
-    $QuickCode  : local := true
 
     fun         := ['rq, 'lib]
     constructor := nil
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 08a302ce..d79ed090 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -398,9 +398,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
     $getDomainCode: local -- code for getting views
     $insideFunctorIfTrue: local:= true
     $functorsUsed: local --not currently used, finds dependent functors
-    $setelt: local :=
-      $QuickCode = true => 'QSETREFV
-      'SETELT
+    $setelt: local := "setShellEntry"
     $TOP__LEVEL: local
     $genSDVar: local:= 0
     originale:= $e
@@ -1007,14 +1005,14 @@ addArgumentConditions($body,$functionName) ==
   $body
  
 putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
-  $elt: local := ($QuickCode => 'QREFELT; 'ELT)
+  $elt: local := "getShellEntry"
 --+
   NRTputInTail CDDADR def
   def
  
  
 canCacheLocalDomain(dom,elt)==
-   dom is [op,'_$,n] and MEMQ(op,'(ELT QREFELT)) => nil
+   dom is [op,'_$,n] and MEMQ(op,'(getShellEntry ELT QREFELT)) => nil
    domargsglobal(dom) =>
         $functorLocalParameters:= [:$functorLocalParameters,dom]
         PUSH([dom,GENVAR(),[elt,$selector,$funcLocLen]],$usedDomList)
@@ -1042,8 +1040,8 @@ compileCases(x,$e) == -- $e is referenced in compile
                 eval substitute(R',R,u)]]
         isEltArgumentIn(Rlist,x) ==
           atom x => nil
-          x is ['ELT,R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
-          x is ["QREFELT",R,.] => MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
+          x is [op,R,.] and op in '(getShellEntry ELT QREFELT) => 
+            MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
           isEltArgumentIn(Rlist,first x) or isEltArgumentIn(Rlist,rest x)
   null specialCaseAssoc => compile x
   listOfDomains:= ASSOCLEFT specialCaseAssoc
@@ -1332,7 +1330,7 @@ doIt(item,$predl) ==
         [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist]
 --+
     code is ['LET,:.] =>
-      RPLACA(item,($QuickCode => 'QSETREFV;'SETELT))
+      RPLACA(item,"setShellEntry")
       rhsCode:=
        rhs'
       RPLACD(item,['$,NRTgetLocalIndexClear lhs,rhsCode])
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 63a94544..6b283a96 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -318,7 +318,7 @@ setVector0(catNames,definition) ==
 -- (e.g. while testing predicates) will generate new domains => trouble
 --definition:= addMutableArg mkDomainConstructor definition
   for u in catNames repeat
-    definition:= [($QuickCode => 'QSETREFV; 'SETELT),u,0,definition]
+    definition:= ["setShellEntry",u,0,definition]
   definition
  
 --presence of GENSYM in arg-list differentiates mutable-domains
@@ -389,7 +389,7 @@ setVector3(name,instantiator) ==
       --element 3 is data structure representing category
       --returns a single LISP statement
   instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body)
-  [($QuickCode => 'QSETREFV; 'SETELT),name,3,mkDomainConstructor instantiator]
+  ["setShellEntry",name,3,mkDomainConstructor instantiator]
  
 mkDomainFormer x ==
   if x is ['DomainSubstitutionMacro,parms,body] then
@@ -477,7 +477,7 @@ setVector4part3(catNames,catvecList) ==
   for [w,:u] in generated repeat
      code := compCategories w
      for v in u repeat
-       code:= [($QuickCode => 'QSETREFV; 'SETELT),rest v,first v,code]
+       code:= ["setShellEntry",rest v,first v,code]
      if CONTAINED('$,w) then $epilogue := [code,:$epilogue]
                         else codeList := [code,:codeList]
   codeList
@@ -492,7 +492,7 @@ setVector5(catNames,locals) ==
        else generated:= [[u,uname],:generated]
   [(w:= mkVectorWithDeferral(first u,first rest u);
       for v in rest u repeat
-         w:= [($QuickCode => 'QSETREFV; 'SETELT),v,5,w];
+         w:= ["setShellEntry",v,5,w];
         w)
           for u in generated]
  
@@ -503,8 +503,8 @@ mkVectorWithDeferral(objects,tag) ==
   ['VECTOR,:
    [if CONTAINED('$,u) then -- It's not safe to instantiate this now
       $ConstantAssignments:=[:$ConstantAssignments,
-                             [($QuickCode=>'QSETREFV;'SETELT),
-                              [($QuickCode=>'QREFELT;'ELT), tag, 5],
+                             ["setShellEntry",
+                              ["getShellEntry", tag, 5],
                                 count,
                                  u]]
       []
@@ -555,10 +555,10 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
       if update(u,copyvec,[]) then code:=delete(u,code))
     where update(code,copyvec,sofar) ==
       ATOM code =>nil
-      MEMQ(QCAR code,'(ELT QREFELT)) =>
+      MEMQ(QCAR code,'(getShellEntry ELT QREFELT)) =>
           copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar)
           true
-      code is [x,name,number,u'] and MEMQ(x,'(SETELT QSETREFV)) =>
+      code is [x,name,number,u'] and MEMQ(x,'(setShellEntry SETELT QSETREFV)) =>
         update(u',copyvec,[[name,:number],:sofar])
   for i in 6..n repeat
     for u in copyvec.i repeat
@@ -574,10 +574,10 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
                   INTERN('"START2",'"KEYWORD"), i,
                    INTERN('"END2",'"KEYWORD"), j+1],:code]
     copyvec.i =>
-      v:=[($QuickCode => 'QREFELT;'ELT),instantiatedBase,i]
+      v:=["getShellEntry",instantiatedBase,i]
       for u in copyvec.i repeat
         [name,:count]:=u
-        v:=[($QuickCode => 'QSETREFV;'SETELT),name,count,v]
+        v:=["setShellEntry",name,count,v]
       code:=[v,:code]
   [['LET,instantiatedBase,base],:code]
  
@@ -625,7 +625,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
     u:=member(name,$locals) =>
         CONTAINED('$,body) and isDomainForm(body,$e) =>
           --instantiate domains which depend on $ after constants are set
-          code:=[($QuickCode => 'QSETREFV; 'SETELT),[($QuickCode => 'QREFELT; 'ELT),'$,5],#$locals-#u,code]
+          code:=["setShellEntry",["getShellEntry",'$,5],#$locals-#u,code]
           $epilogue:=
             TruthP flag => [code,:$epilogue]
             [['COND,[ProcessCond(flag,viewAssoc),code]],:$epilogue]
@@ -653,12 +653,13 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
   code is ['call,:.] => code
   code is ['SETELT,:.] => code -- can be generated by doItIf
   code is ['QSETREFV,:.] => code -- can be generated by doItIf
+  code is ["setShellEntry",:.] => code -- can be generated by doItIf
   stackWarning ['"unknown Functor code ",code]
   code
  
 ConstantCreator u ==
   null u => nil
-  u is [q,.,.,u'] and (q='SETELT or q='QSETREFV) => ConstantCreator u'
+  u is [q,.,.,u'] and (q in '(setShellEntry SETELT QSETREFV)) => ConstantCreator u'
   u is ['CONS,:.] => nil
   true
  
@@ -689,7 +690,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding"
          then
           if q is 'CONST and body is ['CONS,a,b] then
              body := ['CONS,'IDENTITY,['FUNCALL,a,b]]
-          body:= [($QuickCode => 'QSETREFV; 'SETELT),v,index,body]
+          body:= ["setShellEntry",v,index,body]
           if REFVECP $SetFunctions and TruthP flag then u.index:= true
                  --used by CheckVector to determine which ops are missing
           if v='$ then  -- i.e. we are looking at the principal view
@@ -714,6 +715,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding"
            else
             if not (catImplem is ['PAC,:.]) then
               keyedSystemError("S2OR0002",[catImplem])
+  body is ["setShellEntry",:.] => body
   body is ['SETELT,:.] => body
   body is ['QSETREFV,:.] => body
   nil
@@ -755,7 +757,7 @@ CheckVector(vec,name,catvecListMaker) ==
                   --must generate code to fill in
       for x in $catNames for y in catvecListMaker repeat
         if y=v then code:=
-          [[($QuickCode => 'QSETREFV; 'SETELT),name,i,x],:code]
+          [["setShellEntry",name,i,x],:code]
     if name='$ then
       assoc(first v,$CheckVectorList) => nil
       $CheckVectorList:=
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index a1b91344..c6004799 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -148,14 +148,14 @@ optCall (x is ["call",:u]) ==
   fn is ["PAC",:.] => optPackageCall(x,fn,a)
   fn is ["applyFun",name] =>
     (RPLAC(first x,"SPADCALL"); RPLAC(rest x,[:a,name]); x)
-  fn is [q,R,n] and MEMQ(q,'(ELT QREFELT CONST)) =>
+  fn is [q,R,n] and MEMQ(q,'(getShellEntry ELT QREFELT CONST)) =>
     not $bootStrapMode and (w:= optCallSpecially(q,x,n,R)) => w
     q="CONST" =>
 --+
       ["spadConstant",R,n]
     --putInLocalDomainReferences will change this to ELT or QREFELT
     RPLAC(first x,"SPADCALL")
-    if $QuickCode then RPLACA(fn,"QREFELT")
+    RPLACA(fn,"getShellEntry")
     RPLAC(rest x,[:a,fn])
     x
   systemErrorHere ['"optCall with", :bright x]
@@ -212,7 +212,7 @@ optSpecialCall(x,y,n) ==
     x
   [fn,:a]:= first x
   RPLAC(first x,"SPADCALL")
-  if $QuickCode then RPLACA(fn,"QREFELT")
+  RPLACA(fn,"getShellEntry")
   RPLAC(rest x,[:a,fn])
   x
  
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index b064c526..37bdd0fd 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -132,9 +132,10 @@ Undef(:u) ==
 --------------------> NEW DEFINITION (see interop.boot.pamphlet)
 devaluate d ==
   not REFVECP d => d
-  QSGREATERP(QVSIZE d,5) and QREFELT(d,3) is ['Category] => QREFELT(d,0)
+  QSGREATERP(QVSIZE d,5) and getShellEntry(d,3) is ['Category] => 
+    getShellEntry(d,0)
   QSGREATERP(QVSIZE d,0) =>
-    d':=QREFELT(d,0)
+    d':=getShellEntry(d,0)
     isFunctor d' => d'
     d
   d
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 457fa052..3203c699 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -428,7 +428,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
       ['LET,domname,['LIST,MKQ CAR $definition,:ASSOCRIGHT $devaluateList]]
     createViewCode:= ['LET,'$,["newShell", $NRTbase + $NRTdeltaLength]]
     setVector0Code:=[$setelt,'$,0,'dv_$]
-    slot3Code := ['QSETREFV,'$,3,['LET,'pv_$,predBitVectorCode1]]
+    slot3Code := ["setShellEntry",'$,3,['LET,'pv_$,predBitVectorCode1]]
     slamCode:=
       isCategoryPackageName opOf $definition => nil
       [NRTaddToSlam($definition,'$)]
@@ -575,7 +575,7 @@ NRTsetVector4a(sig,form,cond) ==
 NRTmakeSlot1 domainShell ==
   opDirectName := INTERN STRCONC(PNAME first $definition,'";opDirect")
   fun := '(function lookupInCompactTable)
-  [($QuickCode=>'QSETREFV;'SETELT), '$,1, ['LIST,fun,'$,opDirectName]]
+  ["setShellEntry", '$,1, ['LIST,fun,'$,opDirectName]]
 
 NRTmakeSlot1Info() ==
 -- 4 cases:
@@ -691,7 +691,7 @@ NRTsubstDelta(initSig) ==
 updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info)
 
 NRTputInLocalReferences bod ==
-  $elt: local := ($QuickCode => 'QREFELT; 'ELT)
+  $elt: local := "getShellEntry"
   NRTputInHead bod
 
 NRTputInHead bod ==
@@ -699,7 +699,7 @@ NRTputInHead bod ==
   bod is ['SPADCALL,:args,fn] =>
     NRTputInTail rest bod --NOTE: args = COPY of rest bod
     -- The following test allows function-returning expressions
-    fn is [elt,dom,ind] and not (dom='$) and MEMQ(elt,'(ELT QREFELT CONST)) =>
+    fn is [elt,dom,ind] and not (dom='$) and MEMQ(elt,'(getShellEntry ELT QREFELT CONST)) =>
       k:= NRTassocIndex dom => RPLACA(LASTNODE bod,[$elt,'_$,k])
       nil
     NRTputInHead fn
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index 3490bb61..26829cb2 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -267,7 +267,7 @@ augmentPredCode(n,lastPl) ==
          delta:=2 * delta; u) for x in pl]
 
 augmentPredVector(dollar,value) ==
-  QSETREFV(dollar,3,value + QVELT(dollar,3))
+  setShellEntry(dollar,3,value + QVELT(dollar,3))
 
 isHasDollarPred pred ==
   pred is [op,:r] =>
diff --git a/src/interp/nruntime.boot b/src/interp/nruntime.boot
index 460f3e62..0275bd1e 100644
--- a/src/interp/nruntime.boot
+++ b/src/interp/nruntime.boot
@@ -35,6 +35,16 @@
 import '"c-util"
 )package "BOOT"
 
+++ fetchs the item in the nth entry of a domain shell.
+getShellEntry: (%Shell,%Short) -> %Thing
+getShellEntry(s,i) ==
+  SVREF(s,i)
+
+++ sets the nth nth entry of a domain shell to an item.
+setShellEntry: (%Shell,%Short,%Thing) -> %Thing
+setShellEntry(s,i,t) ==
+  SETF(SVREF(s,i),t)
+
 unloadOneConstructor(cnam,fn) ==
     REMPROP(cnam,'LOADED)
     SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
diff --git a/src/interp/package.boot b/src/interp/package.boot
index 81152812..d7905211 100644
--- a/src/interp/package.boot
+++ b/src/interp/package.boot
@@ -83,7 +83,7 @@ processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
                     for v in u repeat
                       if (a:=ASSOC(v,alist)) then
                         [.,:i]:=a
-                        u:=replace(v,[($QuickCode=>'QREFELT;'ELT),"$",i],u) where
+                        u:=replace(v,["getShellEntry","$",i],u) where
                            replace(old,new,l) ==
                              l isnt [h,:t] => l
                              h = old => [new,:t]
@@ -93,7 +93,7 @@ processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
                       u:=replace(v,v',u)
                     u
               precomp:=[elem,:precomp]
-            code:=[[($QuickCode=>'QSETREFV;'SETELT),"$",i,u'],:code]
+            code:=[["setShellEntry","$",i,u'],:code]
           nreverse code
   code:=
     ["PROGN",:$getDomainCode,["LET","$",["newShell",#locals]],
@@ -175,6 +175,7 @@ PackageDescendCode(code,flag,viewAssoc) ==
   code is ["call",:.] => code
   code is ["SETELT",:.] => code
   code is ["QSETREFV",:.] => code
+  code is ["setShellEntry",:.] => code
   stackWarning ["unknown Package code ",code]
   code
  
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index fd6898d9..b9ca2437 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -287,9 +287,6 @@ $SPAD := false
 ++
 $PrintOnly := false
 
-++
-$QuickCode := true
-
 ++
 $QuickLet := true
 
diff --git a/src/interp/template.boot b/src/interp/template.boot
index 9529869d..352c02f1 100644
--- a/src/interp/template.boot
+++ b/src/interp/template.boot
@@ -255,7 +255,7 @@ NRTdescendCodeTran(u,condList) ==
 --NRTbuildFunctor calls to fill $template slots with names of compiled functions
   null u => nil
   u is ['LIST] => nil
-  u is [op,.,i,a] and MEMQ(op,'(SETELT QSETREFV)) =>
+  u is [op,.,i,a] and MEMQ(op,'(setShellEntry SETELT QSETREFV)) =>
     null condList and a is ['CONS,fn,:.] =>
       RPLACA(u,'LIST)
       RPLACD(u,nil)
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 7d2b6538..43d99bd6 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -35,6 +35,7 @@ import '"boot-pkg"
 )package "BOOT"
 
 ++ Basic types used throughout Boot codes.
+%Void <=> nil
 %Boolean <=> BOOLEAN
 %Short <=> FIXNUM
 %Integer <=> BIGNUM
@@ -54,3 +55,4 @@ import '"boot-pkg"
 
 %Modemap <=> %List                             -- modemap
 
+%Shell <=> SIMPLE_-VECTOR                      -- constructor instantiation
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 52999f36..a9311920 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -79,9 +79,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
     $getDomainCode: local -- code for getting views
     $insideFunctorIfTrue: local:= true
     $functorsUsed: local --not currently used, finds dependent functors
-    $setelt: local :=
-      $QuickCode = true => 'QSETREFV
-      'SETELT
+    $setelt: local := "setShellEntry"
     $TOP__LEVEL: local
     $genSDVar: local:= 0
     originale:= $e
@@ -1166,7 +1164,7 @@ doItLet1 item ==
   qe(6,$e)
   code is ['LET,:.] =>
       rhsCode:= rhs'
-      op := ($QuickCode => 'QSETREFV;'SETELT)
+      op := "setShellEntry"
       wiReplaceNode(item,[op,'$,NRTgetLocalIndexClear lhs,rhsCode], 16)
   wiReplaceNode(item, code, 18)
 
-- 
cgit v1.2.3