source: trunk/j/src/org/armedbear/lisp/runtime-class.lisp @ 9266

Last change on this file since 9266 was 7862, checked in by asimon, 17 years ago

Update to asm 1.5.1

File size: 36.2 KB
Line 
1;;; runtime-class.lisp
2;;;
3;;; Copyright (C) 2004 Peter Graves
4;;; $Id: runtime-class.lisp,v 1.14 2004-09-29 21:37:43 asimon Exp $
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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package :java)
21
22(require :format)
23
24;; jparse generated definitions, somewhat simplified
25
26(defclass java-class nil ((java-instance :initarg :java-instance :reader java-instance)))
27(defclass jboolean (java-class) nil)
28(defmethod initialize-instance :after ((b jboolean) &key &allow-other-keys)
29  (setf (slot-value b 'java-instance) (make-immediate-object (java-instance b) :boolean)))
30(defclass jarray (java-class) nil)
31(defclass |java.lang.Object| (java-class) nil)
32(defclass output-stream (java-class) nil)
33(defclass file-output-stream (output-stream java-class) nil)
34(defclass class-visitor (java-class) nil)
35(defclass class-writer (class-visitor java-class) nil)
36(defclass code-visitor (java-class) nil)
37(defclass code-writer (code-visitor java-class) nil)
38(defclass attribute (java-class) nil)
39(defclass constants (java-class) nil)
40(defclass label (java-class) nil)
41(defmethod make-file-output-stream-1 ((v1 string))
42  (make-instance 'file-output-stream :java-instance
43                 (jnew (jconstructor "java.io.FileOutputStream" "java.lang.String") v1)))
44(defmethod write-1 ((instance file-output-stream) (v1 jarray))
45  (jcall (jmethod "java.io.FileOutputStream" "write" "[B") (java-instance instance) (java-instance v1)))
46(defmethod close-0 ((instance file-output-stream))
47  (jcall (jmethod "java.io.FileOutputStream" "close") (java-instance instance)))
48(defmethod make-class-writer-1 ((v1 jboolean))
49  (make-instance 'class-writer :java-instance
50                 (jnew (jconstructor "org.objectweb.asm.ClassWriter" "boolean") (java-instance v1))))
51(defmethod visit-end-0 ((instance class-writer))
52  (jcall (jmethod "org.objectweb.asm.ClassWriter" "visitEnd") (java-instance instance)))
53(defmethod to-byte-array-0 ((instance class-writer))
54  (make-instance 'jarray :java-instance
55                 (jcall (jmethod "org.objectweb.asm.ClassWriter" "toByteArray") (java-instance instance))))
56(defmethod visit-insn-1 ((instance code-visitor) (v1 fixnum))
57  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitInsn" "int") (java-instance instance) v1))
58(defmethod visit-int-insn-2 ((instance code-visitor) (v1 fixnum) (v2 fixnum))
59  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitIntInsn" "int" "int") (java-instance instance) v1
60         v2))
61(defmethod visit-var-insn-2 ((instance code-visitor) (v1 fixnum) (v2 fixnum))
62  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitVarInsn" "int" "int") (java-instance instance) v1
63         v2))
64(defmethod visit-type-insn-2 ((instance code-visitor) (v1 fixnum) (v2 string))
65  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitTypeInsn" "int" "java.lang.String")
66         (java-instance instance) v1 v2))
67(defmethod visit-field-insn-4 ((instance code-visitor) (v1 fixnum) (v2 string) (v3 string) (v4 string))
68  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitFieldInsn" "int" "java.lang.String"
69                  "java.lang.String" "java.lang.String")
70         (java-instance instance) v1 v2 v3 v4))
71(defmethod visit-method-insn-4 ((instance code-visitor) (v1 fixnum) (v2 string) (v3 string) (v4 string))
72  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitMethodInsn" "int" "java.lang.String"
73                  "java.lang.String" "java.lang.String")
74         (java-instance instance) v1 v2 v3 v4))
75(defmethod visit-jump-insn-2 ((instance code-visitor) (v1 fixnum) (v2 label))
76  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitJumpInsn" "int" "org.objectweb.asm.Label")
77         (java-instance instance) v1 (java-instance v2)))
78(defmethod visit-label-1 ((instance code-visitor) (v1 label))
79  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitLabel" "org.objectweb.asm.Label")
80         (java-instance instance) (java-instance v1)))
81(defmethod visit-ldc-insn-1 ((instance code-visitor) (v1 |java.lang.Object|))
82  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitLdcInsn" "java.lang.Object")
83         (java-instance instance) (java-instance v1)))
84(defmethod visit-try-catch-block-4 ((instance code-visitor) (v1 label) (v2 label) (v3 label) (v4 string))
85  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitTryCatchBlock" "org.objectweb.asm.Label"
86                  "org.objectweb.asm.Label" "org.objectweb.asm.Label" "java.lang.String")
87         (java-instance instance) (java-instance v1) (java-instance v2) (java-instance v3) v4))
88(defmethod visit-maxs-2 ((instance code-visitor) (v1 fixnum) (v2 fixnum))
89  (jcall (jmethod "org.objectweb.asm.CodeVisitor" "visitMaxs" "int" "int") (java-instance instance) v1 v2))
90(defconstant constants.ifnonnull (jfield "org.objectweb.asm.Constants" "IFNONNULL"))
91(defconstant constants.ifnull (jfield "org.objectweb.asm.Constants" "IFNULL"))
92(defconstant constants.multianewarray (jfield "org.objectweb.asm.Constants" "MULTIANEWARRAY"))
93(defconstant constants.monitorexit (jfield "org.objectweb.asm.Constants" "MONITOREXIT"))
94(defconstant constants.monitorenter (jfield "org.objectweb.asm.Constants" "MONITORENTER"))
95(defconstant constants.instanceof (jfield "org.objectweb.asm.Constants" "INSTANCEOF"))
96(defconstant constants.checkcast (jfield "org.objectweb.asm.Constants" "CHECKCAST"))
97(defconstant constants.athrow (jfield "org.objectweb.asm.Constants" "ATHROW"))
98(defconstant constants.arraylength (jfield "org.objectweb.asm.Constants" "ARRAYLENGTH"))
99(defconstant constants.anewarray (jfield "org.objectweb.asm.Constants" "ANEWARRAY"))
100(defconstant constants.newarray (jfield "org.objectweb.asm.Constants" "NEWARRAY"))
101(defconstant constants.new (jfield "org.objectweb.asm.Constants" "NEW"))
102(defconstant constants.invokeinterface (jfield "org.objectweb.asm.Constants" "INVOKEINTERFACE"))
103(defconstant constants.invokestatic (jfield "org.objectweb.asm.Constants" "INVOKESTATIC"))
104(defconstant constants.invokespecial (jfield "org.objectweb.asm.Constants" "INVOKESPECIAL"))
105(defconstant constants.invokevirtual (jfield "org.objectweb.asm.Constants" "INVOKEVIRTUAL"))
106(defconstant constants.putfield (jfield "org.objectweb.asm.Constants" "PUTFIELD"))
107(defconstant constants.getfield (jfield "org.objectweb.asm.Constants" "GETFIELD"))
108(defconstant constants.putstatic (jfield "org.objectweb.asm.Constants" "PUTSTATIC"))
109(defconstant constants.getstatic (jfield "org.objectweb.asm.Constants" "GETSTATIC"))
110(defconstant constants.return (jfield "org.objectweb.asm.Constants" "RETURN"))
111(defconstant constants.areturn (jfield "org.objectweb.asm.Constants" "ARETURN"))
112(defconstant constants.dreturn (jfield "org.objectweb.asm.Constants" "DRETURN"))
113(defconstant constants.freturn (jfield "org.objectweb.asm.Constants" "FRETURN"))
114(defconstant constants.lreturn (jfield "org.objectweb.asm.Constants" "LRETURN"))
115(defconstant constants.ireturn (jfield "org.objectweb.asm.Constants" "IRETURN"))
116(defconstant constants.lookupswitch (jfield "org.objectweb.asm.Constants" "LOOKUPSWITCH"))
117(defconstant constants.tableswitch (jfield "org.objectweb.asm.Constants" "TABLESWITCH"))
118(defconstant constants.ret (jfield "org.objectweb.asm.Constants" "RET"))
119(defconstant constants.jsr (jfield "org.objectweb.asm.Constants" "JSR"))
120(defconstant constants.goto (jfield "org.objectweb.asm.Constants" "GOTO"))
121(defconstant constants.if-acmpne (jfield "org.objectweb.asm.Constants" "IF_ACMPNE"))
122(defconstant constants.if-acmpeq (jfield "org.objectweb.asm.Constants" "IF_ACMPEQ"))
123(defconstant constants.if-icmple (jfield "org.objectweb.asm.Constants" "IF_ICMPLE"))
124(defconstant constants.if-icmpgt (jfield "org.objectweb.asm.Constants" "IF_ICMPGT"))
125(defconstant constants.if-icmpge (jfield "org.objectweb.asm.Constants" "IF_ICMPGE"))
126(defconstant constants.if-icmplt (jfield "org.objectweb.asm.Constants" "IF_ICMPLT"))
127(defconstant constants.if-icmpne (jfield "org.objectweb.asm.Constants" "IF_ICMPNE"))
128(defconstant constants.if-icmpeq (jfield "org.objectweb.asm.Constants" "IF_ICMPEQ"))
129(defconstant constants.ifle (jfield "org.objectweb.asm.Constants" "IFLE"))
130(defconstant constants.ifgt (jfield "org.objectweb.asm.Constants" "IFGT"))
131(defconstant constants.ifge (jfield "org.objectweb.asm.Constants" "IFGE"))
132(defconstant constants.iflt (jfield "org.objectweb.asm.Constants" "IFLT"))
133(defconstant constants.ifne (jfield "org.objectweb.asm.Constants" "IFNE"))
134(defconstant constants.ifeq (jfield "org.objectweb.asm.Constants" "IFEQ"))
135(defconstant constants.dcmpg (jfield "org.objectweb.asm.Constants" "DCMPG"))
136(defconstant constants.dcmpl (jfield "org.objectweb.asm.Constants" "DCMPL"))
137(defconstant constants.fcmpg (jfield "org.objectweb.asm.Constants" "FCMPG"))
138(defconstant constants.fcmpl (jfield "org.objectweb.asm.Constants" "FCMPL"))
139(defconstant constants.lcmp (jfield "org.objectweb.asm.Constants" "LCMP"))
140(defconstant constants.i2s (jfield "org.objectweb.asm.Constants" "I2S"))
141(defconstant constants.i2c (jfield "org.objectweb.asm.Constants" "I2C"))
142(defconstant constants.i2b (jfield "org.objectweb.asm.Constants" "I2B"))
143(defconstant constants.d2f (jfield "org.objectweb.asm.Constants" "D2F"))
144(defconstant constants.d2l (jfield "org.objectweb.asm.Constants" "D2L"))
145(defconstant constants.d2i (jfield "org.objectweb.asm.Constants" "D2I"))
146(defconstant constants.f2d (jfield "org.objectweb.asm.Constants" "F2D"))
147(defconstant constants.f2l (jfield "org.objectweb.asm.Constants" "F2L"))
148(defconstant constants.f2i (jfield "org.objectweb.asm.Constants" "F2I"))
149(defconstant constants.l2d (jfield "org.objectweb.asm.Constants" "L2D"))
150(defconstant constants.l2f (jfield "org.objectweb.asm.Constants" "L2F"))
151(defconstant constants.l2i (jfield "org.objectweb.asm.Constants" "L2I"))
152(defconstant constants.i2d (jfield "org.objectweb.asm.Constants" "I2D"))
153(defconstant constants.i2f (jfield "org.objectweb.asm.Constants" "I2F"))
154(defconstant constants.i2l (jfield "org.objectweb.asm.Constants" "I2L"))
155(defconstant constants.iinc (jfield "org.objectweb.asm.Constants" "IINC"))
156(defconstant constants.lxor (jfield "org.objectweb.asm.Constants" "LXOR"))
157(defconstant constants.ixor (jfield "org.objectweb.asm.Constants" "IXOR"))
158(defconstant constants.lor (jfield "org.objectweb.asm.Constants" "LOR"))
159(defconstant constants.ior (jfield "org.objectweb.asm.Constants" "IOR"))
160(defconstant constants.land (jfield "org.objectweb.asm.Constants" "LAND"))
161(defconstant constants.iand (jfield "org.objectweb.asm.Constants" "IAND"))
162(defconstant constants.lushr (jfield "org.objectweb.asm.Constants" "LUSHR"))
163(defconstant constants.iushr (jfield "org.objectweb.asm.Constants" "IUSHR"))
164(defconstant constants.lshr (jfield "org.objectweb.asm.Constants" "LSHR"))
165(defconstant constants.ishr (jfield "org.objectweb.asm.Constants" "ISHR"))
166(defconstant constants.lshl (jfield "org.objectweb.asm.Constants" "LSHL"))
167(defconstant constants.ishl (jfield "org.objectweb.asm.Constants" "ISHL"))
168(defconstant constants.dneg (jfield "org.objectweb.asm.Constants" "DNEG"))
169(defconstant constants.fneg (jfield "org.objectweb.asm.Constants" "FNEG"))
170(defconstant constants.lneg (jfield "org.objectweb.asm.Constants" "LNEG"))
171(defconstant constants.ineg (jfield "org.objectweb.asm.Constants" "INEG"))
172(defconstant constants.drem (jfield "org.objectweb.asm.Constants" "DREM"))
173(defconstant constants.frem (jfield "org.objectweb.asm.Constants" "FREM"))
174(defconstant constants.lrem (jfield "org.objectweb.asm.Constants" "LREM"))
175(defconstant constants.irem (jfield "org.objectweb.asm.Constants" "IREM"))
176(defconstant constants.ddiv (jfield "org.objectweb.asm.Constants" "DDIV"))
177(defconstant constants.fdiv (jfield "org.objectweb.asm.Constants" "FDIV"))
178(defconstant constants.ldiv (jfield "org.objectweb.asm.Constants" "LDIV"))
179(defconstant constants.idiv (jfield "org.objectweb.asm.Constants" "IDIV"))
180(defconstant constants.dmul (jfield "org.objectweb.asm.Constants" "DMUL"))
181(defconstant constants.fmul (jfield "org.objectweb.asm.Constants" "FMUL"))
182(defconstant constants.lmul (jfield "org.objectweb.asm.Constants" "LMUL"))
183(defconstant constants.imul (jfield "org.objectweb.asm.Constants" "IMUL"))
184(defconstant constants.dsub (jfield "org.objectweb.asm.Constants" "DSUB"))
185(defconstant constants.fsub (jfield "org.objectweb.asm.Constants" "FSUB"))
186(defconstant constants.lsub (jfield "org.objectweb.asm.Constants" "LSUB"))
187(defconstant constants.isub (jfield "org.objectweb.asm.Constants" "ISUB"))
188(defconstant constants.dadd (jfield "org.objectweb.asm.Constants" "DADD"))
189(defconstant constants.fadd (jfield "org.objectweb.asm.Constants" "FADD"))
190(defconstant constants.ladd (jfield "org.objectweb.asm.Constants" "LADD"))
191(defconstant constants.iadd (jfield "org.objectweb.asm.Constants" "IADD"))
192(defconstant constants.swap (jfield "org.objectweb.asm.Constants" "SWAP"))
193(defconstant constants.dup2_x2 (jfield "org.objectweb.asm.Constants" "DUP2_X2"))
194(defconstant constants.dup2_x1 (jfield "org.objectweb.asm.Constants" "DUP2_X1"))
195(defconstant constants.dup2 (jfield "org.objectweb.asm.Constants" "DUP2"))
196(defconstant constants.dup_x2 (jfield "org.objectweb.asm.Constants" "DUP_X2"))
197(defconstant constants.dup_x1 (jfield "org.objectweb.asm.Constants" "DUP_X1"))
198(defconstant constants.dup (jfield "org.objectweb.asm.Constants" "DUP"))
199(defconstant constants.pop2 (jfield "org.objectweb.asm.Constants" "POP2"))
200(defconstant constants.pop (jfield "org.objectweb.asm.Constants" "POP"))
201(defconstant constants.sastore (jfield "org.objectweb.asm.Constants" "SASTORE"))
202(defconstant constants.castore (jfield "org.objectweb.asm.Constants" "CASTORE"))
203(defconstant constants.bastore (jfield "org.objectweb.asm.Constants" "BASTORE"))
204(defconstant constants.aastore (jfield "org.objectweb.asm.Constants" "AASTORE"))
205(defconstant constants.dastore (jfield "org.objectweb.asm.Constants" "DASTORE"))
206(defconstant constants.fastore (jfield "org.objectweb.asm.Constants" "FASTORE"))
207(defconstant constants.lastore (jfield "org.objectweb.asm.Constants" "LASTORE"))
208(defconstant constants.iastore (jfield "org.objectweb.asm.Constants" "IASTORE"))
209(defconstant constants.astore (jfield "org.objectweb.asm.Constants" "ASTORE"))
210(defconstant constants.dstore (jfield "org.objectweb.asm.Constants" "DSTORE"))
211(defconstant constants.fstore (jfield "org.objectweb.asm.Constants" "FSTORE"))
212(defconstant constants.lstore (jfield "org.objectweb.asm.Constants" "LSTORE"))
213(defconstant constants.istore (jfield "org.objectweb.asm.Constants" "ISTORE"))
214(defconstant constants.saload (jfield "org.objectweb.asm.Constants" "SALOAD"))
215(defconstant constants.caload (jfield "org.objectweb.asm.Constants" "CALOAD"))
216(defconstant constants.baload (jfield "org.objectweb.asm.Constants" "BALOAD"))
217(defconstant constants.aaload (jfield "org.objectweb.asm.Constants" "AALOAD"))
218(defconstant constants.daload (jfield "org.objectweb.asm.Constants" "DALOAD"))
219(defconstant constants.faload (jfield "org.objectweb.asm.Constants" "FALOAD"))
220(defconstant constants.laload (jfield "org.objectweb.asm.Constants" "LALOAD"))
221(defconstant constants.iaload (jfield "org.objectweb.asm.Constants" "IALOAD"))
222(defconstant constants.aload (jfield "org.objectweb.asm.Constants" "ALOAD"))
223(defconstant constants.dload (jfield "org.objectweb.asm.Constants" "DLOAD"))
224(defconstant constants.fload (jfield "org.objectweb.asm.Constants" "FLOAD"))
225(defconstant constants.lload (jfield "org.objectweb.asm.Constants" "LLOAD"))
226(defconstant constants.iload (jfield "org.objectweb.asm.Constants" "ILOAD"))
227(defconstant constants.ldc (jfield "org.objectweb.asm.Constants" "LDC"))
228(defconstant constants.sipush (jfield "org.objectweb.asm.Constants" "SIPUSH"))
229(defconstant constants.bipush (jfield "org.objectweb.asm.Constants" "BIPUSH"))
230(defconstant constants.dconst_1 (jfield "org.objectweb.asm.Constants" "DCONST_1"))
231(defconstant constants.dconst_0 (jfield "org.objectweb.asm.Constants" "DCONST_0"))
232(defconstant constants.fconst_2 (jfield "org.objectweb.asm.Constants" "FCONST_2"))
233(defconstant constants.fconst_1 (jfield "org.objectweb.asm.Constants" "FCONST_1"))
234(defconstant constants.fconst_0 (jfield "org.objectweb.asm.Constants" "FCONST_0"))
235(defconstant constants.lconst_1 (jfield "org.objectweb.asm.Constants" "LCONST_1"))
236(defconstant constants.lconst_0 (jfield "org.objectweb.asm.Constants" "LCONST_0"))
237(defconstant constants.iconst_5 (jfield "org.objectweb.asm.Constants" "ICONST_5"))
238(defconstant constants.iconst_4 (jfield "org.objectweb.asm.Constants" "ICONST_4"))
239(defconstant constants.iconst_3 (jfield "org.objectweb.asm.Constants" "ICONST_3"))
240(defconstant constants.iconst_2 (jfield "org.objectweb.asm.Constants" "ICONST_2"))
241(defconstant constants.iconst_1 (jfield "org.objectweb.asm.Constants" "ICONST_1"))
242(defconstant constants.iconst_0 (jfield "org.objectweb.asm.Constants" "ICONST_0"))
243(defconstant constants.iconst_m1 (jfield "org.objectweb.asm.Constants" "ICONST_M1"))
244(defconstant constants.aconst-null (jfield "org.objectweb.asm.Constants" "ACONST_NULL"))
245(defconstant constants.nop (jfield "org.objectweb.asm.Constants" "NOP"))
246(defconstant constants.t-long (jfield "org.objectweb.asm.Constants" "T_LONG"))
247(defconstant constants.t-int (jfield "org.objectweb.asm.Constants" "T_INT"))
248(defconstant constants.t-short (jfield "org.objectweb.asm.Constants" "T_SHORT"))
249(defconstant constants.t-byte (jfield "org.objectweb.asm.Constants" "T_BYTE"))
250(defconstant constants.t-double (jfield "org.objectweb.asm.Constants" "T_DOUBLE"))
251(defconstant constants.t-float (jfield "org.objectweb.asm.Constants" "T_FLOAT"))
252(defconstant constants.t-char (jfield "org.objectweb.asm.Constants" "T_CHAR"))
253(defconstant constants.t-boolean (jfield "org.objectweb.asm.Constants" "T_BOOLEAN"))
254(defconstant constants.acc-deprecated (jfield "org.objectweb.asm.Constants" "ACC_DEPRECATED"))
255(defconstant constants.acc-synthetic (jfield "org.objectweb.asm.Constants" "ACC_SYNTHETIC"))
256(defconstant constants.acc-super (jfield "org.objectweb.asm.Constants" "ACC_SUPER"))
257(defconstant constants.acc-strict (jfield "org.objectweb.asm.Constants" "ACC_STRICT"))
258(defconstant constants.acc-abstract (jfield "org.objectweb.asm.Constants" "ACC_ABSTRACT"))
259(defconstant constants.acc-interface (jfield "org.objectweb.asm.Constants" "ACC_INTERFACE"))
260(defconstant constants.acc-enum (jfield "org.objectweb.asm.Constants" "ACC_ENUM"))
261(defconstant constants.acc-native (jfield "org.objectweb.asm.Constants" "ACC_NATIVE"))
262(defconstant constants.acc-transient (jfield "org.objectweb.asm.Constants" "ACC_TRANSIENT"))
263(defconstant constants.acc-varargs (jfield "org.objectweb.asm.Constants" "ACC_VARARGS"))
264(defconstant constants.acc-bridge (jfield "org.objectweb.asm.Constants" "ACC_BRIDGE"))
265(defconstant constants.acc-volatile (jfield "org.objectweb.asm.Constants" "ACC_VOLATILE"))
266(defconstant constants.acc-synchronized (jfield "org.objectweb.asm.Constants" "ACC_SYNCHRONIZED"))
267(defconstant constants.acc-final (jfield "org.objectweb.asm.Constants" "ACC_FINAL"))
268(defconstant constants.acc-static (jfield "org.objectweb.asm.Constants" "ACC_STATIC"))
269(defconstant constants.acc-protected (jfield "org.objectweb.asm.Constants" "ACC_PROTECTED"))
270(defconstant constants.acc-private (jfield "org.objectweb.asm.Constants" "ACC_PRIVATE"))
271(defconstant constants.acc-public (jfield "org.objectweb.asm.Constants" "ACC_PUBLIC"))
272(defconstant constants.v1-1 (jfield "org.objectweb.asm.Constants" "V1_1"))
273(defmethod make-label-0 nil
274  (make-instance 'label :java-instance (jnew (jconstructor "org.objectweb.asm.Label"))))
275
276;;end of jparse generated definitions
277
278
279(defmethod visit-4 ((instance class-writer) (v1 fixnum) (v2 string) (v3 string) v4)
280  (jcall
281   (jmethod "org.objectweb.asm.ClassWriter" "visit" "int" "int" "java.lang.String" "java.lang.String" "[Ljava.lang.String;" "java.lang.String")
282   (java-instance instance) constants.v1-1 v1 v2 v3 v4 nil))
283
284(defmethod visit-field-3 ((instance class-writer) (v1 fixnum) (v2 string) (v3 string))
285  (jcall
286   (jmethod "org.objectweb.asm.ClassWriter" "visitField" "int" "java.lang.String" "java.lang.String" "java.lang.Object" "org.objectweb.asm.Attribute")
287   (java-instance instance) v1 v2 v3 nil nil))
288
289(defmethod visit-method-3 ((instance class-writer) (v1 fixnum) (v2 string) (v3 string))
290  (make-instance 'code-visitor :java-instance
291                 (jcall
292                  (jmethod "org.objectweb.asm.ClassWriter" "visitMethod" "int" "java.lang.String" "java.lang.String" "[Ljava.lang.String;" "org.objectweb.asm.Attribute")
293                  (java-instance instance) v1 v2 v3 nil nil)))
294
295(defun make-java-string (string)
296  (make-instance '|java.lang.Object|
297                 :java-instance (jnew (jconstructor "java.lang.String" "[C") (jnew-array-from-array "char" string))))
298
299(defparameter *primitive-types*
300  (acons "void" (list "V" "" -1 constants.return -1)
301         (acons "byte"
302                (list "B" "org/armedbear/lisp/Fixnum"
303                      constants.iload constants.ireturn constants.iconst_0)
304                (acons "short"
305                       (list "S" "org/armedbear/lisp/Fixnum"
306                             constants.iload constants.ireturn constants.iconst_0)
307                       (acons "int"
308                              (list "I" "org/armedbear/lisp/Fixnum"
309                                    constants.iload constants.ireturn constants.iconst_0)
310                              (acons "long"
311                                     (list "J" "org/armedbear/lisp/Bignum"
312                                           constants.lload constants.lreturn constants.lconst_0)
313                                     (acons "float"
314                                            (list "F" "org/armedbear/lisp/LispFloat"
315                                                  constants.fload constants.freturn constants.fconst_0)
316                                            (acons "double"
317                                                   (list "D" "org/armedbear/lisp/LispFloat"
318                                                         constants.dload constants.dreturn constants.dconst_0)
319                                                   (acons "char"
320                                                          (list "C" "org/armedbear/lisp/LispCharacter"
321                                                                constants.iload constants.ireturn constants.iconst_0)
322                                                          (acons "boolean"
323                                                                 (list "Z" "org/armedbear/lisp/LispObject"
324                                                                       constants.iload constants.ireturn constants.iconst_0)
325                                                                 nil))))))))))
326
327(defun primitive-type-p (type)
328  (assoc type *primitive-types* :test #'string=))
329
330(defun type-name (type)
331  (let* ((dim (count #\[ type :test #'char=))
332         (prefix (make-string dim :initial-element #\[))
333         (base-type (string-right-trim "[ ]" type))
334         (base-name (assoc base-type *primitive-types* :test #'string=)))
335    (concatenate 'string prefix
336                 (if base-name (cadr base-name)
337                     (substitute #\/ #\.
338                                 (if (zerop dim) base-type (decorate-type-name base-type)))))))
339
340
341(defun decorate-type-name (type)
342  (if (char= (char type 0) #\[) type
343      (format nil "L~a;" type)))
344
345(defun decorated-type-name (type)
346  (let ((name (type-name type)))
347    (if (primitive-type-p type) name (decorate-type-name name))))
348
349(defun arg-type-for-make-lisp-object (type)
350  (if (primitive-type-p type)
351      (decorated-type-name type)
352      "Ljava/lang/Object;"))
353
354(defun return-type-for-make-lisp-object (type)
355  (let ((name (assoc type *primitive-types* :test #'string=)))
356    (if name (caddr name) "org/armedbear/lisp/LispObject")))
357
358(defun cast-type (type)
359  (let ((name (assoc type *primitive-types* :test #'string=)))
360    (if name (caddr name) (type-name type))))
361
362
363(defun load-instruction (type)
364  (let ((name (assoc type *primitive-types* :test #'string=)))
365    (if name (cadddr name) constants.aload)))
366
367(defun return-instruction (type)
368  (let ((name (assoc type *primitive-types* :test #'string=)))
369    (if name (car (cddddr name)) constants.areturn)))
370
371(defun error-constant (type)
372  (let ((name (assoc type *primitive-types* :test #'string=)))
373    (if name (cadr (cddddr name)) constants.aconst-null)))
374
375
376(defun size (type)
377  (if (or (string= type "long") (string= type "double")) 2 1))
378
379(defun modifier (m)
380  (cond ((string= "public" m) constants.acc-public)
381        ((string= "protected" m) constants.acc-protected)
382        ((string= "private" m) constants.acc-private)
383        ((string= "static" m) constants.acc-static)
384        ((string= "abstract" m) constants.acc-abstract)
385        ((string= "final" m) constants.acc-final)
386        ((string= "transient" m) constants.acc-transient)
387        ((string= "volatile" m) constants.acc-volatile)
388        ((string= "synchronized" m) constants.acc-synchronized)
389        (t (error "Invalid modifier ~s." m))))
390
391
392(defun write-method
393  (class-writer class-name class-type-name method-name unique-method-name modifiers result-type arg-types &optional super-invocation)
394
395  (let* ((arg-count (length arg-types))
396         (args-size (reduce #'+ arg-types :key #'size))
397         (index (+ 2 args-size))
398         (cv (visit-method-3
399              class-writer
400              (reduce #'+ modifiers :key #'modifier)
401              method-name
402              (format nil "(~{~a~})~a"
403                      (mapcar #'decorated-type-name arg-types) (decorated-type-name result-type)))))
404
405    (when super-invocation
406      (visit-var-insn-2 cv constants.aload 0)
407      (loop for arg-number in (cdr super-invocation)
408        with super-arg-types = (make-string-output-stream)
409        do
410        (visit-var-insn-2 cv
411                          (load-instruction (nth (1- arg-number) arg-types))
412                          (reduce #'+ arg-types :end (1- arg-number) :key #'size :initial-value 1))
413        (write-string (decorated-type-name (nth (1- arg-number) arg-types)) super-arg-types)
414        finally
415        (visit-method-insn-4 cv constants.invokespecial
416                             (type-name (car super-invocation)) "<init>"
417                             (format nil "(~a)~a"
418                                     (get-output-stream-string super-arg-types) "V"))))
419    (visit-ldc-insn-1 cv (make-java-string class-name))
420    (visit-method-insn-4 cv constants.invokestatic
421                         "org/armedbear/lisp/RuntimeClass"
422                         "getRuntimeClass"
423                         "(Ljava/lang/String;)Lorg/armedbear/lisp/RuntimeClass;")
424    (visit-field-insn-4 cv constants.putstatic
425                        class-type-name "rc" "Lorg/armedbear/lisp/RuntimeClass;")
426    (visit-field-insn-4 cv constants.getstatic
427                        class-type-name "rc" "Lorg/armedbear/lisp/RuntimeClass;")
428    (visit-ldc-insn-1 cv (make-java-string unique-method-name))
429    (visit-method-insn-4 cv constants.invokevirtual
430                         "org/armedbear/lisp/RuntimeClass"
431                         "getLispMethod"
432                         "(Ljava/lang/String;)Lorg/armedbear/lisp/Function;")
433    (visit-var-insn-2 cv constants.astore (1+ args-size))
434    (visit-int-insn-2 cv constants.bipush (1+ arg-count))
435    (visit-type-insn-2 cv constants.anewarray "org/armedbear/lisp/LispObject")
436    (visit-var-insn-2 cv constants.astore (+ 2 args-size))
437
438
439    (let ((l0 (make-label-0))(l1 (make-label-0))(l2 (make-label-0))(l3 (make-label-0)))
440      (visit-label-1 cv l0)
441
442      (loop for arg-type in arg-types and i from 0 and j = 1 then (+ j (size arg-type))
443        do
444        (visit-var-insn-2 cv constants.aload index)
445        (visit-int-insn-2 cv constants.bipush i)
446        (visit-var-insn-2 cv (load-instruction arg-type) j)
447        (visit-method-insn-4 cv constants.invokestatic
448                             "org/armedbear/lisp/RuntimeClass" "makeLispObject"
449                             (format nil "(~a)~a"
450                                     (arg-type-for-make-lisp-object arg-type)
451                                     (decorate-type-name (return-type-for-make-lisp-object arg-type))))
452        (visit-insn-1 cv constants.aastore))
453
454      (visit-var-insn-2 cv constants.aload index)
455      (visit-int-insn-2 cv constants.bipush arg-count)
456      (visit-var-insn-2 cv constants.aload 0)
457      (visit-method-insn-4 cv constants.invokestatic
458                           "org/armedbear/lisp/RuntimeClass" "makeLispObject"
459                           (format nil "(~a)~a"
460                                   (arg-type-for-make-lisp-object "java.lang.Object")
461                                   (decorate-type-name (return-type-for-make-lisp-object "java.lang.Object"))))
462      (visit-insn-1 cv constants.aastore)
463
464      (visit-var-insn-2 cv constants.aload (1- index))
465      (visit-var-insn-2 cv constants.aload index)
466      (visit-method-insn-4 cv constants.invokevirtual
467                           "org/armedbear/lisp/Function"
468                           "execute"
469                           "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
470      (cond
471       ((string= "void" result-type)
472        (visit-insn-1 cv constants.pop))
473       ((string= "boolean" result-type)
474        (visit-method-insn-4 cv constants.invokevirtual
475                             (return-type-for-make-lisp-object result-type)
476                             "getBooleanValue"
477                             (concatenate 'string "()" (type-name result-type))))
478       ((primitive-type-p result-type)
479        (visit-type-insn-2 cv constants.checkcast (cast-type result-type))
480        (visit-method-insn-4 cv constants.invokevirtual
481                             (return-type-for-make-lisp-object result-type)
482                             "getValue"
483                             (concatenate 'string "()" (type-name result-type))))
484       (t
485        (visit-method-insn-4 cv constants.invokevirtual
486                             "org/armedbear/lisp/LispObject" "javaInstance" "()Ljava/lang/Object;")
487        (visit-type-insn-2 cv constants.checkcast (cast-type result-type))))
488
489
490      (visit-label-1 cv l1)
491      (if (string= "void" result-type)
492          (visit-jump-insn-2 cv constants.goto l3)
493          (visit-insn-1 cv (return-instruction result-type)))
494      (visit-label-1 cv l2)
495      (visit-var-insn-2 cv constants.astore (1+ index))
496      (visit-var-insn-2 cv constants.aload (1+ index))
497      (visit-method-insn-4 cv constants.invokevirtual
498                           "org/armedbear/lisp/ConditionThrowable" "printStackTrace" "()V")
499
500      (if (string= "void" result-type)
501          (visit-label-1 cv l3)
502          (visit-insn-1 cv (error-constant result-type)))
503
504      (visit-insn-1 cv (return-instruction result-type))
505      (visit-try-catch-block-4 cv l0 l1 l2 "org/armedbear/lisp/ConditionThrowable")
506
507      (visit-maxs-2 cv 0 0))))
508
509
510
511(defun jnew-runtime-class (class-name super-name interfaces constructors methods fields &optional filename)
512  "Creates and loads a Java class with methods calling Lisp closures
513   as given in METHODS.  CLASS-NAME and SUPER-NAME are strings,
514   INTERFACES is a list of strings, CONSTRUCTORS, METHODS and FIELDS are
515   lists of constructor, method and field definitions.
516
517   Constructor definitions are lists of the form
518   (argument-types function &optional super-invocation-arguments)
519   where argument-types is a list of strings and function is a lisp function of
520   (1+ (length argument-types)) arguments; the instance (`this') is passed in as
521   the last argument. The optional super-invocation-arguments is a list of numbers
522   between 1 and (length argument-types), where the number k stands for the kth argument
523   to the just defined constructor. If present, the constructor of the superclass
524   will be called with the appropriate arguments. E.g., if the constructor definition is
525   ((\"java.lang.String\" \"int\") #'(lambda (string i this) ...) (2 1))
526   then the constructor of the superclass with argument types (int, java.lang.String) will
527   be called with the second and first arguments.
528
529   Method definitions are lists of the form
530   (method-name return-type argument-types function modifier*)
531   where method-name and return-type are strings, argument-types is a list of strings and function
532   is a lisp function of (1+ (length argument-types)) arguments; the instance (`this') is
533   passed in as the last argument.
534
535   Field definitions are lists of the form
536   (field-name type modifier*)
537
538   If FILE-NAME is given, a .class file will be written; this is useful for debugging only."
539
540  (let ((cw (make-class-writer-1 (make-instance 'jboolean :java-instance t)))
541        (class-type-name (type-name class-name))
542        (super-type-name (type-name super-name))
543  (interface-type-names 
544   (when interfaces 
545     (let* ((no-of-interfaces (length interfaces))
546      (ifarray (jnew-array "java.lang.String" no-of-interfaces)))
547       (dotimes (i no-of-interfaces ifarray) 
548         (setf (jarray-ref ifarray i) (type-name (nth i interfaces)))))))
549        (args-for-%jnew))
550    (visit-4 cw (+ constants.acc-public constants.acc-super)
551             class-type-name super-type-name interface-type-names)
552    (visit-field-3 cw (+ constants.acc-private constants.acc-static)
553                   "rc" "Lorg/armedbear/lisp/RuntimeClass;")
554
555    (dolist (field-def fields)
556      (visit-field-3 cw
557                     (reduce #'+ (cddr field-def) :key #'modifier)
558                     (car field-def)
559                     (decorated-type-name (cadr field-def))))
560
561
562    (if constructors
563        (loop for (arg-types constr-def super-invocation-args) in constructors
564          for unique-method-name = (apply #'concatenate 'string "<init>|" arg-types)
565          then (apply #'concatenate 'string "<init>|" arg-types)
566          collect unique-method-name into args
567          collect (coerce constr-def 'function) into args
568          do
569          (write-method cw class-name class-type-name "<init>" unique-method-name '("public") "void" arg-types
570                        (cons super-type-name super-invocation-args))
571          finally
572          (setf args-for-%jnew (append args-for-%jnew args)))
573        (let ((cv (visit-method-3 cw constants.acc-public "<init>" "()V")))
574          (visit-var-insn-2 cv constants.aload 0)
575          (visit-method-insn-4 cv constants.invokespecial super-type-name "<init>" "()V")
576          (visit-insn-1 cv constants.return)
577          (visit-maxs-2 cv 1 1)))
578
579    (loop for (method-name ret-type arg-types method-def . modifiers) in methods
580      for unique-method-name = (apply #'concatenate 'string method-name "|" arg-types)
581      then (apply #'concatenate 'string method-name "|" arg-types)
582      collect unique-method-name into args
583      collect (coerce method-def 'function) into args
584      do
585      (write-method cw class-name class-type-name method-name unique-method-name modifiers ret-type arg-types)
586      finally
587      (apply #'java::%jnew-runtime-class class-name (append args-for-%jnew args)))
588
589    (visit-end-0 cw)
590
591    (when filename
592      (let ((os (make-file-output-stream-1 filename)))
593        (write-1 os (to-byte-array-0 cw))
594        (close-0 os)))
595
596    (java::%load-java-class-from-byte-array class-name (java-instance (to-byte-array-0 cw)))))
597
598(defun jredefine-method (class-name method-name arg-types method-def)
599  "Replace the definition of the method named METHDO-NAME (or
600   constructor, if METHD-NAME is nil) of argument types ARG-TYPES of the
601   class named CLASS-NAME defined with JNEW-RUNTIME-CLASS with
602   METHOD-DEF. See the documentation of JNEW-RUNTIME-CLASS."
603  (assert (jruntime-class-exists-p class-name) (class-name)
604          "Can't redefine methods of undefined runtime class ~a" class-name)
605  (let ((unique-method-name 
606   (apply #'concatenate 'string (if method-name method-name "<init>") "|" arg-types)))
607    (java::%jredefine-method class-name unique-method-name  (compile nil method-def))))
608
609(defun jruntime-class-exists-p (class-name)
610  "Returns true if a class named CLASS-NAME has been created and loaded by JNEW-RUNTIME-CLASS.
611   Needed because Java classes cannot be reloaded."
612  (when
613    (jstatic (jmethod "org.armedbear.lisp.RuntimeClass" "getRuntimeClass" "java.lang.String")
614             "org.armedbear.lisp.RuntimeClass"
615             class-name)
616    t))
Note: See TracBrowser for help on using the repository browser.