From 485da99b8c53374c31c96f75abf7c79ff9086374 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sun, 29 Apr 1990 23:30:47 +0000 Subject: [PATCH] typo in sap-. Nuked call to %primitive make-immeidate-type. Nuked a few numeric constants in favor of symbol ones. Changed assq and memq to assoc and member with :test #'eq. --- code/alieneval.lisp | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/code/alieneval.lisp b/code/alieneval.lisp index 8a935e4c7..acccc3f09 100644 --- a/code/alieneval.lisp +++ b/code/alieneval.lisp @@ -71,7 +71,7 @@ (fixnum offset)) (sap+ sap offset)) -(defun sap- (sap1 sap1) +(defun sap- (sap1 sap2) "Return the byte offset between SAP1 and SAP2." (declare (type system-area-pointer sap1 sap2)) (sap- sap1 sap2)) @@ -298,12 +298,10 @@ ;;; contiguously in a pre-validated area at the beginning of system space. We ;;; keep a free pointer to the next word we can allocate. ;;; -(defparameter system-space-start - (%primitive make-immediate-type 0 %static-alien-area) +(defparameter system-space-start (int-sap #x80000000) "The address of the first statically allocated alien.") -(defparameter alien-allocation-end - (%primitive make-immediate-type #x40000 %static-alien-area) +(defparameter alien-allocation-end (int-sap #x8fffffff) "The end of statically allocated aliens.") (defvar *current-alien-free-pointer* system-space-start @@ -318,9 +316,10 @@ (defun allocate-static-alien (bits) (declare (fixnum bits)) (let* ((alien *current-alien-free-pointer*) - (bytes (logand (ash (the fixnum (+ bits 31)) + (bytes (logand (ash (the fixnum (+ bits alien-alignment -1)) (- alien-address-shift)) - (lognot 3))) + (lognot (1- (truncate alien-alignment + alien-address-unit))))) (new (sap+ *current-alien-free-pointer* bytes))) (when (%primitive pointer> new alien-allocation-end) (error "Not enough room to allocate a ~D bit alien." bits)) @@ -825,7 +824,8 @@ ,@(unless source-p `((declare (ignore ,source-var)))) - (unless (memq (mostcar ,alien-var) '(,atype ,@more-types)) + (unless (member (mostcar ,alien-var) '(,atype ,@more-types) + :test #'eq) (error "Wrong Alien type ~S, should have been ~S~ ~{~#[~; or~:;,~] ~S~}." ,alien-var ',atype ',more-types)) @@ -1274,7 +1274,7 @@ don't know that it is supposed to be used for. I suspect it is a PERQ crock. (unless (and min (< min val)) (setq min val)) (when (rassoc val (cdr el)) (error "Element value ~S used more than once." val)) - (when (assq sym (cdr el)) + (when (assoc sym (cdr el) :test #'eq) (error "Enumeration element ~S used more than once." sym)))) (let* ((signed (minusp min)) (to (intern (concatenate 'simple-string (string name) @@ -1329,7 +1329,7 @@ don't know that it is supposed to be used for. I suspect it is a PERQ crock. (mapcar #'car alist)) (write-string "New value: " *query-io*) (let* ((response (read *query-io*)) - (res (cdr (assq response alist)))) + (res (cdr (assoc response alist :test #'eq)))) (when res (return res))))) @@ -1357,7 +1357,7 @@ don't know that it is supposed to be used for. I suspect it is a PERQ crock. ,to)))) `(deport-integer ,signed ,sap ,offset ,size - (or (cdr (assq ,value ,from)) + (or (cdr (assoc ,value ,from :test #'eq)) (enumeration-error ,from)) ',form))))) -- GitLab