The C back end has its own replacement.
#| -*-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
"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
#| -*-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
;;;; Integration Dependencies
(define (initialize/integration-dependencies!)
-
(define (add-declaration! declaration filenames)
(for-each (lambda (filenames)
(let ((node (filename->source-node filenames)))
"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"
(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")
#| -*-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
(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
#| -*-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
(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
#| -*-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
(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.
#| -*-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
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 ()
'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
(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))))))
#| -*-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
(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.
;; 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