From 9ffd018c6fe117de89af9cb9307ec5cf5ac8754f Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 2 Jun 1990 16:10:04 +0000
Subject: [PATCH] Added pointer< and pointer> as functions and changed uses of
 %primitive to them instead.

---
 code/alieneval.lisp | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/code/alieneval.lisp b/code/alieneval.lisp
index ca80cfdbc..06845cfca 100644
--- a/code/alieneval.lisp
+++ b/code/alieneval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.1.1.13 1990/05/26 22:55:36 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.1.1.14 1990/06/02 16:10:04 wlott Exp $
 ;;;
 ;;;    This file contains any the part of the Alien implementation that
 ;;; is not part of the compiler.
@@ -67,6 +67,16 @@
 
 #+new-compiler (progn
 
+(defun pointer< (x y)
+  "Return T iff the SAP X points to a smaller address then the SAP Y."
+  (declare (type system-area-pointer x y))
+  (pointer< x y))
+
+(defun pointer> (x y)
+  "Return T iff the SAP X points to a larger address then the SAP Y."
+  (declare (type system-area-pointer x y))
+  (pointer> x y))
+
 (defun sap+ (sap offset)
   "Return a new sap OFFSET bytes from SAP."
   (declare (type system-area-pointer sap)
@@ -337,7 +347,7 @@
 			(lognot (1- (truncate alien-alignment
 					      alien-address-unit)))))
 	 (new (sap+ *current-alien-free-pointer* bytes)))
-    (when (%primitive pointer> new alien-allocation-end)
+    (when (pointer> new alien-allocation-end)
       (error "Not enough room to allocate a ~D bit alien." bits))
     (setq *current-alien-free-pointer* new)
     alien))
@@ -417,8 +427,8 @@
   "Release the storage allocated for Alien."
   (check-type alien alien-value)
   (let ((address (alien-value-sap alien)))
-    (unless (not (or (%primitive pointer< address system-space-start)
-		     (%primitive pointer> address alien-allocation-end)))
+    (unless (not (or (pointer< address system-space-start)
+		     (pointer> address alien-allocation-end)))
       (gr-call mach:vm_deallocate *task-self* address
 	       (logand #x-200 (ash (+ (alien-value-size alien) #xFFF)
 				   (- alien-address-shift)))))))
-- 
GitLab