mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

(translate-and, translate-or): Don't branch on the last expression.

Browse source
This commit is contained in:
Keisuke Nishida 2000-08-22 18:25:36 +00:00
parent fd329e8725
commit e54350691e
1 changed files with 24 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

38
vm/bytecomp.scm
View file

@ -166,37 +166,47 @@
(return-or-push)) (return-or-push))
(define (translate-and . args) (define (translate-and . args)
;; #:and ARG1 ARG2... ;; #:and ARG1 ARG2... LAST
;; ARG1 ;; ARG1
;; %br-if-not L0 ;; %br-if-not L0
;; ARG2 ;; ARG2
;; %br-if-not L0 ;; %br-if-not L0
;; ... ;; ...
;; LAST
;; L0: ;; L0:
(assert-for-each code? args) (assert-for-each code? args)
(let ((L0 (make-label))) (let* ((list (reverse args))
(for-each (lambda (arg) (last (car list))
(trans-non-stack arg) (ARGS (reverse! (cdr list))))
(push-code! '%br-if-not L0)) (let ((L0 (make-label)))
args) (for-each (lambda (arg)
(push-code! #:label L0)) (trans-non-stack arg)
(push-code! '%br-if-not L0))
args)
(trans-non-stack last)
(push-code! #:label L0)))
(return-or-push)) (return-or-push))
(define (translate-or . args) (define (translate-or . args)
;; #:or ARG1 ARG2... ;; #:or ARG1 ARG2... LAST
;; ARG1 ;; ARG1
;; %br-if L0 ;; %br-if L0
;; ARG2 ;; ARG2
;; %br-if L0 ;; %br-if L0
;; ... ;; ...
;; LAST
;; L0: ;; L0:
(assert-for-each code? args) (assert-for-each code? args)
(let ((L0 (make-label))) (let* ((list (reverse args))
(for-each (lambda (arg) (last (car list))
(trans-non-stack arg) (ARGS (reverse! (cdr list))))
(push-code! '%br-if L0)) (let ((L0 (make-label)))
args) (for-each (lambda (arg)
(push-code! #:label L0)) (trans-non-stack arg)
(push-code! '%br-if L0))
args)
(trans-non-stack last)
(push-code! #:label L0)))
(return-or-push)) (return-or-push))
(define (translate-program nreqs restp code) (define (translate-program nreqs restp code)