Fixed bug in open-coding of VECTOR-CONS.

Made several more primitives into known operators in order to enable
their open-coders.

diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index 1832d7a4201c49b69b497aa18ca4b65043013cbf..329d941898f8a6aaca7261f81c4d43b48cfd2da9 100644 (file)
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.23 1995/09/05 18:59:19 adams Exp $
+$Id: fakeprim.scm,v 1.24 1996/03/08 17:16:12 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -1022,7 +1022,9 @@ MIT in each case. |#
              '(SIDE-EFFECT-FREE)
              '(PROPER-PREDICATE))))
   (list not eq? null? false?
-       boolean? cell? pair? vector? %record? string? bit-string?
+       boolean? cell? pair? string? bit-string?
+       ;; these two no not exist as primitives (SF expands to OBJECT-TYPE?)
+       ;;   vector? %record?
        fixnum? index-fixnum? flo:flonum? object-type?
        fix:= fix:> fix:< fix:<= fix:>=
        fix:zero? fix:positive? fix:negative? 
@@ -1046,11 +1048,13 @@ MIT in each case. |#
           '(SIDE-EFFECT-INSENSITIVE)
           '(SIDE-EFFECT-FREE))))
  (list make-cell cons vector %record string-allocate flo:vector-cons
+       (make-primitive-procedure 'VECTOR-CONS)
        system-pair-cons
        ;;%record-length
        ;;vector-length
        ;;flo:vector-length
        object-type object-datum
+       (make-primitive-procedure 'PRIMITIVE-OBJECT-TYPE)
        ;;bit-string-length
        (make-primitive-procedure 'PRIMITIVE-OBJECT-SET-TYPE)
        fix:-1+ fix:1+ fix:+ fix:- fix:*
@@ -1072,7 +1076,9 @@ MIT in each case. |#
        flo:negate flo:abs flo:sqrt
        flo:floor flo:ceiling flo:truncate flo:round
        flo:exp flo:log flo:sin flo:cos flo:tan flo:asin
-       flo:acos flo:atan flo:atan2 flo:expt))
+       flo:acos flo:atan flo:atan2 flo:expt
+       (make-primitive-procedure 'FLONUM-NORMALIZE)
+       (make-primitive-procedure 'FLONUM-DENORMALIZE)))
 \f
 (for-each
  (lambda (simple-operator)
@@ -1087,6 +1093,10 @@ MIT in each case. |#
        ;;string-length vector-8b-ref
        system-pair-car system-pair-cdr
        system-hunk3-cxr0 system-hunk3-cxr1 system-hunk3-cxr2
+       (make-primitive-procedure 'SYSTEM-VECTOR-SIZE)
+       system-vector-ref
+       (make-primitive-procedure 'SYSTEM-VECTOR-SIZE)
+       (make-primitive-procedure 'GET-INTERRUPT-ENABLES)
        (make-primitive-procedure 'PRIMITIVE-GET-FREE)
        (make-primitive-procedure 'PRIMITIVE-OBJECT-REF)))
 
@@ -1105,6 +1115,7 @@ MIT in each case. |#
      operator
      (list '(SIMPLE) '(UNSPECIFIC-RESULT))))
  (list set-cell-contents!
+       set-string-length!
        ;;set-car! set-cdr! %record-set!
        ;;vector-set!
        ;;string-set! vector-8b-set! flo:vector-set!

diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index c7cd56f8e305ad8523c05eb2ec5254cf642ea905..1975bdd872c46644af523d661e8cd10625f25d47 100644 (file)
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 1.42 1996/03/08 15:57:43 adams Exp $
+$Id: rtlgen.scm,v 1.43 1996/03/08 17:15:38 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -3169,8 +3169,9 @@ MIT in each case. |#
                       (rtlgen/branch/false state)))))))))
   (define-simple-tag-test 'CELL?       (machine-tag 'CELL))
   (define-simple-tag-test 'PAIR?       (machine-tag 'PAIR))
-  (define-simple-tag-test 'VECTOR?     (machine-tag 'VECTOR))
-  (define-simple-tag-test '%RECORD?    (machine-tag 'RECORD))
+  ;; These two are not primitives (yet)
+  ;;(define-simple-tag-test 'VECTOR?     (machine-tag 'VECTOR))
+  ;;(define-simple-tag-test '%RECORD?    (machine-tag 'RECORD))
   (define-simple-tag-test 'STRING?     (machine-tag 'STRING))
   (define-simple-tag-test 'BIT-STRING? (machine-tag 'VECTOR-1B))
   (define-simple-tag-test 'FLONUM?     (machine-tag 'FLONUM))
@@ -3462,6 +3463,7 @@ MIT in each case. |#
          result)))))
 
 (define-open-coder/value 'FLOATING-VECTOR-CONS 1
+  ;; (flo:vector-cons <small-known-integer>)
   (let ((fv-tag  (machine-tag 'FLOATING-POINT-VECTOR))
        (nmv-tag (machine-tag 'MANIFEST-NM-VECTOR)))
     (lambda (state rands open-coder)
@@ -3498,7 +3500,7 @@ MIT in each case. |#
                            len))
        (rtlgen/cons state
                     (cons `(CONSTANT ,len) (make-list len fill))
-                    vector-tag)))))
+                    `(MACHINE-CONSTANT ,vector-tag))))))
 
 ;; *** STRING-ALLOCATE, FLOATING-VECTOR-CONS, and perhaps VECTOR-CONS
 ;; should always be in-lined, even when the length argument is not known.