Moved open-coding of VECTOR?, %RECORD? and CHAR? from SF to

open-coders in compiler.

diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index 683996229cb1960d5f7f457a84a245e962823cdb..dde167b05d92304d077e817bd3a420c40646f444 100644 (file)
--- a/v7/src/compiler/rtlgen/opncod.scm
+++ b/v7/src/compiler/rtlgen/opncod.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: opncod.scm,v 4.65 1997/10/14 14:20:05 adams Exp $
+$Id: opncod.scm,v 4.66 1997/10/15 03:25:55 adams Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -620,8 +620,14 @@ MIT in each case. |#
         (lambda (name type)
           (define-open-coder/predicate name
             (simple-open-coder (open-code/type-test type) '(0) false)))))
-    (simple-type-test 'PAIR? (ucode-type pair))
-    (simple-type-test 'STRING? (ucode-type string))
+    (simple-type-test 'CHAR?    (ucode-type character))
+    (simple-type-test 'CELL?    (ucode-type cell))
+    (simple-type-test 'PAIR?    (ucode-type pair))
+    (simple-type-test 'STRING?  (ucode-type string))
+    (simple-type-test 'VECTOR?  (ucode-type vector))
+    (simple-type-test '%RECORD? (ucode-type record))
+    (simple-type-test 'FIXNUM?  (ucode-type fixnum))
+    (simple-type-test 'FLONUM?  (ucode-type flonum))
     (simple-type-test 'BIT-STRING? (ucode-type vector-1b))))
 
 (define-open-coder/predicate 'EQ?
@@ -632,6 +638,22 @@ MIT in each case. |#
    '(0 1)
    false))
 
+(define-open-coder/predicate 'EQUAL-FIXNUM?
+  (simple-open-coder
+   (lambda (combination expressions finish)
+     combination
+     (finish (rtl:make-eq-test (car expressions) (cadr expressions))))
+   '(0 1)
+   false))
+
+(define-open-coder/predicate 'ZERO-FIXNUM?
+  (simple-open-coder
+   (lambda (combination expressions finish)
+     combination
+     (finish (rtl:make-eq-test (car expressions) (rtl:make-constant 0))))
+   '(0)
+   false))
+
 (define-open-coder/predicate 'INDEX-FIXNUM?
   (simple-open-coder
    (lambda (combination expressions finish)

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index d2dc7eb202f58ab23fbe28cd5b4ebcab17a3a332..b107b972cdb95eb7a864fda0021f5ba11e7263b8 100644 (file)
--- a/v7/src/runtime/char.scm
+++ b/v7/src/runtime/char.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: char.scm,v 14.6 1997/04/20 05:10:43 cph Exp $
+$Id: char.scm,v 14.7 1997/10/15 03:20:42 adams Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -38,12 +38,9 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define-primitives
-  make-char char-code char-bits char->integer integer->char char->ascii
+  char? make-char char-code char-bits char->integer integer->char char->ascii
   char-ascii? ascii->char char-upcase char-downcase)
 
-(define-integrable (char? object)
-  (object-type? (ucode-type character) object))
-
 (define-integrable char-code-limit #x80)
 (define-integrable char-bits-limit #x20)
 (define-integrable char-integer-limit #x1000)

diff --git a/v7/src/runtime/record.scm b/v7/src/runtime/record.scm
index efc06b001076f00d9980cc0720f5c4bfd6177ef1..28b2c0aeae3d3aac7b49fab96ccc4c921dc7ec52 100644 (file)
--- a/v7/src/runtime/record.scm
+++ b/v7/src/runtime/record.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: record.scm,v 1.26 1997/06/25 03:27:54 cph Exp $
+$Id: record.scm,v 1.27 1997/10/15 03:21:02 adams Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -41,6 +41,7 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define-primitives
+  (%record? 1)
   (%record -1)
   (%record-length 1)
   (%record-ref 2)
@@ -49,9 +50,6 @@ MIT in each case. |#
   (primitive-object-set! 3)
   (primitive-object-set-type 2))
 
-(define-integrable (%record? object)
-  (object-type? (ucode-type record) object))
-
 (define (%make-record length #!optional object)
   (if (not (exact-integer? length))
       (error:wrong-type-argument length "exact integer" '%MAKE-RECORD))

diff --git a/v7/src/runtime/vector.scm b/v7/src/runtime/vector.scm
index 7836a30e258e6ec2b74833e0bb504f08aa6979e5..71e52a2de7ef23454740a95d55a09bf2a15b9433 100644 (file)
--- a/v7/src/runtime/vector.scm
+++ b/v7/src/runtime/vector.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vector.scm,v 14.10 1997/02/23 06:16:12 cph Exp $
+$Id: vector.scm,v 14.11 1997/10/15 03:20:51 adams Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -38,7 +38,7 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define-primitives
- vector-length vector-ref vector-set!
+ vector? vector-length vector-ref vector-set!
  list->vector vector subvector->list
  subvector-move-right! subvector-move-left! subvector-fill!)
 
@@ -57,9 +57,6 @@ MIT in each case. |#
   (if (not (fix:<= end (vector-length vector)))
       (error:bad-range-argument end procedure)))
 
-(define-integrable (vector? object)
-  (object-type? (ucode-type vector) object))
-
 (define (make-vector size #!optional fill)
   (if (not (index-fixnum? size))
       (error:wrong-type-argument size "valid vector index" 'MAKE-VECTOR))

diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index e9569d058fcbaf39f5f3bcf2e9a0c2b27792fec5..ecab223ea8fa96e5f1da6a316e95dd7fcbed3d22 100644 (file)
--- a/v7/src/sf/gconst.scm
+++ b/v7/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: gconst.scm,v 4.21 1997/07/15 16:05:10 adams Exp $
+$Id: gconst.scm,v 4.22 1997/10/15 03:22:10 adams Exp $
 
 Copyright (c) 1987-1994 Massachusetts Institute of Technology
 
@@ -47,6 +47,7 @@ MIT in each case. |#
     %RECORD-LENGTH
     %RECORD-REF
     %RECORD-SET!
+    %RECORD?
     *THE-NON-PRINTING-OBJECT*
     ASCII->CHAR
     BIT-STRING->UNSIGNED-INTEGER
@@ -70,6 +71,7 @@ MIT in each case. |#
     CAR
     CDR
     CELL-CONTENTS
+    CELL?
     CHAR->ASCII
     CHAR->INTEGER
     CHAR-ASCII?
@@ -81,6 +83,7 @@ MIT in each case. |#
     CHAR-INTEGER-LIMIT
     CHAR-UPCASE
     CHAR:NEWLINE
+    CHAR?
     COMPILED-CODE-ADDRESS->BLOCK
     COMPILED-CODE-ADDRESS->OFFSET
     CONS
@@ -95,11 +98,12 @@ MIT in each case. |#
     FIX:-1+
     FIX:1+
     FIX:<
-    ;; FIX:= handled by expanding it to EQ?
+    FIX:=
     FIX:>
     FIX:AND
     FIX:ANDC
     FIX:DIVIDE
+    FIX:FIXNUM?
     FIX:GCD
     FIX:LSH
     FIX:NEGATIVE?
@@ -109,7 +113,7 @@ MIT in each case. |#
     FIX:QUOTIENT
     FIX:REMAINDER
     FIX:XOR
-    ;; FIX:ZERO? handled by expanding it to (EQ? x 0)
+    FIX:ZERO?
     FLO:*
     FLO:+
     FLO:-
@@ -127,6 +131,7 @@ MIT in each case. |#
     FLO:COS
     FLO:EXP
     FLO:EXPT
+    FLO:FLONUM?
     FLO:FLOOR
     FLO:FLOOR->EXACT
     FLO:LOG
@@ -280,6 +285,7 @@ MIT in each case. |#
     VECTOR-LENGTH
     VECTOR-REF
     VECTOR-SET!
+    VECTOR?
     WITH-HISTORY-DISABLED
     WITH-INTERRUPT-MASK
     WRITE-BITS!

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index 66c60d7df7fcc4487971abdbb4aa259f5e765985..34488c14376f344d67d576637cc315d2cbc09723 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 4.37 1997/07/31 18:33:07 adams Exp $
+$Id: usiexp.scm,v 4.38 1997/10/15 03:22:26 adams Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -471,13 +471,7 @@ MIT in each case. |#
        (if-expanded (make-type-test expr block type (car operands)))
        (if-not-expanded))))
 
-(define char?-expansion (type-test-expansion (ucode-type character)))
-(define cell?-expansion (type-test-expansion (ucode-type cell)))
-(define vector?-expansion (type-test-expansion (ucode-type vector)))
-(define %record?-expansion (type-test-expansion (ucode-type record)))
 (define weak-pair?-expansion (type-test-expansion (ucode-type weak-cons)))
-(define flo:flonum?-expansion (type-test-expansion (ucode-type big-flonum)))
-(define fix:fixnum?-expansion (type-test-expansion (ucode-type fixnum)))
 
 (define (exact-integer?-expansion expr operands if-expanded if-not-expanded
                                  block)
@@ -584,7 +578,6 @@ MIT in each case. |#
 
 (define usual-integrations/expansion-names
   '(
-    %record?
     *
     +
     -
@@ -626,9 +619,7 @@ MIT in each case. |#
     cddddr
     cdddr
     cddr
-    cell?
     char=?
-    char?
     complex?
     cons*
     eighth
@@ -640,9 +631,6 @@ MIT in each case. |#
     fix:<=
     fix:=
     fix:>=
-    fix:fixnum?
-    fix:zero?
-    flo:flonum?
     fourth
     int:->flonum
     int:integer?
@@ -662,7 +650,6 @@ MIT in each case. |#
     symbol?
     third
     values
-    vector?
     weak-pair?
     with-values
     zero?
@@ -670,7 +657,6 @@ MIT in each case. |#
 \f
 (define usual-integrations/expansion-values
   (list
-   %record?-expansion
    *-expansion
    +-expansion
    --expansion
@@ -712,9 +698,7 @@ MIT in each case. |#
    cddddr-expansion
    cdddr-expansion
    cddr-expansion
-   cell?-expansion
    char=?-expansion
-   char?-expansion
    complex?-expansion
    cons*-expansion
    eighth-expansion
@@ -726,9 +710,6 @@ MIT in each case. |#
    fix:<=-expansion
    fix:=-expansion
    fix:>=-expansion
-   fix:fixnum?-expansion
-   fix:zero?-expansion
-   flo:flonum?-expansion
    fourth-expansion
    int:->flonum-expansion
    exact-integer?-expansion
@@ -748,7 +729,6 @@ MIT in each case. |#
    symbol?-expansion
    third-expansion
    values-expansion
-   vector?-expansion
    weak-pair?-expansion
    call-with-values-expansion
    zero?-expansion

diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index a99a653c95ba25f84021d25b95480db9e2ec57fc..4e7300312c296236b3fab8002f404dca12e08bbb 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.29 1997/07/09 15:12:44 adams Exp $
+$Id: fakeprim.scm,v 1.30 1997/10/15 03:22:57 adams Exp $
 
 Copyright (c) 1994-96 Massachusetts Institute of Technology
 
@@ -1037,9 +1037,8 @@ MIT in each case. |#
              '(SIDE-EFFECT-FREE)
              '(PROPER-PREDICATE))))
   (list not eq? null? false?
-       boolean? cell? pair? string? bit-string?
-       ;; these two no not exist as primitives (SF expands to OBJECT-TYPE?)
-       ;;   vector? %record?
+       boolean? cell? char? pair? string? bit-string?
+       vector? %record?
        fixnum? index-fixnum? flo:flonum? object-type?
        fix:= fix:> fix:< fix:<= fix:>=
        fix:zero? fix:positive? fix:negative? 

diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index 2c33ac36646bd2e711ee62aafe1f503420768645..c474dc50d573ae3097118984758c9401f5b93603 100644 (file)
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 1.52 1997/07/09 15:12:26 adams Exp $
+$Id: rtlgen.scm,v 1.53 1997/10/15 03:23:20 adams Exp $
 
-Copyright (c) 1994-96 Massachusetts Institute of Technology
+Copyright (c) 1994-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -3259,10 +3259,10 @@ MIT in each case. |#
                      (else
                       (rtlgen/branch/false state)))))))))
   (define-simple-tag-test 'CELL?       (machine-tag 'CELL))
+  (define-simple-tag-test 'CHAR?       (machine-tag 'CHARACTER))
   (define-simple-tag-test 'PAIR?       (machine-tag 'PAIR))
-  ;; 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 '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))

diff --git a/v8/src/compiler/midend/typedb.scm b/v8/src/compiler/midend/typedb.scm
index 414ea50dbf4db08e3f9e7b5e4880a849a40b3ec4..54e1989e0ab47bf8e19b350c6465d05e24dea3ef 100644 (file)
--- a/v8/src/compiler/midend/typedb.scm
+++ b/v8/src/compiler/midend/typedb.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: typedb.scm,v 1.15 1997/07/31 10:39:52 adams Exp $
+$Id: typedb.scm,v 1.16 1997/10/15 03:23:50 adams Exp $
 
-Copyright (c) 1996 Massachusetts Institute of Technology
+Copyright (c) 1996-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -386,5 +386,5 @@ MIT in each case. |#
     (lambda (name)
       (define-operator-type (make-primitive-procedure name)
        (primitive-procedure-type (list type:any) type:boolean 'function)))
-  '(BIT-STRING?  CELL?  FIXNUM?  FLONUM?  INDEX-FIXNUM?  NOT  NULL?
-                PAIR?  STRING?  INTEGER?))
+  '(BIT-STRING?  CELL?  CHAR?    FIXNUM?  FLONUM?  INDEX-FIXNUM?  NOT  NULL?
+                PAIR?  STRING?  INTEGER? VECTOR?  %RECORD?))

diff --git a/v8/src/compiler/midend/types.scm b/v8/src/compiler/midend/types.scm
index 0c87170de4311ab629e7fc4c123be3a80c459f5f..bbb03ebab95d7abb00a0c665c6c406a4cb5b9053 100644 (file)
--- a/v8/src/compiler/midend/types.scm
+++ b/v8/src/compiler/midend/types.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: types.scm,v 1.5 1996/07/27 03:31:38 adams Exp $
+$Id: types.scm,v 1.6 1997/10/15 03:24:22 adams Exp $
 
-Copyright (c) 1995-1996 Massachusetts Institute of Technology
+Copyright (c) 1995-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -442,8 +442,10 @@ MIT in each case. |#
   (define (def-prim name . types)
     (apply define-predicate-test-types (make-primitive-procedure name) types))
 
+  (def-prim '%RECORD?       type:%record)
   (def-prim 'BIT-STRING?    type:bit-string)
   (def-prim 'CELL?          type:cell)
+  (def-prim 'CHAR?          type:character)
   (def-prim 'FIXNUM?        type:fixnum)
   (def-prim 'FLONUM?        type:flonum)
   (def-prim 'INDEX-FIXNUM?  type:fixnum>=0)
@@ -451,6 +453,7 @@ MIT in each case. |#
   (def-prim 'NULL?          type:empty-list)
   (def-prim 'PAIR?          type:pair)
   (def-prim 'STRING?        type:string)
+  (def-prim 'VECTOR?        type:vector)
   (def-prim 'INTEGER?       type:exact-integer)
   (define-predicate-test-types %compiled-entry? type:compiled-entry)
   )

diff --git a/v8/src/sf/gconst.scm b/v8/src/sf/gconst.scm
index 8dc4f7a5ecee657f6b06e29eff40368fd4206d0a..5d44c6a412ebcbd769507991119bb8a71cc725d6 100644 (file)
--- a/v8/src/sf/gconst.scm
+++ b/v8/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: gconst.scm,v 1.4 1997/07/09 14:39:47 adams Exp $
+$Id: gconst.scm,v 1.5 1997/10/15 03:21:19 adams Exp $
 
 Copyright (c) 1987-93 Massachusetts Institute of Technology
 
@@ -47,6 +47,7 @@ MIT in each case. |#
     %RECORD-LENGTH
     %RECORD-REF
     %RECORD-SET!
+    %RECORD?
     *THE-NON-PRINTING-OBJECT*
     ASCII->CHAR
     BIT-STRING->UNSIGNED-INTEGER
@@ -82,6 +83,7 @@ MIT in each case. |#
     CHAR-INTEGER-LIMIT
     CHAR-UPCASE
     CHAR:NEWLINE
+    CHAR?
     COMPILED-CODE-ADDRESS->BLOCK
     COMPILED-CODE-ADDRESS->OFFSET
     CONS
@@ -285,6 +287,7 @@ MIT in each case. |#
     VECTOR-LENGTH
     VECTOR-REF
     VECTOR-SET!
+    VECTOR?
     WITH-HISTORY-DISABLED
     WITH-INTERRUPT-MASK
     WRITE-BITS!

diff --git a/v8/src/sf/usiexp.scm b/v8/src/sf/usiexp.scm
index 9769c63596b3274e97de37160ac03fdafeba10b7..0903a07dc6ce5c62cb7571b5e1552aaae10d275c 100644 (file)
--- a/v8/src/sf/usiexp.scm
+++ b/v8/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 1.15 1997/07/31 18:32:58 adams Exp $
+$Id: usiexp.scm,v 1.16 1997/10/15 03:21:37 adams Exp $
 
 Copyright (c) 1988-1995 Massachusetts Institute of Technology
 
@@ -434,16 +434,8 @@ MIT in each case. |#
                         get-the-types))))))
          (if-not-expanded))))
 
-  (define char?-expansion
-    (type-test-expansion (cross-sf/ucode-type 'character)))
-  (define vector?-expansion
-    (type-test-expansion (cross-sf/ucode-type 'vector)))
-  (define %record?-expansion
-    (type-test-expansion (cross-sf/ucode-type 'record)))
   (define weak-pair?-expansion
     (type-test-expansion (cross-sf/ucode-type 'weak-cons)))
-  (define flo:flonum?-expansion
-    (unary-arithmetic (ucode-primitive flonum?)))
 
   (define fixnum-ucode-types
     (let ((-ve  (cross-sf/ucode-type 'negative-fixnum))
@@ -536,8 +528,7 @@ MIT in each case. |#
        `(,(car spec) . ,(apply global-operator spec))))
 \f
   (define usual-integrations/expansion-alist
-    `((%record?           . ,%record?-expansion)
-      (*                  . ,*-expansion)
+    `((*                  . ,*-expansion)
       (+                  . ,+-expansion)
       (-                  . ,--expansion)
       (-1+                . ,-1+-expansion)
@@ -579,7 +570,6 @@ MIT in each case. |#
       (cdddr              . ,cdddr-expansion)
       (cddr               . ,cddr-expansion)
       (char=?             . ,char=?-expansion)
-      (char?              . ,char?-expansion)
       (complex?           . ,complex?-expansion)
       (cons*              . ,cons*-expansion)
       (eighth             . ,eighth-expansion)
@@ -607,7 +597,6 @@ MIT in each case. |#
       (symbol?            . ,symbol?-expansion)
       (third              . ,third-expansion)
       (values             . ,values-expansion)
-      (vector?            . ,vector?-expansion)
       (weak-pair?         . ,weak-pair?-expansion)
       (with-values        . ,call-with-values-expansion)
       (zero?              . ,zero?-expansion)