These changes were to bring the C backend back to life. The major

changes that were made was adding direct calls for floating point
operations as well as using the new rules for floating point vectors
(change in RTL syntax).

diff --git a/v7/src/compiler/machines/C/cout.scm b/v7/src/compiler/machines/C/cout.scm
index d06458e3025e10b34b3b5ac9296a1d604822c1aa..6047d67f2d8b8f8cd09200215ea62e5b81ab57e1 100644 (file)
--- a/v7/src/compiler/machines/C/cout.scm
+++ b/v7/src/compiler/machines/C/cout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cout.scm,v 1.4 1993/06/10 01:06:19 jawilson Exp $
+$Id: cout.scm,v 1.5 1993/10/26 03:02:37 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -112,7 +112,9 @@ MIT in each case. |#
                                  default
                                  (car (last-pair dir)))
                              "_"
-                             (pathname-name path)
+                             (string-replace (pathname-name path) ; kludge
+                                             #\-
+                                             #\_)
                              midfix
                              suffix))))))
 \f

diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm
index 1007339872ed78665e8e364579035a357e4ba1b7..263de01cea7f392d439fd6e5374588d764beb476 100644 (file)
--- a/v7/src/compiler/machines/C/lapgen.scm
+++ b/v7/src/compiler/machines/C/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.4 1993/06/10 18:07:39 gjr Exp $
+$Id: lapgen.scm,v 1.5 1993/10/26 03:02:38 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -64,6 +64,8 @@ MIT in each case. |#
      "unsigned long")
     ((DOUBLE)
      "double")
+    ((DOUBLE*)
+     "double *")
     (else
      (comp-internal-error "Unknown type" 'TYPE->NAME type))))
 
@@ -81,6 +83,8 @@ MIT in each case. |#
      (string-append "uLng" (number->string reg)))
     ((DOUBLE)
      (string-append "Dbl" (number->string reg)))
+    ((DOUBLE*)
+     (string-append "pDbl" (number->string reg)))
     (else
      (comp-internal-error "Unknown type" 'REG*TYPE->NAME type))))
 
@@ -545,6 +549,9 @@ MIT in each case. |#
        (else
         (error "unable to determine register type" reg))))
 
+(define-integrable (word-register? reg)
+  (eq? (register-type reg) 'WORD))
+
 (define (register-types-compatible? type1 type2)
   (boolean=? (eq? type1 'FLOAT) (eq? type2 'FLOAT)))
 

diff --git a/v7/src/compiler/machines/C/rules1.scm b/v7/src/compiler/machines/C/rules1.scm
index 3b8d1d451dce4e0d94e7dc400ac47fd825eb237d..14ccb53e1eb1c987d107f82c0fb28e84ecede8b7 100644 (file)
--- a/v7/src/compiler/machines/C/rules1.scm
+++ b/v7/src/compiler/machines/C/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules1.scm,v 1.1 1993/06/08 06:13:32 gjr Exp $
+$Id: rules1.scm,v 1.2 1993/10/26 03:02:39 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -117,9 +117,23 @@ MIT in each case. |#
   (standard-unary-conversion source 'SCHEME_OBJECT target 'SCHEME_OBJECT*
                             object->address))
 
+\f
+;; long the right type here???
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (OFFSET-ADDRESS (REGISTER (? base))
+                         (REGISTER (? index))))
+  (standard-binary-conversion
+   base 'SCHEME_OBJECT*
+   index 'LONG
+   target 'SCHEME_OBJECT*
+   (lambda (base index target)
+     (LAP ,target " = &" ,base "[" ,index "];\n\t"))))
+
 (define-rule statement
   (ASSIGN (REGISTER (? target))
-         (OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
+         (OFFSET-ADDRESS (REGISTER (? source))
+                         (MACHINE-CONSTANT (? offset))))
   (standard-unary-conversion
    source 'SCHEME_OBJECT* target 'SCHEME_OBJECT*
    (lambda (source target)
@@ -127,11 +141,43 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
-         (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
+         (BYTE-OFFSET-ADDRESS (REGISTER (? base))
+                              (REGISTER (? index))))
+  (standard-binary-conversion
+   base 'CHAR*
+   index 'LONG
+   target 'CHAR*
+   (lambda (base index target)
+     (LAP ,target " = &" ,base "[" ,index "];\n\t"))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (BYTE-OFFSET-ADDRESS (REGISTER (? source))
+                              (MACHINE-CONSTANT (? offset))))
   (standard-unary-conversion
    source 'CHAR* target 'CHAR*
    (lambda (source target)
      (LAP ,target " = &" ,source "[" ,offset "];\n\t"))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET-ADDRESS (REGISTER (? base))
+                               (REGISTER (? index))))
+  (standard-binary-conversion
+   base 'DOUBLE*
+   index 'LONG
+   target 'DOUBLE*
+   (lambda (base index target)
+     (LAP ,target " = &" ,base "[" ,index "];\n\t"))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET-ADDRESS (REGISTER (? source))
+                               (MACHINE-CONSTANT (? offset))))
+  (standard-unary-conversion
+   source 'DOUBLE* target 'DOUBLE*
+   (lambda (source target)
+     (LAP ,target " = &" ,source "[" ,offset "];\n\t"))))
 \f
 ;;;; Loading of Constants
 
@@ -217,10 +263,12 @@ MIT in each case. |#
 ;;;; Transfers from memory
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset)))
-  (standard-unary-conversion address 'SCHEME_OBJECT* target 'SCHEME_OBJECT
-    (lambda (address target)
-      (LAP ,target " = " ,address "[" ,offset "];\n\t"))))
+  (ASSIGN (REGISTER (? target))
+         (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset))))
+  (standard-unary-conversion
+   address 'SCHEME_OBJECT* target 'SCHEME_OBJECT
+   (lambda (address target)
+     (LAP ,target " = " ,address "[" ,offset "];\n\t"))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER (? rsp)) 1))
@@ -232,8 +280,9 @@ MIT in each case. |#
 
 (define-rule statement
   ;; store an object in memory
-  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))
          (REGISTER (? source)))
+  (QUALIFIER (word-register? source))
   (let* ((source (standard-source! source 'SCHEME_OBJECT))
         (address (standard-source! address 'SCHEME_OBJECT*)))
     (LAP ,address "[" ,offset "] = " ,source ";\n\t")))
@@ -242,7 +291,8 @@ MIT in each case. |#
   ;; Push an object register on the heap
   (ASSIGN (POST-INCREMENT (REGISTER (? rfree)) 1)
          (REGISTER (? source)))
-  (QUALIFIER (= rfree regnum:free))
+  (QUALIFIER (and (word-register? source)
+                 (= rfree regnum:free)))
   (let ((source (standard-source! source 'SCHEME_OBJECT)))
     (LAP "*free_pointer++ = " ,source ";\n\t")))
 
@@ -250,14 +300,15 @@ MIT in each case. |#
   ;; Push an object register on the stack
   (ASSIGN (PRE-INCREMENT (REGISTER (? rsp)) -1)
          (REGISTER (? source)))
-  (QUALIFIER (= rsp regnum:stack-pointer))
+  (QUALIFIER (and (word-register? source)
+                 (= rsp regnum:stack-pointer)))
   (let ((source (standard-source! source 'SCHEME_OBJECT)))
     (LAP "*--stack_pointer = " ,source ";\n\t")))
 
 ;; Cheaper, common patterns.
 
 (define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))
          (MACHINE-CONSTANT 0))
   (let ((address (standard-source! address 'SCHEME_OBJECT*)))
     (LAP ,address "[" ,offset "] = ((SCHEME_OBJECT) 0);\n\t")))
@@ -269,7 +320,7 @@ MIT in each case. |#
   (LAP "*free_pointer++ = ((SCHEME_OBJECT) 0);\n\t"))
 
 (define-rule statement
-  ;; Push an object register on the stack
+  ;; Push 0 on the stack
   (ASSIGN (PRE-INCREMENT (REGISTER (? rsp)) -1)
          (MACHINE-CONSTANT (? const)))
   (QUALIFIER (= rsp regnum:stack-pointer))
@@ -280,20 +331,24 @@ MIT in each case. |#
 (define-rule statement
   ;; load char object from memory and convert to ASCII byte
   (ASSIGN (REGISTER (? target))
-         (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
-  (standard-unary-conversion address 'SCHEME_OBJECT* target 'ULONG
-    (lambda (address target)
-      (LAP ,target " = (CHAR_TO_ASCII (" ,address "[" ,offset "]));\n\t"))))
+         (CHAR->ASCII (OFFSET (REGISTER (? address))
+                              (MACHINE-CONSTANT (? offset)))))
+  (standard-unary-conversion
+   address 'SCHEME_OBJECT* target 'ULONG
+   (lambda (address target)
+     (LAP ,target " = (CHAR_TO_ASCII (" ,address "[" ,offset "]));\n\t"))))
 
 (define-rule statement
   ;; load ASCII byte from memory
   (ASSIGN (REGISTER (? target))
-         (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+         (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset))))
   (standard-unary-conversion address 'CHAR* target 'ULONG
     (lambda (address target)
       (LAP ,target " = ((ulong) (((unsigned char *) " ,address ")["
           ,offset "]));\n\t"))))
 
+;*
 (define-rule statement
   ;; convert char object to ASCII byte
   (ASSIGN (REGISTER (? target))
@@ -302,16 +357,19 @@ MIT in each case. |#
     (lambda (source target)
       (LAP ,target " = (CHAR_TO_ASCII (" ,source "));\n\t"))))
 
+;; is this constant correct???
 (define-rule statement
   ;; store null byte in memory
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset)))
          (CHAR->ASCII (CONSTANT #\N\TUL)))
   (let ((address (standard-source! address 'CHAR*)))
     (LAP ,address "[" ,offset "] = '\\0';\n\t")))
 
 (define-rule statement
   ;; store ASCII byte in memory
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset)))
          (REGISTER (? source)))
   (let ((address (standard-source! address 'CHAR*))
        (source (standard-source! source 'ULONG)))
@@ -320,7 +378,8 @@ MIT in each case. |#
 (define-rule statement
   ;; convert char object to ASCII byte and store it in memory
   ;; register + byte offset <- contents of register (clear top bits)
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset)))
          (CHAR->ASCII (REGISTER (? source))))
   (let ((address (standard-source! address 'CHAR*))
        (source (standard-source! source 'SCHEME_OBJECT)))

diff --git a/v7/src/compiler/machines/C/rulflo.scm b/v7/src/compiler/machines/C/rulflo.scm
index b6186ab8e9e5b2f6a303af5aa61c3cb7135e113d..0e2315903e17c94d510d7dc7b6ca72e4dfd41b21 100644 (file)
--- a/v7/src/compiler/machines/C/rulflo.scm
+++ b/v7/src/compiler/machines/C/rulflo.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulflo.scm,v 1.1 1993/06/08 06:13:32 gjr Exp $
+$Id: rulflo.scm,v 1.2 1993/10/26 03:02:40 jawilson Exp $
 
-Copyright (c) 1992 Massachusetts Institute of Technology
+Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -37,8 +37,6 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-;;;; Flonum Arithmetic
-
 (define-rule statement
   ;; convert a floating-point number to a flonum object
   (ASSIGN (REGISTER (? target))
@@ -54,6 +52,92 @@ MIT in each case. |#
     (let ((target (standard-target! target 'double)))
       (LAP ,target " = (FLONUM_TO_DOUBLE (" ,source "));\n\t"))))
 
+;;;; Floating-point vector support
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET (REGISTER (? base))
+                       (MACHINE-CONSTANT (? offset))))
+  (standard-unary-conversion
+   base 'DOUBLE*
+   target 'DOUBLE
+   (lambda (target base)
+     (LAP ,target " = " ,base "[" ,offset "];\n\t"))))
+  
+(define-rule statement
+  (ASSIGN (FLOAT-OFFSET (REGISTER (? base))
+                       (MACHINE-CONSTANT (? offset)))
+         (REGISTER (? source)))
+  (let ((base (standard-source! base 'DOUBLE*))
+       (source (standard-source! source 'DOUBLE)))
+    (LAP ,base "[" ,offset "] = " ,source ";\n\t")))
+\f
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index))))
+  (standard-binary-conversion
+   base 'DOUBLE*
+   index 'LONG
+   target 'DOUBLE*
+   (lambda (base index target)
+     (LAP ,target " = " ,base "[" ,index "];\n\t"))))
+
+(define-rule statement
+  (ASSIGN (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index)))
+         (REGISTER (? source)))
+  (let ((base (standard-source! base 'DOUBLE*))
+       (source (standard-source! source 'DOUBLE))
+       (index (standard-source! index 'LONG)))
+    (LAP ,base "[" ,index "] = " ,source ";\n\t")))
+
+; this can't possibly be right
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base))
+                                       (MACHINE-CONSTANT (? w-offset)))
+                       (MACHINE-CONSTANT (? f-offset))))
+  (let* ((base (standard-source! base 'SCHEME_OBJECT*))
+        (target (standard-target! target 'DOUBLE)))
+    (LAP ,target
+        " = &((double *) & (" ,base "[" ,w-offset "]))[" ,f-offset "];\n\t")))
+
+; this can't possibly be right
+(define-rule statement
+  (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base))
+                                       (MACHINE-CONSTANT (? w-offset)))
+                       (MACHINE-CONSTANT (? f-offset)))
+         (REGISTER (? source)))
+  (let ((base (standard-source! base 'SCHEME_OBJECT*))
+       (source (standard-source! source 'DOUBLE)))
+    (LAP "((double *) & (" ,base "[" ,w-offset "]))[" ,f-offset "]"
+        " = " ,source ";\n\t")))
+
+; this can't possibly be right
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base))
+                                       (MACHINE-CONSTANT (? w-offset)))
+                       (REGISTER (? index))))
+  (let* ((base (standard-source! base 'SCHEME_OBJECT*))
+        (index (standard-source! index 'LONG))
+        (target (standard-target! target 'DOUBLE)))
+    (LAP ,target
+        " = &((double *) & (" ,base "[" ,w-offset "]))[" ,index "];\n\t")))
+
+; this can't possibly be right
+(define-rule statement
+  (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base))
+                                       (MACHINE-CONSTANT (? w-offset)))
+                       (REGISTER (? index)))
+         (REGISTER (? source)))
+  (let* ((base (standard-source! base 'SCHEME_OBJECT*))
+        (index (standard-source! index 'LONG))
+        (source (standard-source! source 'DOUBLE)))
+    (LAP "((double *) & (" ,base "[" ,w-offset "]))[" ,index "]"
+        " = " ,source ";\n\t")))
+\f
+;;;; Flonum Arithmetic
+
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (FLONUM-1-ARG (? operation) (REGISTER (? source)) (? overflow?)))
@@ -78,6 +162,25 @@ MIT in each case. |#
   (lambda (target source)
     (LAP ,target " = (- " ,source ");\n\t")))
 
+(let ((define-use-function
+       (lambda (name function)
+         (define-arithmetic-method name flonum-methods/1-arg
+           (lambda (target source)
+             (LAP ,target " = (" ,function " (" ,source "));\n\t"))))))
+  (define-use-function 'FLONUM-ACOS "DOUBLE_ACOS")
+  (define-use-function 'FLONUM-ASIN "DOUBLE_ASIN")
+  (define-use-function 'FLONUM-ATAN "DOUBLE_ATAN")
+  (define-use-function 'FLONUM-CEILING "DOUBLE_CEILING")
+  (define-use-function 'FLONUM-COS "DOUBLE_COS")
+  (define-use-function 'FLONUM-EXP "DOUBLE_EXP")
+  (define-use-function 'FLONUM-FLOOR "DOUBLE_FLOOR")
+  (define-use-function 'FLONUM-LOG "DOUBLE_LOG")
+  (define-use-function 'FLONUM-ROUND "DOUBLE_ROUND")
+  (define-use-function 'FLONUM-SIN "DOUBLE_SIN")
+  (define-use-function 'FLONUM-SQRT "DOUBLE_SQRT")
+  (define-use-function 'FLONUM-TAN "DOUBLE_TAN")
+  (define-use-function 'FLONUM-TRUNCATE "DOUBLE_TRUNCATE"))
+
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (FLONUM-2-ARGS (? operation)
@@ -110,6 +213,11 @@ MIT in each case. |#
   (define-flonum-operation flonum-multiply " * ")
   (define-flonum-operation flonum-divide " / "))
 
+(define-arithmetic-method 'FLONUM-ATAN2 flonum-methods/2-args
+  (lambda (target source1 source2)
+    (LAP ,target " = (DOUBLE_ATAN2 (" ,source1 ", " ,source2
+        "));\n\t")))
+
 ;;;; Flonum Predicates
 
 (define-rule predicate