aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-06-07 11:18:27 +0000
committerdos-reis <gdr@axiomatics.org>2010-06-07 11:18:27 +0000
commit4fbe17f6ca64c10f69729c412b7a198da4af65a0 (patch)
tree81f7d711fc9789625c56f57f7cf38fec84487929
parentcb7fc37a4e7a95f7c9dbda0a4c587d75250e1760 (diff)
downloadopen-axiom-4fbe17f6ca64c10f69729c412b7a198da4af65a0.tar.gz
* interp/c-util.boot (isLispSpecialVariable): New.
(mutateToBackendCode): Use it to record special vars. Be careful with locally bound variables.
Diffstat
-rw-r--r--src/ChangeLog6
-rw-r--r--src/algebra/strap/ISTRING.lsp2
-rw-r--r--src/algebra/strap/POLYCAT-.lsp94
-rw-r--r--src/interp/c-util.boot17
4 files changed, 68 insertions, 51 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index c1bf33c4..4a682fdd 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2010-06-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/c-util.boot (isLispSpecialVariable): New.
+ (mutateToBackendCode): Use it to record special vars.
+ Be careful with locally bound variables.
+
2010-06-06 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/compiler.boot (replaceExitEtc): Tidy.
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index e13365f3..5ff74145 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -670,7 +670,7 @@
(|stringMatch| |pattern| |target| (CHARACTER |wildcard|)))
(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $)
- (PROG (|n| |m| |s| #0=#:G1521 |i| |p| |q|)
+ (PROG (|m| |n| |s| #0=#:G1521 |i| |p| |q|)
(RETURN
(SEQ (EXIT (SEQ (LETT |n|
(SPADCALL |pattern| (|getShellEntry| $ 47))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 52d48644..e44c104e 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -142,7 +142,7 @@
|POLYCAT-;convert;SIf;43|))
(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $)
- (PROG (#0=#:G1691 #1=#:G1427 |lvar|)
+ (PROG (|e| #0=#:G1691 #1=#:G1427 |lvar|)
(RETURN
(SEQ (COND
((NULL |l|) |p|)
@@ -732,11 +732,11 @@
(|getShellEntry| $ 159)))))))))))
(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $)
- (PROG (|ll| |ch| |l| #0=#:G1722 #1=#:G1723 #2=#:G1583 #3=#:G1581
- #4=#:G1582 #5=#:G1724 |vars| |degs| |nd| #6=#:G1609
- |deg1| |redmons| |llR| |monslist| |ans| #7=#:G1610 |mons|
- #8=#:G1730 |m| #9=#:G1731 |i| #10=#:G1605 #11=#:G1603
- #12=#:G1604)
+ (PROG (#0=#:G1610 #1=#:G1730 #2=#:G1731 #3=#:G1605 #4=#:G1603
+ #5=#:G1604 |nd| #6=#:G1609 |ll| |ch| |l| #7=#:G1722 |u|
+ #8=#:G1723 #9=#:G1583 #10=#:G1581 #11=#:G1582 |mons| |m|
+ #12=#:G1724 |vars| |degs| |deg1| |redmons| |llR| |monslist|
+ |ans| |i|)
(RETURN
(SEQ (EXIT (SEQ (LETT |ll|
(SPADCALL
@@ -759,52 +759,52 @@
(LETT |ch| (|spadConstant| $ 169)
|POLYCAT-;conditionP;MU;27|)
(SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|)
- (LETT #0# |ll| |POLYCAT-;conditionP;MU;27|)
+ (LETT #7# |ll| |POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #0#)
- (PROGN (SETQ |l| (CAR #0#)) NIL))
+ ((OR (ATOM #7#)
+ (PROGN (SETQ |l| (CAR #7#)) NIL))
(GO G191)))
(SEQ (LETT |mons|
(PROGN
- (LETT #4# NIL
+ (LETT #11# NIL
|POLYCAT-;conditionP;MU;27|)
(SEQ
(LETT |u| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #1# |l|
+ (LETT #8# |l|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #1#)
+ ((OR (ATOM #8#)
(PROGN
- (SETQ |u| (CAR #1#))
+ (SETQ |u| (CAR #8#))
NIL))
(GO G191)))
(SEQ
(EXIT
(PROGN
- (LETT #2#
+ (LETT #9#
(SPADCALL |u|
(|getShellEntry| $ 98))
|POLYCAT-;conditionP;MU;27|)
(COND
- (#4#
- (LETT #3#
- (SPADCALL #3# #2#
+ (#11#
+ (LETT #10#
+ (SPADCALL #10# #9#
(|getShellEntry| $
170))
|POLYCAT-;conditionP;MU;27|))
('T
(PROGN
- (LETT #3# #2#
+ (LETT #10# #9#
|POLYCAT-;conditionP;MU;27|)
- (LETT #4# 'T
+ (LETT #11# 'T
|POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #1# (CDR #1#)) (GO G190)
+ (SETQ #8# (CDR #8#)) (GO G190)
G191 (EXIT NIL))
(COND
- (#4# #3#)
+ (#11# #10#)
('T
(|IdentityError|
'|setUnion|))))
@@ -813,13 +813,13 @@
|POLYCAT-;conditionP;MU;27|)
(SEQ (LETT |m| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #5# |mons|
+ (LETT #12# |mons|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #5#)
+ ((OR (ATOM #12#)
(PROGN
- (SETQ |m| (CAR #5#))
+ (SETQ |m| (CAR #12#))
NIL))
(GO G191)))
(SEQ
@@ -908,12 +908,12 @@
(SETQ #18# (CDR #18#))
(SETQ #19# (CDR #19#))))
|POLYCAT-;conditionP;MU;27|)))
- (SETQ #5# (CDR #5#)) (GO G190)
+ (SETQ #12# (CDR #12#)) (GO G190)
G191 (EXIT NIL))
(EXIT (LETT |monslist|
(CONS |redmons| |monslist|)
|POLYCAT-;conditionP;MU;27|)))
- (SETQ #0# (CDR #0#)) (GO G190) G191
+ (SETQ #7# (CDR #7#)) (GO G190) G191
(EXIT NIL))
(LETT |ans|
(SPADCALL
@@ -937,43 +937,43 @@
(|getShellEntry| $ 6))
(SIZE |monslist|))))
(SEQ
- (LETT #7# 0
+ (LETT #0# 0
|POLYCAT-;conditionP;MU;27|)
(LETT |mons| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #8# |monslist|
+ (LETT #1# |monslist|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #8#)
+ ((OR (ATOM #1#)
(PROGN
- (SETQ |mons| (CAR #8#))
+ (SETQ |mons| (CAR #1#))
NIL))
(GO G191)))
(SEQ
(EXIT
(|setSimpleArrayEntry| #21#
- #7#
+ #0#
(PROGN
- (LETT #12# NIL
+ (LETT #5# NIL
|POLYCAT-;conditionP;MU;27|)
(SEQ
(LETT |m| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #9# |mons|
+ (LETT #2# |mons|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #9#)
+ ((OR (ATOM #2#)
(PROGN
(SETQ |m|
- (CAR #9#))
+ (CAR #2#))
NIL))
(GO G191)))
(SEQ
(EXIT
(PROGN
- (LETT #10#
+ (LETT #3#
(SPADCALL |m|
(SPADCALL
(SPADCALL
@@ -989,29 +989,29 @@
182))
|POLYCAT-;conditionP;MU;27|)
(COND
- (#12#
- (LETT #11#
- (SPADCALL #11#
- #10#
+ (#5#
+ (LETT #4#
+ (SPADCALL #4#
+ #3#
(|getShellEntry|
$ 183))
|POLYCAT-;conditionP;MU;27|))
('T
(PROGN
- (LETT #11# #10#
+ (LETT #4# #3#
|POLYCAT-;conditionP;MU;27|)
- (LETT #12# 'T
+ (LETT #5# 'T
|POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #9# (CDR #9#))
+ (SETQ #2# (CDR #2#))
(GO G190) G191
(EXIT NIL))
(COND
- (#12# #11#)
+ (#5# #4#)
('T
(|spadConstant| $ 27)))))))
- (SETQ #8#
- (PROG1 (CDR #8#)
- (SETQ #7# (QSADD1 #7#))))
+ (SETQ #1#
+ (PROG1 (CDR #1#)
+ (SETQ #0# (QSADD1 #0#))))
(GO G190) G191 (EXIT NIL))
#21#)))))))))
#6# (EXIT #6#)))))
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 307470eb..80016080 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1445,6 +1445,12 @@ pushLocalVariable x ==
p.1 ~= char "," and not digit? p.1 => nil
PUSH(x,$LocalVars)
+isLispSpecialVariable x ==
+ s := PNAME x
+ s.0 = char "$" and #s > 1 and alphabetic? s.1 and not BOUNDP x
+
+noteSpecialVariable x ==
+ $SpecialVars := insert(x,$SpecialVars)
--%
--% Middle Env to Back End Transformations.
@@ -1518,6 +1524,7 @@ ilTransformInsns form ==
++ Replace every middle end sub-forms in `x' with Lisp code.
mutateToBackendCode: %Form -> %Void
mutateToBackendCode x ==
+ IDENTP x and isLispSpecialVariable x => noteSpecialVariable x
isAtomicForm x => nil
-- temporarily have TRACELET report MAKEPROPs.
if (u := first x) = "MAKEPROP" and $TRACELETFLAG then
@@ -1540,13 +1547,15 @@ mutateToBackendCode x ==
x.first := eval u
mutateToBackendCode x
u in '(LET LET_*) =>
+ oldVars := $LocalVars
vars := nil
for [var,init] in second x repeat
mutateToBackendCode init
$LocalVars := [var,:$LocalVars]
vars := [var,:vars]
mutateToBackendCode x.rest.rest
- $LocalVars := setDifference($LocalVars,vars)
+ newVars := setDifference($LocalVars,setUnion(vars,oldVars))
+ $LocalVars := setUnion(oldVars,newVars)
u in '(PROG LAMBDA) =>
newBindings := []
for y in second x repeat
@@ -1619,9 +1628,11 @@ transformToBackendCode x ==
LISTOFATOMS second x)
lvars := [:$FluidVars,:$LocalVars]
fluids := S_+($FluidVars,$SpecialVars)
- body :=
+ body :=
fluids ~= nil =>
- [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]]
+ lvars ~= nil or needsPROG? body =>
+ [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]]
+ [declareGlobalVariables fluids,:body]
lvars ~= nil or needsPROG? body =>
[["PROG",lvars,["RETURN",:body]]]
body
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-14 16:53:28 +0000