/[cmucl]/src/pcl/fin.lisp
ViewVC logotype

Contents of /src/pcl/fin.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19.2.1 - (hide annotations)
Sun Mar 9 12:47:21 2003 UTC (11 years, 1 month ago) by gerd
Branch: cold-pcl
Changes since 1.19: +5 -18 lines
*** empty log message ***
1 wlott 1.1 ;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*-
2     ;;;
3     ;;; *************************************************************************
4     ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
5     ;;; All rights reserved.
6     ;;;
7     ;;; Use and copying of this software and preparation of derivative works
8     ;;; based upon this software are permitted. Any distribution of this
9     ;;; software or derivative works must comply with all applicable United
10     ;;; States export control laws.
11     ;;;
12     ;;; This software is made available AS IS, and Xerox Corporation makes no
13     ;;; warranty about the software, its performance or its conformity to any
14     ;;; specification.
15     ;;;
16     ;;; Any person obtaining a copy of this software is requested to send their
17     ;;; name and post office or electronic mail address to:
18     ;;; CommonLoops Coordinator
19     ;;; Xerox PARC
20     ;;; 3333 Coyote Hill Rd.
21     ;;; Palo Alto, CA 94304
22     ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
23     ;;;
24     ;;; Suggestions, comments and requests for improvements are also welcome.
25     ;;; *************************************************************************
26 pw 1.13
27 dtc 1.11 (ext:file-comment
28 gerd 1.19.2.1 "$Header: /tiger/var/lib/cvsroots/cmucl/src/pcl/fin.lisp,v 1.19.2.1 2003/03/09 12:47:21 gerd Exp $")
29 dtc 1.11 ;;;
30 wlott 1.1
31     ;;
32     ;;;;;; FUNCALLABLE INSTANCES
33     ;;
34    
35     #|
36    
37     Generic functions are instances with meta class funcallable-standard-class.
38     Instances with this meta class are called funcallable-instances (FINs for
39     short). They behave something like lexical closures in that they have data
40     associated with them (which is used to store the slots) and are funcallable.
41     When a funcallable instance is funcalled, the function that is invoked is
42     called the funcallable-instance-function. The funcallable-instance-function
43     of a funcallable instance can be changed.
44    
45     This file implements low level code for manipulating funcallable instances.
46    
47     It is possible to implement funcallable instances in pure Common Lisp. A
48     simple implementation which uses lexical closures as the instances and a
49     hash table to record that the lexical closures are funcallable instances
50     is easy to write. Unfortunately, this implementation adds significant
51     overhead:
52    
53     to generic-function-invocation (1 function call)
54     to slot-access (1 function call or one hash table lookup)
55     to class-of a generic-function (1 hash-table lookup)
56    
57     In addition, it would prevent the funcallable instances from being garbage
58     collected. In short, the pure Common Lisp implementation really isn't
59     practical.
60    
61     Instead, PCL uses a specially tailored implementation for each Common Lisp and
62     makes no attempt to provide a purely portable implementation. The specially
63     tailored implementations are based on the lexical closure's provided by that
64     implementation and are fairly short and easy to write.
65    
66     Some of the implementation dependent code in this file was originally written
67     by someone in the employ of the vendor of that Common Lisp. That code is
68     explicitly marked saying who wrote it.
69    
70     |#
71    
72 phg 1.9 (in-package :pcl)
73 wlott 1.1
74     ;;;
75     ;;; The first part of the file contains the implementation dependent code to
76     ;;; implement funcallable instances. Each implementation must provide the
77     ;;; following functions and macros:
78     ;;;
79     ;;; ALLOCATE-FUNCALLABLE-INSTANCE-1 ()
80     ;;; should create and return a new funcallable instance. The
81     ;;; funcallable-instance-data slots must be initialized to NIL.
82     ;;; This is called by allocate-funcallable-instance and by the
83     ;;; bootstrapping code.
84     ;;;
85     ;;; FUNCALLABLE-INSTANCE-P (x)
86     ;;; the obvious predicate. This should be an INLINE function.
87     ;;; it must be funcallable, but it would be nice if it compiled
88     ;;; open.
89     ;;;
90     ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-value)
91     ;;; change the fin so that when it is funcalled, the new-value
92     ;;; function is called. Note that it is legal for new-value
93     ;;; to be copied before it is installed in the fin, specifically
94     ;;; there is no accessor for a FIN's function so this function
95     ;;; does not have to preserve the actual new value. The new-value
96     ;;; argument can be any funcallable thing, a closure, lambda
97     ;;; compiled code etc. This function must coerce those values
98     ;;; if necessary.
99     ;;; NOTE: new-value is almost always a compiled closure. This
100     ;;; is the important case to optimize.
101     ;;;
102     ;;; FUNCALLABLE-INSTANCE-DATA-1 (fin data-name)
103     ;;; should return the value of the data named data-name in the fin.
104     ;;; data-name is one of the symbols in the list which is the value
105     ;;; of funcallable-instance-data. Since data-name is almost always
106     ;;; a quoted symbol and funcallable-instance-data is a constant, it
107     ;;; is possible (and worthwhile) to optimize the computation of
108     ;;; data-name's offset in the data part of the fin.
109     ;;; This must be SETF'able.
110     ;;;
111    
112 pw 1.14 (declaim (notinline called-fin-without-function))
113 ram 1.6 (defun called-fin-without-function (&rest args)
114     (declare (ignore args))
115 gerd 1.19.2.1 (error "~@<Attempt to funcall a funcallable instance without first ~
116     setting its function.~@:>"))
117 wlott 1.1
118    
119 ram 1.3 ;;;; Implementation of funcallable instances for CMU Common Lisp:
120 wlott 1.1 ;;;
121 pw 1.10 (defstruct (pcl-funcallable-instance
122     (:alternate-metaclass kernel:funcallable-instance
123     kernel:random-pcl-class
124     kernel:make-random-pcl-class)
125     (:type kernel:funcallable-structure)
126     (:constructor allocate-funcallable-instance-1 ())
127     (:conc-name nil))
128     ;;
129     ;; PCL wrapper is in the layout slot.
130     ;;
131     ;; PCL data vector.
132     (pcl-funcallable-instance-slots nil)
133     ;;
134     ;; The debug-name for this function.
135 pmai 1.17 (funcallable-instance-name nil)
136     ;;
137     ;; Hash code.
138     (hash-code (get-instance-hash-code) :type fixnum))
139    
140 pw 1.10 ;;; Note: returns true for non-pcl funcallable structures.
141 ram 1.3 (import 'kernel:funcallable-instance-p)
142    
143 pw 1.13
144 ram 1.3 ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION -- Interface
145     ;;;
146     ;;; Set the function that is called when FIN is called.
147     ;;;
148 wlott 1.2 (defun set-funcallable-instance-function (fin new-value)
149 ram 1.6 (declare (type function new-value))
150 ram 1.3 (assert (funcallable-instance-p fin))
151 pw 1.10 (setf (kernel:funcallable-instance-function fin) new-value))
152 wlott 1.2
153 wlott 1.1
154     ;;;; Slightly Higher-Level stuff built on the implementation-dependent stuff.
155     ;;;
156    
157     (defmacro fsc-instance-p (fin)
158     `(funcallable-instance-p ,fin))
159    
160     (defmacro fsc-instance-wrapper (fin)
161 pmai 1.16 `(kernel:%funcallable-instance-layout ,fin))
162 wlott 1.1
163     (defmacro fsc-instance-slots (fin)
164 pmai 1.16 `(kernel:%funcallable-instance-info ,fin 0))
165 pmai 1.18
166 gerd 1.19.2.1 (defmacro fsc-instance-hash (fin)
167     `(kernel:%funcallable-instance-info ,fin 2))

  ViewVC Help
Powered by ViewVC 1.1.5