From 19ec538d78beb24628c5346ccf90e1bcc499948b Mon Sep 17 00:00:00 2001 From: ch <ch> Date: Mon, 26 Feb 1990 22:53:50 +0000 Subject: [PATCH] Various frobs. Compiles now. --- compiler/mips/type-vops.lisp | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp index aaf7b1508..297fac651 100644 --- a/compiler/mips/type-vops.lisp +++ b/compiler/mips/type-vops.lisp @@ -7,7 +7,7 @@ ;;; 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 ;;; for the RT. @@ -18,6 +18,11 @@ ;;; (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: ;;; @@ -96,11 +101,13 @@ (frob simple-vector-p check-simple-vector simple-vector 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) (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 ;;; @@ -148,10 +155,6 @@ (:temporary (:type random :scs (non-descriptor-reg)) temp) (: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) (let ((cost (* (+ (length types) (count-if #'consp types)) @@ -257,9 +260,9 @@ ;;;; Function Coercion -;;; If not a function, get the symbol value and test for that being a function. -;;; Since we test for a function rather than the unbound marker, this works on -;;; NIL. +;;; If not a function, get the symbol value and test for that being a +;;; function. Since we test for a function rather than the unbound +;;; marker, this works on NIL. ;;; (define-vop (coerce-to-function) (:args (object :scs (descriptor-reg) @@ -289,4 +292,4 @@ (error-call di:undefined-symbol-error saved-object) (emit-label not-coercable-label) - (error-call di:object-not-coercable-to-function object)))))) + (error-call di:object-not-coercable-to-function-error object)))))) -- GitLab