source: trunk/abcl/src/org/armedbear/lisp/Java.java

Last change on this file was 15761, checked in by Mark Evenson, 5 months ago

Differentiate STORAGE-CONDITION causes

A STORAGE-CONDITION may be signalled because of various causes which
we differentiate by unique messages as debugging them can be rather
mysterious.

CLHS entry: <https://novaspec.org/cl/t_storage-condition>

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 57.4 KB
Line 
1/*
2 * Java.java
3 *
4 * Copyright (C) 2002-2006 Peter Graves, Andras Simon
5 * $Id: Java.java 15761 2023-12-05 07:20:14Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38import java.lang.reflect.Array;
39import java.lang.reflect.Constructor;
40import java.lang.reflect.Field;
41import java.lang.reflect.InvocationTargetException;
42import java.lang.reflect.Method;
43import java.lang.reflect.Modifier;
44import java.text.MessageFormat;
45import java.math.BigInteger;
46import java.util.*;
47
48public final class Java
49{
50    static final Map<Class,Symbol> registeredExceptions =
51       new HashMap<Class,Symbol>();
52
53    private static final LispClass java_exception = LispClass.findClass(Symbol.JAVA_EXCEPTION);
54
55    static boolean isJavaException(LispClass lc)
56    {
57        return lc.subclassp(java_exception);
58    }
59
60    private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
61    @DocString(name="ensure-java-object", args="obj",
62    doc="Ensures OBJ is wrapped in a JAVA-OBJECT, wrapping it if necessary.")
63    private static final class pf_ensure_java_object extends Primitive
64    {
65        pf_ensure_java_object()
66        {
67            super("ensure-java-object", PACKAGE_JAVA, true);
68        }
69
70        @Override
71        public LispObject execute(LispObject obj) {
72            return obj instanceof JavaObject ? obj : new JavaObject(obj);
73        }
74    };
75
76    private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
77    @DocString(name="register-java-exception", // => T
78    args="exception-name condition-symbol",
79    doc="Registers the Java Throwable named by the symbol EXCEPTION-NAME as the condition " +
80        "designated by CONDITION-SYMBOL.  Returns T if successful, NIL if not.")
81    private static final class pf_register_java_exception extends Primitive
82    {
83        pf_register_java_exception()
84        {
85            super("register-java-exception", PACKAGE_JAVA, true);
86        }
87
88        @Override
89        public LispObject execute(LispObject className, LispObject symbol)
90
91        {
92            LispClass lispClass = (LispClass) LispClass.findClass(symbol, true);
93            // FIXME Signal a continuable error if the exception is already registered.
94            if (isJavaException(lispClass)) {
95                registeredExceptions.put(classForName(className.getStringValue()),
96                                         (Symbol)symbol);
97                return T;
98            }
99            return NIL;
100        }
101    };
102
103    private static final Primitive UNREGISTER_JAVA_EXCEPTION = new pf_unregister_java_exception();
104    @DocString(name="unregister-java-exception", args="exception-name",
105    doc="Unregisters the Java Throwable EXCEPTION-NAME previously registered" +
106        " by REGISTER-JAVA-EXCEPTION.")
107    private static final class pf_unregister_java_exception extends Primitive
108    {
109        pf_unregister_java_exception()
110        {
111            super("unregister-java-exception", PACKAGE_JAVA, true);
112        }
113
114        @Override
115        public LispObject execute(LispObject className)
116
117        {
118            // FIXME Verify that EXCEPTION-NAME designates a subclass of Throwable.
119            return registeredExceptions.remove(classForName(className.getStringValue())) == null ? NIL : T;
120        }
121    };
122
123    static Symbol getCondition(Class cl) {
124        Class o = classForName("java.lang.Object");
125        for (Class c = cl ; c != o ; c = c.getSuperclass()) {
126            Object object = registeredExceptions.get(c);
127            if (object instanceof Symbol) {
128                LispClass lispClass = (LispClass) LispClass.findClass((Symbol) object, true);
129                if(isJavaException(lispClass)) {
130                    return (Symbol) object;
131                }
132            }
133        }
134        return null;
135    }
136
137    private static final Primitive JCLASS = new pf_jclass();
138    @DocString(name="jclass", args="name-or-class-ref &optional class-loader",
139    doc="Returns a reference to the Java class designated by" +
140        " NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the" +
141        " class is resolved with respect to the given ClassLoader.")
142    private static final class pf_jclass extends Primitive
143    {
144
145        pf_jclass() 
146        {
147            super(Symbol.JCLASS);
148        }
149
150        @Override
151        public LispObject execute(LispObject arg)
152        {
153            return JavaObject.getInstance(javaClass(arg, JavaClassLoader.getCurrentClassLoader()));
154        }
155
156        @Override
157        public LispObject execute(LispObject className, LispObject classLoader)
158        {
159            ClassLoader loader = (ClassLoader) classLoader.javaInstance(ClassLoader.class);
160            return JavaObject.getInstance(javaClass(className, loader));
161        }
162    };
163
164    static final LispObject jfield(Primitive fun, LispObject[] args, boolean translate)
165
166    {
167        if (args.length < 2 || args.length > 4)
168            error(new WrongNumberOfArgumentsException(fun, 2, 4));
169        String fieldName = null;
170        Class c;
171        Field f;
172        Class fieldType;
173        Object instance = null;
174        try {
175            if (args[1] instanceof AbstractString) {
176                // Cases 1-5.
177                fieldName = args[1].getStringValue();
178                c = javaClass(args[0]);
179            } else {
180                // Cases 6 and 7.
181                fieldName = args[0].getStringValue();
182                instance = JavaObject.getObject(args[1]);
183                c = instance.getClass();
184            }
185            f = c.getField(fieldName);
186            fieldType = f.getType();
187            switch (args.length) {
188                case 2:
189                    // Cases 1 and 6.
190                    break;
191                case 3:
192                    // Cases 2,3, and 7.
193                    if (instance == null) {
194                        // Cases 2 and 3.
195                        if (args[2] instanceof JavaObject) {
196                            // Case 2.
197                            instance = JavaObject.getObject(args[2]);
198                            break;
199                        } else {
200                            // Case 3.
201                            f.set(null,args[2].javaInstance(fieldType));
202                            return args[2];
203                        }
204                    } else {
205                        // Case 7.
206                        f.set(instance,args[2].javaInstance(fieldType));
207                        return args[2];
208                    }
209                case 4:
210                    // Cases 4 and 5.
211                    if (args[2] != NIL) {
212                        // Case 4.
213                        instance = JavaObject.getObject(args[2]);
214                    }
215                    f.set(instance,args[3].javaInstance(fieldType));
216                    return args[3];
217            }
218            return JavaObject.getInstance(f.get(instance), translate, f.getType());
219        }
220        catch (NoSuchFieldException e) {
221            error(new LispError("no such field"));
222        }
223        catch (SecurityException e) {
224            error(new LispError("inaccessible field"));
225        }
226        catch (IllegalAccessException e) {
227            error(new LispError("illegal access"));
228        }
229        catch (IllegalArgumentException e) {
230            error(new LispError("illegal argument"));
231        }
232        // Not reached
233        return NIL;
234    }
235
236
237    private static final Primitive JFIELD = new pf_jfield();
238    @DocString(name="jfield",
239    args="class-ref-or-field field-or-instance &optional instance value",
240    doc="Retrieves or modifies a public field in a Java class or instance.\n\n"+
241        "Supported argument patterns:\n\n"+
242        "   Case 1: class-ref  field-name:\n"+
243        "      Retrieves the value of a static field.\n\n"+
244        "   Case 2: class-ref  field-name  instance-ref:\n"+
245        "      Retrieves the value of a class field of the instance.\n\n"+
246        "   Case 3: class-ref  field-name  primitive-value:\n"+
247        "      Stores a primitive-value in a static field.\n\n"+
248        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
249        "      Stores value in a class field of the instance.\n\n"+
250        "   Case 5: class-ref  field-name  nil  value:\n"+
251        "      Stores value in a static field (when value may be\n"+
252        "      confused with an instance-ref).\n\n"+
253        "   Case 6: field-name  instance:\n"+
254        "      Retrieves the value of a field of the instance. The\n"+
255        "      class is derived from the instance.\n\n"+
256        "   Case 7: field-name  instance  value:\n"+
257        "      Stores value in a field of the instance. The class is\n"+
258        "      derived from the instance.\n\n"
259        )
260    private static final class pf_jfield extends Primitive
261    {
262        pf_jfield() 
263        {
264            super("jfield", PACKAGE_JAVA, true);
265        }
266
267        @Override
268        public LispObject execute(LispObject[] args)
269        {
270            return jfield(this, args, true);
271        }
272    };
273
274    private static final Primitive JFIELD_RAW = new pf_jfield_raw();
275    @DocString(name="jfield",
276    args="class-ref-or-field field-or-instance &optional instance value",
277    doc="Retrieves or modifies a public field in a Java class or instance without\n"+
278        "attempting to coerce its value or the result into a Lisp object.\n\n"+
279        "Supported argument patterns:\n\n"+
280        "   Case 1: class-ref  field-name:\n"+
281        "      Retrieves the value of a static field.\n\n"+
282        "   Case 2: class-ref  field-name  instance-ref:\n"+
283        "      Retrieves the value of a class field of the instance.\n\n"+
284        "   Case 3: class-ref  field-name  primitive-value:\n"+
285        "      Stores a primitive-value in a static field.\n\n"+
286        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
287        "      Stores value in a class field of the instance.\n\n"+
288        "   Case 5: class-ref  field-name  nil  value:\n"+
289        "      Stores value in a static field (when value may be\n"+
290        "      confused with an instance-ref).\n\n"+
291        "   Case 6: field-name  instance:\n"+
292        "      Retrieves the value of a field of the instance. The\n"+
293        "      class is derived from the instance.\n\n"+
294        "   Case 7: field-name  instance  value:\n"+
295        "      Stores value in a field of the instance. The class is\n"+
296        "      derived from the instance.\n\n"
297        )
298    private static final class pf_jfield_raw extends Primitive
299    {
300        pf_jfield_raw() 
301        {
302            super("jfield-raw", PACKAGE_JAVA, true);
303        }
304
305        @Override
306        public LispObject execute(LispObject[] args)
307        {
308            return jfield(this, args, false);
309        }
310    };
311
312    private static final Primitive JCONSTRUCTOR = new pf_jconstructor();
313    @DocString(name="jconstructor", args="class-ref &rest parameter-class-refs",
314    doc="Returns a reference to the Java constructor of CLASS-REF with the" +
315        " given PARAMETER-CLASS-REFS.")
316    private static final class pf_jconstructor extends Primitive
317    {
318        pf_jconstructor() 
319        {
320            super("jconstructor", PACKAGE_JAVA, true);
321        }
322
323        @Override
324        public LispObject execute(LispObject[] args)
325        {
326            if (args.length < 1)
327                error(new WrongNumberOfArgumentsException(this, 1, -1));
328            try {
329                final Class<?> c = javaClass(args[0]);
330                int argCount = 0;
331                if (args.length == 2 && args[1] instanceof Fixnum) {
332                    argCount = Fixnum.getValue(args[1]);
333                } else {
334                    Class<?>[] parameterTypes = new Class[args.length-1];
335                    for (int i = 1; i < args.length; i++) {
336                        parameterTypes[i-1] = javaClass(args[i]);
337                    }
338                    return JavaObject.getInstance(c.getConstructor(parameterTypes));
339                }
340                // Parameter types not explicitly specified.
341                Constructor[] constructors = c.getConstructors();
342                for (int i = 0; i < constructors.length; i++) {
343                    Constructor constructor = constructors[i];
344                    if (constructor.getParameterTypes().length == argCount)
345                        return JavaObject.getInstance(constructor);
346                }
347                throw new NoSuchMethodException();
348            }
349            catch (NoSuchMethodException e) {
350                error(new LispError("no such constructor"));
351            }
352            catch (ControlTransfer e) {
353                throw e;
354            }
355            catch (Throwable t) { // ControlTransfer addressed above
356                error(new LispError(getMessage(t)));
357            }
358            // Not reached.
359            return NIL;
360        }
361    };
362
363    private static final Primitive JMETHOD = new pf_jmethod();
364
365    @DocString(name="jmethod", args="class-ref method-name &rest parameter-class-refs",
366    doc="Returns a reference to the Java method METHOD-NAME of CLASS-REF with the" +
367        " given PARAMETER-CLASS-REFS.")
368    private static final class pf_jmethod extends Primitive
369    {
370        pf_jmethod() 
371        {
372            super("jmethod", PACKAGE_JAVA, true);
373        }
374
375        @Override
376        public LispObject execute(LispObject[] args)
377        {
378            if (args.length < 2)
379                error(new WrongNumberOfArgumentsException(this, 2, -1));
380            final Class<?> c = javaClass(args[0]);
381            String methodName = args[1].getStringValue();
382            try {
383                int argCount = 0;
384                if (args.length == 3 && args[2] instanceof Fixnum) {
385                    argCount = ((Fixnum)args[2]).value;
386                } else {
387                    Class<?>[] parameterTypes = new Class[args.length-2];
388                    for (int i = 2; i < args.length; i++)
389                        parameterTypes[i-2] = javaClass(args[i]);
390                    return JavaObject.getInstance(c.getMethod(methodName,
391                                                              parameterTypes));
392                }
393                // Parameter types were not explicitly specified.
394                Method[] methods = c.getMethods();
395                for (int i = 0; i < methods.length; i++) {
396                    Method method = methods[i];
397                    if (method.getName().equals(methodName) &&
398                        method.getParameterTypes().length == argCount)
399                        return JavaObject.getInstance(method);
400                }
401                throw new NoSuchMethodException();
402            }
403            catch (NoSuchMethodException e) {
404                StringBuilder sb = new StringBuilder("No such method: ");
405                sb.append(c.getName());
406                sb.append('.');
407                sb.append(methodName);
408                sb.append('(');
409                for (int i = 2; i < args.length; i++) {
410                    sb.append(args[i].princToString());
411                    if (i < args.length - 1)
412                        sb.append(',');
413                }
414                sb.append(')');
415                error(new LispError(sb.toString()));
416            }
417            catch (ControlTransfer e) {
418                throw e;
419            }
420            catch (Throwable t) { // ControlTransfer addressed above
421                error(new LispError(getMessage(t)));
422            }
423            // Not reached.
424            return NIL;
425        }
426    };
427
428    static final LispObject jstatic(Primitive fun, LispObject[] args, boolean translate)
429
430    {
431        if (args.length < 2) {
432            error(new WrongNumberOfArgumentsException(fun, 2, -1));
433        }
434        try {
435            Method m = null;
436            Class c = null;
437            LispObject methodRef = args[0];
438            List<Method> staticMethods = new ArrayList<Method>();
439            String methodName = null;
440       
441            if (methodRef instanceof JavaObject) {
442                Object obj = ((JavaObject)methodRef).getObject();
443                if (obj instanceof Method) {
444                    staticMethods.add((Method) obj);
445                    methodName = ((Method)obj).getName();
446                } else {
447                    error(new LispError(methodRef +  "is not a valid reference to a Method"));
448                }
449            } else if (methodRef instanceof AbstractString) {
450                c = javaClass(args[1]);
451                if (c != null) {
452                    methodName = methodRef.getStringValue();
453                    Method[] methods = c.getMethods();
454                    int argCount = args.length - 2;
455                    for(Method m1 : methods) {
456                        if(Modifier.isStatic(m1.getModifiers())) {
457                            staticMethods.add(m1);
458                        }
459                    }
460                }
461            } else {
462                type_error(methodRef, Symbol.STRING);
463            }
464
465            if (staticMethods.size() > 0) {
466                m = findMethod(staticMethods.toArray(new Method[staticMethods.size()]),
467                               methodName, args, 2);
468            }
469            if (m == null) {
470              StringBuilder sb = new StringBuilder("No such static method: ");
471              String className = "<unknown>";
472              if (c != null) {
473                className = c.getName();
474              }
475              sb.append(className);
476              sb.append('.');
477              sb.append(methodName);
478              sb.append('(');
479              for (int i = 2; i < args.length; i++) {
480                LispObject argClass = Symbol.JCLASS_OF.execute(args[i]);
481                sb.append(argClass.princToString());
482                if (i < args.length - 1)
483                  sb.append(',');
484              }
485              sb.append(')');
486              error(new LispError(sb.toString()));
487            }
488
489            Object[] methodArgs = new Object[args.length-2];
490            Class[] argTypes = m.getParameterTypes();
491            for (int i = 2; i < args.length; i++) {
492                LispObject arg = args[i];
493                if (arg.equals(NIL)) {
494                  methodArgs[i-2] = false;
495                } else if (arg.equals(T)) {
496                  methodArgs[i-2] = true;
497                } else {
498                  methodArgs[i-2] = arg.javaInstance(argTypes[i-2]);
499                }
500            }
501            m.setAccessible(true);
502            Object result = null;
503            if (!m.isVarArgs()) {
504              result = m.invoke(null, methodArgs);
505            } else if (argTypes.length == 1) {
506              result = m.invoke(null, (Object)methodArgs);
507            } else {
508              Object[] objectArgs = new Object[methodArgs.length];
509              for (int i = 0; i < methodArgs.length; i++) {
510                objectArgs[i] = methodArgs[i];
511              }
512              result = m.invoke(null, objectArgs);
513            }
514            return JavaObject.getInstance(result, translate, m.getReturnType());
515        }
516        catch (ControlTransfer c) {
517            throw c;
518        }
519        catch (Throwable t) { // ControlTransfer handled above
520            if (t instanceof InvocationTargetException)
521                t = t.getCause();
522            Symbol condition = getCondition(t.getClass());
523            if (condition == null)
524                error(new JavaException(t));
525            else
526                Symbol.SIGNAL.execute(
527                    condition,
528                    Keyword.CAUSE,
529                    JavaObject.getInstance(t),
530                    Keyword.FORMAT_CONTROL,
531                    new SimpleString(getMessage(t)));
532        }
533        // Not reached.
534        return NIL;
535    }
536
537    private static final Primitive JSTATIC = new pf_jstatic();
538    @DocString(name="jstatic", args="method class &rest args",
539    doc="Invokes the static method METHOD on class CLASS with ARGS.")
540    private static final class pf_jstatic extends Primitive
541    {
542        pf_jstatic() 
543        {
544            super("jstatic", PACKAGE_JAVA, true);
545        }
546
547        @Override
548        public LispObject execute(LispObject[] args)
549        {
550            return jstatic(this, args, true);
551        }
552    };
553
554    private static final Primitive JSTATIC_RAW = new pf_jstatic_raw();
555    @DocString(name="jstatic-raw", args="method class &rest args",
556    doc="Invokes the static method METHOD on class CLASS with ARGS. Does not "+
557        "attempt to coerce the arguments or result into a Lisp object.")
558    private static final class pf_jstatic_raw extends Primitive
559    {
560        pf_jstatic_raw() 
561        {
562            super("jstatic-raw", PACKAGE_JAVA, true);
563        }
564
565        @Override
566        public LispObject execute(LispObject[] args)
567        {
568            return jstatic(this, args, false);
569        }
570    };
571
572    private static final Primitive JNEW = new pf_jnew();
573    @DocString(name="jnew", args="constructor &rest args",
574    doc="Invokes the Java constructor CONSTRUCTOR with the arguments ARGS.")
575    private static final class pf_jnew extends Primitive
576    {
577        pf_jnew()
578        {
579            super("jnew", PACKAGE_JAVA, true);
580        }
581
582        @Override
583        public LispObject execute(LispObject[] args)
584        {
585            if (args.length < 1)
586                error(new WrongNumberOfArgumentsException(this, 1, -1));
587            LispObject classRef = args[0];
588            try {
589                Constructor constructor;
590                if(classRef instanceof AbstractString) {
591                    constructor = findConstructor(javaClass(classRef), args);
592                } else {
593                    Object object = JavaObject.getObject(classRef);
594                    if(object instanceof Constructor) {
595                        constructor = (Constructor) object;
596                    } else if(object instanceof Class<?>) {
597                        constructor = findConstructor((Class<?>) object, args);
598                    } else {
599                        return error(new LispError(classRef.princToString() + " is neither a Constructor nor a Class"));
600                    }
601                }
602                Class[] argTypes = constructor.getParameterTypes();
603                Object[] initargs = new Object[args.length-1];
604                for (int i = 1; i < args.length; i++) {
605                    LispObject arg = args[i];
606                    if (arg.equals(NIL)) {
607                      initargs[i-1] = false ;
608                    } else if (arg.equals(T)) {
609                      initargs[i-1] = true;
610                    } else {
611                      initargs[i-1] = arg.javaInstance(argTypes[i-1]);
612                    }
613                }
614                return JavaObject.getInstance(constructor.newInstance(initargs));
615            }
616            catch (ControlTransfer c) {
617                throw c;
618            }
619            catch (Throwable t) { // ControlTransfer handled above
620                if (t instanceof InvocationTargetException)
621                    t = t.getCause();
622                Symbol condition = getCondition(t.getClass());
623                if (condition == null)
624                    error(new JavaException(t));
625                else
626                    Symbol.SIGNAL.execute(
627                        condition,
628                        Keyword.CAUSE,
629                        JavaObject.getInstance(t),
630                        Keyword.FORMAT_CONTROL,
631                        new SimpleString(getMessage(t)));
632            }
633            // Not reached.
634            return NIL;
635        }
636    };
637
638    private static final Primitive JNEW_ARRAY = new pf_jnew_array();
639    @DocString(name="jnew-array", args="element-type &rest dimensions",
640    doc="Creates a new Java array of type ELEMENT-TYPE, with the given" +
641        " DIMENSIONS.")
642    private static final class pf_jnew_array extends Primitive
643    {
644        pf_jnew_array()
645        {
646            super("jnew-array", PACKAGE_JAVA, true);
647        }
648
649        @Override
650        public LispObject execute(LispObject[] args)
651        {
652            if (args.length < 2)
653                error(new WrongNumberOfArgumentsException(this, 2, -1));
654            try {
655                Class c = javaClass(args[0]);
656                int[] dimensions = new int[args.length - 1];
657                for (int i = 1; i < args.length; i++)
658                    dimensions[i-1] = ((Integer)args[i].javaInstance()).intValue();
659                return JavaObject.getInstance(Array.newInstance(c, dimensions));
660            }
661            catch (Throwable t) { // no code -> no ControlTransfer
662                error(new JavaException(t));
663            }
664            // Not reached.
665            return NIL;
666        }
667    };
668
669    static final LispObject jarray_ref(Primitive fun, LispObject[] args, boolean translate)
670
671    {
672        if (args.length < 2)
673            error(new WrongNumberOfArgumentsException(fun, 2, -1));
674        try {
675            Object a = args[0].javaInstance();
676            for (int i = 1; i<args.length - 1; i++)
677                a = Array.get(a, ((Integer)args[i].javaInstance()).intValue());
678            return JavaObject.getInstance(Array.get(a,
679                    ((Integer)args[args.length - 1].javaInstance()).intValue()), translate);
680        }
681        catch (Throwable t) { // no code -> no ControlTransfer
682            Symbol condition = getCondition(t.getClass());
683            if (condition == null)
684                error(new JavaException(t));
685            else
686                Symbol.SIGNAL.execute(
687                    condition,
688                    Keyword.CAUSE,
689                    JavaObject.getInstance(t),
690                    Keyword.FORMAT_CONTROL,
691                    new SimpleString(getMessage(t)));
692        }
693        // Not reached.
694        return NIL;
695    }
696
697    private static final Primitive JARRAY_REF = new pf_jarray_ref();
698    @DocString(name="jarray-ref", args="java-array &rest indices",
699    doc="Dereferences the Java array JAVA-ARRAY using the given INDICES, " +
700        "coercing the result into a Lisp object, if possible.")
701    private static final class pf_jarray_ref extends Primitive
702    {
703        pf_jarray_ref()
704        {
705            super("jarray-ref", PACKAGE_JAVA, true);
706        }
707
708        @Override
709        public LispObject execute(LispObject[] args)
710        {
711            return jarray_ref(this, args, true);
712        }
713    };
714
715    private static final Primitive JARRAY_REF_RAW = new pf_jarray_ref_raw();
716    @DocString(name="jarray-ref-raw", args="java-array &rest indices",
717    doc="Dereference the Java array JAVA-ARRAY using the given INDICES. " +
718        "Does not attempt to coerce the result into a Lisp object.")
719    private static final class pf_jarray_ref_raw extends Primitive
720    {
721        pf_jarray_ref_raw() 
722        {
723            super("jarray-ref-raw", PACKAGE_JAVA, true);
724        }
725
726        @Override
727        public LispObject execute(LispObject[] args)
728        {
729            return jarray_ref(this, args, false);
730        }
731    };
732
733    private static final Primitive JARRAY_SET = new pf_jarray_set();
734    @DocString(name="jarray-set", args="java-array new-value &rest indices",
735    doc="Stores NEW-VALUE at the given INDICES in JAVA-ARRAY.")
736    private static final class pf_jarray_set extends Primitive
737    {
738        pf_jarray_set()
739        {
740            super("jarray-set", PACKAGE_JAVA, true);
741        }
742
743        @Override
744        public LispObject execute(LispObject[] args)
745        {
746            if (args.length < 3)
747                error(new WrongNumberOfArgumentsException(this, 3, -1));
748            try {
749                Object a = args[0].javaInstance();
750                LispObject v = args[1];
751                for (int i = 2; i<args.length - 1; i++)
752                    a = Array.get(a, ((Integer)args[i].javaInstance()).intValue());
753                Object value = v.javaInstance();
754                int index = ((Integer)args[args.length - 1].javaInstance()).intValue();
755                if (value instanceof java.lang.Number) {
756                  Class type = a.getClass().getComponentType();
757                  Number number = (java.lang.Number)value;
758                  if (type.equals(Byte.TYPE)) {
759                    Array.setByte(a, index, number.byteValue());
760                  } else if (type.equals(Short.TYPE)) {
761                    Array.setShort(a, index, number.shortValue()); 
762                  } else if (type.equals(Character.TYPE)) {
763                    Array.setChar(a, index, (char)number.intValue()); // FIXME: value out of range
764                  } else if (type.equals(Integer.TYPE)) {
765                    Array.setInt(a, index, number.intValue()); 
766                  } else if (type.equals(Long.TYPE)) {
767                    Array.setLong(a, index, number.longValue()); 
768                  } else if (type.equals(Float.TYPE)) {
769                    Array.setFloat(a, index, number.floatValue()); 
770                  } else if (type.equals(Double.TYPE)) {
771                    Array.setDouble(a, index, number.doubleValue()); 
772                  } else if (type.equals(Boolean.TYPE)) {
773                    Array.setBoolean(a, index, number.equals(0) ? false : true); 
774                  } else {
775                    Array.set(a, index, value);
776                  }
777                } else {
778                    Array.set(a, index, value);
779                }
780                return v;
781            }
782            catch (Throwable t) { // no code -> no ControlTransfer
783                Symbol condition = getCondition(t.getClass());
784                if (condition == null)
785                    error(new JavaException(t));
786                else
787                    Symbol.SIGNAL.execute(
788                        condition,
789                        Keyword.CAUSE,
790                        JavaObject.getInstance(t),
791                        Keyword.FORMAT_CONTROL,
792                        new SimpleString(getMessage(t)));
793            }
794            // Not reached.
795            return NIL;
796        }
797    };
798
799    /**  Calls makeLispObject() to convert the result to an appropriate Lisp type. */
800    private static final Primitive JCALL = new pf_jcall();
801    @DocString(name="jcall", args="method-ref instance &rest args",
802    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS," +
803        " coercing the result into a Lisp object, if possible.")
804    private static final class pf_jcall extends Primitive
805    {
806        pf_jcall()
807        {
808            super(Symbol.JCALL);
809        }
810
811        @Override
812        public LispObject execute(LispObject[] args)
813        {
814            return jcall(this, args, true);
815        }
816    };
817
818    /**
819     * Does no type conversion. The result of the call is simply wrapped in a
820     *   JavaObject.
821     */
822    private static final Primitive JCALL_RAW = new pf_jcall_raw();
823    @DocString(name="jcall-raw", args="method-ref instance &rest args",
824    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS." +
825        " Does not attempt to coerce the result into a Lisp object.")
826    private static final class pf_jcall_raw extends Primitive
827    {
828        pf_jcall_raw()
829        {
830            super(Symbol.JCALL_RAW);
831        }
832
833        @Override
834        public LispObject execute(LispObject[] args)
835        {
836            return jcall(this, args, false);
837        }
838    };
839
840    private static final Primitive JRESOLVE_METHOD = new pf_jresolve_method();
841    @DocString(name="jresolve-method", args="method-name instance &rest args",
842    doc="Finds the most specific Java method METHOD-NAME on INSTANCE " +
843        "applicable to arguments ARGS. Returns NIL if no suitable method is " +
844        "found. The algorithm used for resolution is the same used by JCALL " +
845        "when it is called with a string as the first parameter (METHOD-REF).")
846    private static final class pf_jresolve_method extends Primitive {
847        pf_jresolve_method() {
848            super(Symbol.JRESOLVE_METHOD);
849        }
850
851        @Override
852        public LispObject execute(LispObject[] args) {
853            if (args.length < 2) {
854                error(new WrongNumberOfArgumentsException(this, 2, -1));
855            }
856            final LispObject methodArg = args[0];
857            final LispObject instanceArg = args[1];
858            final Object instance;
859            Class<?> intendedClass = null;
860            if (instanceArg instanceof AbstractString) {
861                instance = instanceArg.getStringValue();
862            } else if (instanceArg instanceof JavaObject) {
863                JavaObject jobj = ((JavaObject)instanceArg);
864                instance = jobj.getObject();
865                intendedClass = jobj.getIntendedClass();
866            } else {
867                instance = instanceArg.javaInstance();
868            }
869            if(instance == null) {
870                return program_error("JRESOLVE-METHOD: instance must not be null.");
871            }
872            String methodName = methodArg.getStringValue();
873            Object[] methodArgs = translateMethodArguments(args, 2);
874            Method method = findMethod(instance, intendedClass, methodName, methodArgs);
875            if (method != null) {
876                return JavaObject.getInstance(method);
877            } else if (instanceArg instanceof JavaObject) {
878                // Sometimes JavaObject.intendedClass has the default
879                // value java.lang.Object, so we try again to resolve
880                // the method using a dynamically requested value for
881                // java.lang.Class.
882                intendedClass = ((JavaObject)instanceArg).getObject().getClass();
883                method = findMethod(instance, intendedClass, methodName, methodArgs);
884            } else {
885                return NIL;
886            }
887            if (method != null) {
888                return JavaObject.getInstance(method);
889            } else {
890                return NIL;
891            }
892        }
893    };
894
895    static LispObject jcall(Primitive fun, LispObject[] args, boolean translate)
896
897    {
898        if (args.length < 2)
899            error(new WrongNumberOfArgumentsException(fun, 2, -1));
900        try {
901            final LispObject methodArg = args[0];
902            final LispObject instanceArg = args[1];
903            final Object instance;
904            Method method;
905            Object[] methodArgs;
906            Class<?> intendedClass = null;
907            if (instanceArg instanceof AbstractString) {
908                instance = instanceArg.getStringValue();
909            } else if (instanceArg instanceof JavaObject) {
910                JavaObject jobj = ((JavaObject)instanceArg);
911                instance = jobj.getObject();
912                intendedClass = jobj.getIntendedClass();
913            } else {
914                instance = instanceArg.javaInstance();
915            }
916            if(instance == null) {
917                throw new NullPointerException(); //Handled below
918            }
919            if (methodArg instanceof AbstractString) {
920                String methodName = methodArg.getStringValue();
921                methodArgs = translateMethodArguments(args, 2);
922                method = findMethod(instance, intendedClass, methodName, methodArgs);
923                if (method == null) {
924                    if (intendedClass == null) {
925                        String msg = MessageFormat.format("No instance method named {0} found for type {1}", methodName, instance.getClass().getName());
926                        throw new NoSuchMethodException(msg);
927                    }
928                    String classes = intendedClass.getName();
929                    Class<?> actualClass = instance.getClass();
930                    if(actualClass != intendedClass) {
931                        classes += " or " + actualClass.getName();
932                    }
933                    throw new NoSuchMethodException("No applicable method named " + methodName + " found in " + classes);
934                }
935            } else
936                method = (Method) JavaObject.getObject(methodArg);
937            Class<?>[] argTypes = (Class<?>[])method.getParameterTypes();
938            if(argTypes.length != args.length - 2) {
939                return error(new WrongNumberOfArgumentsException("Wrong number of arguments for " + method + ": expected " + argTypes.length + ", got " + (args.length - 2)));
940            }
941            methodArgs = new Object[argTypes.length];
942            for (int i = 2; i < args.length; i++) {
943              LispObject arg = args[i];
944              if (arg.equals(NIL)) {
945                methodArgs[i-2] = false;
946              } else if (arg.equals(T)) {
947                methodArgs[i-2] = true;
948              } else {
949                methodArgs[i-2] = arg.javaInstance(argTypes[i-2]);
950              }
951            }
952            if (!method.isAccessible()) {
953                 // Possible for static member classes: see #229
954                 if (Modifier.isPublic(method.getModifiers())) { 
955                      method.setAccessible(true);
956                 }
957            }
958            return JavaObject.getInstance(method.invoke(instance, methodArgs),
959                                          translate,
960                                          method.getReturnType());
961        }
962        catch (ControlTransfer t) {
963            throw t;
964        }
965        catch (Throwable t) { // ControlTransfer handled above
966            if (t instanceof InvocationTargetException)
967                t = t.getCause();
968            Symbol condition = getCondition(t.getClass());
969            if (condition == null)
970                error(new JavaException(t));
971            else
972                Symbol.SIGNAL.execute(
973                    condition,
974                    Keyword.CAUSE,
975                    JavaObject.getInstance(t),
976                    Keyword.FORMAT_CONTROL,
977                    new SimpleString(getMessage(t)));
978        }
979        // Not reached.
980        return null;
981    }
982
983    private static Object[] translateMethodArguments(LispObject[] args) {
984        return translateMethodArguments(args, 0);
985    }
986
987    private static Object[] translateMethodArguments(LispObject[] args, int offs) {
988        int argCount = args.length - offs;
989        Object[] javaArgs = new Object[argCount];
990        for (int i = 0; i < argCount; ++i) {
991          Object x = args[i + offs];
992          if (x.equals(NIL)) {
993            javaArgs[i] = false;
994          } else if (x.equals(T)) {
995            javaArgs[i] = true;
996          } else {
997            javaArgs[i] = ((LispObject) x).javaInstance();
998          }
999        }
1000        return javaArgs;
1001    }
1002
1003    private static Method findMethod(Method[] methods, String methodName, Object[] javaArgs) {
1004        int argCount = javaArgs.length;
1005        Method result = null;
1006        for (int i = methods.length; i-- > 0;) {
1007            Method method = methods[i];
1008            if (!method.getName().equals(methodName)) {
1009                continue;
1010            }
1011            if (method.getParameterTypes().length != argCount) {
1012                continue;
1013            }
1014            Class<?>[] methodTypes = (Class<?>[]) method.getParameterTypes();
1015            if (!isApplicableMethod(methodTypes, javaArgs)) {
1016                continue;
1017            }
1018            if (result == null || isMoreSpecialized(methodTypes, result.getParameterTypes())) {
1019                result = method;
1020            }
1021        }
1022        return result;
1023    }
1024
1025    private static Method findMethod(Object instance, Class<?> intendedClass, String methodName, Object[] methodArgs) {
1026        if(intendedClass == null) {
1027            intendedClass = instance.getClass();
1028        }
1029        Method method = findMethod(intendedClass, methodName, methodArgs);
1030        Class actualClass = null;
1031        if(method == null) {
1032            actualClass = instance.getClass();
1033            if(intendedClass != actualClass) { 
1034                method = findMethod(actualClass, methodName, methodArgs);
1035                if (method != null) {
1036                   if (isMethodCallableOnInstance(actualClass, method)) {
1037                      return method;
1038                   }
1039                }
1040            }
1041        }
1042        return method;
1043    }
1044   
1045    private static boolean isMethodCallableOnInstance(Class instance, Method method) {
1046       if (Modifier.isPublic(method.getModifiers())) {
1047          return true;
1048       }
1049       if (instance.isMemberClass()) {
1050          return isMethodCallableOnInstance(instance.getEnclosingClass(), method);
1051       }
1052       return false;
1053    }
1054
1055    private static Method findMethod(Class<?> c, String methodName, Object[] javaArgs) {
1056        Method[] methods = c.getMethods();
1057        return findMethod(methods, methodName, javaArgs);
1058    }
1059
1060    private static Method findMethod(Class<?> c, String methodName, LispObject[] args, int offset) {
1061        Object[] javaArgs = translateMethodArguments(args, offset);
1062        return findMethod(c, methodName, javaArgs);
1063    }
1064
1065    private static Method findMethod(Method[] methods, String methodName, LispObject[] args, int offset) {
1066        Object[] javaArgs = translateMethodArguments(args, offset);
1067        return findMethod(methods, methodName, javaArgs);
1068    }
1069
1070    static Constructor findConstructor(Class<?> c, LispObject[] args) throws NoSuchMethodException {
1071        int argCount = args.length - 1;
1072        Object[] javaArgs = translateMethodArguments(args, 1);
1073        Constructor[] ctors = c.getConstructors();
1074        Constructor result = null;
1075        for (int i = ctors.length; i-- > 0;) {
1076            Constructor ctor = ctors[i];
1077            if (ctor.getParameterTypes().length != argCount) {
1078                continue;
1079            }
1080            Class<?>[] methodTypes = (Class<?>[]) ctor.getParameterTypes();
1081            if (!isApplicableMethod(methodTypes, javaArgs)) {
1082                continue;
1083            }
1084            if (result == null || isMoreSpecialized(methodTypes, result.getParameterTypes())) {
1085                result = ctor;
1086            }
1087        }
1088        if (result == null) {
1089            StringBuilder sb = new StringBuilder(c.getSimpleName());
1090            sb.append('(');
1091            boolean first = true;
1092            for(Object o : javaArgs) {
1093                if(first) {
1094                    first = false;
1095                } else {
1096                    sb.append(", ");
1097                }
1098                if(o != null) {
1099                    sb.append(o.getClass().getName());
1100                } else {
1101                    sb.append("<null>");
1102                }
1103            }
1104            sb.append(')');
1105            throw new NoSuchMethodException(sb.toString());
1106        }
1107        return result;
1108    }
1109
1110    private static boolean isAssignable(Class<?> from, Class<?> to) {
1111        from = maybeBoxClass(from);
1112        to = maybeBoxClass(to);
1113        if (to.isAssignableFrom(from)) {
1114            return true;
1115        }
1116        if (Byte.class.equals(from)) {
1117            return Short.class.equals(to) || Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to);
1118        } else if (Short.class.equals(from) || Character.class.equals(from)) {
1119            return Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to);
1120        } else if (Integer.class.equals(from)) {
1121            return Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to);
1122        } else if (Long.class.equals(from)) {
1123            return Float.class.equals(to) || Double.class.equals(to);
1124        } else if (Float.class.equals(from)) {
1125            return Double.class.equals(to);
1126        } else if (from.isArray() && to.isArray()) {
1127            // for now just indicate that anything is assignable to an
1128            // java.lang.Object[], as this is the most common case
1129            if (to.getComponentType().equals(java.lang.Object.class)) {
1130                return true;
1131            }
1132        }
1133        return false;
1134    }
1135
1136    private static boolean isApplicableMethod(Class<?>[] methodTypes,
1137            Object[] args) {
1138        for (int i = 0; i < methodTypes.length; ++i) {
1139            Class<?> methodType = methodTypes[i];
1140            Object arg = args[i];
1141            if (arg == null) {
1142                return !methodType.isPrimitive();
1143            } else if (!isAssignableWithValue(arg.getClass(), methodType, arg)) {
1144                return false;
1145            }
1146        }
1147        return true;
1148    }
1149
1150    private static boolean isAssignableWithValue(Class<?> from, Class<?> to, Object value) {
1151        if (isAssignable(from, to)) {
1152            return true;
1153        }
1154        if (!(value instanceof Number)) {
1155            return false;
1156        }
1157        from = maybeBoxClass(from);
1158        to = maybeBoxClass(to);
1159        if (Integer.class.equals(from)) {
1160            int v = ((java.lang.Number)value).intValue();
1161
1162            if (Short.class.equals(to)
1163                && Short.MAX_VALUE >= v
1164                && v >= Short.MIN_VALUE) {
1165                return true;
1166            }
1167            if (Byte.class.equals(to)
1168                && 255 >= v
1169                && v >= 0) {
1170                return true;
1171            }
1172        // Java 8 introduces BigInteger.longValueExact() which will make the following much easier
1173        } else if (BigInteger.class.equals(from)) {
1174            // ??? should only need to check for possible conversion to longs
1175            BigInteger v = (java.math.BigInteger) value;
1176            final BigInteger maxLong = BigInteger.valueOf(Long.MAX_VALUE);
1177            final BigInteger minLong = BigInteger.valueOf(Long.MIN_VALUE);
1178            if (Long.class.equals(to)
1179                && ((v.compareTo(maxLong) == -1)
1180                    || (v.compareTo(maxLong) == 0))
1181                && ((v.compareTo(minLong) == 1)
1182                    || (v.compareTo(minLong) == 0))) {
1183                return true;
1184            }
1185        }
1186
1187        return false;
1188    }
1189
1190    private static boolean isMoreSpecialized(Class<?>[] xtypes, Class<?>[] ytypes) {
1191        for (int i = 0; i < xtypes.length; ++i) {
1192            Class<?> xtype = maybeBoxClass(xtypes[i]);
1193            Class<?> ytype = maybeBoxClass(ytypes[i]);
1194            if (xtype.equals(ytype)) {
1195                continue;
1196            }
1197            if (isAssignable(xtype, ytype)) {
1198                return true;
1199            }
1200        }
1201        return false;
1202    }
1203
1204    public static Class<?> maybeBoxClass(Class<?> clazz) {
1205        if(clazz.isPrimitive()) {
1206            return getBoxedClass(clazz);
1207        } else {
1208            return clazz;
1209        }
1210    }
1211   
1212    private static Class<?> getBoxedClass(Class<?> clazz) {
1213        if (clazz.equals(int.class)) {
1214            return Integer.class;
1215        } else if (clazz.equals(boolean.class)) {
1216            return Boolean.class;
1217        } else if (clazz.equals(byte.class)) {
1218            return Byte.class;
1219        } else if (clazz.equals(char.class)) {
1220            return Character.class;
1221        } else if (clazz.equals(long.class)) {
1222            return Long.class;
1223        } else if (clazz.equals(float.class)) {
1224            return Float.class;
1225        } else if (clazz.equals(double.class)) {
1226            return Double.class;
1227        } else if (clazz.equals(short.class)) {
1228            return Short.class;
1229        } else { // if (methodType.equals(void.class))
1230            return Void.class;
1231        }
1232    }
1233
1234    // DEPRECATED Remove MAKE-IMMEDIATE-OBJECT in abcl-0.29
1235    private static final Primitive MAKE_IMMEDIATE_OBJECT = new pf_make_immediate_object();
1236    @DocString(name="make-immediate-object", args="object &optional type",
1237    doc="Attempts to coerce a given Lisp object into a java-object of the\n"
1238      + "given type.  If type is not provided, works as jobject-lisp-value.\n"
1239      + "Currently, type may be :BOOLEAN, treating the object as a truth value,\n"
1240      + "or :REF, which returns Java null if NIL is provided.\n"
1241      + "\n"
1242      + "Deprecated.  Please use JAVA:+NULL+, JAVA:+TRUE+, and JAVA:+FALSE+ for\n"
1243      + "constructing wrapped primitive types, JAVA:JOBJECT-LISP-VALUE for converting a\n"
1244      + "JAVA:JAVA-OBJECT to a Lisp value, or JAVA:JNULL-REF-P to distinguish a wrapped\n"
1245      + "null JAVA-OBJECT from NIL.")
1246    private static final class pf_make_immediate_object extends Primitive
1247    {
1248        pf_make_immediate_object()
1249        {
1250            super("make-immediate-object", PACKAGE_JAVA, true);
1251        }
1252
1253        @Override
1254        public LispObject execute(LispObject[] args)
1255        {
1256            Symbol.WARN.getSymbolFunction()
1257                .execute(new SimpleString("JAVA:MAKE-IMMEDIATE-OBJECT is deprecated."));
1258            if (args.length < 1)
1259                error(new WrongNumberOfArgumentsException(this, 1, -1));
1260            LispObject object = args[0];
1261            if (args.length > 1) {
1262                LispObject type = args[1];
1263                if (type == Keyword.BOOLEAN) {
1264                    if (object == NIL)
1265                        return JavaObject.getInstance(Boolean.FALSE);
1266                    else
1267                        return JavaObject.getInstance(Boolean.TRUE);
1268                }
1269                if (type == Keyword.REF) {
1270                    if (object == NIL)
1271                        return JavaObject.getInstance(null);
1272                    else
1273                        error(new LispError("MAKE-IMMEDIATE-OBJECT: not implemented"));
1274                }
1275                // other special cases come here
1276            }
1277            return JavaObject.getInstance(object.javaInstance());
1278        }
1279    };
1280
1281    private static final Primitive JNULL_REF_P = new pf_jnull_ref_p();
1282    @DocString(name="jnull-ref-p", args="object",
1283    doc="Returns a non-NIL value when the JAVA-OBJECT `object` is `null`,\n"
1284            + "or signals a TYPE-ERROR condition if the object isn't of\n"
1285            + "the right type.")
1286    private static final class pf_jnull_ref_p extends Primitive
1287    {
1288        pf_jnull_ref_p()
1289        {
1290            super("jnull-ref-p", PACKAGE_JAVA, true);
1291        }
1292
1293        @Override
1294        public LispObject execute(LispObject ref)
1295        {
1296            if (ref instanceof JavaObject)
1297            {
1298                JavaObject jref = (JavaObject)ref;
1299                return (jref.javaInstance() == null) ? T : NIL;
1300            } else
1301                return Lisp.type_error(ref, Symbol.JAVA_OBJECT);
1302        }
1303    };
1304
1305
1306    private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
1307    @DocString(name="java-object-p", args="object",
1308    doc="Returns T if OBJECT is a JAVA-OBJECT.")
1309    private static final class pf_java_object_p extends Primitive
1310    {
1311        pf_java_object_p() 
1312        {
1313            super("java-object-p", PACKAGE_JAVA, true);
1314        }
1315
1316        @Override
1317        public LispObject execute(LispObject arg)
1318        {
1319            return (arg instanceof JavaObject) ? T : NIL;
1320        }
1321    };
1322
1323    private static final Primitive JOBJECT_LISP_VALUE = new pf_jobject_lisp_value();
1324    @DocString(name="jobject-lisp-value", args="java-object",
1325    doc="Attempts to coerce JAVA-OBJECT into a Lisp object.")
1326    private static final class pf_jobject_lisp_value extends Primitive
1327    {
1328        pf_jobject_lisp_value()
1329        {
1330            super("jobject-lisp-value", PACKAGE_JAVA, true, "java-object");
1331        }
1332
1333        @Override
1334        public LispObject execute(LispObject arg)
1335        {
1336            return JavaObject.getInstance(arg.javaInstance(), true);
1337        }
1338    };
1339
1340    private static final Primitive JCOERCE = new pf_jcoerce();
1341    @DocString(name="jcoerce", args="object intended-class",
1342    doc="Attempts to coerce OBJECT into a JavaObject of class INTENDED-CLASS." +
1343        "  Raises a TYPE-ERROR if no conversion is possible.")
1344    private static final class pf_jcoerce extends Primitive
1345    {
1346        pf_jcoerce()
1347        {
1348            super("jcoerce", PACKAGE_JAVA, true);
1349        }
1350
1351        @Override
1352        public LispObject execute(LispObject javaObject, LispObject intendedClass)
1353        {
1354            Object o = javaObject.javaInstance();
1355            Class<?> c = javaClass(intendedClass);
1356            try {
1357                return JavaObject.getInstance(o, c);
1358            } catch(ClassCastException e) {
1359          return type_error(javaObject, new SimpleString(c.getName()));
1360            }
1361        }
1362    };
1363
1364    private static final Primitive JRUN_EXCEPTION_PROTECTED = new pf_jrun_exception_protected();
1365    @DocString(name="jrun-exception-protected", args="closure",
1366    doc="Invokes the function CLOSURE and returns the result.  "+
1367        "Signals an error if stack or heap exhaustion occurs.")
1368    private static final class pf_jrun_exception_protected extends Primitive
1369    {
1370        pf_jrun_exception_protected()
1371        {
1372            super("jrun-exception-protected", PACKAGE_JAVA, true);
1373        }
1374
1375        @Override
1376        public LispObject execute(LispObject closure) {
1377            Function fun = checkFunction(closure);
1378
1379            try {
1380                return LispThread.currentThread().execute(closure);
1381            }
1382            catch (OutOfMemoryError oom) {
1383                return error(new StorageCondition("Out of memory " + oom.getMessage()));
1384            }
1385            catch (StackOverflowError oos) {
1386                oos.printStackTrace();
1387                return error(new StorageCondition("Stack overflow encountered in closure execution"));
1388            }
1389        }
1390    };
1391
1392    private static Class classForName(String className) {
1393        return classForName(className, JavaClassLoader.getPersistentInstance());
1394    }
1395
1396  private static Class classForName(String className,
1397                                    ClassLoader classLoader) {
1398    try {
1399      if (!className.endsWith("[]")) {
1400        return Class.forName(className, true, classLoader);
1401      } else {
1402        // <https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.2>
1403        if (className.startsWith("byte")) {
1404          return Class.forName("[B");
1405        } else if (className.startsWith("char")) {
1406          return Class.forName("[C");
1407        } else if (className.startsWith("double")) {
1408          return Class.forName("[D");
1409        } else if (className.startsWith("float")) {
1410          return Class.forName("[F");
1411        } else if (className.startsWith("int")) {
1412          return Class.forName("[I");
1413        } else if (className.startsWith("long")) {
1414          return Class.forName("[J");
1415        } else if (className.startsWith("short")) {
1416          return Class.forName("[S");
1417        } else if (className.startsWith("boolean")) {
1418          return Class.forName("[Z");
1419        } else {
1420          final String arrayTypeName
1421            = "[L" + className.substring(0, className.length() - 2) + ";";
1422          return Class.forName(arrayTypeName); 
1423        }
1424      }
1425    } catch (ClassNotFoundException e) {
1426      error(new LispError("Class not found: " + className));
1427      // Not reached.
1428      return null;
1429    }
1430  }
1431
1432    private static Class javaClass(LispObject obj) {
1433        return javaClass(obj, JavaClassLoader.getCurrentClassLoader());
1434    }
1435
1436    // Supports Java primitive types too.
1437    static Class javaClass(LispObject obj, ClassLoader classLoader)
1438    {
1439        if (obj instanceof AbstractString || obj instanceof Symbol) {
1440            String s = javaString(obj);
1441            if (s.equals("boolean"))
1442                return Boolean.TYPE;
1443            if (s.equals("byte"))
1444                return Byte.TYPE;
1445            if (s.equals("char"))
1446                return Character.TYPE;
1447            if (s.equals("short"))
1448                return Short.TYPE;
1449            if (s.equals("int"))
1450                return Integer.TYPE;
1451            if (s.equals("long"))
1452                return Long.TYPE;
1453            if (s.equals("float"))
1454                return Float.TYPE;
1455            if (s.equals("double"))
1456                return Double.TYPE;
1457            // Not a primitive Java type.
1458            Class c;
1459            c = classForName(s, classLoader);
1460            if (c == null)
1461                error(new LispError(s + " does not designate a Java class."));
1462
1463            return c;
1464        }
1465        // It's not a string, so it must be a JavaObject.
1466        final JavaObject javaObject;
1467        if (obj instanceof JavaObject) {
1468            javaObject = (JavaObject) obj;
1469        }
1470        else {
1471            type_error(obj, list(Symbol.OR, Symbol.STRING,
1472                                       Symbol.JAVA_OBJECT));
1473            // Not reached.
1474            return null;
1475        }
1476        final Object javaObjectgetObject = javaObject.getObject();
1477        if (javaObjectgetObject instanceof Class) {
1478            return (Class) javaObjectgetObject;
1479        }
1480            error(new LispError(obj.princToString() + " does not designate a Java class."));
1481            return null;
1482    }
1483
1484    static final String getMessage(Throwable t)
1485    {
1486        String message = t.getMessage();
1487        if (message == null || message.length() == 0)
1488            message = t.getClass().getName();
1489        return message;
1490    }
1491
1492  // FIXME: better handled as a Lisp symbol?  With a Java enum, the
1493  // compiler probably has a better chance to optimize.
1494  public static class Buffers {
1495    public enum AllocationPolicy { PRIMITIVE_ARRAY, NIO; };
1496    public static AllocationPolicy active = AllocationPolicy.NIO;
1497  }
1498 
1499}
Note: See TracBrowser for help on using the repository browser.