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