Support --output in compiler, for bootstrapping stage.

17 files changed, 200 insertions, 116 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 8ef8b738..cba7ca1c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,26 @@
+2013-06-01  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
+	Support --output in compiler, for bootstrapping stage.
+	* lisp/core.lisp.in (directoryEntries): New.
+	* interp/lisplib.boot (compDefineLisplib): Tidy.  Honor --output.
+	(initializeLisplib): Rewrite.
+	(lisplibDoRename): Likewise.
+	* interp/nlib.lisp (RSHUT): Tidy.
+	* interp/define.boot (getOutputPath): New.
+	(compDefineFunctor): Use it.
+	(compDefineCategory): Likewise.
+	* interp/c-util.boot (%Libstream): Add field for output pathname.
+	(dbOutputPath): New accessor.
+	(moveLibdirByCopy): New.
+	* include/cfuns.h (oa_acquire_temporary_pathname): Declare.
+	(oa_release_temporary_pathname): Likewise.
+	* lib/cfuns-c.c: Implement them.
+	* interp/sys-os.boot: Define acquireTemporaryPathname.
+	* boot/ast.boot (lispKey): New.
+	(bfApplication): Use it.
+	(bfExpandKeys): Likewise.
+	* algebra/Makefile.am: Simplify bootstrapping rules.
+
 2013-05-31  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* interp/nlib.lisp (getIndexIOStreamAndTable): New.
diff --git a/src/algebra/Makefile.am b/src/algebra/Makefile.am
index ae00743b..3c404d0d 100644
--- a/src/algebra/Makefile.am
+++ b/src/algebra/Makefile.am
@@ -1007,31 +1007,17 @@ strap-0 strap-1 strap-2:
 
 .PRECIOUS: strap-0/%.$(FASLEXT)
 strap-0/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-0
-	$(BOOTSTRAP) --sysalg=strap-0 --bootstrap $< \
-		&& cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-0/$*.lsp; fi && \
-		rm -rf $*.NRLIB
+	$(BOOTSTRAP) --sysalg=strap-0 --output=$@ --bootstrap $<
 
 .PRECIOUS: strap-1/%.$(FASLEXT)
 strap-1/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-1
-	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \
-		cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-1/$*-.$(FASLEXT); else : ; fi && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi && \
-		rm -rf $*.NRLIB $*-.NRLIB
+	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 \
+		--output=$@ --optimize=3 $<
 
 .PRECIOUS: strap-2/%.$(FASLEXT)
 strap-2/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-2
-	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \
-		cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-2/$*-.$(FASLEXT); else : ; fi && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-2/$*.lsp; fi && \
-		rm -rf $*.NRLIB $*-.NRLIB
+	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 \
+		--output=$@ --optimize=3 $<
 
 
 SPADFILES= \
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in
index 5fd78ad2..785aaa17 100644
--- a/src/algebra/Makefile.in
+++ b/src/algebra/Makefile.in
@@ -2512,31 +2512,17 @@ strap-0 strap-1 strap-2:
 
 .PRECIOUS: strap-0/%.$(FASLEXT)
 strap-0/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-0
-	$(BOOTSTRAP) --sysalg=strap-0 --bootstrap $< \
-		&& cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-0/$*.lsp; fi && \
-		rm -rf $*.NRLIB
+	$(BOOTSTRAP) --sysalg=strap-0 --output=$@ --bootstrap $<
 
 .PRECIOUS: strap-1/%.$(FASLEXT)
 strap-1/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-1
-	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \
-		cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-1/$*-.$(FASLEXT); else : ; fi && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi && \
-		rm -rf $*.NRLIB $*-.NRLIB
+	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 \
+		--output=$@ --optimize=3 $<
 
 .PRECIOUS: strap-2/%.$(FASLEXT)
 strap-2/%.$(FASLEXT): %.spad initdb.$(FASLEXT) | strap-2
-	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \
-		cp $*.NRLIB/code.$(FASLEXT) $@ && \
-		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
-			strap-2/$*-.$(FASLEXT); else : ; fi && \
-		if test x@oa_keep_files@ = xyes; then \
-			cp $*.NRLIB/code.lsp strap-2/$*.lsp; fi && \
-		rm -rf $*.NRLIB $*-.NRLIB
+	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 \
+		--output=$@ --optimize=3 $<
 
 # The root of the category hierarchy is the Type category.
 # We require the basic integer domains are available at stage 2 of
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index dfffa58a..14259ebd 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -811,16 +811,20 @@ bfHas(expr,prop) ==
 bfKeyArg(k,x) ==
   ['%Key,k,x]
 
+lispKey k ==
+  makeSymbol(stringUpcase symbolName k,'"KEYWORD")
+
 bfExpandKeys l ==
   args := nil
   while l is [a,:l] repeat
     a is ['%Key,k,x] =>
-      args := [x,makeSymbol(stringUpcase symbolName k,'"KEYWORD"),:args]
+      args := [x,lispKey k,:args]
     args := [a,:args]
   reverse! args      
 
 bfApplication(bfop, bfarg) ==
   bfTupleP bfarg => [bfop,:bfExpandKeys rest bfarg]
+  bfarg is ['%Key,k,v] => [bfop,lispKey k,v]
   [bfop,bfarg]
  
 -- returns the meaning of x in the appropriate Boot dialect.
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index a51ee1c2..6cb05e57 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1223,6 +1223,8 @@
 
 (DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|))
 
+(DEFUN |lispKey| (|k|) (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD"))
+
 (DEFUN |bfExpandKeys| (|l|)
   (LET* (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|)
     (PROGN
@@ -1241,17 +1243,24 @@
                     (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                     (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                          (PROGN (SETQ |x| (CAR |ISTMP#2|)) T))))))
-        (SETQ |args|
-                (CONS |x|
-                      (CONS
-                       (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD")
-                       |args|))))
+        (SETQ |args| (CONS |x| (CONS (|lispKey| |k|) |args|))))
        (T (SETQ |args| (CONS |a| |args|)))))
      (|reverse!| |args|))))
 
 (DEFUN |bfApplication| (|bfop| |bfarg|)
-  (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|))))
-        (T (LIST |bfop| |bfarg|))))
+  (LET* (|v| |ISTMP#2| |k| |ISTMP#1|)
+    (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|))))
+          ((AND (CONSP |bfarg|) (EQ (CAR |bfarg|) '|%Key|)
+                (PROGN
+                 (SETQ |ISTMP#1| (CDR |bfarg|))
+                 (AND (CONSP |ISTMP#1|)
+                      (PROGN
+                       (SETQ |k| (CAR |ISTMP#1|))
+                       (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                       (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                            (PROGN (SETQ |v| (CAR |ISTMP#2|)) T))))))
+           (LIST |bfop| (|lispKey| |k|) |v|))
+          (T (LIST |bfop| |bfarg|)))))
 
 (DEFUN |bfReName| (|x|)
   (LET* (|a|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index b6c95484..985611d3 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -388,7 +388,7 @@
       (COND (|done| (RETURN NIL))
             (T
              (SETQ |found|
-                     (LET ((#1=#:G725
+                     (LET ((#1=#:G720
                             (CATCH :OPEN-AXIOM-CATCH-POINT
                               (APPLY |f| |ps| NIL))))
                        (COND
@@ -1371,7 +1371,7 @@
      (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
      (SETQ |varno| (|parserGensymSequenceNumber| |ps|))
      (UNWIND-PROTECT
-         (LET ((#1=#:G726
+         (LET ((#1=#:G721
                 (CATCH :OPEN-AXIOM-CATCH-POINT
                   (PROGN
                    (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 3c0dd848..afd689ad 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -84,10 +84,10 @@
   (LET* (|s|)
     (COND
      ((SETQ |s|
-              (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|)
+              (WITH-HASH-TABLE-ITERATOR (#1=#:G719 |shoeKeyTable|)
                 (LET ((|bfVar#1| NIL))
                   (LOOP
-                   (MULTIPLE-VALUE-BIND (#2=#:G725 |k| |v|)
+                   (MULTIPLE-VALUE-BIND (#2=#:G720 |k| |v|)
                        (#1#)
                      (COND ((NOT #2#) (RETURN |bfVar#1|))
                            (T
@@ -138,9 +138,9 @@
                  (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|)))
                  (SETQ |i| (+ |i| 1))))
               |a|))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G726 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G721 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G727 |s| #:G728)
+        (MULTIPLE-VALUE-BIND (#2=#:G722 |s| #:G723)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|))))))
      |d|)))
@@ -154,9 +154,9 @@
      (LET ((|i| 0))
        (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0)))
              (SETQ |i| (+ |i| 1))))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G729 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G730 |k| #:G731)
+        (MULTIPLE-VALUE-BIND (#2=#:G725 |k| #:G726)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL)
                 (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 4cc7a1bb..d3f85676 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -416,7 +416,7 @@
      (SETQ |ps| (|makeParserState| |toks|))
      (|bpFirstTok| |ps|)
      (SETQ |found|
-             (LET ((#1=#:G734
+             (LET ((#1=#:G729
                     (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
                (COND
                 ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
diff --git a/src/include/cfuns.h b/src/include/cfuns.h
index d3a82fec..52a57e55 100644
--- a/src/include/cfuns.h
+++ b/src/include/cfuns.h
@@ -1,7 +1,7 @@
 /*
-  Copyright (C) 1991-2002, The Numerical ALgorithms Group Ltd.
+  Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd.
   All rights reserved.
-  Copyright (C) 2007-2010, Gabriel Dos Reis.
+  Copyright (C) 2007-2013, Gabriel Dos Reis.
   All rights resrved.
 
   Redistribution and use in source and binary forms, with or without
@@ -50,6 +50,8 @@ OPENAXIOM_C_EXPORT int copyEnvValue(char*, char*);
 OPENAXIOM_C_EXPORT int oa_chdir(const char*);
 OPENAXIOM_C_EXPORT int oa_unlink(const char*);
 OPENAXIOM_C_EXPORT int oa_rename(const char*, const char*);
+OPENAXIOM_C_EXPORT const char* oa_acquire_temporary_pathname();
+OPENAXIOM_C_EXPORT void oa_release_temporary_pathname(const char*);
 OPENAXIOM_C_EXPORT int oa_mkdir(const char*);
 OPENAXIOM_C_EXPORT int oa_system(const char*);
 OPENAXIOM_C_EXPORT char* oa_getenv(const char*);
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 12aa3654..6d7161c4 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -135,28 +135,21 @@ macro domainData d ==
   domainRef(d,4)
 
 --%  
---% Constructor Compilation Data.
---% Operational Semantics:
---%    structure CompilationData ==
---%       Record(formalSubst: Substitution,implicits: List Identifier,
---%         byteList: List SingleInteger,
---%           usedEntities: VectorBuffer Pair(SourceEntity,Elaboration))
---%
-
 structure %CompilationData ==
   Record(subst: %Substitution,idata: %Substitution,bytes: List %Fixnum,
     shell: %Vector %Thing, items: %Buffer %Pair(%SourceEntity,%Code),
-      output: %OutputStream) with
+      lib: %Libstream,outpath: %Pathname) with
         cdSubstitution == (.subst)
         cdImplicits == (.idata)
         cdBytes == (.bytes)
         cdShell == (.shell)
         cdItems == (.items)
-        cdOutput == (.output)
+        cdLib == (.lib)
+        cdOutput == (.outpath)
 
 ++ Make a fresh compilation data structure.
 makeCompilationData() ==
-  mk%CompilationData(nil,nil,nil,nil,[nil,:0],nil)
+  mk%CompilationData(nil,nil,nil,nil,[nil,:0],nil,nil)
 
 ++ Subsitution that replaces parameters with formals.
 macro dbFormalSubst db ==
@@ -197,7 +190,7 @@ macro dbEntityCount db ==
   rest dbEntityBuffer db
 
 macro dbLibstream db ==
-  cdOutput dbCompilerData db
+  cdLib dbCompilerData db
 
 macro dbCodeStream db ==
   libCodeStream dbLibstream db
@@ -205,6 +198,9 @@ macro dbCodeStream db ==
 macro dbInsnStream db ==
   libInsnStream dbLibstream db
 
+macro dbOutputPath db ==
+  cdOutput dbCompilerData db
+
 ++ Return the existential substitution of `db'.
 dbQuerySubst db ==
   x := dbImplicitData db => first x
@@ -1765,3 +1761,12 @@ cleanParameterList! parms ==
 --% Other compiler artifact support
 --%
 
+moveLibdirByCopy lib ==
+  checkMkdir libDirname lib
+  for src in directoryEntries libStationaryDirname lib repeat
+    dst := makeFilePath(directory <- libDirname lib,
+             name <- filePathName src, type <- filePathType src)
+    copyFile(filePathString src,filePathString dst)
+  removeFile libStationaryDirname lib = 0 => libDirname lib
+  systemError ['"Could not remove stationary directory",
+                :bright libStationaryDirname lib]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 585c5461..f3f70c72 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1201,6 +1201,7 @@ compDefineCategory(df,m,e,fal) ==
   dbClearForCompilation! db
   dbConstructorForm(db) := lhs
   dbCompilerData(db) := makeCompilationData()
+  dbOutputPath(db) := getOutputPath()
   $backend: local := function(x +-> printBackendStmt(dbLibstream db,x))
   try
     $insideFunctorIfTrue => compDefineCategory1(db,df,m,e,fal)
@@ -1442,6 +1443,16 @@ setDollarName(form,env) ==
 getDollarName env ==
   get('%compilerData,'%dollar,env)
 
+getOutputPath() ==
+  outfile := getOptionValue "output"
+  outfile = nil => nil
+  $insideCategoryPackageIfTrue =>
+    d := filePathDirectory outfile
+    n := strconc(filePathString filePathName outfile,'"-")
+    t := filePathType outfile
+    filePathString makeFilePath(directory <- d,name <- n,type <- t)
+  outfile
+
 compDefineFunctor(df,m,e,fal) ==
   $profileCompiler: local := true
   $profileAlist:    local := nil
@@ -1450,6 +1461,7 @@ compDefineFunctor(df,m,e,fal) ==
   dbClearForCompilation! db
   dbConstructorForm(db) := form
   dbCompilerData(db) := makeCompilationData()
+  dbOutputPath(db) := getOutputPath()
   $backend: local := function(x +-> printBackendStmt(dbLibstream db,x))
   try compDefineLisplib(db,df,m,e,fal,'compDefineFunctor1)
   finally dbCompilerData(db) := nil
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 74e54194..8dceae5d 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -410,22 +410,19 @@ compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
   if dbSourceFile db = nil then
     dbSourceFile(db) := namestring $editFile
   $compileDocumentation => compileDocumentation(db,libName)
-  sayMSG ['"   initializing ",$spadLibFT,:bright libName,
-    '"for",:bright op]
-  initializeLisplib(db,libName)
-  sayMSG ['"   compiling into ",$spadLibFT,:bright libName]
-  -- following guarantee's compiler output files get closed.
-  ok := false;
+  sayMSG ['"   initializing stationary directory for",:bright op]
+  lib := initializeLisplib(db,libName)
+  sayMSG ['"   compiling into ",:bright libStationaryDirname lib]
+  -- following guarantees compiler output files get closed.
   try
-    res:= FUNCALL(fn,db,df,m,e,fal)
+    res:= apply(fn,[db,df,m,e,fal])
     leaveIfErrors(libName,dbConstructorKind db)
     sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
-    ok := finalizeLisplib(db,libName)
+    finalizeLisplib(db,libName)
+    RECOMPILE_-LIB_-FILE_-IF_-NECESSARY filePath libCodeStream lib
   finally
     RSHUT dbLibstream db
-  if ok then lisplibDoRename(libName)
-  filearg := makeFullFilePath [libName,$spadLibFT,nil]
-  RPACKFILE filearg
+  lisplibDoRename db
   sayMSG fillerSpaces(72,char "-")
   unloadOneConstructor op
   $buildingSystemAlgebra => res
@@ -444,11 +441,15 @@ compileDocumentation(db,libName) ==
   ['dummy, $EmptyMode, $e]
 
 initializeLisplib(db,libName) ==
-  removeFile makeFullFilePath [libName,'ERRORLIB,nil]
   resetErrorCount()
-  lib := writeLib(libName,'ERRORLIB)
-  dbLibstream(db) := lib
-  dbCodeStream(db) := outputTextFile strconc(libDirname lib,'"/code.lsp")
+  tmpdir := acquireTemporaryPathname()
+  removeFile tmpdir
+  checkMkdir tmpdir
+  [stream,:table] := getIndexIOStreamAndTable tmpdir
+  lsp := outputTextFile strconc(tmpdir,'"/code.lsp")
+  libdir := makeFullFilePath [libName,$spadLibFT,nil]
+  dbLibstream(db) := mk%Libstream('OUTPUT,libdir,table,stream,lsp,nil,tmpdir)
+
 
 mkCtorDBForm db ==
   ['constructorDB,quote dbConstructor db]
@@ -570,13 +571,23 @@ finalizeLisplib(db,libName) ==
   writeAncestors db
   if not $bootStrapMode then
     writeDocumentation(db,finalizeDocumentation db)
-  if $profileCompiler then profileWrite db
+  if $profileCompiler then profileWrite dbLibstream db
   leaveIfErrors(libName,dbConstructorKind db)
   true
 
-lisplibDoRename(libName) ==
-  _$REPLACE([libName,$spadLibFT,nil],
-    [libName,'ERRORLIB,nil])
+lisplibDoRename db ==
+  lib := dbLibstream db
+  output := dbOutputPath db =>
+    modpath := filePathString
+      makeFilePath(type <- $faslType,defaults <- filePath libCodeStream lib)
+    do
+      renameFile(modpath,output) = 0 => nil
+      copyFile(modpath,output)
+      removeFile libStationaryDirname lib
+    output
+  removeFile libDirname lib
+  renameFile(libStationaryDirname lib,libDirname lib) = 0 => libDirname lib
+  moveLibdirByCopy lib
  
 lisplibError(cname,fname,type,cn,fn,typ,error) ==
   sayMSG bright ['"  Illegal ",$spadLibFT]
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 79c19b64..901928e1 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -162,11 +162,9 @@
 
 (defun rshut (rstream)
   (when (|libCodeStream| rstream)
-    (close (|libCodeStream| rstream))
-    (setf (|libCodeStream| rstream) nil))
+    (close (|libCodeStream| rstream)))
   (when (|libInsnStream| rstream)
-    (close (|libInsnStream| rstream))
-    (setf (|libInsnStream| rstream) nil))
+    (close (|libInsnStream| rstream)))
   (if (eq (|libIOMode| rstream) 'output)
       (write-indextable (|libIndexTable| rstream) (|libIndexStream| rstream)))
   (close (|libIndexStream| rstream)))
diff --git a/src/interp/profile.boot b/src/interp/profile.boot
index ff6577a9..a9b9d58e 100644
--- a/src/interp/profile.boot
+++ b/src/interp/profile.boot
@@ -40,8 +40,8 @@ namespace BOOT
 --$profileCompiler := true
 $profileAlist := nil
 
-profileWrite db ==  --called from finalizeLisplib
-  outStream := MAKE_-OUTSTREAM strconc(libDirname dbLibstream db,'"/info")
+profileWrite lib ==  --called from finalizeLisplib
+  outStream := outputTextFile strconc(libStationaryDirname lib,'"/info")
   SETQ(_*PRINT_-PRETTY_*, true)
   PRINT_-FULL(profileTran $profileAlist,outStream)
   SHUT outStream
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index d6c5e8e0..c4f7209d 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -49,6 +49,10 @@ loadSystemRuntimeCore()
 
 --% File System Support
 
+++ Get a temporary pathname
+import oa__acquire__temporary__pathname: () -> string for
+  acquireTemporaryPathname
+
 ++ Current working directory
 import oa__getcwd: () -> string for doGetWorkingDirectory
 
diff --git a/src/lib/cfuns-c.c b/src/lib/cfuns-c.c
index e95abbee..cac76b6c 100644
--- a/src/lib/cfuns-c.c
+++ b/src/lib/cfuns-c.c
@@ -2,7 +2,7 @@
    Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd.
    All rights reserved.
 
-   Copyright (C) 2007-2011, Gabriel Dos Reis.
+   Copyright (C) 2007-2013, Gabriel Dos Reis.
    All rights reserved.
 
    Redistribution and use in source and binary forms, with or without
@@ -37,6 +37,7 @@
 #include "openaxiom-c-macros.h"
 
 #include <errno.h>
+#include <limits.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <stdlib.h>
@@ -47,7 +48,7 @@
 #include <unistd.h>
 
 
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
 #  include <windows.h>
 #else
 #  include <dirent.h>
@@ -103,7 +104,7 @@ addtopath(char *dir)
 static inline int
 openaxiom_is_path_separator(char c)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return c == '\\' || c == '/';
 #else
    return c == '/';
@@ -256,7 +257,7 @@ writeablep(const char *path)
             the MinGW/MSYS port appears to use MS' StrDup as the real
             worker.  Consequently, the guarantee that the the string can
             free'd no longer holds.  We have to use MS's LocalFree.  */
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
        LocalFree(dir);
 #else
        free(dir);
@@ -338,7 +339,7 @@ OPENAXIOM_C_EXPORT int
 std_stream_is_terminal(int fd)
 {
    assert(fd > -1 && fd < 3);
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    DWORD handle;
    switch (fd) {
    case 0: handle = STD_INPUT_HANDLE; break;
@@ -369,11 +370,11 @@ std_stream_is_terminal(int fd)
 OPENAXIOM_C_EXPORT int
 oa_chdir(const char* path)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return SetCurrentDirectory(path) ? 0 : -1;
 #else
    return chdir(path);
-#endif /* __WIN32__ */
+#endif /* OPENAXIOM_MS_WINDOWS_HOST */
 }
 
 
@@ -394,7 +395,7 @@ oa_unlink(const char* path)
 {
    const char* curdir;
    int status = -1;
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    WIN32_FIND_DATA findData;
    HANDLE walkHandle;
 
@@ -478,7 +479,7 @@ oa_unlink(const char* path)
       status = -1;
    else
       status = 0;
-#endif /* __WIN32__ */
+#endif /* OPENAXIOM_MS_WINDOWS_HOST */
 
   sortie:
    oa_chdir(curdir);
@@ -486,11 +487,37 @@ oa_unlink(const char* path)
    return status;
 }
 
+OPENAXIOM_C_EXPORT const char*
+oa_acquire_temporary_pathname() {
+#if OPENAXIOM_MS_WINDOWS_HOST
+   char buf[MAX_PATH];
+   const char* tmpdir = oa_get_tmpdir();
+   auto n = GetTempFileName(tmpdir, "oa-", rand() % SHORT_MAX, buf);
+   free(tmpdir);
+   if (n == 0) {
+      perror("oa_acquire_temporary_pathname");
+      exit(1);
+   }
+   return strdup(buf);
+#elif HAVE_DECL_TEMPNAM
+   return tempnam(oa_get_tmpdir(), "oa-");
+#else
+   std::string s = "oa-" + std::to_string(rand());
+   return strdup(s.c_str());
+#endif   
+}
+
+OPENAXIOM_C_EXPORT void
+oa_release_temporary_pathname(const char* s)
+{
+   free(const_cast<char*>(s));  // yuck!
+}
+
 /* Rename a file or directory.  */
 OPENAXIOM_C_EXPORT int
 oa_rename(const char* old_path, const char* new_path)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return MoveFile(old_path, new_path) ? 0 : -1;
 #else
    return rename(old_path, new_path);
@@ -502,7 +529,7 @@ oa_rename(const char* old_path, const char* new_path)
 OPENAXIOM_C_EXPORT int
 oa_mkdir(const char* path)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return CreateDirectory(path, NULL) ? 0 : -1;
 #else
 #  define DIRECTORY_PERM ((S_IRWXU|S_IRWXG|S_IRWXO) & ~(S_IWGRP|S_IWOTH))
@@ -521,7 +548,7 @@ oa_system(const char* cmd)
 OPENAXIOM_C_EXPORT int 
 oa_getpid(void) 
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return GetCurrentProcessId();
 #else
    return getpid();
@@ -566,7 +593,7 @@ oa_strcat(const char* left, const char* right)
 OPENAXIOM_C_EXPORT char*
 oa_getenv(const char* var)
 {
-#ifdef __WIN32__   
+#ifdef OPENAXIOM_MS_WINDOWS_HOST   
 #define BUFSIZE 128
    char* buf = (char*) malloc(BUFSIZE);
    int len = GetEnvironmentVariable(var, buf, BUFSIZE);
@@ -593,7 +620,7 @@ oa_getenv(const char* var)
 OPENAXIOM_C_EXPORT int
 oa_setenv(const char* var, const char* val)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return SetEnvironmentVariable(var, val);
 #elif HAVE_DECL_SETENV
    return !setenv(var, val, true);
@@ -615,7 +642,7 @@ oa_getcwd(void)
 {
    size_t bufsz = 256;
    char* buf = (char*) malloc(bufsz);
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    DWORD n = GetCurrentDirectory(bufsz, buf);
    if (n == 0) {
       perror("oa_getcwd");
@@ -629,7 +656,7 @@ oa_getcwd(void)
       }
    }
    return buf;
-#else /* __WIN32__ */
+#else /* OPENAXIOM_MS_WINDOWS_HOST */
    errno = 0;
    while (getcwd(buf,bufsz) == 0) {
       if (errno == ERANGE) {
@@ -649,7 +676,7 @@ oa_getcwd(void)
 OPENAXIOM_C_EXPORT int
 oa_access_file_for_read(const char* path)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
   return GetFileAttributes(path) == INVALID_FILE_ATTRIBUTES ? -1 : 1;
 #else
    return access(path, R_OK);
@@ -660,7 +687,7 @@ oa_access_file_for_read(const char* path)
 OPENAXIOM_C_EXPORT const char*
 oa_get_tmpdir(void)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    char* buf;
    /* First, probe.  */
    int bufsz = GetTempPath(0, NULL);
@@ -689,7 +716,7 @@ oa_get_tmpdir(void)
 OPENAXIOM_C_EXPORT int
 oa_copy_file(const char* src, const char* dst)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    return CopyFile(src,dst, /* bFailIfExists = */ 0) ? 0 : -1;
 #else
 #define OA_BUFSZ 512
@@ -767,7 +794,7 @@ oa_allocate_process_argv(Process* proc, int argc)
 OPENAXIOM_C_EXPORT int
 oa_spawn(Process* proc, SpawnFlags flags)
 {
-#ifdef __WIN32__
+#ifdef OPENAXIOM_MS_WINDOWS_HOST
    const char* path = NULL;
    char* cmd_line = NULL;
    int curpos = strlen(proc->argv[0]);
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 38183144..4b72e76f 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -3,7 +3,7 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
 ;; 
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -103,7 +103,8 @@
 	   "$InputStream"
 	   "$OutputStream"
 	   "$ErrorStream"
-	   
+
+	   "directoryEntries"
 	   "inputBinaryFile"
 	   "outputBinaryFile"
 	   "inputTextFile"
@@ -551,6 +552,22 @@
 (defparameter |$OutputStream| (make-synonym-stream '*standard-output*))
 (defparameter |$ErrorStream| (make-synonym-stream '*standard-output*))
 
+;; Return all entries (except dot and dot-dot) in a directory
+(defun |directoryEntries| (dir &optional (pattern nil))
+  (let ((dirname (namestring dir)))
+    (cond (pattern (directory (concatenate 'string dirname "/" pattern)))
+	  (t ;; list everything.
+	   ;; There are two groups: those who do the right and obvious thing;
+	   ;; and those that are anal-retentive about it.
+	   #+(or :clisp :clozure :gcl) 
+	   (directory (concatenate 'string dirname "/*"))
+	   #-(or :clisp :clozure :gcl)
+	   (nunion
+	    (directory (concatenate 'string dirname "/*"))
+	    (directory (concatenate 'string dirname "/*.*")))))))
+	   
+	 
+
 (defun |inputBinaryFile| (f)
   (open f
 	:direction :input