home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume10 / comobj.lisp / part01 / ti-low.l < prev    next >
Encoding:
Text File  |  1987-07-30  |  1.8 KB  |  55 lines
  1. ;;; -*- Mode:LISP; Package:(PCL Lisp 1000); Base:10.; Syntax:Common-lisp; Patch-File: Yes -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985 Xerox Corporation.  All rights reserved.
  5. ;;;
  6. ;;; Use and copying of this software and preparation of derivative works
  7. ;;; based upon this software are permitted.  Any distribution of this
  8. ;;; software or derivative works must comply with all applicable United
  9. ;;; States export control laws.
  10. ;;; 
  11. ;;; This software is made available AS IS, and Xerox Corporation makes no
  12. ;;; warranty about the software, its performance or its conformity to any
  13. ;;; specification.
  14. ;;; 
  15. ;;; Any person obtaining a copy of this software is requested to send their
  16. ;;; name and post office or electronic mail address to:
  17. ;;;   CommonLoops Coordinator
  18. ;;;   Xerox Artifical Intelligence Systems
  19. ;;;   2400 Hanover St.
  20. ;;;   Palo Alto, CA 94303
  21. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  22. ;;;
  23. ;;; Suggestions, comments and requests for improvements are also welcome.
  24. ;;; *************************************************************************
  25. ;;;
  26. ;;; This is the 3600 version of the file portable-low.
  27. ;;;
  28.  
  29. (in-package 'pcl)
  30.  
  31. (defmacro without-interrupts (&body body)
  32.   `(zl:without-interrupts ,.body))
  33.  
  34.   ;;   
  35. ;;;;;; Cache No's
  36.   ;;  
  37.  
  38. (defmacro symbol-cache-no (symbol mask)
  39.   `(logand (si::%pointer ,symbol) ,mask))
  40.  
  41. (defmacro object-cache-no (object mask)
  42.   `(logand (si::%pointer ,object) ,mask))
  43.  
  44.   ;;   
  45. ;;;;;; printing-random-thing-internal
  46.   ;;
  47. (defun printing-random-thing-internal (thing stream)
  48.   (format stream "~O" (si:%pointer thing)))
  49.  
  50. (eval-when (compile load eval)             ;There seems to be some bug with
  51.   (setq si::inhibit-displacing-flag t))       ;macrolet'd macros or something.
  52.                        ;This gets around it but its not
  53.                        ;really the right fix.
  54.  
  55.