From 13aab01d2e79671ac648645ff1c32ddf23d7947e Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 29 May 2013 17:53:29 +0000
Subject: Simplify final backend instruction emission.

---
 src/interp/Makefile.in       |  2 +-
 src/interp/c-util.boot       |  9 ++++++---
 src/interp/debug.lisp        |  4 ++--
 src/interp/define.boot       |  2 ++
 src/interp/lisp-backend.boot | 11 +++++------
 src/interp/lisplib.boot      | 10 +++++-----
 src/interp/nlib.lisp         | 18 ++++++------------
 src/interp/spad-parser.boot  |  3 +--
 src/interp/sys-globals.boot  |  3 ---
 src/interp/sys-utility.boot  |  9 +--------
 10 files changed, 29 insertions(+), 42 deletions(-)

(limited to 'src')

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 7365a89a..349bc2a2 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -383,7 +383,7 @@ sys-constants.$(FASLEXT): types.$(FASLEXT)
 hash.$(FASLEXT): types.$(FASLEXT)
 union.$(FASLEXT): vmlisp.$(FASLEXT)
 ggreater.$(FASLEXT): vmlisp.$(FASLEXT)
-lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT) nlib.$(FASLEXT)
+lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT) nlib.$(FASLEXT) c-util.$(FASLEXT)
 sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT) hash.$(FASLEXT)
 vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT)
 io.$(FASLEXT): sys-constants.$(FASLEXT)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 4a28c92d..2c66f487 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -199,6 +199,12 @@ macro dbEntityCount db ==
 macro dbLibstream db ==
   cdOutput dbCompilerData db
 
+macro dbCodeStream db ==
+  libCodeStream dbLibstream db
+
+macro dbInsnStream db ==
+  libInsnStream dbLibstream db
+
 ++ Return the existential substitution of `db'.
 dbQuerySubst db ==
   x := dbImplicitData db => first x
@@ -1308,9 +1314,6 @@ clearReplacement name ==
   property(name,"SPADreplace") := nil
   property(name,'%redex) := nil
 
-printBackendStmt(db,stmt) ==
-  printBackendDecl stmt
-
 evalAndPrintBackendStmt(db,stmt) ==
   eval stmt
   printBackendStmt(db,stmt)
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index ba5fee2c..fdd725b4 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -61,9 +61,9 @@
 (MAKEPROP 'SPAD '/TERMCHR '(#\:  #\<  #\  #\())
 (MAKEPROP 'BOOT '/TERMCHR '(#\:  #\<  #\  #\())
  
-(defmacro |/C,LIB| (&rest L &aux |$compilerOptions| |$editFile|
+(defmacro |/C,LIB| (&rest L &aux |$editFile|
                           ($prettyprint 't) ($reportCompilation 't))
-  (declare (special |$compilerOptions| |$editFile| $prettyprint $reportComilation))
+  (declare (special |$editFile| $prettyprint $reportComilation))
   `',(|compileConstructorLib| L (/COMP) NIL NIL))
  
 (defmacro /C (&rest L) `',(/D-1 L (/COMP) NIL NIL))
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 80e24bd7..c32f3ece 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1200,6 +1200,7 @@ compDefineCategory(df,m,e,fal) ==
   dbClearForCompilation! db
   dbConstructorForm(db) := lhs
   dbCompilerData(db) := makeCompilationData()
+  $backend: local := function(x +-> printBackendStmt(db,x))
   try
     $insideFunctorIfTrue => compDefineCategory1(db,df,m,e,fal)
     compDefineLisplib(db,df,m,e,fal,'compDefineCategory1)
@@ -1448,6 +1449,7 @@ compDefineFunctor(df,m,e,fal) ==
   dbClearForCompilation! db
   dbConstructorForm(db) := form
   dbCompilerData(db) := makeCompilationData()
+  $backend: local := function(x +-> printBackendStmt(db,x))
   try compDefineLisplib(db,df,m,e,fal,'compDefineFunctor1)
   finally dbCompilerData(db) := nil
  
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 941aca5b..c141ab6e 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -38,12 +38,13 @@
 
 import sys_-macros
 import nlib
+import c_-util
 namespace BOOT
 
 module lisp_-backend where
   expandToVMForm: %Thing -> %Thing
   eval: %Thing -> %Thing
-  printBackendDecl: %Code -> %Void
+  printBackendStmt: (%Database,%Code) -> %Void
   transformToBackendCode: %Form -> %Code
 
 
@@ -826,11 +827,9 @@ assembleCode x ==
   else COMP370 x
   first x
 
-printBackendDecl decl ==
-  st :=
-    sp := symbolAssoc('COMPILER_-OUTPUT_-STREAM,$compilerOptions) => rest sp
-    $OutputStream
-  PRINT_-FULL(decl,st)
+printBackendStmt(db,stmt) ==
+  st := dbCodeStream db
+  PRINT_-FULL(stmt,st)
   flushOutput st
 
 ++ Replace every middle end sub-forms in `x' with Lisp code.
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index bc47c2bf..d7dab273 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -426,7 +426,6 @@ compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
   if ok then lisplibDoRename(libName)
   filearg := makeFullFilePath [libName,$spadLibFT,nil]
   RPACKFILE filearg
-  freshLine $algebraOutputStream
   sayMSG fillerSpaces(72,char "-")
   unloadOneConstructor op
   $buildingSystemAlgebra => res
@@ -447,8 +446,9 @@ compileDocumentation(ctor,libName) ==
 initializeLisplib(db,libName) ==
   removeFile makeFullFilePath [libName,'ERRORLIB,nil]
   resetErrorCount()
-  dbLibstream(db) := writeLib(libName,'ERRORLIB)
-  addCompilerOption('FILE,dbLibstream db)
+  lib := writeLib(libName,'ERRORLIB)
+  dbLibstream(db) := lib
+  dbCodeStream(db) := outputTextFile strconc(libDirname lib,'"/code.lsp")
 
 mkCtorDBForm db ==
   ['constructorDB,quote dbConstructor db]
@@ -456,14 +456,14 @@ mkCtorDBForm db ==
 writeInfo(db,info,key,prop) ==
   if info ~= nil then
     insn := ['%store,[prop,mkCtorDBForm db],quote info]
-    printBackendDecl expandToVMForm insn
+    printBackendStmt(db,expandToVMForm insn)
   lisplibWrite(symbolName key,info,dbLibstream db)
 
 ++ Like writeInfo, but only write to the load unit.
 writeLoadInfo(db,info,key,prop) ==
   info = nil => nil
   insn := ['%store,[prop,mkCtorDBForm db],info]
-  printBackendDecl expandToVMForm insn
+  printBackendStmt(db,expandToVMForm insn)
 
 writeTemplate db ==
   dbConstructorKind db = 'category => nil
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 7fdc8a17..6ed9a531 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -157,19 +157,13 @@
          (setf (cddr entry) value-or-pos)))
      entry))
 
-;;(defun rshut (rstream)
-;;  (when (and (equal rstream (cdr (assoc 'FILE |$compilerOptions|)))
-;;             (assoc 'compiler-output-stream |$compilerOptions|))
-;;        (close (cdr (assoc 'compiler-output-stream |$compilerOptions|)))
-;;        (setq |$compilerOptions| nil))
-;;  (if (eq (|libIOMode| rstream) 'output)
-;;      (write-indextable (|libIndexTable| rstream) (|libIndexStream| rstream)))
-;;  (close (|libIndexStream| rstream)))
 (defun rshut (rstream)
-  (when (and (equal rstream (cdr (assoc 'FILE |$compilerOptions|)))
-             (assoc 'compiler-output-stream |$compilerOptions|))
-        (close (cdr (assoc 'compiler-output-stream |$compilerOptions|)))
-        (setq |$compilerOptions| (cddr |$compilerOptions|)))
+  (when (|libCodeStream| rstream)
+    (close (|libCodeStream| rstream))
+    (setf (|libCodeStream| rstream) nil))
+  (when (|libInsnStream| rstream)
+    (close (|libInsnStream| rstream))
+    (setf (|libInsnStream| rstream) nil))
   (if (eq (|libIOMode| rstream) 'output)
       (write-indextable (|libIndexTable| rstream) (|libIndexStream| rstream)))
   (close (|libIndexStream| rstream)))
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 5ded2a11..e2a33476 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -1060,8 +1060,7 @@ translateSpad x ==
   $e: local := $EmptyEnvironment
   $genSDVar: local := 0
   $previousTime: local := TEMPUS_-FUGIT()
-  $compilerOptions: local := nil
-  $backend: local := function printBackendDecl
+  $backend: local := function(x +-> PRINT_-FULL(x,$OutputStream))
   compileParseTree x  
 
 --%
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 53551ae3..3ed63b25 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -388,6 +388,3 @@ $optimizeRep := false
 
 ++
 $leanMode := false
-
-++ Table of compiler data driving compilation.
-$compilerOptions := nil
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index e4757eca..fa29d102 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -400,19 +400,12 @@ structure %Libstream ==
       libDirname == (.dir)
       libIndexTable == (.tbl)
       libIndexStream == (.idxst)
-      libCodeStream == (.cdstr)
+      libCodeStream == (.cdst)
       libInsnStream == (.insnst)
 
 makeLibstream(m,p,idx==nil,st==nil) ==
   mk%Libstream(m,p,idx,st,nil,nil)
 
-addCompilerOption(key,val) ==
-  $compilerOptions := [[key,:val],:$compilerOptions]
-  key is 'FILE =>
-    st := outputTextFile strconc(libDirname val,'"/code.lsp")
-    $compilerOptions := [['COMPILER_-OUTPUT_-STREAM,:st],:$compilerOptions]
-  nil
-
 makeFilename(filearg,filetype==nil) ==
   if ident? filetype then
     filetype := symbolName filetype
-- 
cgit v1.2.3