home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume10 / comobj.lisp / part01 / spice-low.l < prev    next >
Encoding:
Text File  |  1987-07-30  |  2.8 KB  |  91 lines
  1. ;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
  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 Spice Lisp version of the file portable-low.
  27. ;;;
  28. ;;; History:
  29. ;;;    7-Dec-86
  30. ;;;       Rick Busdiecker (rfb) at Carnegie-Mellon University
  31. ;;;          Added suggested change from Gregor Kiczales @ Parc
  32. ;;;    ??-???-??
  33. ;;;      CMU:     David B. McDonald (412)268-8860
  34. ;;;         Modified.
  35. ;;;    ??-???-??
  36. ;;;      Skef Wholey at Carnegie-Mellon University
  37. ;;;         Created.
  38. ;;;
  39. ;;;
  40. ;;; 
  41.  
  42. (in-package 'pcl)
  43.  
  44.   ;;   
  45. ;;;;;; Cache No's
  46.   ;;  
  47.  
  48. ;;; Abuse the type declaration, but it generates great code.
  49.  
  50. (defun symbol-cache-no (symbol mask)
  51.   (logand (the fixnum (%primitive lisp::make-immediate-type
  52.                   symbol
  53.                   system::%+-fixnum-type))
  54.       (the fixnum mask)))
  55.  
  56. (clc::deftransform symbol-cache-no symbol-cache-no-transform (symbol mask)
  57.   `(logand (the fixnum (%primitive lisp::make-immediate-type
  58.                    ,symbol
  59.                    system::%+-fixnum-type))
  60.        (the fixnum ,mask)))
  61.  
  62. (defun object-cache-no (symbol mask)
  63.   (logand (the fixnum (%primitive lisp::make-immediate-type
  64.                   symbol
  65.                   system::%+-fixnum-type))
  66.       (the fixnum mask)))
  67.  
  68. (clc::deftransform object-cache-no object-cache-no-transform (symbol mask)
  69.   `(logand (the fixnum (%primitive make-immediate-type
  70.                    ,symbol
  71.                    system::%+-fixnum-type))
  72.        (the fixnum ,mask)))
  73.  
  74.  
  75.  
  76. (eval-when (load)
  77.   (setq *class-of*        
  78.     '(lambda (x) 
  79.        (or (and (%instancep x)
  80.             (%instance-class-of x))
  81.           ;(%funcallable-instance-p x)
  82.  
  83.            (and (null object) (class-named 'nil))
  84.            (and (stringp object) (class-named 'string))
  85.            (and (ratiop object) (class-named 'rational))
  86.            (and (streamp object) (class-named 'stream))
  87.            
  88.            (class-named (type-of x) t)
  89.            (error "Can't determine class of ~S" x)))))
  90.  
  91.