home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / rtlopt / rcserq.scm < prev    next >
Encoding:
Text File  |  1999-11-08  |  4.3 KB  |  120 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: rcserq.scm,v 4.7 1999/11/08 18:29:35 cph Exp $
  4.  
  5. Copyright (c) 1988, 1989, 1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; RTL Common Subexpression Elimination: Register/Quantity Abstractions
  23. ;;;  Based on the GNU C Compiler
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define-structure (quantity
  28.            (copier quantity-copy)
  29.            (print-procedure
  30.             (standard-unparser (symbol->string 'QUANTITY) false)))
  31.   (number false read-only true)
  32.   (first-register false)
  33.   (last-register false))
  34.  
  35. (define (get-register-quantity register)
  36.   (or (register-quantity register)
  37.       (let ((quantity (new-quantity register)))
  38.     (set-register-quantity! register quantity)
  39.     quantity)))
  40.  
  41. (define (new-quantity register)
  42.   (make-quantity (let ((n *next-quantity-number*))
  43.            (set! *next-quantity-number* (1+ *next-quantity-number*))
  44.            n)
  45.          register
  46.          register))
  47.  
  48. (define *next-quantity-number*)
  49.  
  50. (define (register-tables/make n-registers)
  51.   (vector (make-vector n-registers)
  52.       (make-vector n-registers)
  53.       (make-vector n-registers)
  54.       (make-vector n-registers)
  55.       (make-vector n-registers)
  56.       (make-vector n-registers)))
  57.  
  58. (define (register-tables/reset! register-tables)
  59.   (vector-fill! (vector-ref register-tables 0) false)
  60.   (vector-fill! (vector-ref register-tables 1) false)
  61.   (vector-fill! (vector-ref register-tables 2) false)
  62.   (let ((expressions (vector-ref register-tables 3)))
  63.     (vector-fill! expressions false)
  64.     (for-each-machine-register
  65.      (lambda (register)
  66.        (vector-set! expressions
  67.             register
  68.             (rtl:make-machine-register register)))))
  69.   (vector-fill! (vector-ref register-tables 4) 0)
  70.   (vector-fill! (vector-ref register-tables 5) -1))
  71.  
  72. (define (register-tables/copy register-tables)
  73.   (vector (vector-map (lambda (quantity)
  74.             (and quantity
  75.                  (quantity-copy quantity)))
  76.               (vector-ref register-tables 0))
  77.       (vector-copy (vector-ref register-tables 1))
  78.       (vector-copy (vector-ref register-tables 2))
  79.       (vector-copy (vector-ref register-tables 3))
  80.       (vector-copy (vector-ref register-tables 4))
  81.       (vector-copy (vector-ref register-tables 5))))
  82.  
  83. (define *register-tables*)
  84.  
  85. (define-integrable (register-quantity register)
  86.   (vector-ref (vector-ref *register-tables* 0) register))
  87.  
  88. (define-integrable (set-register-quantity! register quantity)
  89.   (vector-set! (vector-ref *register-tables* 0) register quantity))
  90.  
  91. (define-integrable (register-next-equivalent register)
  92.   (vector-ref (vector-ref *register-tables* 1) register))
  93.  
  94. (define-integrable (set-register-next-equivalent! register next-equivalent)
  95.   (vector-set! (vector-ref *register-tables* 1) register next-equivalent))
  96.  
  97. (define-integrable (register-previous-equivalent register)
  98.   (vector-ref (vector-ref *register-tables* 2) register))
  99.  
  100. (define-integrable
  101.   (set-register-previous-equivalent! register previous-equivalent)
  102.   (vector-set! (vector-ref *register-tables* 2) register previous-equivalent))
  103.  
  104. (define-integrable (register-expression register)
  105.   (vector-ref (vector-ref *register-tables* 3) register))
  106.  
  107. (define-integrable (set-register-expression! register expression)
  108.   (vector-set! (vector-ref *register-tables* 3) register expression))
  109.  
  110. (define-integrable (register-tick register)
  111.   (vector-ref (vector-ref *register-tables* 4) register))
  112.  
  113. (define-integrable (set-register-tick! register tick)
  114.   (vector-set! (vector-ref *register-tables* 4) register tick))
  115.  
  116. (define-integrable (register-in-table register)
  117.   (vector-ref (vector-ref *register-tables* 5) register))
  118.  
  119. (define-integrable (set-register-in-table! register in-table)
  120.   (vector-set! (vector-ref *register-tables* 5) register in-table))