aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/initial-env.lisp5
-rw-r--r--src/boot/strap/translator.clisp92
-rw-r--r--src/boot/translator.boot62
4 files changed, 97 insertions, 67 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index aef60ace..fd253106 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/initial-env.lisp (shoeOpenInputFile): Remove. Adjust
+ callers to use inputTextFile with try/finally.
+
2011-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/ast.boot (idList?, charList?, stringLits?): New.
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index 40ca50cc..ef82d033 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -63,11 +63,6 @@
(defvar *lisp-source-filetype* "lisp")
-(defmacro |shoeOpenInputFile|
- (stream fn prog)
- `(with-open-file (,stream ,fn :direction :input
- :if-does-not-exist nil) ,prog))
-
(defmacro |shoeOpenOutputFile|
(stream fn prog)
`(with-open-file (,stream ,fn :direction :output
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 42a0740f..d0fe10fd 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -150,12 +150,13 @@
(BOOTTOCLLINES |lines| |fn| |out|))
(DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|)
- (PROG (|infn|)
+ (PROG (|a|)
(RETURN
- (PROGN
- (SETQ |infn| (|shoeAddbootIfNec| |fn|))
- (|shoeOpenInputFile| |a| |infn|
- (|shoeClLines| |a| |fn| |lines| |outfn|))))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+ (|shoeClLines| |a| |fn| |lines| |outfn|))
+ (|closeFile| |a|)))))
(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
(PROG (|$GenVarCounter|)
@@ -193,12 +194,13 @@
(|endCompileDuration|)))))
(DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
- (PROG (|infn|)
+ (PROG (|a|)
(RETURN
- (PROGN
- (SETQ |infn| (|shoeAddbootIfNec| |fn|))
- (|shoeOpenInputFile| |a| |infn|
- (|shoeClCLines| |a| |fn| |lines| |outfn|))))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+ (|shoeClCLines| |a| |fn| |lines| |outfn|))
+ (|closeFile| |a|)))))
(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
(PROG (|$GenVarCounter|)
@@ -230,18 +232,20 @@
(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BOOTTOMC))
(DEFUN BOOTTOMC (|fn|)
- (PROG (|$GenVarCounter| |result| |infn| |callingPackage|)
+ (PROG (|$GenVarCounter| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
(SETQ |callingPackage| *PACKAGE*)
(IN-PACKAGE "BOOTTRAN")
(SETQ |$GenVarCounter| 0)
- (SETQ |infn| (|shoeAddbootIfNec| |fn|))
- (SETQ |result|
- (|shoeOpenInputFile| |a| |infn| (|shoeMc| |a| |fn|)))
- (|setCurrentPackage| |callingPackage|)
- |result|))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+ (|shoeMc| |a| |fn|))
+ (PROGN
+ (|closeFile| |a|)
+ (|setCurrentPackage| |callingPackage|)))))))
(DEFUN |shoeMc| (|a| |fn|)
(COND
@@ -250,7 +254,7 @@
(|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))
(DEFUN |evalBootFile| (|fn|)
- (PROG (|outfn| |infn| |b|)
+ (PROG (|a| |outfn| |infn| |b|)
(RETURN
(PROGN
(SETQ |b| *PACKAGE*)
@@ -259,28 +263,31 @@
(SETQ |outfn|
(CONCAT (|shoeRemovebootIfNec| |fn|) "."
*LISP-SOURCE-FILETYPE*))
- (|shoeOpenInputFile| |a| |infn|
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| |infn|))
(|shoeClLines| |a| |infn| NIL |outfn|))
- (|setCurrentPackage| |b|)
+ (PROGN (|closeFile| |a|) (|setCurrentPackage| |b|)))
(LOAD |outfn|)))))
(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BO))
(DEFUN BO (|fn|)
- (PROG (|$GenVarCounter| |infn| |b|)
+ (PROG (|$GenVarCounter| |a| |b|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
(SETQ |b| *PACKAGE*)
(IN-PACKAGE "BOOTTRAN")
(SETQ |$GenVarCounter| 0)
- (SETQ |infn| (|shoeAddbootIfNec| |fn|))
- (|shoeOpenInputFile| |a| |infn| (|shoeToConsole| |a| |fn|))
- (|setCurrentPackage| |b|)))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+ (|shoeToConsole| |a| |fn|))
+ (PROGN (|closeFile| |a|) (|setCurrentPackage| |b|)))))))
(DEFUN BOCLAM (|fn|)
- (PROG (|$bfClamming| |$GenVarCounter| |result| |infn|
- |callingPackage|)
+ (PROG (|$bfClamming| |$GenVarCounter| |a| |callingPackage|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|))
(RETURN
(PROGN
@@ -288,12 +295,13 @@
(IN-PACKAGE "BOOTTRAN")
(SETQ |$GenVarCounter| 0)
(SETQ |$bfClamming| T)
- (SETQ |infn| (|shoeAddbootIfNec| |fn|))
- (SETQ |result|
- (|shoeOpenInputFile| |a| |infn|
- (|shoeToConsole| |a| |fn|)))
- (|setCurrentPackage| |callingPackage|)
- |result|))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+ (|shoeToConsole| |a| |fn|))
+ (PROGN
+ (|closeFile| |a|)
+ (|setCurrentPackage| |callingPackage|)))))))
(DEFUN |shoeToConsole| (|a| |fn|)
(COND
@@ -527,7 +535,7 @@
(SETQ |$bpParenCount| 0)
(|bpFirstTok|)
(SETQ |found|
- (LET ((#0=#:G1356
+ (LET ((#0=#:G1362
(CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem|))))
(COND
((AND (CONSP #0#)
@@ -806,11 +814,13 @@
(COND ((NULL |n|) |s|) (T (|subString| |s| 0 |n|)))))))
(DEFUN DEFUSE (|fn|)
- (PROG (|infn|)
+ (PROG (|a|)
(RETURN
- (PROGN
- (SETQ |infn| (CONCAT |fn| ".boot"))
- (|shoeOpenInputFile| |a| |infn| (|shoeDfu| |a| |fn|))))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (CONCAT |fn| ".boot")))
+ (|shoeDfu| |a| |fn|))
+ (|closeFile| |a|)))))
(DEFPARAMETER |$bootDefined| NIL)
@@ -1113,11 +1123,13 @@
(T (|bootOutLines| (CDR |l|) |outfn| (CONCAT |s| " " |a|)))))))))
(DEFUN XREF (|fn|)
- (PROG (|infn|)
+ (PROG (|a|)
(RETURN
- (PROGN
- (SETQ |infn| (CONCAT |fn| ".boot"))
- (|shoeOpenInputFile| |a| |infn| (|shoeXref| |a| |fn|))))))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETQ |a| (|inputTextFile| (CONCAT |fn| ".boot")))
+ (|shoeXref| |a| |fn|))
+ (|closeFile| |a|)))))
(DEFUN |shoeXref| (|a| |fn|)
(PROG (|$bfClamming| |$GenVarCounter| |$bootUsed| |$bootDefined|
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 5dd5a8dd..4b4e4181 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -105,8 +105,10 @@ BOOTCLAMLINES(lines, fn, out) ==
BOOTTOCLLINES(lines, fn, out)
BOOTTOCLLINES(lines, fn, outfn)==
- infn:=shoeAddbootIfNec fn
- shoeOpenInputFile(a,infn, shoeClLines(a,fn,lines,outfn))
+ try
+ a := inputTextFile shoeAddbootIfNec fn
+ shoeClLines(a,fn,lines,outfn)
+ finally closeFile a
shoeClLines(a,fn,lines,outfn)==
a=nil => shoeNotFound fn
@@ -132,9 +134,10 @@ BOOTTOCLC(fn, out)==
finally endCompileDuration()
BOOTTOCLCLINES(lines, fn, outfn)==
- infn:=shoeAddbootIfNec fn
- shoeOpenInputFile(a,infn, shoeClCLines(a,fn,lines,outfn))
-
+ try
+ a := inputTextFile shoeAddbootIfNec fn
+ shoeClCLines(a,fn,lines,outfn)
+ finally closeFile a
shoeClCLines(a,fn,lines,outfn)==
a=nil => shoeNotFound fn
@@ -154,10 +157,12 @@ BOOTTOMC fn==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
$GenVarCounter: local := 0
- infn:=shoeAddbootIfNec fn
- result := shoeOpenInputFile(a,infn,shoeMc(a,fn))
- setCurrentPackage callingPackage
- result
+ try
+ a := inputTextFile shoeAddbootIfNec fn
+ shoeMc(a,fn)
+ finally
+ closeFile a
+ setCurrentPackage callingPackage
shoeMc(a,fn)==
a=nil => shoeNotFound fn
@@ -169,8 +174,12 @@ evalBootFile fn ==
IN_-PACKAGE '"BOOTTRAN"
infn:=shoeAddbootIfNec fn
outfn := strconc(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
- shoeOpenInputFile(a,infn,shoeClLines(a,infn,[],outfn))
- setCurrentPackage b
+ try
+ a := inputTextFile infn
+ shoeClLines(a,infn,[],outfn)
+ finally
+ closeFile a
+ setCurrentPackage b
LOAD outfn
++ (boot "filename") translates the file "filename.boot"
@@ -180,19 +189,24 @@ BO fn==
b := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
$GenVarCounter: local := 0
- infn:=shoeAddbootIfNec fn
- shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
- setCurrentPackage b
+ try
+ a := inputTextFile shoeAddbootIfNec fn
+ shoeToConsole(a,fn)
+ finally
+ closeFile a
+ setCurrentPackage b
BOCLAM fn==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
$GenVarCounter: local := 0
$bfClamming: local := true
- infn:=shoeAddbootIfNec fn
- result := shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
- setCurrentPackage callingPackage
- result
+ try
+ a := inputTextFile shoeAddbootIfNec fn
+ shoeToConsole(a,fn)
+ finally
+ closeFile a
+ setCurrentPackage callingPackage
shoeToConsole(a,fn)==
a=nil => shoeNotFound fn
@@ -492,8 +506,10 @@ shoeRemoveStringIfNec(str,s)==
-- not defined in the input file and common lisp.
DEFUSE fn==
- infn := strconc(fn,'".boot")
- shoeOpenInputFile(a,infn,shoeDfu(a,fn))
+ try
+ a := inputTextFile strconc(fn,'".boot")
+ shoeDfu(a,fn)
+ finally closeFile a
--%
$bootDefined := nil
@@ -612,8 +628,10 @@ bootOutLines(l,outfn,s)==
-- used in "fn.boot", together with a list of functions that use it.
XREF fn==
- infn := strconc(fn,'".boot")
- shoeOpenInputFile(a,infn,shoeXref(a,fn))
+ try
+ a := inputTextFile strconc(fn,'".boot")
+ shoeXref(a,fn)
+ finally closeFile a
shoeXref(a,fn)==
a = nil => shoeNotFound fn
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-12 20:16:13 +0000