#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/assmd.scm,v 1.1 1990/05/07 04:10:19 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/assmd.scm,v 1.2 1991/06/17 21:20:45 cph Exp $
$MC68020-Header: assmd.scm,v 1.36 89/08/28 18:33:33 GMT cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
;;; Machine dependent instruction order
-(define-integrable (instruction-initial-position block)
- block ; ignored
- 0)
+(define (instruction-initial-position block)
+ (if (eq? endianness 'LITTLE)
+ 0
+ (bit-string-length block)))
(define (instruction-insert! bits block position receiver)
(let ((l (bit-string-length bits)))
- (bit-substring-move-right! bits 0 l block position)
- (receiver (+ position l))))
-
-(define-integrable instruction-append
- bit-string-append)
+ (if (eq? endianness 'LITTLE)
+ (begin
+ (bit-substring-move-right! bits 0 l block position)
+ (receiver (+ position l)))
+ (let ((new-position (- position l)))
+ (bit-substring-move-right! bits 0 l block new-position)
+ (receiver new-position)))))
+
+(define (instruction-append x y)
+ (if (eq? endianness 'LITTLE)
+ (bit-string-append x y)
+ (bit-string-append-reversed x y)))
;;; end let-syntax
)
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/compiler.pkg,v 1.2 1990/07/22 20:16:15 jinx Rel $
-$MC68020-Header: comp.pkg,v 1.30 90/05/03 15:16:59 GMT jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/compiler.pkg,v 1.3 1991/06/17 21:20:50 cph Exp $
+$MC68020-Header: /scheme/compiler/bobcat/RCS/comp.pkg,v 1.32 1991/05/06 23:09:24 jinx Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
compiler:generate-rtl-files?
compiler:generate-type-checks?
compiler:implicit-self-static?
+ compiler:intersperse-rtl-in-lap?
compiler:noisy?
compiler:open-code-flonum-checks?
compiler:open-code-primitives?
cf
compile-bin-file
compile-procedure
+ compile-scode
compiler:reset!
cross-compile-bin-file
cross-compile-bin-file-end)
(export (compiler top-level)
*interned-assignments*
*interned-constants*
+ *interned-global-links*
+ *interned-static-variables*
*interned-uuo-links*
*interned-variables*
*next-constant*
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/dassm2.scm,v 1.1 1990/05/07 04:12:17 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/dassm2.scm,v 1.2 1991/06/17 21:20:56 cph Exp $
$MC68020-Header: dassm2.scm,v 4.16 89/12/11 06:16:42 GMT cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(let ((contents (read-bits (- offset 2) 16)))
(if (bit-string-clear! contents 0)
(let ((offset
- (- offset (* 2 (bit-string->unsigned-integer contents)))))
+ (- offset
+ (* 2 (bit-string->unsigned-integer contents)))))
(and (positive? offset)
(loop offset)))
- (= offset (* 2 (bit-string->unsigned-integer contents)))))))))
+ (= offset
+ (* 2 (bit-string->unsigned-integer contents)))))))))
(define (make-word bit-string)
`(UWORD ,(bit-string->unsigned-integer bit-string)))
(define (make-external-label bit-string)
- `(EXTERNAL-LABEL
- (FORMAT ,(extract bit-string 0 16))
- (@PCO ,(* 4 (extract-signed bit-string 16 32)))))
+ (if (eq? endianness 'LITTLE)
+ `(EXTERNAL-LABEL
+ (FORMAT ,(extract bit-string 0 16))
+ (@PCO ,(* 2 (extract bit-string 16 32))))
+ `(EXTERNAL-LABEL
+ (FORMAT ,(extract bit-string 16 32))
+ (@PCO ,(* 2 (extract bit-string 0 16))))))
#|
;;; 68k version
(define (invalid-instruction)
(set! *valid? false)
- false)
-
+ false)
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/dassm3.scm,v 1.1 1990/05/07 04:12:32 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/dassm3.scm,v 1.2 1991/06/17 21:21:03 cph Exp $
Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
`(,op ,(extract word 0 26)))
(define (relative-offset word)
- `(@PCO ,(* 4 (extract-signed word 0 16))))
+ (let ((pco (* 4 (extract-signed word 0 16))))
+ (if disassembler/symbolize-output?
+ `(@PCR ,(let ((absolute (+ *current-offset pco)))
+ (or (disassembler/lookup-symbol *symbol-table absolute)
+ absolute)))
+ `(@PCO ,pco))))
(define (disassemble-branch-zero word)
(let ((conditions (extract word 16 21))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/insmac.scm,v 1.1 1990/05/07 04:13:45 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/insmac.scm,v 1.2 1991/06/17 21:21:18 cph Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(syntax-table-define assembler-syntax-table 'DEFINE-SYMBOL-TRANSFORMER
(macro (name . alist)
- `(begin
- (declare (integrate-operator ,name))
- (define (,name symbol)
- (declare (integrate symbol))
- (let ((place (assq symbol ',alist)))
- (if (null? place)
+ `(BEGIN
+ (DECLARE (INTEGRATE-OPERATOR ,name))
+ (DEFINE (,name SYMBOL)
+ (DECLARE (INTEGRATE SYMBOL))
+ (LET ((PLACE (ASSQ SYMBOL ',alist)))
+ (IF (NULL? PLACE)
#F
- (cdr place)))))))
+ (CDR PLACE)))))))
(syntax-table-define assembler-syntax-table 'DEFINE-TRANSFORMER
(macro (name value)
- `(define ,name ,value)))
-\f
+ `(DEFINE ,name ,value)))
+
;;;; Fixed width instruction parsing
(define (parse-instruction first-word tail early?)
- (cond ((not (null? tail))
- (error "parse-instruction: Unknown format" (cons first-word tail)))
- ((eq? (car first-word) 'LONG)
- (process-fields (cdr first-word) early?))
- ((eq? (car first-word) 'VARIABLE-WIDTH)
- (process-variable-width first-word early?))
- (else
- (error "parse-instruction: Unknown format" first-word))))
+ (if (not (null? tail))
+ (error "parse-instruction: Unknown format" (cons first-word tail)))
+ (let loop ((first-word first-word))
+ (case (car first-word)
+ ((LONG)
+ (process-fields (cdr first-word) early?))
+ ((VARIABLE-WIDTH)
+ (process-variable-width first-word early?))
+ ((IF)
+ `(IF ,(cadr first-word)
+ ,(loop (caddr first-word))
+ ,(loop (cadddr first-word))))
+ (else
+ (error "parse-instruction: Unknown format" first-word)))))
(define (process-variable-width descriptor early?)
(let ((binding (cadr descriptor))
,size
,@(car clause)))))
clauses)))))
-
+\f
(define (process-fields fields early?)
(expand-fields fields
early?
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/instr1.scm,v 1.1 1990/05/07 04:13:59 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/instr1.scm,v 1.2 1991/06/17 21:21:28 cph Exp $
-Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
;;;; MIPS instruction set
+;; Branch-tensioned instructions are in instr2.scm
+;; Floating point instructions are in instr3.scm
+
(declare (usual-integrations))
\f
(define-integrable (extract bit-string start end)
; External labels cause the output of GC header and format words
(define-instruction EXTERNAL-LABEL
(((? format-word) (@PCR (? label)))
- (LONG (16 label BLOCK-OFFSET)
- (16 format-word UNSIGNED)))
+ (if (eq? endianness 'LITTLE)
+ (LONG (16 label BLOCK-OFFSET)
+ (16 format-word UNSIGNED))
+ (LONG (16 format-word UNSIGNED)
+ (16 label BLOCK-OFFSET))))
(((? format-word) (@PCO (? offset)))
- (LONG (16 offset UNSIGNED)
- (16 format-word UNSIGNED))))
+ (if (eq? endianness 'LITTLE)
+ (LONG (16 offset UNSIGNED)
+ (16 format-word UNSIGNED))
+ (LONG (16 format-word UNSIGNED)
+ (16 offset UNSIGNED)))))
(define-instruction PC-RELATIVE-OFFSET
(((? target) (@PCR (? label)))
(LONG (6 15) ; LUI
(5 0)
(5 target)
- (16 (adjusted:high offset))
+ (16 (adjusted:high (- offset 4)))
(6 9) ; ADDIU
(5 target)
(5 target)
- (16 (adjusted:low offset) SIGNED))))))
+ (16 (adjusted:low (- offset 4)) SIGNED))))))
(define-instruction NOP
(() ; ADDI 0, 0
- (LONG (6 8) (5 0) (5 0) (16 0))))
-
-;; Branch-tensioned instructions are in instr2.scm
-;; Floating point instructions are in instr3.scm
+ (LONG (6 8) (5 0) (5 0) (16 0))))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/instr2a.scm,v 1.2 1990/11/28 22:10:56 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/instr2a.scm,v 1.3 1991/06/17 21:21:34 cph Exp $
Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
(6 15) ; LUI
(5 0)
(5 1)
- (16 (adjusted:high offset))
+ (16 (adjusted:high (* (- offset 3) 4)))
(6 1) ; BGEZAL
(5 0)
(5 17)
(6 9) ; ADDIU
(5 1)
(5 1)
- (16 (adjusted:low offset) SIGNED)
+ (16 (adjusted:low (* (- offset 3) 4)) SIGNED)
(6 0) ; ADD
(5 1)
(5 31)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/lapgen.scm,v 1.3 1990/11/29 02:11:06 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/lapgen.scm,v 1.4 1991/06/17 21:21:40 cph Exp $
$MC68020-Header: lapgen.scm,v 4.26 90/01/18 22:43:36 GMT cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
;; Handled by VARIABLE-WIDTH in instr1.scm
-(define-integrable (fp-load-doubleword offset base target NOP?)
- (LAP (LWC1 ,(float-register->fpr target)
- (OFFSET ,offset ,base))
- (LWC1 ,(+ (float-register->fpr target) 1)
- (OFFSET ,(+ offset 4) ,base))
- ,@(if NOP? (LAP (NOP)) (LAP))))
-
-(define-integrable (fp-store-doubleword offset base source)
- (LAP (SWC1 ,(float-register->fpr source)
- (OFFSET ,offset ,base))
- (SWC1 ,(+ (float-register->fpr source) 1)
- (OFFSET ,(+ offset 4) ,base))))
+(define (fp-load-doubleword offset base target NOP?)
+ (let* ((least (float-register->fpr target))
+ (most (+ least 1)))
+ (if (eq? endianness 'LITTLE)
+ (LAP (LWC1 ,least (OFFSET ,offset ,base))
+ (LWC1 ,most (OFFSET ,(+ offset 4) ,base))
+ ,@(if NOP? (LAP (NOP)) (LAP)))
+ (LAP (LWC1 ,least (OFFSET ,(+ offset 4) ,base))
+ (LWC1 ,most (OFFSET ,offset ,base))
+ ,@(if NOP? (LAP (NOP)) (LAP))))))
+
+(define (fp-store-doubleword offset base source)
+ (let* ((least (float-register->fpr source))
+ (most (+ least 1)))
+ (if (eq? endianness 'LITTLE)
+ (LAP (SWC1 ,least (OFFSET ,offset ,base))
+ (SWC1 ,most (OFFSET ,(+ offset 4) ,base)))
+ (LAP (SWC1 ,least (OFFSET ,(+ offset 4) ,base))
+ (SWC1 ,most (OFFSET ,offset ,base))))))
(define (load-pc-relative label target)
;; Load a pc-relative location's contents into a machine register.
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/machin.scm,v 1.2 1990/07/22 20:21:37 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/machin.scm,v 1.3 1991/06/17 21:21:46 cph Exp $
$MC68020-Header: machin.scm,v 4.22 90/05/03 15:17:20 GMT jinx Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
\f
;;;; Architecture Parameters
-(define-integrable endianness 'LITTLE)
+(define endianness 'LITTLE)
(define-integrable addressing-granularity 8)
(define-integrable scheme-object-width 32)
(define-integrable scheme-type-width 6) ;or 8
(define compiler:primitives-with-no-open-coding
'(DIVIDE-FIXNUM GCD-FIXNUM FIXNUM-QUOTIENT FIXNUM-REMAINDER
- INTEGER-QUOTIENT INTEGER-REMAINDER &/
+ INTEGER-QUOTIENT INTEGER-REMAINDER &/ QUOTIENT REMAINDER
FLONUM-SIN FLONUM-COS FLONUM-TAN FLONUM-ASIN FLONUM-ACOS
FLONUM-ATAN FLONUM-EXP FLONUM-LOG FLONUM-TRUNCATE FLONUM-ROUND
FLONUM-REMAINDER FLONUM-SQRT))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/make.scm-big,v 4.84 1991/05/30 05:51:11 cph Exp $
-$MC68020-Header: /scheme/compiler/bobcat/RCS/make.scm,v 4.84 1991/05/07 13:47:44 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/make.scm-big,v 4.85 1991/06/17 21:21:52 cph Exp $
+$MC68020-Header: /scheme/compiler/machines/bobcat/RCS/make.scm,v 4.86 1991/06/12 20:54:31 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
'((COMPILER MACROS)
(COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (MIPS)" 4 84 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (MIPS)" 4 86 '()))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/make.scm-little,v 4.84 1991/05/30 05:51:11 cph Exp $
-$MC68020-Header: /scheme/compiler/bobcat/RCS/make.scm,v 4.84 1991/05/07 13:47:44 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/make.scm-little,v 4.85 1991/06/17 21:21:52 cph Exp $
+$MC68020-Header: /scheme/compiler/machines/bobcat/RCS/make.scm,v 4.86 1991/06/12 20:54:31 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
'((COMPILER MACROS)
(COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (MIPS)" 4 84 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (MIPS)" 4 86 '()))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules1.scm,v 1.2 1990/07/22 20:24:55 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules1.scm,v 1.3 1991/06/17 21:21:59 cph Exp $
$MC68020-Header: rules1.scm,v 4.33 90/05/03 15:17:28 GMT jinx Exp $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
(CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
(standard-unary-conversion address target
(lambda (address target)
- (LAP (LBU ,target (OFFSET ,(* 4 offset) ,address))
+ (LAP (LBU ,target
+ (OFFSET ,(let ((offset (* 4 offset)))
+ (if (eq? endianness 'LITTLE)
+ offset
+ (+ offset 3)))
+ ,address))
(NOP)))))
(define-rule statement
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules3.scm,v 1.4 1990/11/28 22:32:23 cph Rel $
-$MC68020-Header: rules3.scm,v 4.26 90/08/21 02:23:26 GMT jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules3.scm,v 1.5 1991/06/17 21:22:05 cph Exp $
+$MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.30 1991/05/07 13:45:31 jinx Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
continuation ;ignore
(LAP ,@(clear-map!)
(BGEZ 0 (@PCR ,(free-uuo-link-label name frame-size)))
+ (NOP)))
+
+(define-rule statement
+ (INVOCATION:GLOBAL-LINK (? frame-size) (? continuation) (? name))
+ continuation ;ignore
+ (LAP ,@(clear-map!)
+ (BGEZ 0 (@PCR ,(global-uuo-link-label name frame-size)))
(NOP))) ; DELAY SLOT
(define-rule statement
n-sections)
;; Link all of the top level procedures within the file
(LAP ,@(load-pc-relative code-block-label regnum:third-arg)
- (LW ,regnum:assembler-temp ,reg:environment)
+ (LW ,regnum:fourth-arg ,reg:environment)
,@(object->address regnum:third-arg)
- ,@(add-immediate environment-offset regnum:third-arg
- regnum:second-arg)
- (SW ,regnum:assembler-temp (OFFSET 0 ,regnum:second-arg))
+ ,@(add-immediate environment-offset regnum:third-arg regnum:second-arg)
+ (SW ,regnum:fourth-arg (OFFSET 0 ,regnum:second-arg))
,@(add-immediate free-ref-offset regnum:third-arg regnum:fourth-arg)
,@(load-immediate n-sections regnum:first-arg)
(SW ,regnum:first-arg (OFFSET 16 ,regnum:C-stack-pointer))
,@(make-external-label (continuation-code-word false)
(generate-label))))
\f
-(define (generate/constants-block constants references assignments uuo-links)
+(define (generate/constants-block constants references assignments uuo-links
+ global-links static-vars)
(let ((constant-info
(declare-constants 0 (transmogrifly uuo-links)
(declare-constants 1 references
(declare-constants 2 assignments
- (declare-constants false constants
- (cons false (LAP))))))))
+ (declare-constants 3 (transmogrifly global-links)
+ (declare-constants false
+ (map (lambda (pair)
+ (cons false (cdr pair)))
+ static-vars)
+ (declare-constants false constants
+ (cons false (LAP))))))))))
(let ((free-ref-label (car constant-info))
(constants-code (cdr constant-info))
(debugging-information-label (allocate-constant-label))
(n-sections
(+ (if (null? uuo-links) 0 1)
(if (null? references) 0 1)
- (if (null? assignments) 0 1))))
+ (if (null? assignments) 0 1)
+ (if (null? global-links) 0 1))))
(values
(LAP ,@constants-code
;; Place holder for the debugging info filename
projects / mit-scheme.git / commitdiff