aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot5
-rw-r--r--src/interp/define.boot14
-rw-r--r--src/interp/functor.boot30
-rw-r--r--src/interp/g-opt.boot6
-rw-r--r--src/interp/i-util.boot5
-rw-r--r--src/interp/nruncomp.boot8
-rw-r--r--src/interp/nrunopt.boot2
-rw-r--r--src/interp/nruntime.boot10
-rw-r--r--src/interp/package.boot5
-rw-r--r--src/interp/sys-globals.boot3
-rw-r--r--src/interp/template.boot2
-rw-r--r--src/interp/types.boot2
-rw-r--r--src/interp/wi2.boot6
13 files changed, 53 insertions, 45 deletions
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
@@ -288,9 +288,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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-17 11:34:16 +0000