Make instruction sequencing independent of machine byte ordering.

diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm
index ec1d8ac302541a55afd89ae126856545e93eca4c..deee5218b34c86f0b57288161abffdbd97ad0ebd 100644 (file)
--- a/v7/src/compiler/back/asmmac.scm
+++ b/v7/src/compiler/back/asmmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/asmmac.scm,v 1.4 1987/07/22 17:15:34 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/asmmac.scm,v 1.5 1987/08/13 01:59:58 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -76,8 +76,8 @@ MIT in each case. |#
       (cond ((null? components)
             (cons (make-constant bit-string) '()))
            ((car-constant? components)
-            (compact (bit-string-append (car-constant-value components)
-                                        bit-string)
+            (compact (instruction-append bit-string
+                                         (car-constant-value components))
                      (cdr components)))
            (else
             (cons (make-constant bit-string)

diff --git a/v7/src/compiler/back/bittop.scm b/v7/src/compiler/back/bittop.scm
index 66be6b037f875eca0f6cb2ea0a6017e2fb0755b1..92e5962fe0a1a8ca6782915a4f8acfb4e696fea3 100644 (file)
--- a/v7/src/compiler/back/bittop.scm
+++ b/v7/src/compiler/back/bittop.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.5 1987/07/30 21:26:59 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.6 1987/08/13 02:00:44 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -101,9 +101,6 @@ MIT in each case. |#
 \f
 ;;;; Output block generation
 
-(define (bit-string-insert! b1 b2 position)
-  (bit-substring-move-right! b1 0 (bit-string-length b1) b2 position))
-
 (define (final-phase directives)
   ;; Label values are now integers.
   (for-each (lambda (pair)
@@ -115,11 +112,12 @@ MIT in each case. |#
                       (symbol-table-value *the-symbol-table* *end-label*))
                    starting-pc))
         (output-block (bit-string-allocate (+ scheme-object-width length))))
-    (bit-string-insert!
+    (instruction-insert!
      (make-nmv-header (quotient length scheme-object-width))
      output-block
-     length)
-    (assemble-directives! output-block directives length)))
+     (instruction-initial-position output-block)
+     (lambda (position)
+       (assemble-directives! output-block directives position)))))
 
 (define (assemble-objects! block)
   (let ((objects (queue->list *objects*))
@@ -138,25 +136,29 @@ MIT in each case. |#
         (error "insert-objects!: object phase error" where))
        (else v)))
 \f
-(define (assemble-directives! block directives block-length)
+(define (assemble-directives! block directives initial-position)
 
   (define (loop directives dir-stack pc pc-stack position last-blabel blabel)
 
     (define (actual-bits bits l)
-      (let ((np (- position l)))
-       (bit-string-insert! bits block np)
-       (loop (cdr directives) dir-stack (+ pc l) pc-stack np
-             last-blabel blabel)))
+      (instruction-insert!
+       bits
+       block position
+       (lambda (np)
+        (declare (integrate np))
+        (loop (cdr directives) dir-stack (+ pc l) pc-stack np
+              last-blabel blabel))))
 
     (define (block-offset offset last-blabel blabel)
-      (let ((np (- position block-offset-width)))
-       (bit-string-insert!
-        (block-offset->bit-string offset (eq? blabel *start-label*))
-        block np)
-       (loop (cdr directives) dir-stack
-             (+ pc block-offset-width)
-             pc-stack np
-             last-blabel blabel)))
+      (instruction-insert!
+       (block-offset->bit-string offset (eq? blabel *start-label*))
+       block position
+       (lambda (np)
+        (declare (integrate np))
+        (loop (cdr directives) dir-stack
+              (+ pc block-offset-width)
+              pc-stack np
+              last-blabel blabel))))
 
     (define (evaluation handler expression l)
       (actual-bits (handler
@@ -209,11 +211,13 @@ MIT in each case. |#
          ((not (null? dir-stack))
           (loop (car dir-stack) (cdr dir-stack) pc pc-stack position
                 last-blabel blabel))
-         ((not (= (+ block-length starting-pc) (+ pc position)))
+         ((not (= (abs (- position initial-position))
+                  (- pc starting-pc)))
           (error "assemble-directives!: phase error"
-                 block-length pc position))
+                 `(PC ,starting-pc ,pc)
+                 `(BIT-POSITION ,initial-position ,position)))
          (else (assemble-objects! block))))
-  (loop directives '() starting-pc '() block-length
+  (loop directives '() starting-pc '() initial-position
        *start-label* *start-label*))
 \f
 ;;;; Input conversion
@@ -429,5 +433,5 @@ MIT in each case. |#
 (define (list->bit-string l)
   (if (null? (cdr l))
       (car l)
-      (bit-string-append (list->bit-string (cdr l))
-                        (car l))))
\ No newline at end of file
+      (instruction-append (car l)
+                         (list->bit-string (cdr l)))))
\ No newline at end of file

diff --git a/v7/src/compiler/back/insseq.scm b/v7/src/compiler/back/insseq.scm
index 777d8da7e5ab21c923aa132354ea385bd14033e1..3057e6b71981b760da62686fc1e1b51de5a77b8c 100644 (file)
--- a/v7/src/compiler/back/insseq.scm
+++ b/v7/src/compiler/back/insseq.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/insseq.scm,v 1.2 1987/07/01 20:48:04 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/insseq.scm,v 1.3 1987/08/13 02:00:21 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -37,6 +37,7 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define lap:syntax-instruction)
+(define instruction-append)
 
 (define (instruction-sequence->directives insts)
   (if (null? insts)
@@ -77,8 +78,7 @@ MIT in each case. |#
        (else
         (if (and (bit-string? (cadr seq1))
                  (bit-string? (caar seq2)))
-            (let ((result (bit-string-append (caar seq2)
-                                             (cadr seq1))))
+            (let ((result (instruction-append (cadr seq1) (caar seq2))))
               (set-car! (cdr seq1) result)
               (if (not (eq? (car seq2) (cdr seq2)))
                   (begin (set-cdr! (cdr seq1) (cdr (car seq2)))

diff --git a/v7/src/compiler/back/syerly.scm b/v7/src/compiler/back/syerly.scm
index 15851b38499d0fe5daa0b112e875ebc29cf48c36..aaa566ecd39f367c44da821e1a6095e408840b08 100644 (file)
--- a/v7/src/compiler/back/syerly.scm
+++ b/v7/src/compiler/back/syerly.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.3 1987/07/30 21:27:11 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.4 1987/08/13 02:01:16 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -180,9 +180,9 @@ MIT in each case. |#
                  (if (scode/constant? (cadr inner-operands))
                      (scode/make-absolute-reference 'CONS)
                      operator)
-                 (cons (bit-string-append
-                        (scode/constant-value (car inner-operands))
-                        (scode/constant-value (car operands)))
+                 (cons (instruction-append
+                        (scode/constant-value (car operands))
+                        (scode/constant-value (car inner-operands)))
                        (cdr inner-operands))))
                (default))))
         (default)))))

diff --git a/v7/src/compiler/back/syntax.scm b/v7/src/compiler/back/syntax.scm
index 0b0b1f25e73df0701221ce6f367710d2d04d8fbc..1749eb24770807a1814dfcafff7572bd8bce2a01 100644 (file)
--- a/v7/src/compiler/back/syntax.scm
+++ b/v7/src/compiler/back/syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.19 1987/07/30 21:27:21 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.20 1987/08/13 01:59:05 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -41,7 +41,7 @@ MIT in each case. |#
           (not (null? directives))
           (bit-string? (car directives)))
       (begin (set-car! directives
-                      (bit-string-append (car directives) directive))
+                      (instruction-append directive (car directives)))
             directives)
       (cons directive directives)))
 
@@ -54,7 +54,7 @@ MIT in each case. |#
                    (bit-string? (car directives2)))
               (begin
                 (set-car! tail
-                          (bit-string-append (car directives2) (car tail)))
+                          (instruction-append (car tail) (car directives2)))
                 (set-cdr! tail (cdr directives2)))
               (set-cdr! tail directives2))
           directives1))))
@@ -122,7 +122,7 @@ MIT in each case. |#
       (cond ((null? components)
             (list bit-string))
            ((bit-string? (car components))
-            (loop2 (bit-string-append (car components) bit-string)
+            (loop2 (instruction-append bit-string (car components))
                    (cdr components)))
            (else
             (cons bit-string

diff --git a/v7/src/compiler/machines/bobcat/assmd.scm b/v7/src/compiler/machines/bobcat/assmd.scm
index 0317cad202a9c160a53840c00d66ec0c11264e49..30f4b6a1817293f0b67a54b3383b15141f1c27e9 100644 (file)
--- a/v7/src/compiler/machines/bobcat/assmd.scm
+++ b/v7/src/compiler/machines/bobcat/assmd.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/assmd.scm,v 1.31 1987/07/30 21:43:32 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/assmd.scm,v 1.32 1987/08/13 01:58:42 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -70,4 +70,17 @@ MIT in each case. |#
 
 (define (block-offset->bit-string offset start?)
   (unsigned-integer->bit-string block-offset-width
-                               (if start? offset (1+ offset))))
\ No newline at end of file
+                               (if start? offset (1+ offset))))
+\f
+;;; Machine dependent instruction order
+
+(define (instruction-initial-position block)
+  (bit-string-length block))
+
+(define (instruction-insert! bits block position receiver)
+  (let* ((l (bit-string-length bits))
+        (new-position (- position l)))
+    (bit-substring-move-right! bits 0 l block new-position)
+    (receiver new-position)))
+
+(set! instruction-append bit-string-append-reversed)