Added clock timing. Still needs much work.

diff --git a/v8/src/compiler/machines/i386/lapopt.scm b/v8/src/compiler/machines/i386/lapopt.scm
index 3501f505743f1b9902c889801b92e5368ac381b3..a783c24c99ab1b9a01fd8452a2bd9bc221319c8c 100644 (file)
--- a/v8/src/compiler/machines/i386/lapopt.scm
+++ b/v8/src/compiler/machines/i386/lapopt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/compiler/machines/i386/lapopt.scm,v 1.2 1995/01/12 15:33:07 ssmith Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/compiler/machines/i386/lapopt.scm,v 1.3 1995/01/12 16:16:21 ssmith Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -37,5 +37,92 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define (optimize-linear-lap instructions)
-  (pp instructions)
+  ;; The following returns a list of information about the instruction:
+  ;; 1. timing -- how many cycles
+  ;; 2. pipelining -- which pipes 1 - first pipe, 2 - second pipe, 12 - both pipes, #f - unpipable
+  ;; 3. list of registers modified
+  ;; 4. list of registers read
+  ;; 5. list of registers used in addressing
+  (define (get-instruction-info inst)
+    (define ins-vars '())
+    (define instruction-data
+      '((1 12 (a) (b) () mov ? (? a) (? b))
+       (1 12 (a) () () lea (? a) ())))
+      
+    ;; Given a list of registers/variables from the instruction data,
+    ;; this procedure creates a list containing all the registers referenced
+    ;; If the list specifies a variable, then that variable is looked up to
+    ;; find out if it is a register or an addressing mode (we only care
+    ;; about registers).  A register can also be explicitly stated in the
+    ;; list passed to make-reg-list
+    (define (make-reg-list a)
+      (define (find-var v)
+       (let loop ((data ins-vars))
+         (if (null? data)
+             #f
+             (if (eq? (car (car data))
+                      v)
+                 (cdr (car data))
+                 (loop (cdr data))))))
+      (if (pair? a)
+         (let ((data (find-var (car a))))
+           (if data
+               (if (eq? (car data) 'R)
+                   (cons (cadr data)
+                         (make-my-list (cdr a)))
+                   (make-my-list (cdr a)))
+               (if (number? (car a))
+                   (cons (car a)
+                         (make-my-list (cdr a)))
+                   (begin
+                     (pp (car a))
+                     ()))))
+         a))
+
+    ;; Checks to see if the the pattern matches given data
+    (define (is-all-match? pattern data)
+      (define (is-match? pattern data)
+       (cond ((eq? '? pattern)
+              #t)
+             ((and (pair? pattern)
+                   (eq? '? (car pattern)))
+
+              ;; Add data to variable list
+              (set! ins-vars
+                    (cons (cons (cadr pattern)
+                                data)
+                          ins-vars))
+              #t)
+             ((eq? pattern data)
+              #t)
+             (else
+              #f)))
+      (cond ((and (pair? pattern) (pair? data))
+            (and (is-match? (car pattern)
+                            (car data))
+                 (is-all-match? (cdr pattern)
+                                (cdr data))))
+           (else
+            (eq? pattern data))))
+
+    (let loop ((data instruction-data))
+      (set! ins-vars '())
+      (if (null? data)
+         (begin
+           (pp inst)
+           '(0 0 () () ()))
+         (if (is-all-match? (cdr (cdr (cdr (cdr (car data)))))
+                            inst)
+             (list (car (car data))
+                   (cadr (car data))
+                   (make-reg-list (caddr (car data)))
+                   (make-reg-list (cadddr (car data)))
+                   ())
+             (loop (cdr data))))))
+  (let loop ((inst instructions)
+            (times 0))
+    (if (null? inst)
+       (pp times)
+       (loop (cdr inst)
+             (+ times (car get-instruction-info)))))
   instructions)