aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/strap/translator.clisp122
-rw-r--r--src/boot/translator.boot46
2 files changed, 90 insertions, 78 deletions
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index ed424b1e..a5a24e72 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -140,8 +140,10 @@
(|endCompileDuration|)))))
(DEFUN BOOTCLAM (|fn| |out|)
- (DECLARE (SPECIAL |$bfClamming|))
- (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))
+ (PROG (|$bfClamming|)
+ (DECLARE (SPECIAL |$bfClamming|))
+ (RETURN
+ (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
(DEFUN BOOTCLAMLINES (|lines| |fn| |out|)
(BOOTTOCLLINES |lines| |fn| |out|))
@@ -155,24 +157,26 @@
(|shoeClLines| |a| |fn| |lines| |outfn|))))))
(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- (T (SETQ |$GenVarCounter| 0)
- (|shoeOpenOutputFile| |stream| |outfn|
- (PROGN
- (|genOptimizeOptions| |stream|)
- (LET ((|bfVar#7| |lines|) (|line| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#7|)
- (PROGN (SETQ |line| (CAR |bfVar#7|)) NIL))
- (RETURN NIL))
- (T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#7| (CDR |bfVar#7|))))
- (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)
- (|genModuleFinalization| |stream|)))
- |outfn|)))
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ (T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (|genOptimizeOptions| |stream|)
+ (LET ((|bfVar#7| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |line| (CAR |bfVar#7|)) NIL))
+ (RETURN NIL))
+ (T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#7| (CDR |bfVar#7|))))
+ (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)
+ (|genModuleFinalization| |stream|)))
+ |outfn|)))))
(DEFUN BOOTTOCLC (|fn| |out|)
(PROG (|result| |callingPackage|)
@@ -196,33 +200,36 @@
(|shoeClCLines| |a| |fn| |lines| |outfn|))))))
(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- (T (SETQ |$GenVarCounter| 0)
- (|shoeOpenOutputFile| |stream| |outfn|
- (PROGN
- (|genOptimizeOptions| |stream|)
- (LET ((|bfVar#8| |lines|) (|line| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#8|)
- (PROGN (SETQ |line| (CAR |bfVar#8|)) NIL))
- (RETURN NIL))
- (T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#8| (CDR |bfVar#8|))))
- (|shoeFileTrees|
- (|shoeTransformToFile| |stream|
- (|shoeInclude|
- (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))
- |stream|)
- (|genModuleFinalization| |stream|)))
- |outfn|)))
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ (T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (|genOptimizeOptions| |stream|)
+ (LET ((|bfVar#8| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#8|)
+ (PROGN (SETQ |line| (CAR |bfVar#8|)) NIL))
+ (RETURN NIL))
+ (T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#8| (CDR |bfVar#8|))))
+ (|shoeFileTrees|
+ (|shoeTransformToFile| |stream|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|)
+ (|bIgen| 0))))
+ |stream|)
+ (|genModuleFinalization| |stream|)))
+ |outfn|)))))
(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BOOTTOMC))
(DEFUN BOOTTOMC (|fn|)
- (PROG (|result| |infn| |callingPackage|)
+ (PROG (|$GenVarCounter| |result| |infn| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -259,7 +266,7 @@
(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BO))
(DEFUN BO (|fn|)
- (PROG (|infn| |b|)
+ (PROG (|$GenVarCounter| |infn| |b|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -271,7 +278,8 @@
(|setCurrentPackage| |b|)))))
(DEFUN BOCLAM (|fn|)
- (PROG (|result| |infn| |callingPackage|)
+ (PROG (|$bfClamming| |$GenVarCounter| |result| |infn|
+ |callingPackage|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|))
(RETURN
(PROGN
@@ -297,7 +305,7 @@
(DEFUN STOUT (|string|) (PSTOUT (LIST |string|)))
(DEFUN |string2BootTree| (|string|)
- (PROG (|result| |a| |callingPackage|)
+ (PROG (|$GenVarCounter| |result| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -314,7 +322,7 @@
|result|))))
(DEFUN STEVAL (|string|)
- (PROG (|result| |fn| |a| |callingPackage|)
+ (PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -333,7 +341,7 @@
|result|))))
(DEFUN STTOMC (|string|)
- (PROG (|result| |a| |callingPackage|)
+ (PROG (|$GenVarCounter| |result| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -812,7 +820,8 @@
(DEFPARAMETER |$lispWordTable| NIL)
(DEFUN |shoeDfu| (|a| |fn|)
- (PROG (|out|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootDefinedTwice| |$bootUsed|
+ |$bootDefined| |$lispWordTable| |out|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|
|$bootDefinedTwice| |$bootUsed| |$bootDefined|
|$lispWordTable|))
@@ -1110,7 +1119,8 @@
(|shoeOpenInputFile| |a| |infn| (|shoeXref| |a| |fn|))))))
(DEFUN |shoeXref| (|a| |fn|)
- (PROG (|out|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootUsed| |$bootDefined|
+ |$lispWordTable| |out|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter| |$bootUsed|
|$bootDefined| |$lispWordTable|))
(RETURN
@@ -1220,10 +1230,12 @@
|b|))))
(DEFUN PSTTOMC (|string|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (PROGN
- (SETQ |$GenVarCounter| 0)
- (|shoePCompileTrees| (|shoeTransformString| |string|))))
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoePCompileTrees| (|shoeTransformString| |string|))))))
(DEFUN BOOTLOOP ()
(PROG (|stream| |b| |a|)
@@ -1256,7 +1268,7 @@
(T (PSTOUT (LIST |a|)) (BOOTPO)))))))))
(DEFUN PSTOUT (|string|)
- (PROG (|result| |callingPackage|)
+ (PROG (|$GenVarCounter| |result| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 9ecde37e..a90079a5 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -97,7 +97,7 @@ BOOTTOCL(fn, out) ==
++ a hash table to store previously computed values indexed by argument
++ list.
BOOTCLAM(fn, out) ==
- $bfClamming := true
+ $bfClamming: local := true
BOOTCLAMLINES(nil,fn, out)
BOOTCLAMLINES(lines, fn, out) ==
@@ -109,7 +109,7 @@ BOOTTOCLLINES(lines, fn, outfn)==
shoeClLines(a,fn,lines,outfn)==
a=nil => shoeNotFound fn
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
shoeOpenOutputFile(stream,outfn,_
(genOptimizeOptions stream;
(for line in lines repeat shoeFileLine(line,stream);
@@ -137,7 +137,7 @@ BOOTTOCLCLINES(lines, fn, outfn)==
shoeClCLines(a,fn,lines,outfn)==
a=nil => shoeNotFound fn
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
shoeOpenOutputFile(stream,outfn,
(genOptimizeOptions stream;
for line in lines repeat shoeFileLine (line,stream);
@@ -152,7 +152,7 @@ BOOTTOMC: %String -> %Thing
BOOTTOMC fn==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
infn:=shoeAddbootIfNec fn
result := shoeOpenInputFile(a,infn,shoeMc(a,fn))
setCurrentPackage callingPackage
@@ -178,7 +178,7 @@ BO: %String -> %Thing
BO fn==
b := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
infn:=shoeAddbootIfNec fn
shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
setCurrentPackage b
@@ -186,8 +186,8 @@ BO fn==
BOCLAM fn==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
- $bfClamming := true
+ $GenVarCounter: local := 0
+ $bfClamming: local := true
infn:=shoeAddbootIfNec fn
result := shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
setCurrentPackage callingPackage
@@ -207,7 +207,7 @@ STOUT string ==
string2BootTree string ==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
a := shoeTransformString [string]
result :=
bStreamNull a => nil
@@ -219,7 +219,7 @@ string2BootTree string ==
STEVAL string==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
a:= shoeTransformString [string]
result :=
bStreamNull a => nil
@@ -234,7 +234,7 @@ STEVAL string==
STTOMC string==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
a:= shoeTransformString [string]
result :=
bStreamNull a => nil
@@ -502,13 +502,13 @@ $lispWordTable := nil
shoeDfu(a,fn)==
a=nil => shoeNotFound fn
- $lispWordTable :=MAKE_-HASHTABLE ("EQ")
+ $lispWordTable: local := MAKE_-HASHTABLE ("EQ")
DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
- $bootDefined :=MAKE_-HASHTABLE "EQ"
- $bootUsed :=MAKE_-HASHTABLE "EQ"
- $bootDefinedTwice := nil
- $GenVarCounter := 0
- $bfClamming := false
+ $bootDefined: local :=MAKE_-HASHTABLE "EQ"
+ $bootUsed:local := MAKE_-HASHTABLE "EQ"
+ $bootDefinedTwice: local := nil
+ $GenVarCounter: local := 0
+ $bfClamming: local := false
shoeDefUse shoeTransformStream a
out := strconc(fn,'".defuse")
shoeOpenOutputFile(stream,out,shoeReport stream)
@@ -616,12 +616,12 @@ XREF fn==
shoeXref(a,fn)==
a = nil => shoeNotFound fn
- $lispWordTable :=MAKE_-HASHTABLE ("EQ")
+ $lispWordTable: local := MAKE_-HASHTABLE ("EQ")
DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
- $bootDefined :=MAKE_-HASHTABLE "EQ"
- $bootUsed :=MAKE_-HASHTABLE "EQ"
- $GenVarCounter :=0
- $bfClamming :=false
+ $bootDefined: local := MAKE_-HASHTABLE "EQ"
+ $bootUsed: local := MAKE_-HASHTABLE "EQ"
+ $GenVarCounter: local := 0
+ $bfClamming: local := false
shoeDefUse shoeTransformStream a
out := strconc(fn,'".xref")
shoeOpenOutputFile(stream,out,shoeXReport stream)
@@ -666,7 +666,7 @@ bStreamPackageNull s==
b
PSTTOMC string==
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
shoePCompileTrees shoeTransformString string
BOOTLOOP() ==
@@ -700,7 +700,7 @@ BOOTPO() ==
PSTOUT string==
callingPackage := _*PACKAGE_*
IN_-PACKAGE '"BOOTTRAN"
- $GenVarCounter := 0
+ $GenVarCounter: local := 0
result := shoeConsoleTrees shoeTransformString string
setCurrentPackage callingPackage
result
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 20:51:03 +0000