Move some back-end-dependent stuff to back/asutl.
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Wed, 18 Nov 1992 00:48:50 +0000 (00:48 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Wed, 18 Nov 1992 00:48:50 +0000 (00:48 +0000)
The C back end has its own replacement.

v7/src/compiler/machines/spectrum/compiler.pkg
v7/src/compiler/machines/spectrum/decls.scm
v7/src/compiler/machines/spectrum/machin.scm
v7/src/compiler/rtlbase/rtlcon.scm
v7/src/compiler/rtlbase/rtlty2.scm
v7/src/compiler/rtlgen/opncod.scm
v7/src/compiler/rtlgen/rgrval.scm

index d5e7ff785405e44d8afa13a44968b9f748cc9ffe..2ed5814308542016beb5ac16bfa23eca740ed445 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compiler.pkg,v 1.39 1992/11/14 17:21:08 gjr Exp $
+$Id: compiler.pkg,v 1.40 1992/11/18 00:46:37 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -45,6 +45,7 @@ MIT in each case. |#
         "base/mvalue"                  ;multiple-value support
         "base/scode"                   ;SCode abstraction
         "machines/spectrum/machin"     ;machine dependent stuff
+        "back/asutl"                   ;back-end odds and ends
         "base/utils"                   ;odds and ends
 
         "base/cfg1"                    ;control flow graph
index 2b9469cc9c0b77f3b586ba8f14774f5f6ab1a922..192105cc63395dd67cfffde9933e7bfc57cab1ca 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: decls.scm,v 4.31 1992/10/19 19:15:41 jinx Exp $
+$Id: decls.scm,v 4.32 1992/11/18 00:46:26 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -379,7 +379,6 @@ MIT in each case. |#
 ;;;; Integration Dependencies
 
 (define (initialize/integration-dependencies!)
-
   (define (add-declaration! declaration filenames)
     (for-each (lambda (filenames)
                (let ((node (filename->source-node filenames)))
@@ -396,7 +395,8 @@ MIT in each case. |#
                           "object" "proced" "rvalue"
                           "scode" "subprb" "utils"))
         (spectrum-base
-         (filename/append "machines/spectrum" "machin"))
+         (append (filename/append "machines/spectrum" "machin")
+                 (filename/append "back" "asutl")))
         (rtl-base
          (filename/append "rtlbase"
                           "rgraph" "rtlcfg" "rtlobj" "rtlreg" "rtlty1"
@@ -446,6 +446,7 @@ MIT in each case. |#
        (string-append directory "/" name)
        (apply filename/append directory* names)))
 
+    (define-integration-dependencies "machines/spectrum" "machin" "back" "asutl")
     (define-integration-dependencies "base" "object" "base" "enumer")
     (define-integration-dependencies "base" "enumer" "base" "object")
     (define-integration-dependencies "base" "utils" "base" "scode")
index df7f9f92b374e4203da6d94b8482ff8d3f191f27..36bc4d8794d44e288a6d02c3ae516c1ac85bb7ec 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: machin.scm,v 4.25 1992/11/08 04:09:47 jinx Exp $
+$Id: machin.scm,v 4.26 1992/11/18 00:46:45 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -147,12 +147,6 @@ MIT in each case. |#
 (define (closure-environment-adjustment nentries entry)
   nentries entry                       ; ignored
   0)
-
-(define-integrable (byte-offset:zero? obj)
-  (zero? obj))
-
-(define-integrable (byte-offset:- x y)
-  (- x y))
 \f
 ;;;; Machine Registers
 
index f306e95405324f7b02865721d89de1b2c16cf769..b938ef7734d39c2e2ce68c63611bfa94ef0c4597 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlcon.scm,v 4.23 1992/11/09 18:42:25 jinx Exp $
+$Id: rtlcon.scm,v 4.24 1992/11/18 00:48:24 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -146,18 +146,6 @@ MIT in each case. |#
        (rtl:make-machine-constant type-code:unassigned)
        (rtl:make-machine-constant 0))
       (%make-constant value)))
-(define make-non-pointer-literal
-  (let ((type-maximum (expt 2 scheme-type-width))
-       (type-scale-factor (expt 2 scheme-datum-width)))
-    (lambda (type datum)
-      (if (not (and (exact-nonnegative-integer? type)
-                   (< type type-maximum)))
-         (error "non-pointer type out of range" type))
-      (if (not (and (exact-nonnegative-integer? datum)
-                   (< datum type-scale-factor)))
-         (error "non-pointer datum out of range" datum))
-      (+ (* type type-scale-factor) datum))))
 \f
 ;;; Interpreter Calls
 
index d5ae4e5dfc27a3f16e6ee0753480df3719928f4e..947c1318ab29661742ea4c7cafcd27a0afe26a32 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty2.scm,v 4.9 1990/05/03 15:10:34 jinx Rel $
+$Id: rtlty2.scm,v 4.10 1992/11/18 00:48:50 gjr Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -109,27 +109,30 @@ MIT in each case. |#
   (eq? (rtl:locative-offset-granularity locative) 'OBJECT))
 
 (define (rtl:locative-offset locative offset)
-  (cond ((zero? offset) locative)
+  (cond ((back-end:= offset 0) locative)
        ((rtl:locative-offset? locative)
         (if (rtl:locative-byte-offset? locative)
             (error "Can't add object-offset to byte-offset"
                    locative offset)
             `(OFFSET ,(rtl:locative-offset-base locative)
-                     ,(+ (rtl:locative-offset-offset locative) offset)
+                     ,(back-end:+ (rtl:locative-offset-offset locative)
+                                  offset)
                      OBJECT)))
-       (else `(OFFSET ,locative ,offset OBJECT))))
+       (else
+        `(OFFSET ,locative ,offset OBJECT))))
 
 (define (rtl:locative-byte-offset locative byte-offset)
-  (cond ((zero? byte-offset) locative)
+  (cond ((back-end:= byte-offset 0) locative)
        ((rtl:locative-offset? locative)
         `(OFFSET ,(rtl:locative-offset-base locative)
-                 ,(+ byte-offset
-                     (if (rtl:locative-byte-offset? locative)
-                         (rtl:locative-offset-offset locative)
-                         (* (rtl:locative-offset-offset locative)
-                            (quotient scheme-object-width 8))))
+                 ,(back-end:+ byte-offset
+                              (if (rtl:locative-byte-offset? locative)
+                                  (rtl:locative-offset-offset locative)
+                                  (back-end:* (rtl:locative-offset-offset locative)
+                                              address-units-per-object)))
                  BYTE))
-       (else `(OFFSET ,locative ,byte-offset BYTE))))
+       (else
+        `(OFFSET ,locative ,byte-offset BYTE))))
 \f
 ;;; Expressions that are used in the intermediate form.
 
index 492522272a3530fd606ac9d19432c60d8c09eeef..15df5fdcfcb7f5f60593bc8b2665474460336397 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/opncod.scm,v 4.47 1992/04/13 04:44:13 jinx Exp $
+$Id: opncod.scm,v 4.48 1992/11/18 00:47:21 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -452,8 +452,9 @@ MIT in each case. |#
                                  header-length-in-objects
                                  address-units-per-index)
   (let ((header-length-in-indexes
-        (* header-length-in-objects
-           (quotient address-units-per-object address-units-per-index))))
+        (back-end:* header-length-in-objects
+                    (back-end:quotient address-units-per-object
+                                       address-units-per-index))))
     (lambda (base index finish)
       (let ((unknown-index
             (lambda ()
@@ -464,7 +465,7 @@ MIT in each case. |#
                  'PLUS-FIXNUM
                  (rtl:make-address->fixnum (rtl:make-object->address base))
                  (let ((index (rtl:make-object->fixnum index)))
-                   (if (= address-units-per-index 1)
+                   (if (back-end:= address-units-per-index 1)
                        index
                        (rtl:make-fixnum-2-args
                         'MULTIPLY-FIXNUM
@@ -481,7 +482,9 @@ MIT in each case. |#
              (if (and (object-type? (ucode-type fixnum) value)
                       (not (negative? value)))
                  (finish
-                  (make-locative base (+ header-length-in-indexes value)))
+                  (make-locative base
+                                 (back-end:+ header-length-in-indexes
+                                             value)))
                  (unknown-index)))
            (unknown-index))))))
 
index 83c5d0c1b3c4254ba24cc82b2fe8a3ddcf36c099..4c8a2a5aa308318ba1c9eac16e9f5ab968aed6d7 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rgrval.scm,v 4.19 1992/11/09 18:42:52 jinx Exp $
+$Id: rgrval.scm,v 4.20 1992/11/18 00:47:09 gjr Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -271,10 +271,10 @@ MIT in each case. |#
            (entry (closure-block-entry-number block))
            (entry* (closure-block-entry-number block*)))
        (let ((distance
-              (byte-offset:-
+              (back-end:-
                (closure-entry-distance nentries entry entry*)
                (closure-environment-adjustment nentries entry))))
-         (if (byte-offset:zero? distance)
+         (if (back-end:= distance 0)
              expression
              ;; This is cheaper than the obvious thing with object->address,
              ;; etc.
@@ -404,7 +404,7 @@ MIT in each case. |#
   ;; is always the canonical entry point.
   (let* ((closure-block (procedure-closing-block procedure))
         (shared-block (block-shared-block closure-block)))
-    (byte-offset:zero?
-     (closure-environment-adjustment
-      (block-number-of-entries shared-block)
-      (closure-block-entry-number closure-block)))))
\ No newline at end of file
+    (back-end:= (closure-environment-adjustment
+                (block-number-of-entries shared-block)
+                (closure-block-entry-number closure-block))
+               0)))
\ No newline at end of file