Skip to content
Snippets Groups Projects
Commit 19ec538d authored by ch's avatar ch
Browse files

Various frobs. Compiles now.

parent 8d52c598
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/mips/type-vops.lisp,v 1.2 1990/02/26 20:59:15 ch Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.3 1990/02/26 22:53:50 ch 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.
...@@ -18,6 +18,11 @@ ...@@ -18,6 +18,11 @@
;;; ;;;
(in-package "C") (in-package "C")
;;; ### These belongs in compiler/fundb.lisp
;;;
(defknown realp (t) boolean (movable foldable flushable))
(defknown sap-p (t) boolean (movable foldable flushable))
;;;; Simple type checking and testing: ;;;; Simple type checking and testing:
;;; ;;;
...@@ -96,11 +101,13 @@ ...@@ -96,11 +101,13 @@
(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 base-character-p check-base-character base-character ;; ### This should really be base-character-p ...
(frob string-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)
(frob sap-p check-sap sap (frob sap-p check-sap sap
vm:sap-type di:object-no-sap-error)) vm:sap-type di:object-not-sap-error))
;;; Slightly tenser versions for FIXNUM's ;;; Slightly tenser versions for FIXNUM's
;;; ;;;
...@@ -148,10 +155,6 @@ ...@@ -148,10 +155,6 @@
(:temporary (:type random :scs (non-descriptor-reg)) temp) (:temporary (:type random :scs (non-descriptor-reg)) temp)
(:node-var node)) (:node-var node))
;;; ### This belongs in compiler/fundb.lisp
;;;
(defknown realp (t) boolean (movable foldable flushable))
(macrolet ((frob (pred-name check-name error-code &rest types) (macrolet ((frob (pred-name check-name error-code &rest types)
(let ((cost (* (+ (length types) (let ((cost (* (+ (length types)
(count-if #'consp types)) (count-if #'consp types))
...@@ -257,9 +260,9 @@ ...@@ -257,9 +260,9 @@
;;;; Function Coercion ;;;; Function Coercion
;;; If not a function, get the symbol value and test for that being a function. ;;; If not a function, get the symbol value and test for that being a
;;; Since we test for a function rather than the unbound marker, this works on ;;; function. Since we test for a function rather than the unbound
;;; NIL. ;;; marker, this works on NIL.
;;; ;;;
(define-vop (coerce-to-function) (define-vop (coerce-to-function)
(:args (object :scs (descriptor-reg) (:args (object :scs (descriptor-reg)
...@@ -289,4 +292,4 @@ ...@@ -289,4 +292,4 @@
(error-call di:undefined-symbol-error saved-object) (error-call di:undefined-symbol-error saved-object)
(emit-label not-coercable-label) (emit-label not-coercable-label)
(error-call di:object-not-coercable-to-function object)))))) (error-call di:object-not-coercable-to-function-error object))))))
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