From da9f79f1d47983d726e90858f85b074dc88d0866 Mon Sep 17 00:00:00 2001 From: dos-reis 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/ChangeLog | 35 +++++++++++++++++++++++++++++++++++ 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 ++---- 14 files changed, 88 insertions(+), 45 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index b202fc6c..e2536ef0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,38 @@ +2008-04-07 Gabriel Dos Reis + + * 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. + 2008-04-06 Gabriel Dos Reis * interp/sys-constants.boot ($quitTag): Define here. 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