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 / rtlbase / regset.scm next >
Text File  |  1999-01-02  |  4KB  |  130 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: regset.scm,v 1.4 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1988, 1990, 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 Register Sets
  23.  
  24. (declare (usual-integrations))
  25.  
  26. (define-integrable (make-regset n-registers)
  27.   (make-bit-string n-registers false))
  28.  
  29. (define (for-each-regset-member regset procedure)
  30.   (let ((end (bit-string-length regset)))
  31.     (let loop ((start 0))
  32.       (let ((register (bit-substring-find-next-set-bit regset start end)))
  33.     (if register
  34.         (begin
  35.           (procedure register)
  36.           (loop (1+ register))))))))
  37.  
  38. (define (regset->list regset)
  39.   (let ((end (bit-string-length regset)))
  40.     (let loop ((start 0))
  41.       (let ((register (bit-substring-find-next-set-bit regset start end)))
  42.     (if register
  43.         (cons register (loop (1+ register)))
  44.         '())))))
  45.  
  46. (define-integrable (regset-clear! regset)
  47.   (bit-string-fill! regset false))
  48.  
  49. (define-integrable (regset-disjoint? x y)
  50.   (regset-null? (regset-intersection x y)))
  51.  
  52. (define-integrable regset-allocate bit-string-allocate)
  53. (define-integrable regset-adjoin! bit-string-set!)
  54. (define-integrable regset-delete! bit-string-clear!)
  55. (define-integrable regset-member? bit-string-ref)
  56. (define-integrable regset=? bit-string=?)
  57. (define-integrable regset-null? bit-string-zero?)
  58.  
  59. (define-integrable regset-copy! bit-string-move!)
  60. (define-integrable regset-union! bit-string-or!)
  61. (define-integrable regset-difference! bit-string-andc!)
  62. (define-integrable regset-intersection! bit-string-and!)
  63.  
  64. (define-integrable regset-copy bit-string-copy)
  65. (define-integrable regset-union bit-string-or)
  66. (define-integrable regset-difference bit-string-andc)
  67. (define-integrable regset-intersection bit-string-and)
  68.  
  69. #| Alternate representation.
  70.  
  71. (define-integrable (make-regset n-registers)
  72.   n-registers
  73.   (list 'REGSET))
  74.  
  75. (define-integrable (regset-allocate n-registers)
  76.   n-registers
  77.   (list 'REGSET))
  78.  
  79. (define-integrable (for-each-regset-member regset procedure)
  80.   (for-each procedure (cdr regset)))
  81.  
  82. (define-integrable (regset->list regset)
  83.   (list-copy (cdr regset)))
  84.  
  85. (define-integrable (regset-clear! regset)
  86.   (set-cdr! regset '()))
  87.  
  88. (define-integrable (regset-disjoint? x y)
  89.   (eq-set-disjoint? (cdr x) (cdr y)))
  90.  
  91. (define (regset-adjoin! regset register)
  92.   (if (not (memq register (cdr regset)))
  93.       (set-cdr! regset (cons register (cdr regset)))))
  94.  
  95. (define (regset-delete! regset register)
  96.   (set-cdr! regset (delq register (cdr regset))))
  97.  
  98. (define-integrable (regset-member? regset register)
  99.   (memq register (cdr regset)))
  100.  
  101. (define-integrable (regset=? x y)
  102.   (eq-set-same-set? (cdr x) (cdr y)))
  103.  
  104. (define-integrable (regset-null? regset)
  105.   (null? (cdr regset)))
  106.  
  107. (define-integrable (regset-copy! destination source)
  108.   (set-cdr! destination (cdr source)))
  109.  
  110. (define (regset-union! destination source)
  111.   (set-cdr! destination (eq-set-union (cdr source) (cdr destination))))
  112.  
  113. (define (regset-difference! destination source)
  114.   (set-cdr! destination (eq-set-difference (cdr destination) (cdr source))))
  115.  
  116. (define (regset-intersection! destination source)
  117.   (set-cdr! destination (eq-set-intersection (cdr source) (cdr destination))))
  118.  
  119. (define-integrable regset-copy list-copy)
  120.  
  121. (define-integrable (regset-union x y)
  122.   (cons 'REGSET (eq-set-union (cdr x) (cdr y))))
  123.  
  124. (define-integrable (regset-difference x y)
  125.   (cons 'REGSET (eq-set-difference (cdr x) (cdr y))))
  126.  
  127. (define-integrable (regset-intersection x y)
  128.   (cons 'REGSET (eq-set-intersection (cdr x) (cdr y))))
  129.  
  130. |#