diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/c-util.boot | 21 | ||||
| -rw-r--r-- | src/interp/define.boot | 4 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 22 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 8 |
4 files changed, 23 insertions, 32 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index a5496abc..20768ba8 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1308,15 +1308,22 @@ clearReplacement name == property(name,"SPADreplace") := nil property(name,'%redex) := nil +printBackendStmt(db,stmt) == + printBackendDecl(nil,stmt) + +evalAndPrintBackendStmt(db,stmt) == + eval stmt + printBackendStmt(db,stmt) + ++ Register the inlinable form of a function. registerFunctionReplacement(db,name,body) == - evalAndPrintBackendStmt - ["PUT",MKQ name,MKQ "SPADreplace",quoteMinimally body] + evalAndPrintBackendStmt(db, + ["PUT",MKQ name,MKQ "SPADreplace",quoteMinimally body]) ++ Remember the redex form of this function registerRedexForm(db,name,parms,body) == - evalAndPrintBackendStmt - ["PUT",quote name,quote '%redex,quote ['ILAM,parms,body]] + evalAndPrintBackendStmt(db, + ["PUT",quote name,quote '%redex,quote ['ILAM,parms,body]]) ++ Retrieve the redex form of the function `name'. redexForm name == @@ -1492,10 +1499,10 @@ setCompilerOptimizations level == ++ Note that all capsule functions take an additional argument ++ standing for the domain of computation object. proclaimCapsuleFunction(db,op,sig) == - printBackendStmt + printBackendStmt(db, ["DECLAIM",["FTYPE", ["FUNCTION",[:[vmType first d for d in tails rest sig],"%Shell"], - vmType first sig],op]] where + vmType first sig],op]]) where vmType d == $subdomain and d = "$" => -- We want accurate approximation for subdomains/superdomains @@ -1547,7 +1554,7 @@ backendCompileSPADSLAM(db,name,args,body) == ["PROGN",["SETQ",g2,app], ["SETQ",al,["cons5",["CONS",key,g2],al]],g2]]]] -- define the global cache. - evalAndPrintBackendDecl(al,['DEFPARAMETER,al,nil]) + evalAndPrintBackendStmt(db,['DEFPARAMETER,al,nil]) assembleCode [auxfn,["LAMBDA",args,:body]] assembleCode [name,["LAMBDA",args,code]] diff --git a/src/interp/define.boot b/src/interp/define.boot index 7b9fbb4f..65bf6de4 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1553,7 +1553,7 @@ compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) == --either lookupComplete (for forgetful guys) or lookupIncomplete $NRTslot1PredicateList := [simpBool x for x in $NRTslot1PredicateList] - printBackendDecl('loadTimeStuff, + printBackendStmt(db, ['MAKEPROP,MKQ $op,''infovec,getInfovecCode(db,$e)]) $lisplibOperationAlist:= operationAlist [fun,['Mapping,:signature'],originale] @@ -2159,7 +2159,7 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) == ++ Subroutine of compileConstructor1. Called to compile the body ++ of a category constructor definition. compAndDefine(db,l) == - $backend: local := function evalAndPrintBackendDecl + $backend: local := function((v,x) +-> evalAndPrintBackendStmt(db,x)) backendCompile(db,l) compHash(db,op,argl,body) == diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 1bb39713..db970d90 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -43,10 +43,7 @@ namespace BOOT module lisp_-backend where expandToVMForm: %Thing -> %Thing eval: %Thing -> %Thing - printBackendStmt: %Code -> %Void printBackendDecl: (%Symbol,%Code) -> %Void - evalAndPrintBackendStmt: %Code -> %Void - evalAndPrintBackendDecl: (%Symbol,%Code) -> %Void transformToBackendCode: %Form -> %Code @@ -830,27 +827,12 @@ assembleCode x == else COMP370 x first x -printBackendStmt stmt == - printBackendDecl(nil,stmt) - -evalAndPrintBackendStmt stmt == - eval stmt - printBackendStmt stmt - printBackendDecl(label,decl) == st := sp := symbolAssoc('COMPILER_-OUTPUT_-STREAM,$compilerOptions) => rest sp $OutputStream - if label ~= nil and ioTerminal? st and functionSymbol? label - and not COMPILED_-FUNCTION_-P symbolFunction label then - COMPILE label - if $PrettyPrint or not ioTerminal? st then - PRINT_-FULL(decl,st) - flushOutput st - -evalAndPrintBackendDecl(label,decl) == - eval decl - printBackendDecl(label,decl) + PRINT_-FULL(decl,st) + flushOutput st ++ Replace every middle end sub-forms in `x' with Lisp code. massageBackendCode: %Code -> %Void diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 3ad86d9e..5f7102f6 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -407,15 +407,17 @@ macro constructorDB ctor == --% structure %Libstream == - Record(mode: %IOMode, dir: %Pathname,tbl: %Thing, idxst: %Stream) - with + Record(mode: %IOMode, dir: %Pathname,tbl: %Thing, idxst: %Stream, + cdst: %Stream,insnst: %Stream) with libIOMode == (.mode) libDirname == (.dir) libIndexTable == (.tbl) libIndexStream == (.idxst) + libCodeStream == (.cdstr) + libInsnStream == (.insnst) makeLibstream(m,p,idx==nil,st==nil) == - mk%Libstream(m,p,idx,st) + mk%Libstream(m,p,idx,st,nil,nil) addCompilerOption(key,val) == $compilerOptions := [[key,:val],:$compilerOptions] |