From 32a242a6fb5bb55fa895e1d145011eab6bf75225 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 18 Nov 1992 00:48:50 +0000 Subject: [PATCH] Move some back-end-dependent stuff to back/asutl. The C back end has its own replacement. --- .../compiler/machines/spectrum/compiler.pkg | 3 ++- v7/src/compiler/machines/spectrum/decls.scm | 7 ++--- v7/src/compiler/machines/spectrum/machin.scm | 8 +----- v7/src/compiler/rtlbase/rtlcon.scm | 14 +--------- v7/src/compiler/rtlbase/rtlty2.scm | 27 ++++++++++--------- v7/src/compiler/rtlgen/opncod.scm | 13 +++++---- v7/src/compiler/rtlgen/rgrval.scm | 14 +++++----- 7 files changed, 38 insertions(+), 48 deletions(-) diff --git a/v7/src/compiler/machines/spectrum/compiler.pkg b/v7/src/compiler/machines/spectrum/compiler.pkg index d5e7ff785..2ed581430 100644 --- a/v7/src/compiler/machines/spectrum/compiler.pkg +++ b/v7/src/compiler/machines/spectrum/compiler.pkg @@ -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 diff --git a/v7/src/compiler/machines/spectrum/decls.scm b/v7/src/compiler/machines/spectrum/decls.scm index 2b9469cc9..192105cc6 100644 --- a/v7/src/compiler/machines/spectrum/decls.scm +++ b/v7/src/compiler/machines/spectrum/decls.scm @@ -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") diff --git a/v7/src/compiler/machines/spectrum/machin.scm b/v7/src/compiler/machines/spectrum/machin.scm index df7f9f92b..36bc4d879 100644 --- a/v7/src/compiler/machines/spectrum/machin.scm +++ b/v7/src/compiler/machines/spectrum/machin.scm @@ -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)) ;;;; Machine Registers diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm index f306e9540..b938ef773 100644 --- a/v7/src/compiler/rtlbase/rtlcon.scm +++ b/v7/src/compiler/rtlbase/rtlcon.scm @@ -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)))) ;;; Interpreter Calls diff --git a/v7/src/compiler/rtlbase/rtlty2.scm b/v7/src/compiler/rtlbase/rtlty2.scm index d5ae4e5df..947c1318a 100644 --- a/v7/src/compiler/rtlbase/rtlty2.scm +++ b/v7/src/compiler/rtlbase/rtlty2.scm @@ -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)))) ;;; Expressions that are used in the intermediate form. diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm index 492522272..15df5fdcf 100644 --- a/v7/src/compiler/rtlgen/opncod.scm +++ b/v7/src/compiler/rtlgen/opncod.scm @@ -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)))))) diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm index 83c5d0c1b..4c8a2a5aa 100644 --- a/v7/src/compiler/rtlgen/rgrval.scm +++ b/v7/src/compiler/rtlgen/rgrval.scm @@ -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 -- 2.25.1