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

Start the process of de-dottification.

Browse source 
* module/system/vm/assemble.scm: De-dottify.
This commit is contained in:
Andy Wingo 2008-05-04 14:03:53 +02:00
parent bdaffda2c4
commit 024e186230
1 changed files with 9 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

18
module/system/vm/assemble.scm
View file

@ -108,7 +108,7 @@
(let ((name (car v)) (type (cadr v)) (i (caddr v))) (let ((name (car v)) (type (cadr v)) (i (caddr v)))
(case type (case type
((argument) (make-binding name #f i)) ((argument) (make-binding name #f i))
((local) (make-binding name #f (+ vars.nargs i))) ((local) (make-binding name #f (+ (glil-vars-nargs vars) i)))
((external) (make-binding name #t i))))) ((external) (make-binding name #t i)))))
binds))) binds)))
(set! binding-alist (set! binding-alist
@ -133,13 +133,13 @@
((<glil-local> op index) ((<glil-local> op index)
(if (eq? op 'ref) (if (eq? op 'ref)
(push-code! `(local-ref ,(+ vars.nargs index))) (push-code! `(local-ref ,(+ (glil-vars-nargs vars) index)))
(push-code! `(local-set ,(+ vars.nargs index))))) (push-code! `(local-set ,(+ (glil-vars-nargs vars) index)))))
((<glil-external> op depth index) ((<glil-external> op depth index)
(do ((e venv e.parent) (do ((e venv (venv-parent e))
(d depth (1- d)) (d depth (1- d))
(n 0 (+ n e.nexts))) (n 0 (+ n (venv-nexts e))))
((= d 0) ((= d 0)
(if (eq? op 'ref) (if (eq? op 'ref)
(push-code! `(external-ref ,(+ n index))) (push-code! `(external-ref ,(+ n index)))
@ -173,7 +173,7 @@
; (format #t "codegen: stack = ~a~%" (reverse stack)) ; (format #t "codegen: stack = ~a~%" (reverse stack))
(let ((bytes (stack->bytes (reverse! stack) label-alist))) (let ((bytes (stack->bytes (reverse! stack) label-alist)))
(if toplevel (if toplevel
(bytecode->objcode bytes vars.nlocs vars.nexts) (bytecode->objcode bytes (glil-vars-nlocs vars) (glil-vars-nexts vars))
(make-bytespec :vars vars :bytes bytes (make-bytespec :vars vars :bytes bytes
:meta (if (and (null? binding-alist) :meta (if (and (null? binding-alist)
(null? source-alist)) (null? source-alist))
@ -182,7 +182,7 @@
(reverse! source-alist))) (reverse! source-alist)))
:objs (let ((objs (map car (reverse! object-alist)))) :objs (let ((objs (map car (reverse! object-alist))))
(if (null? objs) #f (list->vector objs))) (if (null? objs) #f (list->vector objs)))
:closure? venv.closure?))))))))) :closure? (venv-closure? venv))))))))))
(define (object-assoc x alist) (define (object-assoc x alist)
(record-case x (record-case x
@ -225,8 +225,8 @@
(record-case x (record-case x
((<bytespec> vars bytes meta objs closure?) ((<bytespec> vars bytes meta objs closure?)
;; dump parameters ;; dump parameters
(let ((nargs vars.nargs) (nrest vars.nrest) (let ((nargs (glil-vars-nargs vars)) (nrest (glil-vars-nrest vars))
(nlocs vars.nlocs) (nexts vars.nexts)) (nlocs (glil-vars-nlocs vars)) (nexts (glil-vars-nexts vars)))
(cond (cond
((and (< nargs 4) (< nlocs 8) (< nexts 4)) ((and (< nargs 4) (< nlocs 8) (< nexts 4))
;; 8-bit representation ;; 8-bit representation