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