diff options
| -rw-r--r-- | src/interp/Makefile.in | 2 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 10 | ||||
| -rw-r--r-- | src/interp/define.boot | 1 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 138 | ||||
| -rw-r--r-- | src/interp/profile.boot | 5 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 |
6 files changed, 74 insertions, 85 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 195bef45..7365a89a 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -270,7 +270,7 @@ hypertex.$(FASLEXT): types.$(FASLEXT) ## OpenAxiom's interpreter. makeint.$(FASLEXT): util.$(FASLEXT) setvars.$(FASLEXT): sys-macros.$(FASLEXT) debug.$(FASLEXT) -profile.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) +profile.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) c-util.$(FASLEXT) rulesets.$(FASLEXT): vmlisp.$(FASLEXT) osyscmd.$(FASLEXT): int-top.$(FASLEXT) int-top.$(FASLEXT): incl.$(FASLEXT) i-toplev.$(FASLEXT) unlisp.$(FASLEXT) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 9ac95081..af95339b 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -145,17 +145,18 @@ macro domainData d == structure %CompilationData == Record(subst: %Substitution,idata: %Substitution,bytes: List %Fixnum, - shell: %Vector %Thing, - items: %Buffer %Pair(%SourceEntity,%Elaboration)) with + shell: %Vector %Thing, items: %Buffer %Pair(%SourceEntity,%Code), + output: %OutputStream) with cdSubstitution == (.subst) cdImplicits == (.idata) cdBytes == (.bytes) cdShell == (.shell) cdItems == (.items) + cdOutput == (.output) ++ Make a fresh compilation data structure. makeCompilationData() == - mk%CompilationData(nil,nil,nil,nil,[nil,:0]) + mk%CompilationData(nil,nil,nil,nil,[nil,:0],nil) ++ Subsitution that replaces parameters with formals. macro dbFormalSubst db == @@ -195,6 +196,9 @@ macro dbUsedEntities db == macro dbEntityCount db == rest dbEntityBuffer db +macro dbOutputStream db == + cdOutput dbCompilerData db + ++ Return the existential substitution of `db'. dbQuerySubst db == x := dbImplicitData db => first x diff --git a/src/interp/define.boot b/src/interp/define.boot index f4b2887e..db416e94 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1556,7 +1556,6 @@ compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) == LAM_,FILEACTQ('loadTimeStuff, ['MAKEPROP,MKQ $op,''infovec,getInfovecCode(db,$e)]) $lisplibOperationAlist:= operationAlist - dbBeingDefined?(db) := nil [fun,['Mapping,:signature'],originale] diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 89a96e01..c954e61a 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -387,7 +387,6 @@ compileConstructorLib(l,op,editFlag,traceFlag) == compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == $PrettyPrint: local := 'T $lisplibOperationAlist: local := nil - $libFile: local := nil if cons? fun and null rest fun then fun:= first fun -- unwrap nullary libName:= getConstructorAbbreviation fun infile:= infileOrNil or getFunctionSourceFile fun or @@ -404,7 +403,6 @@ compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) == sayMSG fillerSpaces(72,char "-") $op: local := op $lisplibOperationAlist: local := nil - $libFile: local := nil --for categories, is rhs of definition; otherwise, is target of functor --will eventually become the "constructorCategory" property in lisplib --set in compDefineCategory1 if category, otherwise in finalizeLisplib @@ -414,7 +412,7 @@ compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) == $compileDocumentation => compileDocumentation(op,libName) sayMSG ['" initializing ",$spadLibFT,:bright libName, '"for",:bright op] - initializeLisplib libName + initializeLisplib(db,libName) sayMSG ['" compiling into ",$spadLibFT,:bright libName] -- following guarantee's compiler output files get closed. ok := false; @@ -424,7 +422,7 @@ compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) == sayMSG ['" finalizing ",$spadLibFT,:bright libName] ok := finalizeLisplib(db,libName) finally - RSHUT $libFile + RSHUT dbOutputStream db if ok then lisplibDoRename(libName) filearg := makeFullFilePath [libName,$spadLibFT,nil] RPACKFILE filearg @@ -446,86 +444,76 @@ compileDocumentation(ctor,libName) == $REPLACE([libName,$spadLibFT],[libName,'DOCLB]) ['dummy, $EmptyMode, $e] -initializeLisplib libName == +initializeLisplib(db,libName) == removeFile makeFullFilePath [libName,'ERRORLIB,nil] resetErrorCount() - $libFile := writeLib(libName,'ERRORLIB) - addCompilerOption('FILE,$libFile) + dbOutputStream(db) := writeLib(libName,'ERRORLIB) + addCompilerOption('FILE,dbOutputStream db) -mkCtorDBForm ctor == - ['constructorDB,quote ctor] +mkCtorDBForm db == + ['constructorDB,quote dbConstructor db] -writeInfo(ctor,info,key,prop,file) == +writeInfo(db,info,key,prop) == if info ~= nil then - insn := ['%store,[prop,mkCtorDBForm ctor],quote info] + insn := ['%store,[prop,mkCtorDBForm db],quote info] LAM_,FILEACTQ(key,expandToVMForm insn) - lisplibWrite(symbolName key,info,file) + lisplibWrite(symbolName key,info,dbOutputStream db) ++ Like writeInfo, but only write to the load unit. -writeLoadInfo(ctor,info,key,prop,file) == +writeLoadInfo(db,info,key,prop) == info = nil => nil - insn := ['%store,[prop,mkCtorDBForm ctor],info] + insn := ['%store,[prop,mkCtorDBForm db],info] LAM_,FILEACTQ(key,expandToVMForm insn) -writeTemplate(db,file) == +writeTemplate db == dbConstructorKind db = 'category => nil - writeLoadInfo(dbConstructor db,dbTemplate db, - 'template,'dbTemplate,file) + writeLoadInfo(db,dbTemplate db,'template,'dbTemplate) -writeLookupFunction(db,file) == +writeLookupFunction db == fun := dbLookupFunction db => - writeLoadInfo(dbConstructor db,quote fun, - 'lookupFunction,'dbLookupFunction,file) + writeLoadInfo(db,quote fun,'lookupFunction,'dbLookupFunction) nil -writeKind(db,file) == - writeInfo(dbConstructor db,dbConstructorKind db, - 'constructorKind,'dbConstructorKind,file) +writeKind db == + writeInfo(db,dbConstructorKind db,'constructorKind,'dbConstructorKind) -writeAbbreviation(db,file) == - writeInfo(dbConstructor db,dbAbbreviation db, - 'abbreviation,'dbAbbreviation,file) +writeAbbreviation db == + writeInfo(db,dbAbbreviation db,'abbreviation,'dbAbbreviation) -writeConstructorForm(db,file) == - writeInfo(dbConstructor db,dbConstructorForm db, - 'constructorForm,'dbConstructorForm,file) +writeConstructorForm db == + writeInfo(db,dbConstructorForm db,'constructorForm,'dbConstructorForm) -writeCategory(db,file) == - writeInfo(dbConstructor db,dbCategory db, - 'constructorCategory,'dbCategory,file) +writeCategory db == + writeInfo(db,dbCategory db,'constructorCategory,'dbCategory) -writeSuperDomain(db,file) == - writeInfo(dbConstructor db,dbSuperDomain db, - 'superDomain,'dbSuperDomain,file) +writeSuperDomain db == + writeInfo(db,dbSuperDomain db,'superDomain,'dbSuperDomain) -writePredicates(db,file) == - writeInfo(dbConstructor db,dbPredicates db, - 'predicates,'dbPredicates,file) +writePredicates db == + writeInfo(db,dbPredicates db,'predicates,'dbPredicates) -writeOperations(ctor,ops,file) == - writeInfo(ctor,ops,'operationAlist,'dbOperations,file) +writeOperations(db,ops) == + writeInfo(db,ops,'operationAlist,'dbOperations) -writeAttributes(db,file) == - writeInfo(dbConstructor db,dbAttributes db, - 'attributes,'dbAttributes,file) +writeAttributes db == + writeInfo(db,dbAttributes db,'attributes,'dbAttributes) -writeConstructorModemap(db,file) == - writeInfo(dbConstructor db,dbConstructorModemap db, - 'constructorModemap,'dbConstructorModemap,file) +writeConstructorModemap db == + writeInfo(db,dbConstructorModemap db, + 'constructorModemap,'dbConstructorModemap) -writeDualSignature(db,file) == - writeInfo(dbConstructor db,dbDualSignature db, - 'dualSignature,'dbDualSignature,file) +writeDualSignature db == + writeInfo(db,dbDualSignature db,'dualSignature,'dbDualSignature) -writeAncestors(db,file) == - writeInfo(dbConstructor db,dbAncestors db,'ancestors,'dbAncestors,file) +writeAncestors db == + writeInfo(db,dbAncestors db,'ancestors,'dbAncestors) -writePrincipals(db,file) == - writeInfo(dbConstructor db,dbPrincipals db,'parents,'dbPrincipals,file) +writePrincipals db == + writeInfo(db,dbPrincipals db,'parents,'dbPrincipals) -writeCapsuleLevelDefinitions(db,file) == - writeInfo(dbConstructor db,dbCapsuleDefinitions db, - 'signaturesAndLocals,'dbCapsuleDefinitions,file) +writeCapsuleLevelDefinitions db == + writeInfo(db,dbCapsuleDefinitions db, + 'signaturesAndLocals,'dbCapsuleDefinitions) ++ If compilation produces an error, issue inform user and ++ return to toplevel reader. @@ -538,36 +526,36 @@ leaveIfErrors(libName,kind) == ++ Finalize `libName' compilation; returns true if everything is OK. finalizeLisplib(db,libName) == form := dbConstructorForm db - writeTemplate(db,$libFile) - writeLookupFunction(db,$libFile) - writeConstructorForm(db,$libFile) - writeKind(db,$libFile) - writeConstructorModemap(db,$libFile) - writeDualSignature(db,$libFile) + writeTemplate db + writeLookupFunction db + writeConstructorForm db + writeKind db + writeConstructorModemap db + writeDualSignature db -- set to target of dbConstructorModemap for package/domain constructors; -- to the right-hand sides (the definition) for category constructors if dbConstructorKind db = 'category then - writeCategory(db,$libFile) - lisplibWrite('"sourceFile",dbSourceFile db,$libFile) - lisplibWrite('"modemaps",dbModemaps db,$libFile) + writeCategory db + lisplibWrite('"sourceFile",dbSourceFile db,dbOutputStream db) + lisplibWrite('"modemaps",dbModemaps db,dbOutputStream db) opsAndAtts := dbConstructorKind db = 'category => getCategoryOpsAndAtts db getFunctorOpsAndAtts db - writeOperations(dbConstructor db,first opsAndAtts,$libFile) + writeOperations(db,first opsAndAtts) if dbConstructorKind db = 'category then $NRTslot1PredicateList : local := [] NRTgenInitialAttributeAlist(db,rest opsAndAtts) - writeSuperDomain(db,$libFile) - writeCapsuleLevelDefinitions(db,$libFile) - writeAttributes(db,$libFile) - writePredicates(db,$libFile) - writeAbbreviation(db,$libFile) - writePrincipals(db,$libFile) - writeAncestors(db,$libFile) + writeSuperDomain db + writeCapsuleLevelDefinitions db + writeAttributes db + writePredicates db + writeAbbreviation db + writePrincipals db + writeAncestors db if not $bootStrapMode then lisplibWrite('"documentation", - finalizeDocumentation dbConstructor db,$libFile) - if $profileCompiler then profileWrite() + finalizeDocumentation dbConstructor db,dbOutputStream db) + if $profileCompiler then profileWrite db leaveIfErrors(libName,dbConstructorKind db) true diff --git a/src/interp/profile.boot b/src/interp/profile.boot index 7714c190..74aeb9f1 100644 --- a/src/interp/profile.boot +++ b/src/interp/profile.boot @@ -34,13 +34,14 @@ import sys_-macros import sys_-utility +import c_-util namespace BOOT --$profileCompiler := true $profileAlist := nil -profileWrite() == --called from finalizeLisplib - outStream := MAKE_-OUTSTREAM strconc(libDirname $libFile,'"/info") +profileWrite db == --called from finalizeLisplib + outStream := MAKE_-OUTSTREAM strconc(libDirname dbOutputStream db,'"/info") SETQ(_*PRINT_-PRETTY_*, true) PRINT_-FULL(profileTran $profileAlist,outStream) SHUT outStream diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index ab28b9d0..a7090579 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -142,9 +142,6 @@ $leaveLevelStack := [] $letAssoc := false ++ -$libFile := nil - -++ $lisplibOperationAlist := [] ++ |