mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-16 18:50:23 +02:00
Code Activity

* vm/bytecomp.scm (translate-ref): Combined translate-local-ref,

Browse source 
translate-external-ref, and translate-top-level-ref.
(translate-set): Combined translate-local-set,
translate-external-set, and translate-top-level-ref.
Set a name to the object.
(translate-and, translate-or): Bug fixed.
This commit is contained in:
Keisuke Nishida 2000-09-20 21:07:49 +00:00
parent 3cdfcd54eb
commit 17a2034883
1 changed files with 46 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

106
vm/bytecomp.scm
View file

@ -111,57 +111,51 @@
(define (translate-top-level-var name var) (define (translate-top-level-var name var)
(push-code! name (variable-name var))) (push-code! name (variable-name var)))
(define (translate-local-ref var) (define (translate-ref var)
;; #:ref #<vm:local-var>
;; %pushl OFFSET (if use-stack)
;; %loadl OFFSET (if non-stack)
(assert variable? var) (assert variable? var)
(translate-local-var (if use-stack '%pushl '%loadl) var) (cond
((local-variable? var)
;; #:ref #<vm:local-var>
;; %pushl OFFSET (if use-stack)
;; %loadl OFFSET (if non-stack)
(translate-local-var (if use-stack '%pushl '%loadl) var))
((external-variable? var)
;; #:ref #<vm:external-var>
;; %pushe (DEPTH . OFFSET) (if use-stack)
;; %loade (DEPTH . OFFSET) (if non-stack)
(translate-external-var (if use-stack '%pushe '%loade) var))
((top-level-variable? var)
;; #:ref #<vm:top-level-var>
;; %pusht SYMBOL (if use-stack)
;; %loadt SYMBOL (if non-stack)
(translate-top-level-var (if use-stack '%pusht '%loadt) var)))
(return-position)) (return-position))
(define (translate-external-ref var) (define (translate-set var obj)
;; #:ref #<vm:external-var>
;; %pushe (DEPTH . OFFSET) (if use-stack)
;; %loade (DEPTH . OFFSET) (if non-stack)
(assert variable? var)
(translate-external-var (if use-stack '%pushe '%loade) var)
(return-position))
(define (translate-top-level-ref var)
;; #:ref #<vm:top-level-var>
;; %pusht SYMBOL (if use-stack)
;; %loadt SYMBOL (if non-stack)
(assert variable? var)
(translate-top-level-var (if use-stack '%pusht '%loadt) var)
(return-position))
(define (translate-local-set var obj)
;; #:set #<vm:local-var> OBJ
;; OBJ
;; %savel OFFSET
(assert variable? var) (assert variable? var)
(trans-non-stack obj) (trans-non-stack obj)
(translate-local-var '%savel var) (cond
(unspecified-position) ((local-variable? var)
(return-or-push)) ;; #:set #<vm:local-var> OBJ
;; OBJ
(define (translate-external-set var obj) ;; %savel OFFSET
;; #:set #<vm:external-var> OBJ ;; %name NAME
;; OBJ (translate-local-var '%savel var))
;; %savee (DEPTH . OFFSET) ((external-variable? var)
(assert variable? var) ;; #:set #<vm:external-var> OBJ
(trans-non-stack obj) ;; OBJ
(translate-external-var '%savee var) ;; %savee (DEPTH . OFFSET)
(unspecified-position) ;; %name NAME
(return-or-push)) (translate-external-var '%savee var))
((top-level-variable? var)
(define (translate-top-level-set var obj) ;; #:set #<vm:top-level-var> OBJ
;; #:set #<vm:top-level-var> OBJ ;; OBJ
;; OBJ ;; %savet SYMBOL
;; %savet SYMBOL ;; %name NAME
(assert variable? var) (translate-top-level-var '%savet var)))
(trans-non-stack obj) ;; FIXME: Giving name to every objects is bad, but
(translate-top-level-var '%savet var) ;; FIXME: this is useful for debugging.
(push-code! '%name (variable-name var))
(unspecified-position) (unspecified-position)
(return-or-push)) (return-or-push))
@ -177,13 +171,13 @@
(assert-for-each code? args) (assert-for-each code? args)
(let* ((list (reverse args)) (let* ((list (reverse args))
(last (car list)) (last (car list))
(ARGS (reverse! (cdr list)))) (args (reverse! (cdr list))))
(let ((L0 (make-label))) (let ((L0 (make-label)))
(for-each (lambda (arg) (for-each (lambda (arg)
(trans-non-stack arg) (trans-non-stack arg)
(push-code! '%br-if-not L0)) (push-code! '%br-if-not L0))
args) args)
(trans-non-stack last) (trans-tail last)
(push-code! #:label L0))) (push-code! #:label L0)))
(return-or-push)) (return-or-push))
@ -199,13 +193,13 @@
(assert-for-each code? args) (assert-for-each code? args)
(let* ((list (reverse args)) (let* ((list (reverse args))
(last (car list)) (last (car list))
(ARGS (reverse! (cdr list)))) (args (reverse! (cdr list))))
(let ((L0 (make-label))) (let ((L0 (make-label)))
(for-each (lambda (arg) (for-each (lambda (arg)
(trans-non-stack arg) (trans-non-stack arg)
(push-code! '%br-if L0)) (push-code! '%br-if L0))
args) args)
(trans-non-stack last) (trans-tail last)
(push-code! #:label L0))) (push-code! #:label L0)))
(return-or-push)) (return-or-push))
@ -366,19 +360,11 @@
((#:ref) ((#:ref)
;; #:ref VAR ;; #:ref VAR
(check-nargs args = 1) (check-nargs args = 1)
(let ((var (car args))) (translate-ref (car args)))
(cond
((local-variable? var) (translate-local-ref var))
((external-variable? var) (translate-external-ref var))
((top-level-variable? var) (translate-top-level-ref var)))))
((#:set) ((#:set)
;; #:set VAR OBJ ;; #:set VAR OBJ
(check-nargs args = 2) (check-nargs args = 2)
(let ((var (car args)) (obj (cadr args))) (translate-set (car args) (cadr args)))
(cond
((local-variable? var) (translate-local-set var obj))
((external-variable? var) (translate-external-set var obj))
((top-level-variable? var) (translate-top-level-set var obj)))))
((#:and) ((#:and)
;; #:and ARGS... ;; #:and ARGS...
(apply translate-and args)) (apply translate-and args))