Skip to content
Snippets Groups Projects
Commit 9ffd018c authored by wlott's avatar wlott
Browse files

Added pointer< and pointer> as functions and changed uses of %primitive

to them instead.
parent 703c427d
No related branches found
No related tags found
No related merge requests found
......@@ -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)))))))
......
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