#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.3 1987/07/22 17:14:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.4 1987/07/30 07:05:13 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(define (list->bit-string l)
(if (null? (cdr l))
(car l)
- (bit-string-append (car l)
- (list->bit-string (cdr l)))))
\ No newline at end of file
+ (bit-string-append (list->bit-string (cdr l))
+ (car l))))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bitutl.scm,v 1.2 1987/07/22 17:14:31 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bitutl.scm,v 1.3 1987/07/30 07:05:24 jinx Rel $
Copyright (c) 1987 Massachusetts Institute of Technology
(and (or (false? low) (<= low val))
(or (false? high) (<= val high)))))
-(declare (integrate-operator selector/low selector/high
+(declare (integrate-operator selector/high selector/low
selector/handler selector/length))
-(define (selector/low sel)
+(define (selector/high sel)
(declare (integrate sel))
- (vector-ref sel 0))
+ (vector-ref sel 3))
-(define (selector/high sel)
+(define (selector/low sel)
(declare (integrate sel))
- (vector-ref sel 1))
+ (vector-ref sel 2))
(define (selector/length sel)
(declare (integrate sel))
- (vector-ref sel 2))
+ (vector-ref sel 1))
(define (selector/handler sel)
(declare (integrate sel))
- (vector-ref sel 3))
+ (vector-ref sel 0))
\f
;;;; Random utilities
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.17 1987/07/22 17:15:00 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.18 1987/07/30 07:05:33 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
directives)
(cons directive directives)))
+(define (append-syntax! directives1 directives2)
+ (cond ((null? directives1) directives2)
+ ((null? directives2) directives1)
+ (else
+ (let ((tail (last-pair directives1)))
+ (if (and (bit-string? (car tail))
+ (bit-string? (car directives2)))
+ (begin
+ (set-car! tail
+ (bit-string-append (car directives2) (car tail)))
+ (set-cdr! tail (cdr directives2)))
+ (set-cdr! tail directives2))
+ directives1))))
+
(define-export (lap:syntax-instruction instruction)
(if (memq (car instruction) '(EQUATE SCHEME-OBJECT ENTRY-POINT LABEL))
(directive->instruction-sequence instruction)
(let ((coercion (make-coercion-name coercion-type size)))
(if (integer? expression)
`',((lexical-reference coercion-environment coercion) expression)
- `(SYNTAX-EVALUATION ,expression ,coercion))))
+ `(SYNTAX-EVALUATION ,expression ,coercion))))
(define (syntax-evaluation expression coercion)
- (if (integer? expression)
- (coercion expression)
- (list 'EVALUATION expression (coercion-size coercion) coercion)))
+ (cond ((integer? expression)
+ (coercion expression))
+ (else
+ (list 'EVALUATION expression (coercion-size coercion) coercion))))
(define (optimize-group . components)
(optimize-group-internal components
(cond ((null? clauses)
(error "choose-clause: value out of range" value))
- ((in-range? value (caar clauses) (cadar clauses))
+ ((in-range? value (caddr (car clauses)) (cadddr (car clauses)))
(car clauses))
- (else (choose-clause (cdr clauses)))))
+ (else (choose-clause value (cdr clauses)))))
(define (variable-width-expression-syntaxer name expression clauses)
(if (integer? expression)
(let ((chosen (choose-clause expression clauses)))
- `(let ((,name ,expression))
- (declare (integrate ,name))
- ,(cadddr chosen)))
- `(LIST
- (SYNTAX-VARIABLE-WIDTH-EXPRESSION
- ,expression
- (LIST
- ,@(map (LAMBDA (clause)
- `(LIST ,(car clause)
- ,(cadr clause)
- ,(caddr clause)
- (LAMBDA (,name)
- ,(cadddr clause))))
- clauses))))))
+ `(LET ((,name ,expression))
+ (DECLARE (INTEGRATE ,name))
+ (CAR ,(car chosen))))
+ `(SYNTAX-VARIABLE-WIDTH-EXPRESSION
+ ,expression
+ (LIST
+ ,@(map (LAMBDA (clause)
+ `(CONS (LAMBDA (,name) ,(car clause))
+ ',(cdr clause)))
+ clauses)))))
(define (syntax-variable-width-expression expression clauses)
(if (integer? expression) (let ((chosen (choose-clause expression clauses)))
- ((cadddr chosen) expression))
- (cons* 'VARIABLE-WIDTH-EXPRESSION
- expression
- clauses)))
+ (car ((car chosen) expression)))
+ `(VARIABLE-WIDTH-EXPRESSION
+ ,expression
+ ,@clauses)))
\f
;;;; Coercion Machinery
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.3 1987/07/22 17:16:22 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.4 1987/07/30 07:08:36 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(declare (usual-integrations))
\f
+;;;; Transformers and utilities
+
(define early-instructions '())
(define early-transformers '())
(cons (cons name transformer)
early-transformers)))
+(define (make-ea-transformer #!optional modes keywords)
+ (make-database-transformer
+ (mapcan (lambda (rule)
+ (apply
+ (lambda (pattern variables categories expression)
+ (if (and (or (unassigned? modes) (eq-subset? modes categories))
+ (or (unassigned? keywords) (not (memq (car pattern) keywords))))
+ (list (early-make-rule pattern variables expression))
+ '()))
+ rule))
+ early-ea-database)))
+
+
+(define (eq-subset? s1 s2)
+ (or (null? s1)
+ (and (memq (car s1) s2)
+ (eq-subset? (cdr s1) s2))))
+
+(syntax-table-define early-syntax-table 'DEFINE-EA-TRANSFORMER
+ (macro (name . restrictions)
+ `(define-early-transformer ',name (apply make-ea-transformer ',restrictions))))
+
+(syntax-table-define early-syntax-table 'DEFINE-SYMBOL-TRANSFORMER
+ (macro (name . assoc)
+ `(define-early-transformer ',name (make-symbol-transformer ',assoc))))
+
+(syntax-table-define early-syntax-table 'DEFINE-REG-LIST-TRANSFORMER
+ (macro (name . assoc)
+ `(define-early-transformer ',name (make-bit-mask-transformer 16 ',assoc))))
+\f
+;;;; Instruction and addressing mode macros
+
(syntax-table-define early-syntax-table 'DEFINE-INSTRUCTION
(macro (opcode . patterns)
`(set! early-instructions
(error "EXTENSION-WORD: Extensions must be 16 bit multiples"
size)))))))
-(syntax-table-define early-syntax-table 'DEFINE-SYMBOL-TRANSFORMER
- (macro (name . assoc)
- `(define-early-transformer ',name (make-symbol-transformer ',assoc))))
-
-(syntax-table-define early-syntax-table 'DEFINE-REG-LIST-TRANSFORMER
- (macro (name . assoc)
- `(define-early-transformer ',name (make-bit-mask-transformer 16 ',assoc))))
-
-(syntax-table-define early-syntax-table 'DEFINE-EA-TRANSFORMER
- (macro (name . restrictions)
- `(define-early-transformer ',name (apply make-ea-transformer ',restrictions))))
+(syntax-table-define early-syntax-table 'VARIABLE-EXTENSION
+ (macro (binding . clauses)
+ (variable-width-expression-syntaxer
+ (car binding)
+ (cadr binding)
+ (map (lambda (clause)
+ `((LIST ,(caddr clause))
+ ,(cadr clause) ; Size
+ ,@(car clause))) ; Range
+ clauses))))
\f
;;;; Early effective address assembly.
`(define early-ea-database
(list
,@(map (lambda (rule)
- (apply (lambda (pattern categories mode register . extension)
- (let ((keyword (car pattern)))
- `(early-parse-rule
- ',pattern
- (lambda (pat vars)
- (list pat
- vars
- ',categories
- (scode-quote
- (MAKE-EFFECTIVE-ADDRESS
- ',keyword
- ,(integer-syntaxer mode 'UNSIGNED 3)
- ,(integer-syntaxer register 'UNSIGNED 3)
- (lambda (IMMEDIATE-SIZE INSTRUCTION-TAIL)
- (DECLARE (INTEGRATE IMMEDIATE-SIZE INSTRUCTION-TAIL))
- ,(if (null? extension)
- 'INSTRUCTION-TAIL
- `(CONS-SYNTAX ,(car extension)
- INSTRUCTION-TAIL)))
- ',categories)))))))
- rule))
+ (if (null? (cdddr rule))
+ (apply make-position-dependent-early rule)
+ (apply make-position-independent-early rule)))
rules)))))
(define (make-ea-selector-expander late-name index)
(define ea-register-expander (make-ea-selector-expander 'EA-REGISTER 2))
(define ea-extension-expander (make-ea-selector-expander 'EA-EXTENSION 3))
(define ea-categories-expander (make-ea-selector-expander 'EA-CATEGORIES 4))
-
-;;; Utility procedures
-
-(define (make-ea-transformer #!optional modes keywords)
- (make-database-transformer
- (mapcan (lambda (rule)
- (apply
- (lambda (pattern variables categories expression)
- (if (and (or (unassigned? modes) (eq-subset? modes categories))
- (or (unassigned? keywords) (not (memq (car pattern) keywords))))
- (list (early-make-rule pattern variables expression))
- '()))
- rule))
- early-ea-database)))
-
-(define (eq-subset? s1 s2)
- (or (null? s1)
- (and (memq (car s1) s2)
- (eq-subset? (cdr s1) s2))))
+\f
+;;;; Utilities
+
+(define (make-position-independent-early pattern categories mode register . extension)
+ (let ((keyword (car pattern)))
+ `(early-parse-rule
+ ',pattern
+ (lambda (pat vars)
+ (list pat
+ vars
+ ',categories
+ (scode-quote
+ (MAKE-EFFECTIVE-ADDRESS
+ ',keyword
+ ,(integer-syntaxer mode 'UNSIGNED 3)
+ ,(integer-syntaxer register 'UNSIGNED 3)
+ (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ (DECLARE (INTEGRATE IMMEDIATE-SIZE INSTRUCTION-TAIL))
+ ,(if (null? extension)
+ 'INSTRUCTION-TAIL
+ `(CONS-SYNTAX ,(car extension)
+ INSTRUCTION-TAIL)))
+ ',categories)))))))
+
+(define (make-position-dependent-early pattern categories code-list)
+ (let ((keyword (car pattern))
+ (code (cdr code-list)))
+ (let ((name (car code))
+ (mode (cadr code))
+ (register (caddr code))
+ (extension (cadddr code)))
+ `(EARLY-PARSE-RULE
+ ',pattern
+ (LAMBDA (PAT VARS)
+ (LIST PAT
+ VARS
+ ',categories
+ (SCODE-QUOTE
+ (LET ((,name (GENERATE-LABEL 'MARK)))
+ (MAKE-EFFECTIVE-ADDRESS
+ ',keyword
+ ,(process-ea-field mode)
+ ,(process-ea-field register)
+ (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ (DECLARE (INTEGRATE IMMEDIATE-SIZE INSTRUCTION-TAIL))
+ ,(if (null? extension)
+ 'INSTRUCTION-TAIL
+ `(CONS (LIST 'LABEL ,name)
+ (CONS-SYNTAX ,extension INSTRUCTION-TAIL))))
+ ',categories)))))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insmac.scm,v 1.122 1987/07/22 17:16:31 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insmac.scm,v 1.123 1987/07/30 07:08:55 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
`(define ,ea-database-name
,(compile-database rules
(lambda (pattern actions)
- (let ((keyword (car pattern))
- (categories (car actions))
- (mode (cadr actions))
- (register (caddr actions))
- (extension (cdddr actions)))
- ;;(declare (integrate keyword categories mode register extension))
- `(MAKE-EFFECTIVE-ADDRESS
- ',keyword
- ,(integer-syntaxer mode 'UNSIGNED 3)
- ,(integer-syntaxer register 'UNSIGNED 3)
- (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
- ,(if (null? extension)
- 'INSTRUCTION-TAIL
- `(CONS-SYNTAX ,(car extension) INSTRUCTION-TAIL)))
- ',categories)))))))
+ (if (null? (cddr actions))
+ (make-position-dependent pattern actions)
+ (make-position-independent pattern actions)))))))
(syntax-table-define assembler-syntax-table 'EXTENSION-WORD
(macro descriptors
(optimize-group-syntax instruction false)
(error "EXTENSION-WORD: Extensions must be 16 bit multiples"
size)))))))
+
+(syntax-table-define assembler-syntax-table 'VARIABLE-EXTENSION
+ (macro (binding . clauses)
+ (variable-width-expression-syntaxer
+ (car binding)
+ (cadr binding)
+ (map (lambda (clause)
+ `((LIST ,(caddr clause))
+ ,(cadr clause)
+ ,@(car clause)))
+ clauses))))
+\f
+(define (make-position-independent pattern actions)
+ (let ((keyword (car pattern))
+ (categories (car actions))
+ (mode (cadr actions))
+ (register (caddr actions))
+ (extension (cdddr actions)))
+ ;;(declare (integrate keyword categories mode register extension))
+ `(MAKE-EFFECTIVE-ADDRESS
+ ',keyword
+ ,(integer-syntaxer mode 'UNSIGNED 3)
+ ,(integer-syntaxer register 'UNSIGNED 3)
+ (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ ,(if (null? extension)
+ 'INSTRUCTION-TAIL
+ `(CONS-SYNTAX ,(car extension) INSTRUCTION-TAIL)))
+ ',categories)))
+
+(define (process-ea-field field)
+ (if (integer? field) (integer-syntaxer field 'UNSIGNED 3)
+ (let ((binding (cadr field))
+ (clauses (cddr field)))
+ (variable-width-expression-syntaxer
+ (car binding)
+ (cadr binding)
+ (map (lambda (clause)
+ `((LIST ,(integer-syntaxer (cadr clause) 'UNSIGNED 3))
+ 3
+ ,@(car clause)))
+ clauses)))))
+
+(define (make-position-dependent pattern actions)
+ (let ((keyword (car pattern))
+ (categories (car actions))
+ (code (cdr (cadr actions))))
+ (let ((name (car code))
+ (mode (cadr code))
+ (register (caddr code))
+ (extension (cadddr code)))
+ `(LET ((,name (GENERATE-LABEL 'MARK)))
+ (make-effective-address
+ ',keyword
+ ,(process-ea-field mode)
+ ,(process-ea-field register)
+ (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL)
+ ,(if (null? extension)
+ 'INSTRUCTION-TAIL
+ `(CONS (LIST 'LABEL ,name)
+ (CONS-SYNTAX ,extension INSTRUCTION-TAIL))))
+ ',categories)))))
\f
;;;; Transformers
(if (not (null? tail))
(error "PARSE-GROWING-WORD: non null tail" tail))
(let ((binding (cadr expression)))
- (variable-width-expression-syntaxer
- (car binding)
- (cadr binding)
- (map (lambda (clause)
- (if (not (null? (cddr clause)))
- (error "PARSE-GROWING-WORD: Extension found in clause" clause))
- (expand-descriptors
- (cdadr clause)
- (lambda (instruction size src dst)
- (if (not (zero? (remainder size 16)))
- (error "PARSE-GROWING-WORD: Instructions must be 16 bit multiples"
- size)
- (list (caar clause) ; Range low
- (cadar clause) ; Range high
- size ; Width in bits
- (collect-word instruction src dst '()))))))
- (cddr expression)))))
+ `(LIST
+ ,(variable-width-expression-syntaxer
+ (car binding)
+ (cadr binding)
+ (map (lambda (clause)
+ (if (not (null? (cddr clause)))
+ (error "PARSE-GROWING-WORD: Extension found in clause" clause))
+ (expand-descriptors
+ (cdadr clause)
+ (lambda (instruction size src dst)
+ (if (not (zero? (remainder size 16)))
+ (error "PARSE-GROWING-WORD: Instructions must be 16 bit multiples"
+ size)
+ `(,(collect-word instruction src dst '())
+ ,size
+ ,@(car clause)))))) ; Range
+ (cddr expression))))))
\f
;;;; Fixed width instruction parsing
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.64 1987/07/21 18:34:34 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.65 1987/07/30 07:09:17 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(DATA MEMORY CONTROL) #b111 #b010
(output-16bit-offset o))
- ((@PCR (? l))
+ ((@PCR.W (? l))
(DATA MEMORY CONTROL) #b111 #b010
(output-16bit-relative l))
(DATA MEMORY CONTROL) #b111 #b011
(output-full-format-extension-word xtype xr xsz factor
pcs irs bdtype `(- ,bd *PC*)
- memtype odtype od)))
+ memtype odtype od))
+
+;;; Optimized addressing modes.
+;;; Only a subset of those that can be optimized.
+
+ ((@PCR (? l))
+ (DATA MEMORY CONTROL)
+ (POSITION-DEPENDENT label
+ #b111
+ (FIELD (offset `(- ,l ,label))
+ ((-32768 32767) #b010)
+ ((() ()) #b011))
+ (VARIABLE-EXTENSION (offset `(- ,l ,label))
+ ((-32768 32767)
+ 16
+ (EXTENSION-WORD (16 offset SIGNED)))
+ ((() ())
+ 48
+ (output-32bit-offset offset))))))
\f
;;;; Effective address transformers (restrictions)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.11 1987/07/17 15:48:53 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.12 1987/07/30 07:09:32 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(define-instruction DC
((W (? expression))
- (WORD (16 expression SIGNED))))
+ (WORD (16 expression SIGNED)))
+
+ ((L (? expression))
+ (WORD (32 expression SIGNED)))
+
+ ((O (? expression))
+ (GROWING-WORD
+ (offset expression)
+ ((0 65535)
+ (WORD (16 offset)))
+ ;; Always non-negative
+ ((0 ())
+ (WORD (32 (1+ offset)))))))
\f
;;;; BCD Arithmetic
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr3.scm,v 1.13 1987/07/22 17:16:43 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr3.scm,v 1.14 1987/07/30 07:09:49 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
\f
;;;; Control Transfer: Branch instructions
-;; The size U (unknown, undecided?) means that the assembler should
-;; choose the right size.
+;; No size suffix means that the assembler should choose the right
+;; size offset.
;; When the displacement goes to 0, a NOP is issued.
;; The instruction is hard to remove because of the workings of the
-;; branch tensioner. Note that the NOP ``kludge'' is not correct for
-;; the BSR instruction.
+;; branch tensioner.
+
+;; Note that this NOP ``kludge'' is not correct for the BSR
+;; instruction, but doing a BSR to the following instruction is even
+;; stranger than branching to the following instruction.
(let-syntax
((define-branch-instruction
(8 #b11111111))
(relative-long l))
\f
- ((,@prefix U (@PCO (? o)))
+ ((,@prefix (@PCO (? o)))
(GROWING-WORD (disp o)
((0 0)
(WORD (16 #b0100111001110001))) ; NOP
(8 #b11111111)
(32 disp SIGNED)))))
- ((,@prefix U (@PCR (? l)))
+ ((,@prefix (@PCR (? l)))
(GROWING-WORD (disp `(- ,l (+ *PC* 2)))
((0 0)
(WORD (16 #b0100111001110001))) ; NOP
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.4 1987/07/21 18:34:47 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.5 1987/07/30 07:10:09 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
memory-indirection-type
outer-displacement-size
outer-displacement)
- (EXTENSION-WORD (1 index-register-type)
- (3 index-register)
- (1 index-size)
- (2 factor SCALE-FACTOR)
- (1 #b1)
- (1 base-suppress)
- (1 index-suppress)
- (2 base-displacement-size)
- (1 #b0)
- (3 (case memory-indirection-type
- ((#F)
- #b000)
- ((PRE)
- outer-displacement-size)
- ((POST)
- (+ #b100 outer-displacement-size))
- (else
- "bad memory indirection-type" memory-indirection-type))))
- (output-displacement base-displacement-size base-displacement)
- (output-displacement outer-displacement-size outer-displacement))
+ (append-syntax!
+ (EXTENSION-WORD (1 index-register-type)
+ (3 index-register)
+ (1 index-size)
+ (2 factor SCALE-FACTOR)
+ (1 #b1)
+ (1 base-suppress)
+ (1 index-suppress)
+ (2 base-displacement-size)
+ (1 #b0)
+ (3 (case memory-indirection-type
+ ((#F)
+ #b000)
+ ((PRE)
+ outer-displacement-size)
+ ((POST)
+ (+ #b100 outer-displacement-size))
+ (else
+ (error "bad memory indirection-type" memory-indirection-type)))))
+ (append-syntax!
+ (output-displacement base-displacement-size base-displacement)
+ (output-displacement outer-displacement-size outer-displacement))))
(define (output-displacement size displacement)
(case size
(1 #b0)
(3 #b000) ;no memory indirection
(16 displacement SIGNED)))
+
+(define (output-32bit-offset offset)
+ (EXTENSION-WORD (1 #b0) ;index register = data
+ (3 #b000) ;register number = 0
+ (1 #b0) ;index size = 32 bits
+ (2 #b00) ;scale factor = 1
+ (1 #b1)
+ (1 #b0) ;use base register
+ (1 #b1) ;suppress index register
+ (2 #b11) ;base displacement size = 32 bits
+ (1 #b0)
+ (3 #b000) ;no memory indirection
+ (32 offset SIGNED)))
\f
;;;; Operand Syntaxers.
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.186 1987/07/16 10:10:29 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.187 1987/07/30 07:10:24 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(define (set-standard-branches! cc)
(set-current-branches!
(lambda (label)
- (LAP (B ,cc U (@PCR ,label))))
+ (LAP (B ,cc (@PCR ,label))))
(lambda (label)
- (LAP (B ,(invert-cc cc) U (@PCR ,label))))))
+ (LAP (B ,(invert-cc cc) (@PCR ,label))))))
\f
(define (invert-cc cc)
(cdr (or (assq cc
(INST (LABEL ,label)))
(define-export (lap:make-unconditional-branch label)
- (INST (BRA U (@PCR ,label))))
+ (INST (BRA (@PCR ,label))))
(define-export (lap:make-entry-point label block-start-label)
(set! compiler:external-labels
(cons label compiler:external-labels))
(LAP (ENTRY-POINT ,label)
- (DC W (- ,label ,block-start-label))
+ (DC O (- ,label ,block-start-label))
(LABEL ,label)))
\f
;;;; Registers/Entries
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.36 1987/07/22 17:17:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.37 1987/07/30 07:10:47 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(make-environment
(define :name "Liar (Bobcat 68020)")
(define :version 1)
- (define :modification 36)
+ (define :modification 37)
(define :files)
; (parse-rcs-header
-; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.36 1987/07/22 17:17:01 jinx Exp $"
+; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.37 1987/07/30 07:10:47 jinx Exp $"
; (lambda (filename version date time zone author state)
; (set! :version (car version))
; (set! :modification (cadr version))))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.11 1987/07/21 01:40:20 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.12 1987/07/30 07:10:59 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
(QUALIFIER (not (memq (car prefix) '(APPLY-CLOSURE APPLY-STACK))))
(disable-frame-pointer-offset!
(LAP ,@(generate-invocation-prefix prefix '())
- (BRA U (@PCR ,label)))))
+ (BRA (@PCR ,label)))))
(define-rule statement
(INVOCATION:LEXPR (? number-pushed) (? prefix) (? continuation)
(disable-frame-pointer-offset!
(LAP ,@(generate-invocation-prefix prefix '())
,(load-dnw number-pushed 0)
- (BRA U (@PCR ,label)))))
+ (BRA (@PCR ,label)))))
\f
(define-rule statement
(INVOCATION:CACHE-REFERENCE (? frame-size) (? prefix) (? continuation)
(define (make-external-label label)
(set! compiler:external-labels
(cons label compiler:external-labels))
- (LAP (DC W (- ,label ,*block-start-label*))
+ (LAP (DC O (- ,label ,*block-start-label*))
(LABEL ,label)))
projects / mit-scheme.git / commitdiff