Generate SVREF for simple vector slot refs.

12 files changed, 67 insertions, 63 deletions

diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 6888f321..3b5694f7 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -244,6 +244,7 @@
                   (LIST '|toString| 'WRITE-TO-STRING) (LIST '|true| 'T)
                   (LIST '|upperCase?| 'UPPER-CASE-P)
                   (LIST '|vector?| 'SIMPLE-VECTOR-P)
+                  (LIST '|vectorRef| 'SVREF)
                   (LIST '|writeByte| 'WRITE-BYTE)
                   (LIST '|writeLine| 'WRITE-LINE) (LIST 'PLUS '+)
                   (LIST 'MINUS '-) (LIST 'TIMES '*) (LIST 'POWER 'EXPT)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 9647e0e5..dd46d89b 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -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
@@ -307,6 +307,7 @@ for i in [ _
   ["true",           "T"]  , _
   ["upperCase?", "UPPER-CASE-P"], _
   ["vector?", "SIMPLE-VECTOR-P"], _
+  ["vectorRef", "SVREF"] , _
   ["writeByte", "WRITE-BYTE"], _
   ["writeLine", "WRITE-LINE"], _
   ["PLUS",           "+"]  , _
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index d885b1c1..2f08bc29 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -85,23 +85,24 @@ Record(:args) ==
   nargs := #args
   dom := newShell(nargs + 10)
   -- JHD added an extra slot to cache EQUAL methods
-  dom.0 := ["Record", :srcArgs]
-  dom.1 :=
+  vectorRef(dom,0) := ["Record", :srcArgs]
+  vectorRef(dom,1) :=
     ["lookupInTable",dom,
 	[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	  ["~=",[[$Boolean,"$","$"],:0]], 
             ["hash",[[$SingleInteger,"$"],:0]],
                ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
-  dom.2 := nil
-  dom.3 := ["RecordCategory",:rest dom.0]
-  dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
-  dom.5 := nil
-  for i in $FirstParamSlot.. for a in args repeat dom.i := third a
-  dom.($FirstParamSlot + nargs) := [function RecordEqual, :dom]
-  dom.($FirstParamSlot + nargs + 1) := [function RecordPrint, :dom]
-  dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom]
+  vectorRef(dom,2) := nil
+  vectorRef(dom,3) := ["RecordCategory",:rest dom.0]
+  vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
+  vectorRef(dom,5) := nil
+  for i in $FirstParamSlot.. for a in args repeat
+    vectorRef(dom,i) := third a
+  vectorRef(dom,$FirstParamSlot + nargs) := [function RecordEqual, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 1) := [function RecordPrint, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 2) := [function Undef, :dom]
 -- following is cache for equality functions
-  dom.($FirstParamSlot + nargs + 3) := if nargs <= 2
+  vectorRef(dom,$FirstParamSlot + nargs + 3) := if nargs <= 2
 	    then [nil,:nil]
 	    else newShell nargs
   -- remember this instantiation for future re-use.
@@ -160,26 +161,27 @@ Union(:args) ==
           "domainEqualList") => CDRwithIncrement t
   nargs := #args
   dom := newShell (nargs + 9)
-  dom.0 := ["Union", :srcArgs]
-  dom.1 :=
+  vectorRef(dom,0) := ["Union", :srcArgs]
+  vectorRef(dom,1) :=
     ["lookupInTable",dom,
        [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	 ["~=",[[$Boolean,"$","$"],:0]],
            ["hash", [[$SingleInteger,"$"],:0]],
               ["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]]
-  dom.2 := nil
-  dom.3 := ["UnionCategory",:rest dom.0]
-  dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
-  dom.5 := nil
-  for i in $FirstParamSlot.. for a in args repeat dom.i := a
-  dom.($FirstParamSlot + nargs) := [function UnionEqual, :dom]
-  dom.($FirstParamSlot + nargs + 1) := [function UnionPrint, :dom]
-  dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom]
+  vectorRef(dom,2) := nil
+  vectorRef(dom,3) := ["UnionCategory",:rest dom.0]
+  vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
+  vectorRef(dom,5) := nil
+  for i in $FirstParamSlot.. for a in args repeat
+    vectorRef(dom,i) := a
+  vectorRef(dom,$FirstParamSlot + nargs) := [function UnionEqual, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 1) := [function UnionPrint, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 2) := [function Undef, :dom]
   haddProp($ConstructorCache,"Union",srcArgs,[1,:dom])
   dom
 
 UnionEqual(x, y, dom) ==
-  ["Union",:branches] := dom.0
+  ["Union",:branches] := vectorRef(dom,0)
   predlist := mkPredList branches
   same := false
   for b in stripUnionTags branches for p in predlist while not same repeat
@@ -216,21 +218,22 @@ Mapping(:args) ==
           "domainEqualList") => CDRwithIncrement t
   nargs := #args
   dom := newShell(nargs + 9)
-  dom.0 := ["Mapping", :srcArgs]
-  dom.1 :=
+  vectorRef(dom,0) := ["Mapping", :srcArgs]
+  vectorRef(dom,1) :=
     ["lookupInTable",dom,
        [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	 ["~=",[[$Boolean,"$","$"],:0]],
            ["hash", [[$SingleInteger,"$"],:0]],
               ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
-  dom.2 := nil
-  dom.3 := $SetCategory
-  dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
-  dom.5 := nil
-  for i in $FirstParamSlot.. for a in args repeat dom.i := a
-  dom.($FirstParamSlot + nargs) := [function MappingEqual, :dom]
-  dom.($FirstParamSlot + nargs + 1) := [function MappingPrint, :dom]
-  dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom]
+  vectorRef(dom,2) := nil
+  vectorRef(dom,3) := $SetCategory
+  vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
+  vectorRef(dom,5) := nil
+  for i in $FirstParamSlot.. for a in args repeat
+    vectorRef(dom,i) := a
+  vectorRef(dom,$FirstParamSlot + nargs) := [function MappingEqual, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 1) := [function MappingPrint, :dom]
+  vectorRef(dom,$FirstParamSlot + nargs + 2) := [function Undef, :dom]
   haddProp($ConstructorCache,"Mapping",srcArgs,[1,:dom])
   dom
 
@@ -252,8 +255,8 @@ Enumeration(:"args") ==
   nargs := #args
   dom := newShell(nargs + 9)
   -- JHD added an extra slot to cache EQUAL methods
-  dom.0 := ["Enumeration", :args]
-  dom.1 :=
+  vectorRef(dom,0) := ["Enumeration", :args]
+  vectorRef(dom,1) :=
     ["lookupInTable",dom,
 	[["=",[[$Boolean,"$","$"],:oldSlotCode nargs]],
 	  ["~=",[[$Boolean,"$","$"],:0]],
@@ -261,10 +264,10 @@ Enumeration(:"args") ==
               ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs+1)], 
                 [["$", $Symbol], :oldSlotCode(nargs+2)]]
                   ]]
-  dom.2 := nil
-  dom.3 := ["EnumerationCategory",:rest dom.0]
-  dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
-  dom.5 := nil
+  vectorRef(dom,2) := nil
+  vectorRef(dom,3) := ["EnumerationCategory",:rest dom.0]
+  vectorRef(dom,4) := [$commonCategoryDefaults, $commonCategoryAncestors]
+  vectorRef(dom,5) := nil
   for i in $FirstParamSlot.. for a in args repeat dom.i := a
   dom.($FirstParamSlot + nargs) := [function EnumEqual, :dom]
   dom.($FirstParamSlot + nargs + 1) := [function EnumPrint, :dom]
@@ -276,10 +279,10 @@ EnumEqual(e1,e2,dom) ==
   e1=e2
 
 EnumPrint(enum, dom) == 
-  (rest(dom.0)).enum
+  rest(vectorRef(dom,0)).enum
 
 createEnum(sym, dom) ==
-  args := rest(dom.0)
+  args := vectorRef(dom,0).args
   val := -1
   for v in args for i in 0.. repeat
      sym=v => return(val:=i)
@@ -302,7 +305,7 @@ constructorCategory (title is [op,:.]) ==
   cat:=
     JoinInner([eval $SetCategory,mkCategory("domain",oplist,nil,nil,nil)],
       $EmptyEnvironment)
-  cat.0 := title
+  vectorRef(cat,0) := title
   cat
 
 --mkMappingFunList(nam,mapForm,e) == [[],e]
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index cfb68f21..08bfb572 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -179,10 +179,9 @@ declareUnusedParameters x == (augment x; x) where
 
 devaluate d ==
   not vector? d => d
-  QSGREATERP(QVSIZE d,5) and getShellEntry(d,3) is ['Category] => 
-    getShellEntry(d,0)
-  QSGREATERP(QVSIZE d,0) =>
-    d':=getShellEntry(d,0)
+  QVSIZE d > 5 and vectorRef(d,3) is ['Category] => vectorRef(d,0)
+  QVSIZE d > 0 =>
+    d' := vectorRef(d,0)
     isFunctor d' => d'
     d
   d
@@ -1629,7 +1628,7 @@ expandFormTemplate(shell,args,slot) ==
   integer? slot =>
     slot = 0 => "$"
     slot = 2 => "$$"
-    expandFormTemplate(shell,args,getShellEntry(shell,slot))
+    expandFormTemplate(shell,args,vectorRef(shell,slot))
   atom slot => slot
   slot is ["local",parm] and (n := isFormal parm) => 
     args.n   -- FIXME: we should probably expand with dual signature
@@ -1645,7 +1644,7 @@ equalFormTemplate(shell,args,slot,form) ==
   integer? slot =>
     slot = 0 => form = "$"
     slot = 2 => form = "$$"
-    equalFormTemplate(shell,args,getShellEntry(shell,slot),form)
+    equalFormTemplate(shell,args,vectorRef(shell,slot),form)
   slot is ["local",parm] and (n := isFormal parm) => 
     equalFormTemplate(shell,args,args.n,form)
   slot is ["NTREVAL",val] => form = val
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 4d873c5b..e788700f 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -48,7 +48,7 @@ $NewCatVec := nil
 ++ Returns true if `a' is a category (runtime) object.
 isCategory: %Thing -> %Boolean
 isCategory a == 
-  vector? a and #a > 5 and getShellEntry(a,3) = $Category
+  vector? a and #a > 5 and vectorRef(a,3) = $Category
 
 ++ Return true if the form `x' designates an instantiaion of a
 ++ category constructor known to the global database or the
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 369a43bb..993f928c 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -435,7 +435,7 @@ optQSMINUS u ==
 ++ List of VM side effect free operators.
 $VMsideEffectFreeOperators ==
   '(CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND
-    SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH
+    SPADfirst _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH
      QEQCAR QCDR QCAR IDENTP SYMBOLP
       GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN
        CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 6a75ba52..4949f043 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -195,7 +195,7 @@ pushDownOp?(op,n) ==
   numMms := # ops
   for [.,targ,:argl] in ops repeat
     for arg in argl for i in 0.. repeat
-      targ = arg => setShellEntry(sameAsTarg,i,1 + sameAsTarg.i)
+      targ = arg => vectorRef(sameAsTarg,i) := 1 + sameAsTarg.i
   -- now see which args have their count = numMms
   ok := NIL
   for i in 0..(n-1) repeat
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index 66f72f73..e26c256d 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2080,7 +2080,7 @@ writify ob ==
                 HPUT($seen, ob, nob)
                 HPUT($seen, nob, nob)
                 for i in 0..n repeat
-                    QSETVELT(nob, i, writifyInner QVELT(ob,i))
+                    vectorRef(nob, i) := writifyInner vectorRef(ob,i)
                 nob
             ob = 'WRITIFIED_!_! =>
                 ['WRITIFIED_!_!, 'SELF]
@@ -2223,7 +2223,7 @@ dewritify ob ==
                 HPUT($seen, ob, nob)
                 HPUT($seen, nob, nob)
                 for i in 0..n repeat
-                    QSETVELT(nob, i, dewritifyInner QVELT(ob,i))
+                    vectorRef(nob,i) := dewritifyInner vectorRef(ob,i)
                 nob
             -- Default case: return the object itself.
             ob
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 2722de20..bd9cf23f 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -578,12 +578,12 @@ newHasCategory(domain,catform) ==
     predIndex := lazyMatchAssocV1(catform,catvec,domain)
     null predIndex => false
     predIndex = 0 => true
-    predvec := QVELT(domain,3)
+    predvec := vectorRef(domain,3)
     testBitVector(predvec,predIndex)
   lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
 
 getCatForm(catvec, index, domain) ==
-   integer?(form := QVELT(catvec,index)) => domain.form
+   integer?(form := vectorRef(catvec,index)) => domain.form
    form
 
 HasSignature(domain,[op,sig]) ==
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 8a2fa6b8..a9097d17 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -84,7 +84,7 @@ getOpCode(op,vec,max) ==
 --search Op vector for "op" returning code if found, nil otherwise
   res := nil
   for i in 0..max by 2 repeat
-    EQ(QVELT(vec,i),op) => return (res := QSADD1 i)
+    EQ(vectorRef(vec,i),op) => return (res := QSADD1 i)
   res
 
 evalSlotDomain(u,dollar) ==
@@ -157,7 +157,7 @@ replaceGoGetSlot env ==
     keyedSystemError("S2NR0001",[op,sig,goGetDomain.0])
   if $monitorNewWorld then
     sayLooking1(['"goget stuffing slot",:bright thisSlot,'"of "],thisDomain)
-  setShellEntry(thisDomain,thisSlot,slot)
+  vectorRef(thisDomain,thisSlot) := slot
   if $monitorNewWorld then
     sayLooking1('"<------",[first slot,:devaluate rest slot])
   slot
@@ -601,7 +601,7 @@ lazyDomainSet(lazyForm,thisDomain,slot) ==
     sayLooking1(concat(form2String devaluate thisDomain,
       '" activating lazy slot ",slot,'": "),slotDomain)
   name := first form
-  setShellEntry(thisDomain,slot,slotDomain)
+  vectorRef(thisDomain,slot) := slotDomain
  
 
 ++ Return a type form where all niladic constructors are
@@ -676,13 +676,13 @@ lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
   n := MAXINDEX catvec
   xop := first x
   or/[auxvec.i for i in 0..n |
-    xop = first (lazyt := QVELT(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
+    xop = first (lazyt := vectorRef(catvec,i)) and lazyMatch(x,lazyt,domain,domain)]
  
 lazyMatchAssocV1(x,vec,domain) ==               --old style slot4
   n  := MAXINDEX vec
   xop := first x
-  or/[rest QVELT(vec,i) for i in 0..n |
-    xop = first (lazyt := first QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
+  or/[rest vectorRef(vec,i) for i in 0..n |
+    xop = first (lazyt := first vectorRef(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
  
 --=======================================================
 --                   Utility Functions
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 4dea8353..b446b4cd 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -124,7 +124,7 @@ goGet(:l) ==
   fn:= basicLookup(op,sig,lookupDomain,dollar)
   fn = nil => keyedSystemError("S2NR0001",[op,sig,lookupDomain.0])
   val:= apply(first fn,[:arglist,rest fn])
-  setShellEntry(thisDomain,index,fn)
+  vectorRef(thisDomain,index) := fn
   val
 
 NRTreplaceLocalTypes(t,dom) ==
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index 635937a6..f15ed5f4 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -272,7 +272,7 @@ augmentPredCode(n,lastPl) ==
          delta:=2 * delta; u) for x in pl]
 
 augmentPredVector(dollar,value) ==
-  setShellEntry(dollar,3,value + QVELT(dollar,3))
+  vectorRef(dollar,3) := value + vectorRef(dollar,3)
 
 isHasDollarPred pred ==
   pred is [op,:r] =>