aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot21
-rw-r--r--src/interp/define.boot4
-rw-r--r--src/interp/lisp-backend.boot22
-rw-r--r--src/interp/sys-utility.boot8
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]