Menu
▾
▴
Re: mark_ht_invalid
|
From: Bruno H. <br...@cl...> - 2003-05-14 16:45:16
|
Sam writes:
> here is a smaller test case:
>
> (defun zz (packages)
> (dolist (p packages)
> (block fail
> (do-symbols (sym p)
> (let ((s (find-symbol (symbol-name sym) p)))
> (return-from fail s))))))
Good. After macroexpansion it is equivalent to:
(defun zz (packages)
(BLOCK NIL
(LET* ((#:G1189 PACKAGES) (P NIL)) (DECLARE (LIST #:G1189))
(TAGBODY
#:G1190
(IF (ENDP #:G1189) (GO #:G1191))
(SETQ P (CAR #:G1189))
(BLOCK FAIL
(LET ((#:G1192 P))
(SYSTEM::MAP-SYMBOLS
#'(LAMBDA (SYM)
(LET ((S (FIND-SYMBOL (SYMBOL-NAME SYM) P)))
(RETURN-FROM FAIL S)))
#:G1192)
NIL))
(SETQ #:G1189 (CDR #:G1189))
(GO #:G1190)
#:G1191
(RETURN-FROM NIL (PROGN NIL))))))
Here the line that assigns to P and, two lines later, the use of P
are separated only by the BLOCK-OPEN.
> 11 (car)
> 12 (storec 1 0)
> 15 (block-open 0 l30)
> 18 (push)
So the (PUSH) would have been a LOADC&PUSH if the optimization in
traverse-anode had not been.
Can you try this patch? If it works, please also update
doc/impbyte.xml.
2003-05-14 Bruno Haible <br...@cl...>
* compiler.lisp: Clarify that BLOCK-OPEN and TAGBODY-OPEN have
undefined values.
(traverse-anode): Clear the current known value when encountering
BLOCK-OPEN or TAGBODY-OPEN.
*** compiler.lisp 9 May 2003 15:57:56 -0000 1.124
--- compiler.lisp 14 May 2003 16:39:27 -0000
***************
*** 491,498 ****
(BLOCK-OPEN const label) Stores a Block-Cons (with CAR=const and CDR=
Framepointer) to -(STACK), constructs a
! Block-Frame. On RETURN to this
! Frame --> jump to label.
(BLOCK-CLOSE) Leave the Block and thereby dismantle a Block-
Frame (including the Block-Cons-Variables)
(RETURN-FROM const) Leave the Block, whose Block-Cons is specified,
--- 491,498 ----
(BLOCK-OPEN const label) Stores a Block-Cons (with CAR=const and CDR=
Framepointer) to -(STACK), constructs a
! Block-Frame. Undefined values. On RETURN to
! this Frame --> jump to label.
(BLOCK-CLOSE) Leave the Block and thereby dismantle a Block-
Frame (including the Block-Cons-Variables)
(RETURN-FROM const) Leave the Block, whose Block-Cons is specified,
***************
*** 508,515 ****
(TAGBODY-OPEN const label1 ... labelm)
Stores a Tagbody-Cons (with CAR=const
and CDR=Framepointer) on -(STACK), constructs a
! Tagbody-Frame. On GO with number l
! ---> jump to labell.
(TAGBODY-CLOSE-NIL) Leave the Tagbody and thereby dismantle a
Tagbody-Frame (including the Tagbody-Cons-
Variables). A0 := NIL, 1 value
--- 508,515 ----
(TAGBODY-OPEN const label1 ... labelm)
Stores a Tagbody-Cons (with CAR=const
and CDR=Framepointer) on -(STACK), constructs a
! Tagbody-Frame. Undefined values. On GO with
! number l ---> jump to labell.
(TAGBODY-CLOSE-NIL) Leave the Tagbody and thereby dismantle a
Tagbody-Frame (including the Tagbody-Cons-
Variables). A0 := NIL, 1 value
***************
*** 7506,7512 ****
(let ((label (third item)))
(push `(BLOCK-OPEN ,(const-index (second item)) ,label)
*code-part*)
! (push (first *code-part*) (symbol-value label))))
(RETURN-FROM
(push
(if (cddr item)
--- 7506,7514 ----
(let ((label (third item)))
(push `(BLOCK-OPEN ,(const-index (second item)) ,label)
*code-part*)
! (push (first *code-part*) (symbol-value label))
! ;; undefined values
! (setq *current-value* nil *current-vars* '())))
(RETURN-FROM
(push
(if (cddr item)
***************
*** 7522,7528 ****
(TAGBODY-OPEN
(push `(TAGBODY-OPEN ,(const-index (second item)) ,@(cddr item))
*code-part*)
! (dolist (label (cddr item)) (push item (symbol-value label))))
(GO
(push
(if (cdddr item)
--- 7524,7532 ----
(TAGBODY-OPEN
(push `(TAGBODY-OPEN ,(const-index (second item)) ,@(cddr item))
*code-part*)
! (dolist (label (cddr item)) (push item (symbol-value label)))
! ;; undefined values
! (setq *current-value* nil *current-vars* '()))
(GO
(push
(if (cdddr item)
|