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

Last change on this file was 15569, checked in by Mark Evenson, 2 years ago

Untabify en masse

Results of running style.org source blocks on tree
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.4 KB
Line 
1/*
2 * Function.java
3 *
4 * Copyright (C) 2002-2005 Peter Graves
5 * $Id: Function.java 15569 2022-03-19 12:50:18Z 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 java.io.*;
37import java.io.ByteArrayInputStream;
38import java.io.ByteArrayOutputStream;
39
40import static org.armedbear.lisp.Lisp.*;
41
42public abstract class Function extends Operator implements Serializable {
43    private LispObject propertyList = NIL;
44    private int callCount;
45    private int hotCount;
46    /**
47     * The value of *load-truename* which was current when this function
48     * was loaded, used for fetching the class bytes in case of disassembly.
49     */
50    public final LispObject loadedFrom;
51
52    protected Function() {
53        LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValueNoThrow();
54        LispObject loadTruenameFasl = Symbol.LOAD_TRUENAME_FASL.symbolValueNoThrow();
55        loadedFrom = loadTruenameFasl != null ? loadTruenameFasl : (loadTruename != null ? loadTruename : NIL);
56    }
57
58    public Function(String name)
59    {
60        this(name, (String)null);
61    }
62
63    public Function(String name, String arglist)
64    {
65        this();
66        if(arglist != null)
67            setLambdaList(new SimpleString(arglist));
68        if (name != null) {
69            Symbol symbol = Symbol.addFunction(name.toUpperCase(), this);
70            if (cold)
71                symbol.setBuiltInFunction(true);
72            setLambdaName(symbol);
73        }
74    }
75
76    public Function(Symbol symbol)
77    {
78        this(symbol, null, null);
79    }
80
81    public Function(Symbol symbol, String arglist)
82    {
83        this(symbol, arglist, null);
84    }
85
86    public Function(Symbol symbol, String arglist, String docstring)
87    {
88        this();
89        symbol.setSymbolFunction(this);
90        if (cold)
91            symbol.setBuiltInFunction(true);
92        setLambdaName(symbol);
93        if(arglist != null)
94            setLambdaList(new SimpleString(arglist));
95        if (docstring != null)
96            symbol.setDocumentation(Symbol.FUNCTION,
97                                    new SimpleString(docstring));
98    }
99
100    public Function(String name, Package pkg)
101    {
102        this(name, pkg, false);
103    }
104
105    public Function(String name, Package pkg, boolean exported)
106    {
107        this(name, pkg, exported, null, null);
108    }
109
110    public Function(String name, Package pkg, boolean exported,
111                    String arglist)
112    {
113        this(name, pkg, exported, arglist, null);
114    }
115
116    public Function(String name, Package pkg, boolean exported,
117                    String arglist, String docstring)
118    {
119        this();
120        if (arglist instanceof String)
121            setLambdaList(new SimpleString(arglist));
122        if (name != null) {
123            Symbol symbol;
124            if (exported)
125                symbol = pkg.internAndExport(name.toUpperCase());
126            else
127                symbol = pkg.intern(name.toUpperCase());
128            symbol.setSymbolFunction(this);
129            if (cold)
130                symbol.setBuiltInFunction(true);
131            setLambdaName(symbol);
132            if (docstring != null)
133                symbol.setDocumentation(Symbol.FUNCTION,
134                                        new SimpleString(docstring));
135        }
136    }
137
138    public Function(LispObject name)
139    {
140        this();
141        setLambdaName(name);
142    }
143
144    public Function(LispObject name, LispObject lambdaList)
145    {
146        this();
147        setLambdaName(name);
148        setLambdaList(lambdaList);
149    }
150
151    @Override
152    public LispObject typeOf()
153    {
154        return Symbol.FUNCTION;
155    }
156
157    @Override
158    public LispObject classOf()
159    {
160        return BuiltInClass.FUNCTION;
161    }
162
163    @Override
164    public LispObject typep(LispObject typeSpecifier)
165    {
166        if (typeSpecifier == Symbol.FUNCTION)
167            return T;
168        if (typeSpecifier == Symbol.COMPILED_FUNCTION)
169            return T;
170        if (typeSpecifier == BuiltInClass.FUNCTION)
171            return T;
172        return super.typep(typeSpecifier);
173    }
174
175    @Override
176    public final LispObject getPropertyList()
177    {
178        if (propertyList == null)
179            propertyList = NIL;
180        return propertyList;
181    }
182
183    @Override
184    public final void setPropertyList(LispObject obj)
185    {
186        if (obj == null)
187            throw new NullPointerException();
188        propertyList = obj;
189    }
190
191    public final void setClassBytes(byte[] bytes)
192    {
193        propertyList = putf(propertyList, Symbol.CLASS_BYTES,
194                            new JavaObject(bytes));
195    }
196
197    public final LispObject getClassBytes() {
198        LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
199        if(o != NIL) {
200            return o;
201        } else {
202            ClassLoader c = getClass().getClassLoader();
203            if(c instanceof JavaClassLoader) {
204                final LispThread thread = LispThread.currentThread();
205                SpecialBindingsMark mark = thread.markSpecialBindings();
206                try {
207                    thread.bindSpecial(Symbol.LOAD_TRUENAME, loadedFrom);
208                    return new JavaObject(((JavaClassLoader) c).getFunctionClassBytes(this));
209                } catch(Throwable t) {
210                    //This is because unfortunately getFunctionClassBytes uses
211                    //Debug.assertTrue(false) to signal errors
212                    if(t instanceof ControlTransfer) {
213                        throw (ControlTransfer) t;
214                    } else {
215                        return NIL;
216                    }
217                } finally {
218                    thread.resetSpecialBindings(mark);
219                }
220            } else {
221                return NIL;
222            }
223        }
224    }
225
226    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
227    public static final class pf_function_class_bytes extends Primitive {
228        public pf_function_class_bytes() {
229            super("function-class-bytes", PACKAGE_SYS, false, "function");
230        }
231        @Override
232        public LispObject execute(LispObject arg) {
233            if (arg instanceof Function) {
234                return ((Function) arg).getClassBytes();
235            }
236            return type_error(arg, Symbol.FUNCTION);
237        }
238    }
239
240    @Override
241    public LispObject execute()
242    {
243        return error(new WrongNumberOfArgumentsException(this, 0));
244    }
245
246    @Override
247    public LispObject execute(LispObject arg)
248    {
249        return error(new WrongNumberOfArgumentsException(this, 1));
250    }
251
252    @Override
253    public LispObject execute(LispObject first, LispObject second)
254
255    {
256        return error(new WrongNumberOfArgumentsException(this, 2));
257    }
258
259    @Override
260    public LispObject execute(LispObject first, LispObject second,
261                              LispObject third)
262
263    {
264        return error(new WrongNumberOfArgumentsException(this, 3));
265    }
266
267    @Override
268    public LispObject execute(LispObject first, LispObject second,
269                              LispObject third, LispObject fourth)
270
271    {
272        return error(new WrongNumberOfArgumentsException(this, 4));
273    }
274
275    @Override
276    public LispObject execute(LispObject first, LispObject second,
277                              LispObject third, LispObject fourth,
278                              LispObject fifth)
279
280    {
281        return error(new WrongNumberOfArgumentsException(this, 5));
282    }
283
284    @Override
285    public LispObject execute(LispObject first, LispObject second,
286                              LispObject third, LispObject fourth,
287                              LispObject fifth, LispObject sixth)
288
289    {
290        return error(new WrongNumberOfArgumentsException(this, 6));
291    }
292
293    @Override
294    public LispObject execute(LispObject first, LispObject second,
295                              LispObject third, LispObject fourth,
296                              LispObject fifth, LispObject sixth,
297                              LispObject seventh)
298
299    {
300        return error(new WrongNumberOfArgumentsException(this, 7));
301    }
302
303    @Override
304    public LispObject execute(LispObject first, LispObject second,
305                              LispObject third, LispObject fourth,
306                              LispObject fifth, LispObject sixth,
307                              LispObject seventh, LispObject eighth)
308
309    {
310        return error(new WrongNumberOfArgumentsException(this, 8));
311    }
312
313    @Override
314    public LispObject execute(LispObject[] args)
315    {
316        return error(new WrongNumberOfArgumentsException(this));
317    }
318
319    @Override
320    public String printObject()
321    {
322        LispObject name = getLambdaName();
323        if (name != null && name != NIL) {
324            return unreadableString(name.princToString());
325        }
326        // No name.
327        LispObject lambdaList = getLambdaList();
328        if (lambdaList != null) {
329            StringBuilder sb = new StringBuilder("FUNCTION ");
330            sb.append("(LAMBDA ");
331            if (lambdaList == NIL) {
332                sb.append("()");
333            } else {
334                final LispThread thread = LispThread.currentThread();
335                final SpecialBindingsMark mark = thread.markSpecialBindings();
336                thread.bindSpecial(Symbol.PRINT_LENGTH, Fixnum.THREE);
337                try {
338                    sb.append(lambdaList.printObject());
339                }
340                finally {
341                    thread.resetSpecialBindings(mark);
342                }
343            }
344            sb.append(")");
345            return unreadableString(sb.toString());
346        }
347        return unreadableString("FUNCTION");
348    }
349
350    // Used by the JVM compiler.
351    public final void argCountError()
352    {
353        error(new WrongNumberOfArgumentsException(this));
354    }
355
356    // Profiling.
357    @Override
358    public final int getCallCount()
359    {
360        return callCount;
361    }
362
363    @Override
364    public void setCallCount(int n)
365    {
366        callCount = n;
367    }
368
369    @Override
370    public final void incrementCallCount()
371    {
372        ++callCount;
373    }
374
375    @Override
376    public final int getHotCount()
377    {
378        return hotCount;
379    }
380
381    @Override
382    public void setHotCount(int n)
383    {
384        hotCount = n;
385    }
386
387    @Override
388    public final void incrementHotCount()
389    {
390        ++hotCount;
391    }
392
393    //Serialization
394    public static class SerializedNamedFunction implements Serializable {
395        private final Symbol name;
396        public SerializedNamedFunction(Symbol name) {
397            this.name = name;
398        }
399
400        public Object readResolve() {
401            return name.getSymbolFunctionOrDie();
402        }
403    }
404
405    public static class ObjectInputStreamWithClassLoader extends ObjectInputStream {
406        private final ClassLoader classLoader;
407        public ObjectInputStreamWithClassLoader(InputStream in, ClassLoader classLoader) throws IOException {
408            super(in);
409            this.classLoader = classLoader;
410        }
411
412        @Override
413        protected Class<?> resolveClass(ObjectStreamClass desc) throws IOException, ClassNotFoundException {
414            return Class.forName(desc.getName(), false, classLoader);
415        }
416    }
417
418    public static class SerializedLocalFunction implements Serializable {
419        final LispObject className;
420        final LispObject classBytes;
421        final byte[] serializedFunction;
422
423        public SerializedLocalFunction(Function function) {
424            this.className = new SimpleString(function.getClass().getName());
425            this.classBytes = function.getClassBytes();
426            serializingClosure.set(true);
427            try {
428                ByteArrayOutputStream baos = new ByteArrayOutputStream();
429                new ObjectOutputStream(baos).writeObject(function);
430                serializedFunction = baos.toByteArray();
431            } catch (IOException e) {
432                throw new RuntimeException(e);
433            } finally {
434                serializingClosure.remove();
435            }
436        }
437
438        public Object readResolve() throws InvalidObjectException {
439            MemoryClassLoader loader = new MemoryClassLoader();
440            MemoryClassLoader.PUT_MEMORY_FUNCTION.execute(JavaObject.getInstance(loader), className, classBytes);
441            try {
442                ByteArrayInputStream in = new ByteArrayInputStream(serializedFunction);
443                return new ObjectInputStreamWithClassLoader(in, loader).readObject();
444            } catch (Exception e) {
445                InvalidObjectException ex = new InvalidObjectException("Could not read the serialized function back");
446                ex.initCause(e);
447                throw ex;
448            }
449        }
450    }
451
452    private static final ThreadLocal<Boolean> serializingClosure = new ThreadLocal<Boolean>();
453
454    public Object writeReplace() throws ObjectStreamException {
455        if(shouldSerializeByName()) {
456            return new SerializedNamedFunction((Symbol) getLambdaName());
457        } else if(getClassBytes() == NIL || serializingClosure.get() != null) {
458            return this;
459        } else {
460            return new SerializedLocalFunction(this);
461        }
462    }
463
464    protected boolean shouldSerializeByName() {
465        LispObject lambdaName = getLambdaName();
466        return lambdaName instanceof Symbol && lambdaName.getSymbolFunction() == this;
467    }
468}
Note: See TracBrowser for help on using the repository browser.