diff options
author | dos-reis <gdr@axiomatics.org> | 2008-04-07 10:34:36 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-04-07 10:34:36 +0000 |
commit | da9f79f1d47983d726e90858f85b074dc88d0866 (patch) | |
tree | 1091fb7e2473a9910eb0592fa553856c5562df78 | |
parent | 498b53ea49bdd7d640fc4f8426e8ecf6b0128cc5 (diff) | |
download | open-axiom-da9f79f1d47983d726e90858f85b074dc88d0866.tar.gz |
* 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.
-rwxr-xr-x | configure | 18 | ||||
-rw-r--r-- | configure.ac | 2 | ||||
-rw-r--r-- | configure.ac.pamphlet | 2 | ||||
-rw-r--r-- | src/ChangeLog | 35 | ||||
-rw-r--r-- | src/interp/compiler.boot | 5 | ||||
-rw-r--r-- | src/interp/define.boot | 14 | ||||
-rw-r--r-- | src/interp/functor.boot | 30 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 6 | ||||
-rw-r--r-- | src/interp/i-util.boot | 5 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 8 | ||||
-rw-r--r-- | src/interp/nrunopt.boot | 2 | ||||
-rw-r--r-- | src/interp/nruntime.boot | 10 | ||||
-rw-r--r-- | src/interp/package.boot | 5 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 3 | ||||
-rw-r--r-- | src/interp/template.boot | 2 | ||||
-rw-r--r-- | src/interp/types.boot | 2 | ||||
-rw-r--r-- | src/interp/wi2.boot | 6 |
17 files changed, 99 insertions, 56 deletions
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-04-05. +# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-04-07. # # Report bugs to <open-axiom-bugs@lists.sf.net>. # @@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.2.0-2008-04-05' -PACKAGE_STRING='OpenAxiom 1.2.0-2008-04-05' +PACKAGE_VERSION='1.2.0-2008-04-07' +PACKAGE_STRING='OpenAxiom 1.2.0-2008-04-07' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' ac_unique_file="src/Makefile.pamphlet" @@ -1402,7 +1402,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OpenAxiom 1.2.0-2008-04-05 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.2.0-2008-04-07 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1472,7 +1472,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-04-05:";; + short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-04-07:";; esac cat <<\_ACEOF @@ -1576,7 +1576,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.2.0-2008-04-05 +OpenAxiom configure 1.2.0-2008-04-07 generated by GNU Autoconf 2.60 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1590,7 +1590,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.2.0-2008-04-05, which was +It was created by OpenAxiom $as_me 1.2.0-2008-04-07, which was generated by GNU Autoconf 2.60. Invocation command line was $ $0 $@ @@ -25801,7 +25801,7 @@ exec 6>&1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OpenAxiom $as_me 1.2.0-2008-04-05, which was +This file was extended by OpenAxiom $as_me 1.2.0-2008-04-07, which was generated by GNU Autoconf 2.60. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -25850,7 +25850,7 @@ Report bugs to <bug-autoconf@gnu.org>." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -OpenAxiom config.status 1.2.0-2008-04-05 +OpenAxiom config.status 1.2.0-2008-04-07 configured by $0, generated by GNU Autoconf 2.60, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.ac b/configure.ac index e0e52418..ffae31c9 100644 --- a/configure.ac +++ b/configure.ac @@ -1,6 +1,6 @@ sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-04-05], +AC_INIT([OpenAxiom], [1.2.0-2008-04-07], [open-axiom-bugs@lists.sf.net]) AC_CONFIG_AUX_DIR(config) diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet index 3e11fae7..bc220c4b 100644 --- a/configure.ac.pamphlet +++ b/configure.ac.pamphlet @@ -1092,7 +1092,7 @@ information: <<Autoconf init>>= sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-04-05], +AC_INIT([OpenAxiom], [1.2.0-2008-04-07], [open-axiom-bugs@lists.sf.net]) @ 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 <gdr@cs.tamu.edu> + + * 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 <gdr@cs.tamu.edu> * 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 @@ -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) |