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

Last change on this file since 12415 was 12415, checked in by ehuelsmann, 12 years ago

Rename class-file to abcl-class-file in anticipation of

a more generic class file representation to come.

  • 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 12415 2010-02-02 21:01:41Z ehuelsmann $
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  compiland
359  inline-expansion
360  function    ;; the function loaded through load-compiled-function
361  class-file  ;; the class file structure for this function
362  variable    ;; the variable which contains the loaded compiled function
363              ;; or compiled closure
364  environment ;; the environment in which the function is stored in
365              ;; case of a function from an enclosing lexical environment
366              ;; which itself isn't being compiled
367  (references-allowed-p t) ;;whether a reference to the function CAN be captured
368  (references-needed-p nil) ;;whether a reference to the function NEEDS to be
369          ;;captured, because the function name is used in a
370                            ;;(function ...) form. Obviously implies
371                            ;;references-allowed-p.
372  )
373
374(defvar *local-functions* ())
375
376(defknown find-local-function (t) t)
377(defun find-local-function (name)
378  (dolist (local-function *local-functions* nil)
379    (when (equal name (local-function-name local-function))
380        (return local-function))))
381
382(defvar *using-arg-array* nil)
383(defvar *hairy-arglist-p* nil)
384
385(defstruct node
386  form
387  (compiland *current-compiland*))
388;; No need for a special constructor: nobody instantiates
389;; nodes directly
390
391;; control-transferring blocks: TAGBODY, CATCH, to do: BLOCK
392
393(defstruct (control-transferring-node (:include node))
394  ;; If non-nil, the TAGBODY contains local blocks which "contaminate" the
395  ;; environment, with GO forms in them which target tags in this TAGBODY
396  ;; Non-nil if and only if the block doesn't modify the environment
397  needs-environment-restoration
398  )
399;; No need for a special constructor: nobody instantiates
400;; control-transferring-nodes directly
401
402(defstruct (tagbody-node (:conc-name tagbody-)
403                         (:include control-transferring-node)
404       (:constructor %make-tagbody-node ()))
405  ;; True if a tag in this tagbody is the target of a non-local GO.
406  non-local-go-p
407  ;; Tags in the tagbody form; a list of tag structures
408  tags
409  ;; Contains a variable whose value uniquely identifies the
410  ;; lexical scope from this block, to be used by GO
411  id-variable)
412(defknown make-tagbody-node () t)
413(defun make-tagbody-node ()
414  (let ((block (%make-tagbody-node)))
415    (push block (compiland-blocks *current-compiland*))
416    block))
417
418(defstruct (catch-node (:conc-name catch-)
419                       (:include control-transferring-node)
420           (:constructor %make-catch-node ()))
421  ;; The catch tag-form is evaluated, meaning we
422  ;; have no predefined value to store here
423  )
424(defknown make-catch-node () t)
425(defun make-catch-node ()
426  (let ((block (%make-catch-node)))
427    (push block (compiland-blocks *current-compiland*))
428    block))
429
430(defstruct (block-node (:conc-name block-)
431                       (:include control-transferring-node)
432                       (:constructor %make-block-node (name)))
433  name  ;; Block name
434  (exit (gensym))
435  target
436  ;; True if there is a non-local RETURN from this block.
437  non-local-return-p
438  ;; Contains a variable whose value uniquely identifies the
439  ;; lexical scope from this block, to be used by RETURN-FROM
440  id-variable)
441(defknown make-block-node (t) t)
442(defun make-block-node (name)
443  (let ((block (%make-block-node name)))
444    (push block (compiland-blocks *current-compiland*))
445    block))
446
447;; binding blocks: LET, LET*, FLET, LABELS, M-V-B, PROGV, LOCALLY
448;;
449;; Binding blocks can carry references to local (optionally special) variable bindings,
450;;  contain free special bindings or both
451
452(defstruct (binding-node (:include node))
453  ;; number of the register of the saved dynamic env, or NIL if none
454  environment-register
455  ;; Not used for LOCALLY and FLET; LABELS uses vars to store its functions
456  vars
457  free-specials)
458;; nobody instantiates any binding nodes directly, so there's no reason
459;; to create a constructor with the approprate administration code
460
461(defstruct (let/let*-node (:conc-name let-)
462                          (:include binding-node)
463        (:constructor %make-let/let*-node ())))
464(defknown make-let/let*-node () t)
465(defun make-let/let*-node ()
466  (let ((block (%make-let/let*-node)))
467    (push block (compiland-blocks *current-compiland*))
468    block))
469
470(defstruct (flet-node (:conc-name flet-)
471                      (:include binding-node)
472          (:constructor %make-flet-node ())))
473(defknown make-flet-node () t)
474(defun make-flet-node ()
475  (let ((block (%make-flet-node)))
476    (push block (compiland-blocks *current-compiland*))
477    block))
478
479(defstruct (labels-node (:conc-name labels-)
480                        (:include binding-node)
481      (:constructor %make-labels-node ())))
482(defknown make-labels-node () t)
483(defun make-labels-node ()
484  (let ((block (%make-labels-node)))
485    (push block (compiland-blocks *current-compiland*))
486    block))
487
488(defstruct (m-v-b-node (:conc-name m-v-b-)
489                       (:include binding-node)
490           (:constructor %make-m-v-b-node ())))
491(defknown make-m-v-b-node () t)
492(defun make-m-v-b-node ()
493  (let ((block (%make-m-v-b-node)))
494    (push block (compiland-blocks *current-compiland*))
495    block))
496
497(defstruct (progv-node (:conc-name progv-)
498                       (:include binding-node)
499           (:constructor %make-progv-node ())))
500(defknown make-progv-node () t)
501(defun make-progv-node ()
502  (let ((block (%make-progv-node)))
503    (push block (compiland-blocks *current-compiland*))
504    block))
505
506(defstruct (locally-node (:conc-name locally-)
507                         (:include binding-node)
508       (:constructor %make-locally-node ())))
509(defknown make-locally-node () t)
510(defun make-locally-node ()
511  (let ((block (%make-locally-node)))
512    (push block (compiland-blocks *current-compiland*))
513    block))
514
515;; blocks requiring non-local exits: UNWIND-PROTECT, SYS:SYNCHRONIZED-ON
516
517(defstruct (protected-node (:include node)
518         (:constructor %make-protected-node ())))
519(defknown make-protected-node () t)
520(defun make-protected-node ()
521  (let ((block (%make-protected-node)))
522    (push block (compiland-blocks *current-compiland*))
523    block))
524
525(defstruct (unwind-protect-node (:conc-name unwind-protect-)
526                                (:include protected-node)
527        (:constructor %make-unwind-protect-node ())))
528(defknown make-unwind-protect-node () t)
529(defun make-unwind-protect-node ()
530  (let ((block (%make-unwind-protect-node)))
531    (push block (compiland-blocks *current-compiland*))
532    block))
533
534(defstruct (synchronized-node (:conc-name synchronized-)
535                              (:include protected-node)
536            (:constructor %make-synchronized-node ())))
537(defknown make-synchronized-node () t)
538(defun make-synchronized-node ()
539  (let ((block (%make-synchronized-node)))
540    (push block (compiland-blocks *current-compiland*))
541    block))
542
543
544(defvar *blocks* ())
545
546(defun find-block (name)
547  (dolist (block *blocks*)
548    (when (and (block-node-p block)
549               (eq name (block-name block)))
550      (return block))))
551
552(defknown node-constant-p (t) boolean)
553(defun node-constant-p (object)
554  (cond ((node-p object)
555         nil)
556        ((var-ref-p object)
557         nil)
558        ((constantp object)
559         t)
560        (t
561         nil)))
562
563(defknown block-requires-non-local-exit-p (t) boolean)
564(defun block-requires-non-local-exit-p (object)
565  "A block which *always* requires a 'non-local-exit' is a block which
566requires a transfer control exception to be thrown: e.g. Go and Return.
567
568Non-local exits are required by blocks which do more in their cleanup
569than just restore the lastSpecialBinding (= dynamic environment).
570"
571  (or (unwind-protect-node-p object)
572      (catch-node-p object)
573      (synchronized-node-p object)))
574
575(defknown block-creates-runtime-bindings-p (t) boolean)
576(defun block-creates-runtime-bindings-p (block)
577  ;; FIXME: This may be false, if the bindings to be
578  ;; created are a quoted list
579  (progv-node-p block))
580
581(defknown enclosed-by-runtime-bindings-creating-block-p (t) boolean)
582(defun enclosed-by-runtime-bindings-creating-block-p (outermost-block)
583  "Indicates whether the code being compiled/analyzed is enclosed in a
584block which creates special bindings at runtime."
585  (dolist (enclosing-block *blocks*)
586    (when (eq enclosing-block outermost-block)
587      (return-from enclosed-by-runtime-bindings-creating-block-p nil))
588    (when (block-creates-runtime-bindings-p enclosing-block)
589      (return-from enclosed-by-runtime-bindings-creating-block-p t))))
590
591(defknown enclosed-by-protected-block-p (&optional t) boolean)
592(defun enclosed-by-protected-block-p (&optional outermost-block)
593  "Indicates whether the code being compiled/analyzed is enclosed in
594a block which requires a non-local transfer of control exception to
595be generated.
596"
597  (dolist (enclosing-block *blocks*)
598    (when (eq enclosing-block outermost-block)
599      (return-from enclosed-by-protected-block-p nil))
600    (when (block-requires-non-local-exit-p enclosing-block)
601      (return-from enclosed-by-protected-block-p t))))
602
603(defknown enclosed-by-environment-setting-block-p (&optional t) boolean)
604(defun enclosed-by-environment-setting-block-p (&optional outermost-block)
605  (dolist (enclosing-block *blocks*)
606    (when (eq enclosing-block outermost-block)
607      (return nil))
608    (when (and (binding-node-p enclosing-block)
609               (binding-node-environment-register enclosing-block))
610      (return t))))
611
612(defknown environment-register-to-restore (&optional t) t)
613(defun environment-register-to-restore (&optional outermost-block)
614  "Returns the environment register which contains the
615saved environment from the outermost enclosing block:
616
617That's the one which contains the environment used in the outermost block."
618  (flet ((outermost-register (last-register block)
619           (when (eq block outermost-block)
620             (return-from environment-register-to-restore last-register))
621           (or (and (binding-node-p block)
622                    (binding-node-environment-register block))
623               last-register)))
624    (reduce #'outermost-register *blocks*
625            :initial-value nil)))
626
627(defstruct tag
628  ;; The symbol (or integer) naming the tag
629  name
630  ;; The symbol which is the jump target in JVM byte code
631  label
632  ;; The associated TAGBODY
633  block
634  (compiland *current-compiland*)
635  used
636  used-non-locally)
637
638(defknown find-tag (t) t)
639(defun find-tag (name)
640  (dolist (tag *visible-tags*)
641    (when (eql name (tag-name tag))
642      (return tag))))
643
644(defun process-ignore/ignorable (declaration names variables)
645  (when (memq declaration '(IGNORE IGNORABLE))
646    (let ((what (if (eq declaration 'IGNORE) "ignored" "ignorable")))
647      (dolist (name names)
648        (unless (and (consp name) (eq (car name) 'FUNCTION))
649          (let ((variable (find-variable name variables)))
650            (cond ((null variable)
651                   (compiler-style-warn "Declaring unknown variable ~S to be ~A."
652                                        name what))
653                  ((variable-special-p variable)
654                   (compiler-style-warn "Declaring special variable ~S to be ~A."
655                                        name what))
656                  ((eq declaration 'IGNORE)
657                   (setf (variable-ignore-p variable) t))
658                  (t
659                   (setf (variable-ignorable-p variable) t)))))))))
660
661(defun finalize-generic-functions ()
662  (dolist (sym '(make-instance
663                 initialize-instance
664                 shared-initialize))
665    (let ((gf (and (fboundp sym) (fdefinition sym))))
666      (when (typep gf 'generic-function)
667        (unless (compiled-function-p gf)
668          (mop::finalize-generic-function gf))))))
669
670(finalize-generic-functions)
671
672(provide 'jvm)
Note: See TracBrowser for help on using the repository browser.