diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 10 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 10 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 158 | ||||
| -rw-r--r-- | src/interp/define.boot | 9 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 24 | ||||
| -rw-r--r-- | src/interp/i-syscmd.boot | 173 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 1 | ||||
| -rw-r--r-- | src/interp/package.boot | 4 | ||||
| -rw-r--r-- | src/interp/patches.lisp | 2 | ||||
| -rw-r--r-- | src/interp/sys-macros.lisp | 3 | ||||
| -rw-r--r-- | src/interp/wi2.boot | 24 |
12 files changed, 208 insertions, 217 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index efd0f893..d3015d29 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,12 @@ 2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot: Import "msgdb", not "c-util". Move + compiler driver to i-syscmd.boot. + * interp/define.boot: Import "nruncomp", "functor", "package". + * interp/wi2.boot (NRTgetLocalIndex): Remove duplicate. + +2008-11-15 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/spad.lisp (incTimeSum): Remove. * interp/modemap.boot ($forceAdd): Define. * interp/nruncomp.boot ($NRTderivedTargetIfTrue): Likewise. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 44f1e0f2..a21b7bdb 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -171,7 +171,7 @@ all-axiomsys: all-interpsys mostlyclean-local: @rm -f *.fn *.data *.$(FASLEXT) *.lib *.$(OBJEXT) - rm -f makeint.lisp + @rm -f $(SAVESYS) makeint.lisp clean-local: mostlyclean-local @rm -f *.clisp *.lsp @@ -303,14 +303,16 @@ setvart.$(FASLEXT): macros.$(FASLEXT) ## OpenAxiom's compiler wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT) wi1.$(FASLEXT): macros.$(FASLEXT) -compiler.$(FASLEXT): c-util.$(FASLEXT) modemap.$(FASLEXT) \ +compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \ pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) nrunopt.$(FASLEXT): c-util.$(FASLEXT) nrunfast.$(FASLEXT): c-util.$(FASLEXT) -nruncomp.$(FASLEXT): c-util.$(FASLEXT) +nruncomp.$(FASLEXT): c-util.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT) nrungo.$(FASLEXT): c-util.$(FASLEXT) iterator.$(FASLEXT): g-util.$(FASLEXT) -define.$(FASLEXT): cattable.$(FASLEXT) category.$(FASLEXT) c-util.$(FASLEXT) +define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \ + functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \ + nruncomp.$(FASLEXT) package.$(FASLEXT): clam.$(FASLEXT) database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 67c3671b..5c531e9d 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -473,7 +473,7 @@ all-axiomsys: all-interpsys mostlyclean-local: @rm -f *.fn *.data *.$(FASLEXT) *.lib *.$(OBJEXT) - rm -f makeint.lisp + @rm -f $(SAVESYS) makeint.lisp clean-local: mostlyclean-local @rm -f *.clisp *.lsp @@ -552,14 +552,16 @@ setvart.$(FASLEXT): macros.$(FASLEXT) ## OpenAxiom's compiler wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT) wi1.$(FASLEXT): macros.$(FASLEXT) -compiler.$(FASLEXT): c-util.$(FASLEXT) modemap.$(FASLEXT) \ +compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \ pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) nrunopt.$(FASLEXT): c-util.$(FASLEXT) nrunfast.$(FASLEXT): c-util.$(FASLEXT) -nruncomp.$(FASLEXT): c-util.$(FASLEXT) +nruncomp.$(FASLEXT): c-util.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT) nrungo.$(FASLEXT): c-util.$(FASLEXT) iterator.$(FASLEXT): g-util.$(FASLEXT) -define.$(FASLEXT): cattable.$(FASLEXT) category.$(FASLEXT) c-util.$(FASLEXT) +define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \ + functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \ + nruncomp.$(FASLEXT) package.$(FASLEXT): clam.$(FASLEXT) database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index c62d4345..c91458e1 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -32,12 +32,13 @@ -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -import c_-util +import msgdb import pathname import modemap import define import iterator namespace BOOT + module compiler where compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple coerce: (%Triple,%Mode) -> %Maybe %Triple @@ -1641,161 +1642,6 @@ modeEqualSubst(m1,m,e) == and/[modeEqualSubst(xm1,xm2,e) for xm1 in l1 for xm2 in l2] nil ---% Things to support )compile - -compileSpad2Cmd args == - -- This is the old compiler - -- Assume we entered from the "compiler" function, so args ^= nil - -- and is a file with file extension .spad. - - path := pathname args - pathnameType path ^= '"spad" => throwKeyedMsg("S2IZ0082", nil) - ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) - - SETQ(_/EDITFILE, path) - updateSourceFiles path - sayKeyedMsg("S2IZ0038",[namestring args]) - - optList := '( _ - break _ - constructor _ - functions _ - library _ - lisp _ - new _ - old _ - nobreak _ - nolibrary _ - noquiet _ - vartrace _ - quiet _ - translate _ - optimize - ) - - translateOldToNew := nil - - $scanIfTrue : local := false - $compileOnlyCertainItems : local := nil - $f : local := nil -- compiler - $m : local := nil -- variables - - -- following are for )quick option for code generation - $QuickLet : local := true - - fun := ['rq, 'lib] - constructor := nil - $sourceFileTypes : local := '("SPAD") - - for opt in $options repeat - [optname,:optargs] := opt - fullopt := selectOptionLC(optname,optList,nil) - - fullopt = 'new => error "Internal error: compileSpad2Cmd got )new" - fullopt = 'old => NIL -- no opt - fullopt = 'translate => translateOldToNew := true - - fullopt = 'library => fun.1 := 'lib - fullopt = 'nolibrary => fun.1 := 'nolib - - -- Ignore quiet/nonquiet if "constructor" is given. - fullopt = 'quiet => if fun.0 ^= 'c then fun.0 := 'rq - fullopt = 'noquiet => if fun.0 ^= 'c then fun.0 := 'rf - fullopt = 'nobreak => $scanIfTrue := true - fullopt = 'break => $scanIfTrue := nil - fullopt = 'vartrace => - $QuickLet := false - fullopt = 'lisp => - throwKeyedMsg("S2IZ0036",['")lisp"]) - fullopt = 'functions => - null optargs => - throwKeyedMsg("S2IZ0037",['")functions"]) - $compileOnlyCertainItems := optargs - fullopt = 'constructor => - null optargs => - throwKeyedMsg("S2IZ0037",['")constructor"]) - fun.0 := 'c - constructor := [unabbrev o for o in optargs] - fullopt = "optimize" => setCompilerOptimizations first optargs - throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) - - $InteractiveMode : local := nil - -- avoid transformations based on syntax only - $normalizeTree := false - if translateOldToNew then - spad2AsTranslatorAutoloadOnceTrigger() - sayKeyedMsg("S2IZ0085", nil) - convertSpadToAsFile path - else if $compileOnlyCertainItems then - null constructor => sayKeyedMsg("S2IZ0040",NIL) - compilerDoitWithScreenedLisplib(constructor, fun) - else - compilerDoit(constructor, fun) - if not $buildingSystemAlgebra then - extendLocalLibdb $newConlist - terminateSystemCommand() - -- reset compiler optimization options - setCompilerOptimizations 0 - spadPrompt() - -convertSpadToAsFile path == - -- can assume path has type = .spad - $globalMacroStack : local := nil -- for spad -> as translator - $abbreviationStack: local := nil -- for spad -> as translator - $macrosAlreadyPrinted: local := nil -- for spad -> as translator - SETQ($badStack, nil) --ditto TEMP to check for bad code - $newPaths: local := true --ditto TEMP - $abbreviationsAlreadyPrinted: local := nil -- for spad -> as translator - $convertingSpadFile : local := true - $options: local := '((nolib)) -- translator shouldn't create nrlibs - SETQ(HT,MAKE_-HASHTABLE 'UEQUAL) - - newName := fnameMake(pathnameDirectory path, pathnameName path, '"as") - canDoIt := true - if not fnameWritable? newName then - sayKeyedMsg("S2IZ0086", [NAMESTRING newName]) - newName := fnameMake('".", pathnameName path, '"as") - if not fnameWritable? newName then - sayKeyedMsg("S2IZ0087", [NAMESTRING newName]) - canDoIt := false - not canDoIt => 'failure - - sayKeyedMsg("S2IZ0088", [NAMESTRING newName]) - - $outStream :local := MAKE_-OUTSTREAM newName - markSay('"#include _"axiom.as_"") - markTerpri() - CATCH($SpadReaderTag,compiler [path]) - SHUT $outStream - mkCheck() - 'done - -compilerDoit(constructor, fun) == - $byConstructors : local := [] - $constructorsSeen : local := [] - fun = ['rf, 'lib] => _/RQ_,LIB() -- Ignore "noquiet". - fun = ['rf, 'nolib] => _/RF() - fun = ['rq, 'lib] => _/RQ_,LIB() - fun = ['rq, 'nolib] => _/RQ() - fun = ['c, 'lib] => - $byConstructors := [opOf x for x in constructor] - _/RQ_,LIB() - for ii in $byConstructors repeat - null member(ii,$constructorsSeen) => - sayBrightly ['">>> Warning ",'%b,ii,'%d,'" was not found"] - -compilerDoitWithScreenedLisplib(constructor, fun) == - EMBED('RWRITE, - '(LAMBDA (KEY VALUE STREAM) - (COND ((AND (EQ STREAM $libFile) - (NOT (MEMBER KEY $saveableItems))) - VALUE) - ((NOT NIL) - (RWRITE KEY VALUE STREAM)))) ) - UNWIND_-PROTECT(compilerDoit(constructor,fun), - SEQ(UNEMBED 'RWRITE)) - - --% Categories compCat(form is [functorName,:argl],m,e) == diff --git a/src/interp/define.boot b/src/interp/define.boot index 3901ffbd..7f80200c 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -31,10 +31,13 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -import c_-util +import nruncomp +import g_-error +import lisplib import cattable -import category +import functor +import package + namespace BOOT module define diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index f06675df..155d7985 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -40,12 +40,17 @@ namespace BOOT module g_-util where getTypeOfSyntax: %Form -> %Mode pairList: (%List,%List) -> %List + mkList: %List -> %List ++ $interpOnly := false --% Utility Functions of General Use +mkList u == + u => ["LIST",:u] + nil + ELEMN(x, n, d) == null x => d n = 1 => car x @@ -57,6 +62,25 @@ PPtoFile(x, fname) == SHUT stream x +ScanOrPairVec(f, ob) == + $seen: local := MAKE_-HASHTABLE 'EQ + + CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where + ScanOrInner(f, ob) == + HGET($seen, ob) => nil + PAIRP ob => + HPUT($seen, ob, true) + ScanOrInner(f, QCAR ob) + ScanOrInner(f, QCDR ob) + nil + VECP ob => + HPUT($seen, ob, true) + for i in 0..#ob-1 repeat ScanOrInner(f, ob.i) + nil + FUNCALL(f, ob) => + THROW('ScanOrPairVecAnswer, true) + nil + ++ Query properties for an entity in a given environment. get: (%Thing,%Symbol,%List) -> %Thing diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index b380f1f5..224d24f7 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -760,6 +760,159 @@ compileSpadLispCmd args == terminateSystemCommand() spadPrompt() +compileSpad2Cmd args == + -- This is the old compiler + -- Assume we entered from the "compiler" function, so args ^= nil + -- and is a file with file extension .spad. + + path := pathname args + pathnameType path ^= '"spad" => throwKeyedMsg("S2IZ0082", nil) + ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args]) + + SETQ(_/EDITFILE, path) + updateSourceFiles path + sayKeyedMsg("S2IZ0038",[namestring args]) + + optList := '( _ + break _ + constructor _ + functions _ + library _ + lisp _ + new _ + old _ + nobreak _ + nolibrary _ + noquiet _ + vartrace _ + quiet _ + translate _ + optimize + ) + + translateOldToNew := nil + + $scanIfTrue : local := false + $compileOnlyCertainItems : local := nil + $f : local := nil -- compiler + $m : local := nil -- variables + + -- following are for )quick option for code generation + $QuickLet : local := true + + fun := ['rq, 'lib] + constructor := nil + $sourceFileTypes : local := '("SPAD") + + for opt in $options repeat + [optname,:optargs] := opt + fullopt := selectOptionLC(optname,optList,nil) + + fullopt = 'new => error "Internal error: compileSpad2Cmd got )new" + fullopt = 'old => NIL -- no opt + fullopt = 'translate => translateOldToNew := true + + fullopt = 'library => fun.1 := 'lib + fullopt = 'nolibrary => fun.1 := 'nolib + + -- Ignore quiet/nonquiet if "constructor" is given. + fullopt = 'quiet => if fun.0 ^= 'c then fun.0 := 'rq + fullopt = 'noquiet => if fun.0 ^= 'c then fun.0 := 'rf + fullopt = 'nobreak => $scanIfTrue := true + fullopt = 'break => $scanIfTrue := nil + fullopt = 'vartrace => + $QuickLet := false + fullopt = 'lisp => + throwKeyedMsg("S2IZ0036",['")lisp"]) + fullopt = 'functions => + null optargs => + throwKeyedMsg("S2IZ0037",['")functions"]) + $compileOnlyCertainItems := optargs + fullopt = 'constructor => + null optargs => + throwKeyedMsg("S2IZ0037",['")constructor"]) + fun.0 := 'c + constructor := [unabbrev o for o in optargs] + fullopt = "optimize" => setCompilerOptimizations first optargs + throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)]) + + $InteractiveMode : local := nil + -- avoid transformations based on syntax only + $normalizeTree := false + if translateOldToNew then + spad2AsTranslatorAutoloadOnceTrigger() + sayKeyedMsg("S2IZ0085", nil) + convertSpadToAsFile path + else if $compileOnlyCertainItems then + null constructor => sayKeyedMsg("S2IZ0040",NIL) + compilerDoitWithScreenedLisplib(constructor, fun) + else + compilerDoit(constructor, fun) + if not $buildingSystemAlgebra then + extendLocalLibdb $newConlist + terminateSystemCommand() + -- reset compiler optimization options + setCompilerOptimizations 0 + spadPrompt() + +convertSpadToAsFile path == + -- can assume path has type = .spad + $globalMacroStack : local := nil -- for spad -> as translator + $abbreviationStack: local := nil -- for spad -> as translator + $macrosAlreadyPrinted: local := nil -- for spad -> as translator + SETQ($badStack, nil) --ditto TEMP to check for bad code + $newPaths: local := true --ditto TEMP + $abbreviationsAlreadyPrinted: local := nil -- for spad -> as translator + $convertingSpadFile : local := true + $options: local := '((nolib)) -- translator shouldn't create nrlibs + SETQ(HT,MAKE_-HASHTABLE 'UEQUAL) + + newName := fnameMake(pathnameDirectory path, pathnameName path, '"as") + canDoIt := true + if not fnameWritable? newName then + sayKeyedMsg("S2IZ0086", [NAMESTRING newName]) + newName := fnameMake('".", pathnameName path, '"as") + if not fnameWritable? newName then + sayKeyedMsg("S2IZ0087", [NAMESTRING newName]) + canDoIt := false + not canDoIt => 'failure + + sayKeyedMsg("S2IZ0088", [NAMESTRING newName]) + + $outStream :local := MAKE_-OUTSTREAM newName + markSay('"#include _"axiom.as_"") + markTerpri() + CATCH($SpadReaderTag,compiler [path]) + SHUT $outStream + mkCheck() + 'done + +compilerDoit(constructor, fun) == + $byConstructors : local := [] + $constructorsSeen : local := [] + fun = ['rf, 'lib] => _/RQ_,LIB() -- Ignore "noquiet". + fun = ['rf, 'nolib] => _/RF() + fun = ['rq, 'lib] => _/RQ_,LIB() + fun = ['rq, 'nolib] => _/RQ() + fun = ['c, 'lib] => + $byConstructors := [opOf x for x in constructor] + _/RQ_,LIB() + for ii in $byConstructors repeat + null member(ii,$constructorsSeen) => + sayBrightly ['">>> Warning ",'%b,ii,'%d,'" was not found"] + +compilerDoitWithScreenedLisplib(constructor, fun) == + EMBED('RWRITE, + '(LAMBDA (KEY VALUE STREAM) + (COND ((AND (EQ STREAM $libFile) + (NOT (MEMBER KEY $saveableItems))) + VALUE) + ((NOT NIL) + (RWRITE KEY VALUE STREAM)))) ) + UNWIND_-PROTECT(compilerDoit(constructor,fun), + SEQ(UNEMBED 'RWRITE)) + + withAsharpCmd args == $options: local := nil LOCALDATABASE(args, $options) @@ -2082,26 +2235,6 @@ dewritify ob == -- Default case: return the object itself. ob -ScanOrPairVec(f, ob) == - $seen: local := MAKE_-HASHTABLE 'EQ - - CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where - ScanOrInner(f, ob) == - HGET($seen, ob) => nil - PAIRP ob => - HPUT($seen, ob, true) - ScanOrInner(f, QCAR ob) - ScanOrInner(f, QCDR ob) - nil - VECP ob => - HPUT($seen, ob, true) - for i in 0..#ob-1 repeat ScanOrInner(f, ob.i) - nil - FUNCALL(f, ob) => - THROW('ScanOrPairVecAnswer, true) - nil - - diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index dc6218e1..d362a87f 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -34,6 +34,7 @@ import c_-util import simpbool +import profile namespace BOOT diff --git a/src/interp/package.boot b/src/interp/package.boot index 38ae9bd8..8dd15b8b 100644 --- a/src/interp/package.boot +++ b/src/interp/package.boot @@ -126,10 +126,6 @@ subTree(u,v) == ATOM v => nil or/[subTree(u,v') for v' in v] -mkList u == - u => ["LIST",:u] - nil - setPackageLocals(pac,locs) == for var in locs for i in 0.. | var^=nil repeat pac.i:= var diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp index 2c25a1fd..e6d206ba 100644 --- a/src/interp/patches.lisp +++ b/src/interp/patches.lisp @@ -117,8 +117,6 @@ (defun SHAREDITEMS (x) T) ;;checked in history code -(define-function '|eval| #'eval) - (defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0)) (defun READSPADEXPR () diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp index b86c597e..920d71d0 100644 --- a/src/interp/sys-macros.lisp +++ b/src/interp/sys-macros.lisp @@ -364,6 +364,9 @@ `(let ((,gi ,fn)) (the (values t) (funcall (car ,gi) ,@args (cdr ,gi)))))) +(defmacro |eval| (form) + `(EVAL ,form)) + ;; ;; -*- Arithmetics -*- ;; diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index e449b0f0..d0481570 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -671,30 +671,6 @@ compMapCond''(cexpr,dc) == --====================================================================== -- From nruncomp.boot --====================================================================== -NRTgetLocalIndex item == - k := NRTassocIndex item => k - item = $NRTaddForm => 5 - item = '$ => 0 - item = '_$_$ => 2 - value:= - MEMQ(item,$formalArgList) => item - nil - atom item and null MEMQ(item,'($ _$_$)) - and null value => --give slots to atoms - $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList] - $NRTdeltaListComp:=[item,:$NRTdeltaListComp] - $NRTdeltaLength := $NRTdeltaLength+1 - $NRTbase + $NRTdeltaLength - 1 - $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList] - saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp] - saveIndex := $NRTbase + $NRTdeltaLength - $NRTdeltaLength := $NRTdeltaLength+1 - compEntry:= item - ----94/11/07 - -- WAS: compOrCroak(item,$EmptyMode,$e).expr - RPLACA(saveNRTdeltaListComp,compEntry) - saveIndex - optDeltaEntry(op,sig,dc,eltOrConst) == return nil --------> kill it $killOptimizeIfTrue = true => nil |