home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume10 / comobj.lisp / part01 / hp-low.l < prev    next >
Encoding:
Text File  |  1987-07-30  |  3.8 KB  |  122 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;
  3. ; File:         new-hp-low.l
  4. ; SCCS:         %A% %G% %U%
  5. ; Description:  Revised hp-low.l
  6. ; Author:       James Kempf, HP/DCC
  7. ; Created:      16-Jul-86
  8. ; Modified:     26-Feb-87 13:35:43 (James Kempf)
  9. ; Language:     Lisp
  10. ; Package:      USER
  11. ; Status:       Experimental (Do Not Distribute)
  12. ;
  13. ; (c) Copyright 1986, James Kempf, all rights reserved.
  14. ;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. ;;; -*- Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
  18. ;;;
  19. ;;; *************************************************************************
  20. ;;; Copyright (c) 1985 Xerox Corporation.  All rights reserved.
  21. ;;;
  22. ;;; Use and copying of this software and preparation of derivative works
  23. ;;; based upon this software are permitted.  Any distribution of this
  24. ;;; software or derivative works must comply with all applicable United
  25. ;;; States export control laws.
  26. ;;; 
  27. ;;; This software is made available AS IS, and Xerox Corporation makes no
  28. ;;; warranty about the software, its performance or its conformity to any
  29. ;;; specification.
  30. ;;; 
  31. ;;; Any person obtaining a copy of this software is requested to send their
  32. ;;; name and post office or electronic mail address to:
  33. ;;;   CommonLoops Coordinator
  34. ;;;   Xerox Artifical Intelligence Systems
  35. ;;;   2400 Hanover St.
  36. ;;;   Palo Alto, CA 94303
  37. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  38. ;;;
  39. ;;; Suggestions, comments and requests for improvements are also welcome.
  40. ;;; *************************************************************************
  41. ;;; 
  42. ;;; This is the HP Common Lisp version of the file low.
  43. ;;;
  44. ;;; 
  45.  
  46. (in-package 'pcl)
  47.  
  48.   ;;   
  49. ;;;;;; Load Time Eval
  50.   ;;
  51. ;;;
  52. ;;; #, is woefully inadequate.  You can't use it inside of a macro and have
  53. ;;; the expansion of part of the macro be evaluated at load-time its kind of
  54. ;;; a joke.  load-time-eval is used to provide an interface to implementation
  55. ;;; dependent implementation of load time evaluation.
  56. ;;;
  57. ;;; A compiled call to load-time-eval:
  58. ;;;   should evaluated the form at load time,
  59. ;;;   but if it is being compiled-to-core evaluate it at compile time
  60. ;;; Interpreted calls to load-time-eval:
  61. ;;;   should just evaluate form at run-time.
  62. ;;; 
  63. ;;; The portable implementation just evaluates it every time, and PCL knows
  64. ;;; this.  PCL is careful to only use load-time-eval in places where (except
  65. ;;; for performance penalty) it is OK to evaluate the form every time.
  66. ;;; 
  67. ;;(defmacro load-time-eval (form)
  68. ;;  `(progn ,form))
  69. ;;(defmacro load-time-eval (form)
  70. ;;   `(impl::loadtime ,form))
  71.  
  72. (defmacro load-time-eval (form)
  73.   `(eval-when (load eval) ,form))  
  74.  
  75.  
  76. (setq *class-of*
  77.     '(lambda (x) 
  78.        (cond ((%instancep x)
  79.           (%instance-class-of x))
  80.          ;; Ports of PCL should define the rest of class-of
  81.          ;; more meaningfully.  Because of the underspecification
  82.                  ;; of type-of this is the best that I can do.
  83.          ((null x)
  84.                   (class-named 'null))
  85.                  ((stringp x)
  86.                   (class-named 'string))
  87.          ((characterp x)
  88.           (class-named 'character))
  89.          (t
  90.           (or (class-named (type-of x) t)
  91.               (error "Can't determine class of ~S." x)
  92.           )
  93.         )
  94.             )
  95.         )
  96. )
  97.  
  98. (eval-when (load eval)
  99.   (recompile-class-of)
  100. )
  101.   ;;   
  102. ;;;;;; Cache No's
  103.   ;;  
  104.  
  105. ;;; Grab the top 29 bits
  106. ;;;
  107. (defmacro symbol-cache-no (symbol mask)
  108. ;`(logand (prim:@inf ,symbol) ,mask)            ;    33% hit rate
  109.   `(logand (ash (prim:@inf ,symbol) -5) ,mask))        ;    83% hit rate
  110. ;   `(the extn::index (logand (prim::@>> ,symbol 4) ,mask)))  ; 75% hit rate
  111.  
  112. (defmacro object-cache-no (symbol mask)
  113.   `(logand (ash (prim:@inf ,symbol) -5) ,mask))
  114.  
  115.   ;;   
  116. ;;;;;; printing-random-thing-internal
  117.   ;;
  118. (defun printing-random-thing-internal (thing stream)
  119.   (format stream "~O" (prim:@inf thing)))
  120.  
  121.  
  122.