source: trunk/abcl/src/org/armedbear/lisp/jvm.lisp @ 12421

Last change on this file since 12421 was 12421, checked in by astalla, 12 years ago

Missing file from previous commit.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 24.2 KB
Line 
1;;; jvm.lisp
2;;;
3;;; Copyright (C) 2003-2008 Peter Graves
4;;; $Id: jvm.lisp 12421 2010-02-05 23:26:33Z astalla $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
19;;;
20;;; As a special exception, the copyright holders of this library give you
21;;; permission to link this library with independent modules to produce an
22;;; executable, regardless of the license terms of these independent
23;;; modules, and to copy and distribute the resulting executable under
24;;; terms of your choice, provided that you also meet, for each linked
25;;; independent module, the terms and conditions of the license of that
26;;; module.  An independent module is a module which is not derived from
27;;; or based on this library.  If you modify this library, you may extend
28;;; this exception to your version of the library, but you are not
29;;; obligated to do so.  If you do not wish to do so, delete this
30;;; exception statement from your version.
31
32(in-package "JVM")
33
34(export '(compile-defun *catch-errors* jvm-compile-package
35          derive-compiler-type))
36
37(eval-when (:compile-toplevel :load-toplevel :execute)
38  (require "LOOP")
39  (require "FORMAT")
40  (require "CLOS")
41  (require "PRINT-OBJECT")
42  (require "COMPILER-TYPES")
43  (require "COMPILER-ERROR")
44  (require "KNOWN-FUNCTIONS")
45  (require "KNOWN-SYMBOLS")
46  (require "DUMP-FORM")
47  (require "OPCODES")
48  (require "JAVA")
49  (require "COMPILER-PASS1")
50  (require "COMPILER-PASS2"))
51
52(defvar *closure-variables* nil)
53
54(defvar *enable-dformat* nil)
55
56#+nil
57(defun dformat (destination control-string &rest args)
58  (when *enable-dformat*
59    (apply #'sys::%format destination control-string args)))
60
61(defmacro dformat (&rest ignored)
62  (declare (ignore ignored)))
63
64
65(defmacro with-saved-compiler-policy (&body body)
66  "Saves compiler policy variables, restoring them after evaluating `body'."
67  `(let ((*speed* *speed*)
68         (*space* *space*)
69         (*safety* *safety*)
70         (*debug* *debug*)
71         (*explain* *explain*)
72         (*inline-declarations* *inline-declarations*))
73     ,@body))
74
75
76
77(defvar *compiler-debug* nil)
78
79(defvar *pool* nil)
80(defvar *pool-count* 1)
81(defvar *pool-entries* nil)
82(defvar *fields* ())
83(defvar *static-code* ())
84
85(defvar *declared-symbols* nil)
86(defvar *declared-functions* nil)
87(defvar *declared-strings* nil)
88(defvar *declared-integers* nil)
89(defvar *declared-floats* nil)
90(defvar *declared-doubles* nil)
91
92(defstruct (abcl-class-file (:constructor %make-abcl-class-file))
93  pathname ; pathname of output file
94  lambda-name
95  class
96  superclass
97  lambda-list ; as advertised
98  pool
99  (pool-count 1)
100  (pool-entries (make-hash-table :test #'equal))
101  fields
102  methods
103  static-code
104  (symbols (make-hash-table :test 'eq))
105  (functions (make-hash-table :test 'equal))
106  (strings (make-hash-table :test 'eq))
107  (integers (make-hash-table :test 'eql))
108  (floats (make-hash-table :test 'eql))
109  (doubles (make-hash-table :test 'eql)))
110
111(defun class-name-from-filespec (filespec)
112  (let* ((name (pathname-name filespec)))
113    (declare (type string name))
114    (dotimes (i (length name))
115      (declare (type fixnum i))
116      (when (or (char= (char name i) #\-)
117    (char= (char name i) #\Space))
118        (setf (char name i) #\_)))
119    (concatenate 'string "org/armedbear/lisp/" name)))
120
121(defun make-unique-class-name ()
122  "Creates a random class name for use with a `class-file' structure's
123`class' slot."
124  (concatenate 'string "abcl_"
125          (java:jcall (java:jmethod "java.lang.String" "replace" "char" "char")
126                      (java:jcall (java:jmethod "java.util.UUID" "toString")
127                             (java:jstatic "randomUUID" "java.util.UUID"))
128                      #\- #\_)))
129
130(defun make-class-file (&key pathname lambda-name lambda-list)
131  "Creates a `class-file' structure. If `pathname' is non-NIL, it's
132used to derive a class name. If it is NIL, a random one created
133using `make-unique-class-name'."
134  (let* ((class-name (if pathname
135                         (class-name-from-filespec  pathname)
136                         (make-unique-class-name)))
137         (class-file (%make-abcl-class-file :pathname pathname
138                                            :class class-name
139                                            :lambda-name lambda-name
140                                            :lambda-list lambda-list)))
141    class-file))
142
143(defmacro with-class-file (class-file &body body)
144  (let ((var (gensym)))
145    `(let* ((,var ,class-file)
146            (*pool*               (abcl-class-file-pool ,var))
147            (*pool-count*         (abcl-class-file-pool-count ,var))
148            (*pool-entries*       (abcl-class-file-pool-entries ,var))
149            (*fields*             (abcl-class-file-fields ,var))
150            (*static-code*        (abcl-class-file-static-code ,var))
151            (*declared-symbols*   (abcl-class-file-symbols ,var))
152            (*declared-functions* (abcl-class-file-functions ,var))
153            (*declared-strings*   (abcl-class-file-strings ,var))
154            (*declared-integers*  (abcl-class-file-integers ,var))
155            (*declared-floats*    (abcl-class-file-floats ,var))
156            (*declared-doubles*   (abcl-class-file-doubles ,var)))
157       (progn ,@body)
158       (setf (abcl-class-file-pool ,var)         *pool*
159             (abcl-class-file-pool-count ,var)   *pool-count*
160             (abcl-class-file-pool-entries ,var) *pool-entries*
161             (abcl-class-file-fields ,var)       *fields*
162             (abcl-class-file-static-code ,var)  *static-code*
163             (abcl-class-file-symbols ,var)      *declared-symbols*
164             (abcl-class-file-functions ,var)    *declared-functions*
165             (abcl-class-file-strings ,var)      *declared-strings*
166             (abcl-class-file-integers ,var)     *declared-integers*
167             (abcl-class-file-floats ,var)       *declared-floats*
168             (abcl-class-file-doubles ,var)      *declared-doubles*))))
169
170(defstruct compiland
171  name
172  lambda-expression
173  arg-vars          ; variables for lambda arguments
174  free-specials     ;
175  arity             ; number of args, or NIL if the number of args can vary.
176  p1-result         ; the parse tree as created in pass 1
177  parent            ; the parent for compilands which defined within another
178  (children 0       ; Number of local functions
179            :type fixnum) ; defined with FLET, LABELS or LAMBDA
180  blocks            ; TAGBODY, PROGV, BLOCK, etc. blocks
181  argument-register
182  closure-register
183  environment-register
184  class-file ; class-file object
185  (%single-valued-p t))
186
187(defknown compiland-single-valued-p (t) t)
188(defun compiland-single-valued-p (compiland)
189  (unless (compiland-parent compiland)
190    (let ((name (compiland-name compiland)))
191      (when name
192        (let ((result-type
193               (or (function-result-type name)
194                   (and (proclaimed-ftype name)
195                        (ftype-result-type (proclaimed-ftype name))))))
196          (when result-type
197            (return-from compiland-single-valued-p
198                         (cond ((eq result-type '*)
199                                nil)
200                               ((atom result-type)
201                                t)
202                               ((eq (%car result-type) 'VALUES)
203                                (= (length result-type) 2))
204                               (t
205                                t))))))))
206  ;; Otherwise...
207  (compiland-%single-valued-p compiland))
208
209(defvar *current-compiland* nil)
210
211(defvar *this-class* nil)
212
213(defvar *code* ())
214
215;; All tags visible at the current point of compilation, some of which may not
216;; be in the current compiland.
217(defvar *visible-tags* ())
218
219;; The next available register.
220(defvar *register* 0)
221
222;; Total number of registers allocated.
223(defvar *registers-allocated* 0)
224
225(defvar *handlers* ())
226
227(defstruct handler
228  from       ;; label indicating the start of the protected block
229  to         ;; label indicating the end of the protected block
230  code       ;; label to jump to if the specified exception occurs
231  catch-type ;; pool index of the class name of the exception, or 0 (zero)
232             ;; for 'all'
233  )
234
235;; Variables visible at the current point of compilation.
236(defvar *visible-variables* nil
237  "All variables visible to the form currently being
238processed, including free specials.")
239
240;; All variables seen so far.
241(defvar *all-variables* nil
242  "All variables in the lexical scope (thus excluding free specials)
243of the compilands being processed (p1: so far; p2: in total).")
244
245;; Undefined variables that we've already warned about.
246(defvar *undefined-variables* nil)
247
248(defvar *dump-variables* nil)
249
250(defun dump-1-variable (variable)
251  (sys::%format t "  ~S special-p = ~S register = ~S binding-reg = ~S index = ~S declared-type = ~S~%"
252           (variable-name variable)
253           (variable-special-p variable)
254           (variable-register variable)
255           (variable-binding-register variable)
256           (variable-index variable)
257           (variable-declared-type variable)))
258
259(defun dump-variables (list caption &optional (force nil))
260  (when (or force *dump-variables*)
261    (write-string caption)
262    (if list
263        (dolist (variable list)
264          (dump-1-variable variable))
265        (sys::%format t "  None.~%"))))
266
267(defstruct (variable-info (:conc-name variable-)
268                          (:constructor make-variable)
269                          (:predicate variable-p))
270  name
271  initform
272  (declared-type :none)
273  (derived-type :none)
274  ignore-p
275  ignorable-p
276  representation
277  special-p     ; indicates whether a variable is special
278  register      ; register number for a local variable
279  binding-register ; register number containing the binding reference
280  index         ; index number for a variable in the argument array
281  closure-index ; index number for a variable in the closure context array
282  environment   ; the environment for the variable, if we're compiling in
283                ; a non-null lexical environment with variables
284    ;; a variable can be either special-p *or* have a register *or*
285    ;; have an index *or* a closure-index *or* an environment
286  (reads 0 :type fixnum)
287  (writes 0 :type fixnum)
288  references
289  (references-allowed-p t) ; NIL if this is a symbol macro in the enclosing
290                           ; lexical environment
291  used-non-locally-p
292  (compiland *current-compiland*)
293  block)
294
295(defstruct (var-ref (:constructor make-var-ref (variable)))
296  ;; The variable this reference refers to. Will be NIL if the VAR-REF has been
297  ;; rewritten to reference a constant value.
298  variable
299  ;; True if the VAR-REF has been rewritten to reference a constant value.
300  constant-p
301  ;; The constant value of this VAR-REF.
302  constant-value)
303
304;; obj can be a symbol or variable
305;; returns variable or nil
306(declaim (ftype (function (t) t) unboxed-fixnum-variable))
307(defun unboxed-fixnum-variable (obj)
308  (cond ((symbolp obj)
309         (let ((variable (find-visible-variable obj)))
310           (if (and variable
311                    (eq (variable-representation variable) :int))
312               variable
313               nil)))
314        ((variable-p obj)
315         (if (eq (variable-representation obj) :int)
316             obj
317             nil))
318        (t
319         nil)))
320
321(defvar *child-p* nil
322  "True for local functions created by FLET, LABELS and (NAMED-)LAMBDA")
323
324(defknown find-variable (symbol list) t)
325(defun find-variable (name variables)
326  (dolist (variable variables)
327    (when (eq name (variable-name variable))
328      (return variable))))
329
330(defknown find-visible-variable (t) t)
331(defun find-visible-variable (name)
332  (dolist (variable *visible-variables*)
333    (when (eq name (variable-name variable))
334      (return variable))))
335
336(defknown allocate-register () (integer 0 65535))
337(defun allocate-register ()
338  (let* ((register *register*)
339         (next-register (1+ register)))
340    (declare (type (unsigned-byte 16) register next-register))
341    (setf *register* next-register)
342    (when (< *registers-allocated* next-register)
343      (setf *registers-allocated* next-register))
344    register))
345
346(defknown allocate-register-pair () (integer 0 65535))
347(defun allocate-register-pair ()
348  (let* ((register *register*)
349         (next-register (+ register 2)))
350    (declare (type (unsigned-byte 16) register next-register))
351    (setf *register* next-register)
352    (when (< *registers-allocated* next-register)
353      (setf *registers-allocated* next-register))
354    register))
355
356(defstruct local-function
357  name
358  definition
359  compiland
360  inline-expansion
361  function    ;; the function loaded through load-compiled-function
362  class-file  ;; the class file structure for this function
363  variable    ;; the variable which contains the loaded compiled function
364              ;; or compiled closure
365  environment ;; the environment in which the function is stored in
366              ;; case of a function from an enclosing lexical environment
367              ;; which itself isn't being compiled
368  (references-allowed-p t) ;;whether a reference to the function CAN be captured
369  (references-needed-p nil) ;;whether a reference to the function NEEDS to be
370          ;;captured, because the function name is used in a
371                            ;;(function ...) form. Obviously implies
372                            ;;references-allowed-p.
373  )
374
375(defvar *local-functions* ())
376
377(defknown find-local-function (t) t)
378(defun find-local-function (name)
379  (dolist (local-function *local-functions* nil)
380    (when (equal name (local-function-name local-function))
381        (return local-function))))
382
383(defvar *using-arg-array* nil)
384(defvar *hairy-arglist-p* nil)
385
386(defstruct node
387  form
388  (compiland *current-compiland*))
389;; No need for a special constructor: nobody instantiates
390;; nodes directly
391
392;; control-transferring blocks: TAGBODY, CATCH, to do: BLOCK
393
394(defstruct (control-transferring-node (:include node))
395  ;; If non-nil, the TAGBODY contains local blocks which "contaminate" the
396  ;; environment, with GO forms in them which target tags in this TAGBODY
397  ;; Non-nil if and only if the block doesn't modify the environment
398  needs-environment-restoration
399  )
400;; No need for a special constructor: nobody instantiates
401;; control-transferring-nodes directly
402
403(defstruct (tagbody-node (:conc-name tagbody-)
404                         (:include control-transferring-node)
405       (:constructor %make-tagbody-node ()))
406  ;; True if a tag in this tagbody is the target of a non-local GO.
407  non-local-go-p
408  ;; Tags in the tagbody form; a list of tag structures
409  tags
410  ;; Contains a variable whose value uniquely identifies the
411  ;; lexical scope from this block, to be used by GO
412  id-variable)
413(defknown make-tagbody-node () t)
414(defun make-tagbody-node ()
415  (let ((block (%make-tagbody-node)))
416    (push block (compiland-blocks *current-compiland*))
417    block))
418
419(defstruct (catch-node (:conc-name catch-)
420                       (:include control-transferring-node)
421           (:constructor %make-catch-node ()))
422  ;; The catch tag-form is evaluated, meaning we
423  ;; have no predefined value to store here
424  )
425(defknown make-catch-node () t)
426(defun make-catch-node ()
427  (let ((block (%make-catch-node)))
428    (push block (compiland-blocks *current-compiland*))
429    block))
430
431(defstruct (block-node (:conc-name block-)
432                       (:include control-transferring-node)
433                       (:constructor %make-block-node (name)))
434  name  ;; Block name
435  (exit (gensym))
436  target
437  ;; True if there is a non-local RETURN from this block.
438  non-local-return-p
439  ;; Contains a variable whose value uniquely identifies the
440  ;; lexical scope from this block, to be used by RETURN-FROM
441  id-variable)
442(defknown make-block-node (t) t)
443(defun make-block-node (name)
444  (let ((block (%make-block-node name)))
445    (push block (compiland-blocks *current-compiland*))
446    block))
447
448;; binding blocks: LET, LET*, FLET, LABELS, M-V-B, PROGV, LOCALLY
449;;
450;; Binding blocks can carry references to local (optionally special) variable bindings,
451;;  contain free special bindings or both
452
453(defstruct (binding-node (:include node))
454  ;; number of the register of the saved dynamic env, or NIL if none
455  environment-register
456  ;; Not used for LOCALLY and FLET; LABELS uses vars to store its functions
457  vars
458  free-specials)
459;; nobody instantiates any binding nodes directly, so there's no reason
460;; to create a constructor with the approprate administration code
461
462(defstruct (let/let*-node (:conc-name let-)
463                          (:include binding-node)
464        (:constructor %make-let/let*-node ())))
465(defknown make-let/let*-node () t)
466(defun make-let/let*-node ()
467  (let ((block (%make-let/let*-node)))
468    (push block (compiland-blocks *current-compiland*))
469    block))
470
471(defstruct (flet-node (:conc-name flet-)
472                      (:include binding-node)
473          (:constructor %make-flet-node ())))
474(defknown make-flet-node () t)
475(defun make-flet-node ()
476  (let ((block (%make-flet-node)))
477    (push block (compiland-blocks *current-compiland*))
478    block))
479
480(defstruct (labels-node (:conc-name labels-)
481                        (:include binding-node)
482      (:constructor %make-labels-node ())))
483(defknown make-labels-node () t)
484(defun make-labels-node ()
485  (let ((block (%make-labels-node)))
486    (push block (compiland-blocks *current-compiland*))
487    block))
488
489(defstruct (m-v-b-node (:conc-name m-v-b-)
490                       (:include binding-node)
491           (:constructor %make-m-v-b-node ())))
492(defknown make-m-v-b-node () t)
493(defun make-m-v-b-node ()
494  (let ((block (%make-m-v-b-node)))
495    (push block (compiland-blocks *current-compiland*))
496    block))
497
498(defstruct (progv-node (:conc-name progv-)
499                       (:include binding-node)
500           (:constructor %make-progv-node ())))
501(defknown make-progv-node () t)
502(defun make-progv-node ()
503  (let ((block (%make-progv-node)))
504    (push block (compiland-blocks *current-compiland*))
505    block))
506
507(defstruct (locally-node (:conc-name locally-)
508                         (:include binding-node)
509       (:constructor %make-locally-node ())))
510(defknown make-locally-node () t)
511(defun make-locally-node ()
512  (let ((block (%make-locally-node)))
513    (push block (compiland-blocks *current-compiland*))
514    block))
515
516;; blocks requiring non-local exits: UNWIND-PROTECT, SYS:SYNCHRONIZED-ON
517
518(defstruct (protected-node (:include node)
519         (:constructor %make-protected-node ())))
520(defknown make-protected-node () t)
521(defun make-protected-node ()
522  (let ((block (%make-protected-node)))
523    (push block (compiland-blocks *current-compiland*))
524    block))
525
526(defstruct (unwind-protect-node (:conc-name unwind-protect-)
527                                (:include protected-node)
528        (:constructor %make-unwind-protect-node ())))
529(defknown make-unwind-protect-node () t)
530(defun make-unwind-protect-node ()
531  (let ((block (%make-unwind-protect-node)))
532    (push block (compiland-blocks *current-compiland*))
533    block))
534
535(defstruct (synchronized-node (:conc-name synchronized-)
536                              (:include protected-node)
537            (:constructor %make-synchronized-node ())))
538(defknown make-synchronized-node () t)
539(defun make-synchronized-node ()
540  (let ((block (%make-synchronized-node)))
541    (push block (compiland-blocks *current-compiland*))
542    block))
543
544
545(defvar *blocks* ())
546
547(defun find-block (name)
548  (dolist (block *blocks*)
549    (when (and (block-node-p block)
550               (eq name (block-name block)))
551      (return block))))
552
553(defknown node-constant-p (t) boolean)
554(defun node-constant-p (object)
555  (cond ((node-p object)
556         nil)
557        ((var-ref-p object)
558         nil)
559        ((constantp object)
560         t)
561        (t
562         nil)))
563
564(defknown block-requires-non-local-exit-p (t) boolean)
565(defun block-requires-non-local-exit-p (object)
566  "A block which *always* requires a 'non-local-exit' is a block which
567requires a transfer control exception to be thrown: e.g. Go and Return.
568
569Non-local exits are required by blocks which do more in their cleanup
570than just restore the lastSpecialBinding (= dynamic environment).
571"
572  (or (unwind-protect-node-p object)
573      (catch-node-p object)
574      (synchronized-node-p object)))
575
576(defknown block-creates-runtime-bindings-p (t) boolean)
577(defun block-creates-runtime-bindings-p (block)
578  ;; FIXME: This may be false, if the bindings to be
579  ;; created are a quoted list
580  (progv-node-p block))
581
582(defknown enclosed-by-runtime-bindings-creating-block-p (t) boolean)
583(defun enclosed-by-runtime-bindings-creating-block-p (outermost-block)
584  "Indicates whether the code being compiled/analyzed is enclosed in a
585block which creates special bindings at runtime."
586  (dolist (enclosing-block *blocks*)
587    (when (eq enclosing-block outermost-block)
588      (return-from enclosed-by-runtime-bindings-creating-block-p nil))
589    (when (block-creates-runtime-bindings-p enclosing-block)
590      (return-from enclosed-by-runtime-bindings-creating-block-p t))))
591
592(defknown enclosed-by-protected-block-p (&optional t) boolean)
593(defun enclosed-by-protected-block-p (&optional outermost-block)
594  "Indicates whether the code being compiled/analyzed is enclosed in
595a block which requires a non-local transfer of control exception to
596be generated.
597"
598  (dolist (enclosing-block *blocks*)
599    (when (eq enclosing-block outermost-block)
600      (return-from enclosed-by-protected-block-p nil))
601    (when (block-requires-non-local-exit-p enclosing-block)
602      (return-from enclosed-by-protected-block-p t))))
603
604(defknown enclosed-by-environment-setting-block-p (&optional t) boolean)
605(defun enclosed-by-environment-setting-block-p (&optional outermost-block)
606  (dolist (enclosing-block *blocks*)
607    (when (eq enclosing-block outermost-block)
608      (return nil))
609    (when (and (binding-node-p enclosing-block)
610               (binding-node-environment-register enclosing-block))
611      (return t))))
612
613(defknown environment-register-to-restore (&optional t) t)
614(defun environment-register-to-restore (&optional outermost-block)
615  "Returns the environment register which contains the
616saved environment from the outermost enclosing block:
617
618That's the one which contains the environment used in the outermost block."
619  (flet ((outermost-register (last-register block)
620           (when (eq block outermost-block)
621             (return-from environment-register-to-restore last-register))
622           (or (and (binding-node-p block)
623                    (binding-node-environment-register block))
624               last-register)))
625    (reduce #'outermost-register *blocks*
626            :initial-value nil)))
627
628(defstruct tag
629  ;; The symbol (or integer) naming the tag
630  name
631  ;; The symbol which is the jump target in JVM byte code
632  label
633  ;; The associated TAGBODY
634  block
635  (compiland *current-compiland*)
636  used
637  used-non-locally)
638
639(defknown find-tag (t) t)
640(defun find-tag (name)
641  (dolist (tag *visible-tags*)
642    (when (eql name (tag-name tag))
643      (return tag))))
644
645(defun process-ignore/ignorable (declaration names variables)
646  (when (memq declaration '(IGNORE IGNORABLE))
647    (let ((what (if (eq declaration 'IGNORE) "ignored" "ignorable")))
648      (dolist (name names)
649        (unless (and (consp name) (eq (car name) 'FUNCTION))
650          (let ((variable (find-variable name variables)))
651            (cond ((null variable)
652                   (compiler-style-warn "Declaring unknown variable ~S to be ~A."
653                                        name what))
654                  ((variable-special-p variable)
655                   (compiler-style-warn "Declaring special variable ~S to be ~A."
656                                        name what))
657                  ((eq declaration 'IGNORE)
658                   (setf (variable-ignore-p variable) t))
659                  (t
660                   (setf (variable-ignorable-p variable) t)))))))))
661
662(defun finalize-generic-functions ()
663  (dolist (sym '(make-instance
664                 initialize-instance
665                 shared-initialize))
666    (let ((gf (and (fboundp sym) (fdefinition sym))))
667      (when (typep gf 'generic-function)
668        (unless (compiled-function-p gf)
669          (mop::finalize-generic-function gf))))))
670
671(finalize-generic-functions)
672
673(provide 'jvm)
Note: See TracBrowser for help on using the repository browser.