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 / machines / sparc / lapopt.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  3.0 KB  |  93 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: lapopt.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1991, 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. ;;;; LAP Optimizer for MIPS.
  23.  
  24. (declare (usual-integrations))
  25.  
  26. (define (optimize-linear-lap instructions)
  27.   instructions)
  28.  
  29. #|
  30. (define (optimize-linear-lap instructions)
  31.   ;; Find occurrences of LW/LBU/LWC1 followed by NOP, and delete the
  32.   ;; NOP if the instruction following it has no reference to the
  33.   ;; target register of the load.
  34.  
  35.   ;; **** This is pretty fragile. ****
  36.   (letrec
  37.       ((find-load
  38.     (lambda (instructions)
  39.       (cond ((null? instructions) '())
  40.         ((and (pair? (car instructions))
  41.               (or (eq? 'LW (caar instructions))
  42.               (eq? 'LBU (caar instructions))
  43.               (eq? 'LWC1 (caar instructions))))
  44.          instructions)
  45.         (else (find-load (cdr instructions))))))
  46.        (get-next
  47.     (lambda (instructions)
  48.       (let ((instructions (cdr instructions)))
  49.         (cond ((null? instructions) '())
  50.           ((or (not (pair? (car instructions)))
  51.                (eq? 'LABEL (caar instructions))
  52.                (eq? 'COMMENT (caar instructions)))
  53.            (get-next instructions))
  54.           (else instructions)))))
  55.        (refers-to-register?
  56.     (lambda (instruction register)
  57.       (let loop ((x instruction))
  58.         (if (pair? x)
  59.         (or (loop (car x))
  60.             (loop (cdr x)))
  61.         (eqv? register x))))))
  62.     (let loop ((instructions instructions))
  63.       (let ((first (find-load instructions)))
  64.     (if (not (null? first))
  65.         (let ((second (get-next first)))
  66.           (if (not (null? second))
  67.           (let ((third (get-next second)))
  68.             (if (not (null? third))
  69.             (if (and (equal? '(NOP) (car second))
  70.                  ;; This is a crude way to test for a
  71.                  ;; reference to the target register
  72.                  ;; -- it will sometimes incorrectly
  73.                  ;; say that there is a reference, but
  74.                  ;; it will never incorrectly say that
  75.                  ;; there is no reference.
  76.                  (not (refers-to-register? (car third)
  77.                                (cadar first)))
  78.                  (or (not (and (eq? 'LWC1 (caar first))
  79.                            (odd? (cadar first))))
  80.                      (not (refers-to-register?
  81.                        (car third)
  82.                        (- (cadar first) 1)))))
  83.                 (begin
  84.                   (let loop ((this (cdr first)) (prev first))
  85.                 (if (eq? second this)
  86.                     (set-cdr! prev (cdr this))
  87.                     (loop (cdr this) this)))
  88.                   (loop (if (equal? '(NOP) (car third))
  89.                     first
  90.                     third)))
  91.                 (loop second))))))))))
  92.   instructions)
  93. |#