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

Remove duplicate procedure in slot-allocation.scm.

Browse source 
* module/language/cps/slot-allocation.scm (add-live-slot)
(kill-dead-slot, compute-slot): Move higher up in the file.
(compute-shuffles): Remove duplicate 'add-live-slot' procedure.
This commit is contained in:
Ludovic Courtès 2020-02-08 11:28:59 +01:00
parent ff14b77ff5
commit 7e7d8b778c
1 changed files with 12 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

25
module/language/cps/slot-allocation.scm
View file

@ -1,6 +1,6 @@
;; Continuation-passing style (CPS) intermediate language (IL) ;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013-2019 Free Software Foundation, Inc. ;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -482,10 +482,18 @@ are comparable with eqv?. A tmp slot may be used."
tmp) tmp)
(loop to-move b (cons s+d moved) last-source)))))))))) (loop to-move b (cons s+d moved) last-source))))))))))
(define (compute-shuffles cps slots call-allocs live-in) (define-inlinable (add-live-slot slot live-slots)
(define (add-live-slot slot live-slots)
(logior live-slots (ash 1 slot))) (logior live-slots (ash 1 slot)))
(define-inlinable (kill-dead-slot slot live-slots)
(logand live-slots (lognot (ash 1 slot))))
(define-inlinable (compute-slot live-slots hint)
(if (and hint (not (logbit? hint live-slots)))
hint
(find-first-zero live-slots)))
(define (compute-shuffles cps slots call-allocs live-in)
(define (get-cont label) (define (get-cont label)
(intmap-ref cps label)) (intmap-ref cps label))
@ -665,17 +673,6 @@ are comparable with eqv?. A tmp slot may be used."
(_ slots))) (_ slots)))
cps empty-intmap)))) cps empty-intmap))))
(define-inlinable (add-live-slot slot live-slots)
(logior live-slots (ash 1 slot)))
(define-inlinable (kill-dead-slot slot live-slots)
(logand live-slots (lognot (ash 1 slot))))
(define-inlinable (compute-slot live-slots hint)
(if (and hint (not (logbit? hint live-slots)))
hint
(find-first-zero live-slots)))
(define (allocate-lazy-vars cps slots call-allocs live-in lazy) (define (allocate-lazy-vars cps slots call-allocs live-in lazy)
(define (compute-live-slots slots label) (define (compute-live-slots slots label)
(intset-fold (lambda (var live) (intset-fold (lambda (var live)