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 / rcseep.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  2.6 KB  |  69 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: rcseep.scm,v 4.7 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1987, 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 Common Subexpression Elimination: Expression Predicates
  23. ;;;  Based on the GNU C Compiler
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define (expression-equivalent? x y validate?)
  28.   ;; If VALIDATE? is true, assume that Y comes from the hash table and
  29.   ;; should have its register references validated.
  30.   (define (loop x y)
  31.     (let ((type (rtl:expression-type x)))
  32.       (and (eq? type (rtl:expression-type y))
  33.        (cond ((eq? type 'REGISTER)
  34.           (register-equivalent? x y))
  35.          ((and (memq type '(OFFSET BYTE-OFFSET))
  36.                (interpreter-stack-pointer? (rtl:offset-base x)))
  37.           (and (interpreter-stack-pointer? (rtl:offset-base y))
  38.                (eq? (stack-reference-quantity x)
  39.                 (stack-reference-quantity y))))
  40.          (else
  41.           (rtl:match-subexpressions x y loop))))))
  42.  
  43.   (define (register-equivalent? x y)
  44.     (let ((x (rtl:register-number x))
  45.       (y (rtl:register-number y)))
  46.       (and (eq? (get-register-quantity x) (get-register-quantity y))
  47.        (or (not validate?)
  48.            (= (register-in-table y) (register-tick y))))))
  49.  
  50.   (loop x y))
  51.  
  52. (define (expression-refers-to? x y)
  53.   ;; True iff any subexpression of X matches Y.
  54.   (define (loop x)
  55.     (or (eq? x y)
  56.     (if (eq? (rtl:expression-type x) (rtl:expression-type y))
  57.         (expression-equivalent? x y false)
  58.         (rtl:any-subexpression? x loop))))
  59.   (loop x))
  60.  
  61. (define (interpreter-register-reference? expression)
  62.   (and (rtl:offset? expression)
  63.        (interpreter-regs-pointer? (rtl:offset-base expression))))
  64.  
  65. (define (expression-address-varies? expression)
  66.   (and (not (interpreter-register-reference? expression))
  67.        (or (memq (rtl:expression-type expression)
  68.          '(OFFSET BYTE-OFFSET PRE-INCREMENT POST-INCREMENT)))
  69.        (rtl:any-subexpression? expression expression-address-varies?)))