Skip to content
Snippets Groups Projects
Commit 3f36a370 authored by wlott's avatar wlott
Browse files

Added predicates and check-vops for the simple-array-unsigned-byte-n and

simple-array-mumble-float primitive types.
parent fe8161b2
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.5 1990/05/09 06:41:53 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.6 1990/05/14 01:59:03 wlott Exp $
;;; ;;;
;;; This file defines the machine specific function signatures. ;;; This file defines the machine specific function signatures.
;;; ;;;
...@@ -26,8 +26,11 @@ ...@@ -26,8 +26,11 @@
(defknown (fixnump bignump ratiop short-float-p single-float-p double-float-p (defknown (fixnump bignump ratiop short-float-p single-float-p double-float-p
long-float-p base-char-p %string-char-p %standard-char-p structurep long-float-p base-char-p %string-char-p %standard-char-p structurep
array-header-p simple-array-p system-area-pointer-p realp array-header-p simple-array-p simple-array-unsigned-byte-2-p
unsigned-byte-32-p signed-byte-32-p) simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p
simple-array-unsigned-byte-16-p simple-array-unsigned-byte-32-p
simple-array-single-float-p simple-array-double-float-p
system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p)
(t) boolean (movable foldable flushable)) (t) boolean (movable foldable flushable))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.4 1990/05/06 05:31:38 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.5 1990/05/14 01:59:07 wlott Exp $
;;; ;;;
;;; This file contains the implimentation specific type transformation magic. ;;; This file contains the implimentation specific type transformation magic.
;;; Basically, the various non-standard predicates that can be used in typep ;;; Basically, the various non-standard predicates that can be used in typep
...@@ -33,6 +33,20 @@ ...@@ -33,6 +33,20 @@
(define-type-predicate short-float-p short-float) (define-type-predicate short-float-p short-float)
(define-type-predicate single-float-p single-float) (define-type-predicate single-float-p single-float)
(define-type-predicate simple-array-p simple-array) (define-type-predicate simple-array-p simple-array)
(define-type-predicate simple-array-unsigned-byte-2-p
(simple-array (unsigned-byte 2) (*)))
(define-type-predicate simple-array-unsigned-byte-4-p
(simple-array (unsigned-byte 4) (*)))
(define-type-predicate simple-array-unsigned-byte-8-p
(simple-array (unsigned-byte 8) (*)))
(define-type-predicate simple-array-unsigned-byte-16-p
(simple-array (unsigned-byte 16) (*)))
(define-type-predicate simple-array-unsigned-byte-32-p
(simple-array (unsigned-byte 32) (*)))
(define-type-predicate simple-array-single-float-p
(simple-array single-float (*)))
(define-type-predicate simple-array-double-float-p
(simple-array double-float (*)))
(define-type-predicate system-area-pointer-p system-area-pointer) (define-type-predicate system-area-pointer-p system-area-pointer)
(define-type-predicate unsigned-byte-32-p (unsigned-byte 32)) (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
(define-type-predicate signed-byte-32-p (signed-byte 32)) (define-type-predicate signed-byte-32-p (signed-byte 32))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.11 1990/05/06 05:27:31 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.12 1990/05/14 01:58:57 wlott Exp $
;;; ;;;
;;; This file contains the VM definition of type testing and checking VOPs ;;; This file contains the VM definition of type testing and checking VOPs
;;; for the RT. ;;; for the RT.
...@@ -53,30 +53,33 @@ ...@@ -53,30 +53,33 @@
(define-vop (,pred-name simple-type-predicate) (define-vop (,pred-name simple-type-predicate)
(:variant ,type-code) (:variant ,type-code)
(:translate ,pred-name)) (:translate ,pred-name))
(define-vop (,check-name check-simple-type)
,@(when check-name (:variant ,type-code ,error-code))
`((define-vop (,check-name check-simple-type) (primitive-type-vop ,check-name (:check) ,ptype))))
(:variant ,type-code ,error-code))
(primitive-type-vop ,check-name (:check) ,ptype))))))
;; ### Want to tweek costs so that checks that do dereferences are ;; ### Want to tweek costs so that checks that do dereferences are
;; more expensive. ;; more expensive.
;; ;;
;; ### May want to add all of the (simple-array <mumble> (*))
;; primitive types.
;;
(frob functionp check-function function (frob functionp check-function function
vm:function-pointer-type di:object-not-function-error) vm:function-pointer-type di:object-not-function-error)
(frob listp check-list list (frob listp check-list list
vm:list-pointer-type di:object-not-list-error) vm:list-pointer-type di:object-not-list-error)
#+nil ;; ### Only after we have real structures.
(frob structurep check-structure structure
vm:structure-pointer-type di:object-not-structure)
(frob bignump check-bigunm bignum (frob bignump check-bigunm bignum
vm:bignum-type di:object-not-bignum-error) vm:bignum-type di:object-not-bignum-error)
(frob ratiop check-ratio ratio (frob ratiop check-ratio ratio
vm:ratio-type di:object-not-ratio-error) vm:ratio-type di:object-not-ratio-error)
#+nil ;; ### Need to verify the existance of this predicate.
(frob complexp check-complex complex
vm:complex-type di:object-not-complex)
(frob single-float-p check-single-float single-float (frob single-float-p check-single-float single-float
vm:single-float-type di:object-not-single-float-error) vm:single-float-type di:object-not-single-float-error)
...@@ -92,6 +95,34 @@ ...@@ -92,6 +95,34 @@
(frob simple-vector-p check-simple-vector simple-vector (frob simple-vector-p check-simple-vector simple-vector
vm:simple-vector-type di:object-not-simple-vector-error) vm:simple-vector-type di:object-not-simple-vector-error)
(frob simple-array-unsigned-byte-2-p check-simple-array-unsigned-byte-2
simple-array-unsigned-byte-2 vm:simple-array-unsigned-byte-2-type
di:object-not-simple-array-unsigned-byte-2-error)
(frob simple-array-unsigned-byte-4-p check-simple-array-unsigned-byte-4
simple-array-unsigned-byte-4 vm:simple-array-unsigned-byte-4-type
di:object-not-simple-array-unsigned-byte-4-error)
(frob simple-array-unsigned-byte-8-p check-simple-array-unsigned-byte-8
simple-array-unsigned-byte-8 vm:simple-array-unsigned-byte-8-type
di:object-not-simple-array-unsigned-byte-8-error)
(frob simple-array-unsigned-byte-16-p check-simple-array-unsigned-byte-16
simple-array-unsigned-byte-16 vm:simple-array-unsigned-byte-16-type
di:object-not-simple-array-unsigned-byte-16-error)
(frob simple-array-unsigned-byte-32-p check-simple-array-unsigned-byte-32
simple-array-unsigned-byte-32 vm:simple-array-unsigned-byte-32-type
di:object-not-simple-array-unsigned-byte-32-error)
(frob simple-array-single-float-p check-simple-array-single-float
simple-array-single-float vm:simple-array-single-float-type
di:object-not-simple-array-single-float-error)
(frob simple-array-double-float-p check-simple-array-double-float
simple-array-double-float vm:simple-array-double-float-type
di:object-not-simple-array-double-float-error)
(frob base-char-p check-base-character base-character (frob base-char-p check-base-character base-character
vm:base-character-type di:object-not-base-character-error) vm:base-character-type di:object-not-base-character-error)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment