source: branches/streams/abcl/src/org/armedbear/lisp/LispThread.java

Last change on this file was 14690, checked in by Mark Evenson, 11 years ago

THREADS:YIELD implements java.lang.Thread.yield().

Improved documenation strings in threads package.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 52.1 KB
Line 
1/*
2 * LispThread.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: LispThread.java 14690 2014-04-22 11:24:50Z 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.lang.ref.WeakReference;
37import static org.armedbear.lisp.Lisp.*;
38
39import java.util.Iterator;
40import java.util.concurrent.ConcurrentHashMap;
41import java.util.concurrent.ConcurrentLinkedQueue;
42import java.util.concurrent.atomic.AtomicInteger;
43
44import java.text.MessageFormat;
45
46public final class LispThread extends LispObject
47{
48    // use a concurrent hashmap: we may want to add threads
49    // while at the same time iterating the hash
50    final static ConcurrentHashMap<Thread,LispThread> map =
51       new ConcurrentHashMap<Thread,LispThread>();
52
53    LispObject threadValue = NIL;
54
55    private static ThreadLocal<LispThread> threads = new ThreadLocal<LispThread>(){
56        @Override
57        public LispThread initialValue() {
58            Thread thisThread = Thread.currentThread();
59            LispThread thread = LispThread.map.get(thisThread);
60            if (thread == null) {
61                thread = new LispThread(thisThread);
62                LispThread.map.put(thisThread,thread);
63            }
64            return thread;
65        }
66    };
67
68    public static final LispThread currentThread()
69    {
70        return threads.get();
71    }
72
73    final Thread javaThread;
74    private boolean destroyed;
75    final LispObject name;
76    public LispObject[] _values;
77    private boolean threadInterrupted;
78    private LispObject pending = NIL;
79    private Symbol wrapper =
80        PACKAGE_THREADS.intern("THREAD-FUNCTION-WRAPPER");
81
82    LispThread(Thread javaThread)
83    {
84        this.javaThread = javaThread;
85        name = new SimpleString(javaThread.getName());
86    }
87
88    LispThread(final Function fun, LispObject name)
89    {
90        Runnable r = new Runnable() {
91            public void run()
92            {
93                try {
94                    threadValue = funcall(wrapper,
95                            new LispObject[] { fun },
96                            LispThread.this);
97                }
98                catch (ThreadDestroyed ignored) {
99                      // Might happen.
100                }
101                catch (ProcessingTerminated e) {
102                    System.exit(e.getStatus());
103                }
104                catch (Throwable t) { // any error: process thread interrupts
105                    if (isInterrupted()) {
106                        processThreadInterrupts();
107                    }
108                    String msg
109                        = MessageFormat.format("Ignoring uncaught exception {0}.",
110                                               t.toString());
111                    Debug.warn(msg);
112                }
113                finally {
114                    // make sure the thread is *always* removed from the hash again
115                    map.remove(Thread.currentThread());
116                }
117            }
118        };
119        javaThread = new Thread(r);
120        this.name = name;
121        map.put(javaThread, this);
122        if (name != NIL)
123            javaThread.setName(name.getStringValue());
124        javaThread.setDaemon(true);
125        javaThread.start();
126    }
127
128    public StackTraceElement[] getJavaStackTrace() {
129        return javaThread.getStackTrace();
130    }
131
132    @Override
133    public LispObject typeOf()
134    {
135        return Symbol.THREAD;
136    }
137
138    @Override
139    public LispObject classOf()
140    {
141        return BuiltInClass.THREAD;
142    }
143
144    @Override
145    public LispObject typep(LispObject typeSpecifier)
146    {
147        if (typeSpecifier == Symbol.THREAD)
148            return T;
149        if (typeSpecifier == BuiltInClass.THREAD)
150            return T;
151        return super.typep(typeSpecifier);
152    }
153
154    public final synchronized boolean isDestroyed()
155    {
156        return destroyed;
157    }
158
159    final synchronized boolean isInterrupted()
160    {
161        return threadInterrupted;
162    }
163
164    final synchronized void setDestroyed(boolean b)
165    {
166        destroyed = b;
167    }
168
169    final synchronized void interrupt(LispObject function, LispObject args)
170    {
171        pending = new Cons(args, pending);
172        pending = new Cons(function, pending);
173        threadInterrupted = true;
174        javaThread.interrupt();
175    }
176
177    final synchronized void processThreadInterrupts()
178
179    {
180        while (pending != NIL) {
181            LispObject function = pending.car();
182            LispObject args = pending.cadr();
183            pending = pending.cddr();
184            Primitives.APPLY.execute(function, args);
185        }
186        threadInterrupted = false;
187    }
188
189    public final LispObject[] getValues()
190    {
191        return _values;
192    }
193
194    public final LispObject[] getValues(LispObject result, int count)
195    {
196        if (_values == null) {
197            LispObject[] values = new LispObject[count];
198            if (count > 0)
199                values[0] = result;
200            for (int i = 1; i < count; i++)
201                values[i] = NIL;
202            return values;
203        }
204        // If the caller doesn't want any extra values, just return the ones
205        // we've got.
206        if (count <= _values.length)
207            return _values;
208        // The caller wants more values than we have. Pad with NILs.
209        LispObject[] values = new LispObject[count];
210        for (int i = _values.length; i-- > 0;)
211            values[i] = _values[i];
212        for (int i = _values.length; i < count; i++)
213            values[i] = NIL;
214        return values;
215    }
216
217    /** Used by the JVM compiler for MULTIPLE-VALUE-CALL. */
218    public final LispObject[] accumulateValues(LispObject result,
219                                               LispObject[] oldValues)
220    {
221        if (oldValues == null) {
222            if (_values != null)
223                return _values;
224            LispObject[] values = new LispObject[1];
225            values[0] = result;
226            return values;
227        }
228        if (_values != null) {
229            if (_values.length == 0)
230                return oldValues;
231            final int totalLength = oldValues.length + _values.length;
232            LispObject[] values = new LispObject[totalLength];
233            System.arraycopy(oldValues, 0,
234                             values, 0,
235                             oldValues.length);
236            System.arraycopy(_values, 0,
237                             values, oldValues.length,
238                             _values.length);
239            return values;
240        }
241        // _values is null.
242        final int totalLength = oldValues.length + 1;
243        LispObject[] values = new LispObject[totalLength];
244        System.arraycopy(oldValues, 0,
245                         values, 0,
246                         oldValues.length);
247        values[totalLength - 1] = result;
248        return values;
249    }
250
251    public final LispObject setValues()
252    {
253        _values = new LispObject[0];
254        return NIL;
255    }
256
257    public final LispObject setValues(LispObject value1)
258    {
259        _values = null;
260        return value1;
261    }
262
263    public final LispObject setValues(LispObject value1, LispObject value2)
264    {
265        _values = new LispObject[2];
266        _values[0] = value1;
267        _values[1] = value2;
268        return value1;
269    }
270
271    public final LispObject setValues(LispObject value1, LispObject value2,
272                                      LispObject value3)
273    {
274        _values = new LispObject[3];
275        _values[0] = value1;
276        _values[1] = value2;
277        _values[2] = value3;
278        return value1;
279    }
280
281    public final LispObject setValues(LispObject value1, LispObject value2,
282                                      LispObject value3, LispObject value4)
283    {
284        _values = new LispObject[4];
285        _values[0] = value1;
286        _values[1] = value2;
287        _values[2] = value3;
288        _values[3] = value4;
289        return value1;
290    }
291
292    public final LispObject setValues(LispObject[] values)
293    {
294        switch (values.length) {
295            case 0:
296                _values = values;
297                return NIL;
298            case 1:
299                _values = null;
300                return values[0];
301            default:
302                _values = values;
303                return values[0];
304        }
305    }
306
307    public final void clearValues()
308    {
309        _values = null;
310    }
311
312    public final LispObject nothing()
313    {
314        _values = new LispObject[0];
315        return NIL;
316    }
317
318   /**
319    * Force a single value, for situations where multiple values should be
320    * ignored.
321    */
322    public final LispObject value(LispObject obj)
323    {
324        _values = null;
325        return obj;
326    }
327
328
329
330    final static int UNASSIGNED_SPECIAL_INDEX = 0;
331
332    /** Indicates the last special slot which has been assigned.
333     * Symbols which don't have a special slot assigned use a slot
334     * index of 0 for efficiency reasons: it eliminates the need to
335     * check for index validity before accessing the specials array.
336     *
337     */
338    final static AtomicInteger lastSpecial
339        = new AtomicInteger(UNASSIGNED_SPECIAL_INDEX);
340
341    /** A list of indices which can be (re)used for symbols to
342     * be assigned a special slot index.
343     */
344    final static ConcurrentLinkedQueue<Integer> freeSpecialIndices
345        = new ConcurrentLinkedQueue<Integer>();
346
347    final static int specialsInitialSize
348        = Integer.valueOf(System.getProperty("abcl.specials.initialSize","4096"));
349
350    /** This array stores the current special binding for every symbol
351     * which has been globally or locally declared special.
352     *
353     * If the array element has a null value, this means there currently
354     * is no active binding. If the array element contains a valid
355     * SpecialBinding object, but the value field of it is null, that
356     * indicates an "UNBOUND VARIABLE" situation.
357     */
358    SpecialBinding[] specials
359        = new SpecialBinding[specialsInitialSize + 1];
360
361    final static ConcurrentHashMap<Integer, WeakReference<Symbol>> specialNames
362        = new ConcurrentHashMap<Integer, WeakReference<Symbol>>();
363
364    /** The number of slots to grow the specials table in
365     * case of insufficient storage.
366     */
367    final static int specialsDelta
368        = Integer.valueOf(System.getProperty("abcl.specials.grow.delta","1024"));
369
370    /** This variable points to the head of a linked list of saved
371     * special bindings. Its main purpose is to allow a mark/reset
372     * interface to special binding and unbinding.
373     */
374    private SpecialBindingsMark savedSpecials = null;
375
376    /** Marks the state of the special bindings,
377     * for later rewinding by resetSpecialBindings().
378     */
379    public final SpecialBindingsMark markSpecialBindings() {
380        return savedSpecials;
381    }
382
383    /** Restores the state of the special bindings to what
384     * was captured in the marker 'mark' by a call to markSpecialBindings().
385     */
386    public final void resetSpecialBindings(SpecialBindingsMark mark) {
387        SpecialBindingsMark c = savedSpecials;
388        while (mark != c) {
389            specials[c.idx] = c.binding;
390            c = c.next;
391        }
392        savedSpecials = c;
393    }
394
395    /** Clears out all active special bindings including any marks
396     * previously set. Invoking resetSpecialBindings() with marks
397     * set before this call results in undefined behaviour.
398     */
399    // Package level access: only for Interpreter.run()
400    final void clearSpecialBindings() {
401        resetSpecialBindings(null);
402    }
403
404    /** Assigns a specials array index number to the symbol,
405     * if it doesn't already have one.
406     */
407    private void assignSpecialIndex(Symbol sym)
408    {
409        if (sym.specialIndex != 0)
410            return;
411
412        synchronized (sym) {
413            // Don't use an atomic access: we'll be swapping values only once.
414            if (sym.specialIndex == 0) {
415                Integer next = freeSpecialIndices.poll();
416                if (next == null
417                        && specials.length < lastSpecial.get()
418                        && null == System.getProperty("abcl.specials.grow.slowly")) {
419                    // free slots are exhausted; in the middle and at the end.
420                    System.gc();
421                    next = freeSpecialIndices.poll();
422                }
423                if (next == null)
424                    sym.specialIndex = lastSpecial.incrementAndGet();
425                else
426                    sym.specialIndex = next.intValue();
427            }
428        }
429    }
430
431    /** Frees up an index previously assigned to a symbol for re-assignment
432     * to another symbol. Returns without effect if the symbol has the
433     * default UNASSIGNED_SPECIAL_INDEX special index.
434     */
435    protected static void releaseSpecialIndex(Symbol sym)
436    {
437        int index = sym.specialIndex;
438        if (index != UNASSIGNED_SPECIAL_INDEX) {
439            // clear out the values in the
440            Iterator<LispThread> it = map.values().iterator();
441            while (it.hasNext()) {
442                LispThread thread = it.next();
443
444                // clear out the values in the saved specials list
445                SpecialBindingsMark savedSpecial = thread.savedSpecials;
446                while (savedSpecial != null) {
447                    if (savedSpecial.idx == index) {
448                        savedSpecial.idx = 0;
449                        savedSpecial.binding = null;
450                    }
451                    savedSpecial = savedSpecial.next;
452                }
453
454                thread.specials[index] = null;
455            }
456
457            freeSpecialIndices.add(new Integer(index));
458        }
459    }
460
461    private void growSpecials() {
462        SpecialBinding[] newSpecials
463                = new SpecialBinding[specials.length + specialsDelta];
464        System.arraycopy(specials, 0, newSpecials, 0, specials.length);
465        specials = newSpecials;
466    }
467
468    private SpecialBinding ensureSpecialBinding(int idx) {
469        SpecialBinding binding;
470        boolean assigned;
471        do {
472            try {
473                binding = specials[idx];
474                assigned = true;
475            }
476            catch (ArrayIndexOutOfBoundsException e) {
477                assigned = false;
478                binding = null;  // suppresses 'unassigned' error
479                growSpecials();
480            }
481        } while (! assigned);
482        return binding;
483    }
484
485    public final SpecialBinding bindSpecial(Symbol name, LispObject value)
486    {
487        int idx;
488
489        assignSpecialIndex(name);
490        SpecialBinding binding = ensureSpecialBinding(idx = name.specialIndex);
491        savedSpecials = new SpecialBindingsMark(idx, binding, savedSpecials);
492        return specials[idx] = new SpecialBinding(idx, value);
493    }
494
495    public final SpecialBinding bindSpecialToCurrentValue(Symbol name)
496    {
497        int idx;
498
499        assignSpecialIndex(name);
500        SpecialBinding binding = ensureSpecialBinding(idx = name.specialIndex);
501        savedSpecials = new SpecialBindingsMark(idx, binding, savedSpecials);
502        return specials[idx]
503            = new SpecialBinding(idx,
504                                 (binding == null) ?
505                                 name.getSymbolValue() : binding.value);
506    }
507
508    /** Looks up the value of a special binding in the context of the
509     * given thread.
510     *
511     * In order to find the value of a special variable (in general),
512     * use {@link Symbol#symbolValue}.
513     *
514     * @param name The name of the special variable, normally a symbol
515     * @return The inner most binding of the special, or null if unbound
516     *
517     * @see Symbol#symbolValue
518     */
519    public final LispObject lookupSpecial(Symbol name)
520    {
521        SpecialBinding binding = ensureSpecialBinding(name.specialIndex);
522        return (binding == null) ? null : binding.value;
523    }
524
525    public final SpecialBinding getSpecialBinding(Symbol name)
526    {
527        return ensureSpecialBinding(name.specialIndex);
528    }
529
530    public final LispObject setSpecialVariable(Symbol name, LispObject value)
531    {
532        SpecialBinding binding = ensureSpecialBinding(name.specialIndex);
533        if (binding != null)
534            return binding.value = value;
535
536        name.setSymbolValue(value);
537        return value;
538    }
539
540    public final LispObject pushSpecial(Symbol name, LispObject thing)
541
542    {
543        SpecialBinding binding = ensureSpecialBinding(name.specialIndex);
544        if (binding != null)
545            return binding.value = new Cons(thing, binding.value);
546
547        LispObject value = name.getSymbolValue();
548        if (value != null) {
549            LispObject newValue = new Cons(thing, value);
550            name.setSymbolValue(newValue);
551            return newValue;
552        } else
553            return error(new UnboundVariable(name));
554    }
555
556    // Returns symbol value or NIL if unbound.
557    public final LispObject safeSymbolValue(Symbol name)
558    {
559        SpecialBinding binding = ensureSpecialBinding(name.specialIndex);
560        if (binding != null)
561            return binding.value;
562
563        LispObject value = name.getSymbolValue();
564        return value != null ? value : NIL;
565    }
566
567    public final void rebindSpecial(Symbol name, LispObject value)
568    {
569        SpecialBinding binding = getSpecialBinding(name);
570        binding.value = value;
571    }
572
573    private LispObject catchTags = NIL;
574
575    public void pushCatchTag(LispObject tag)
576    {
577        catchTags = new Cons(tag, catchTags);
578    }
579
580    public void popCatchTag()
581    {
582        if (catchTags != NIL)
583            catchTags = catchTags.cdr();
584        else
585            Debug.assertTrue(false);
586    }
587
588    public void throwToTag(LispObject tag, LispObject result)
589
590    {
591        LispObject rest = catchTags;
592        while (rest != NIL) {
593            if (rest.car() == tag)
594                throw new Throw(tag, result, this);
595            rest = rest.cdr();
596        }
597        error(new ControlError("Attempt to throw to the nonexistent tag " +
598                                tag.princToString() + "."));
599    }
600
601
602    private static class StackMarker {
603
604        final int numArgs;
605
606        StackMarker(int numArgs) {
607            this.numArgs = numArgs;
608        }
609
610        int getNumArgs() {
611            return numArgs;
612        }
613    }
614
615    // markers for args
616    private final static StackMarker STACK_MARKER_0 = new StackMarker(0);
617    private final static StackMarker STACK_MARKER_1 = new StackMarker(1);
618    private final static StackMarker STACK_MARKER_2 = new StackMarker(2);
619    private final static StackMarker STACK_MARKER_3 = new StackMarker(3);
620    private final static StackMarker STACK_MARKER_4 = new StackMarker(4);
621    private final static StackMarker STACK_MARKER_5 = new StackMarker(5);
622    private final static StackMarker STACK_MARKER_6 = new StackMarker(6);
623    private final static StackMarker STACK_MARKER_7 = new StackMarker(7);
624    private final static StackMarker STACK_MARKER_8 = new StackMarker(8);
625
626    private final int STACK_FRAME_EXTRA = 2;
627    // a LispStackFrame with n arguments occupies n + STACK_FRAME_EXTRA elements
628    // in {@code stack} array.
629    // stack[framePos] == operation
630    // stack[framePos + 1 + i] == arg[i]
631    // stack[framePos + 1 + n] == initially SrackMarker(n)
632    // LispStackFrame object may be lazily allocated later.
633    // In this case it is stored in stack framePos + 1 + n]
634    //
635    // Java stack frame occupies 1 element
636    // stack[framePos] == JavaStackFrame
637    //
638    // Stack consists of a list of StackSegments.
639    // Top StackSegment is cached in variables stack and stackPtr.
640    private StackSegment topStackSegment = new StackSegment(INITIAL_SEGMENT_SIZE, null);
641    private Object[] stack = topStackSegment.stack;
642    private int stackPtr = 0;
643    private StackSegment spareStackSegment;
644   
645    private static class StackSegment 
646      implements org.armedbear.lisp.protocol.Inspectable
647    {
648        final Object[] stack;
649        final StackSegment next;
650        int stackPtr;
651       
652        StackSegment(int size, StackSegment next) {
653            stack = new Object[size];
654            this.next = next;
655        }
656        public LispObject getParts() {
657        Cons result = new Cons(NIL);
658        return result
659          .push(new Symbol("INITIAL-SEGMENT-SIZE"))
660            .push(LispInteger.getInstance(LispThread.INITIAL_SEGMENT_SIZE))
661          .push(new Symbol("SEGMENT-SIZE"))
662            .push(LispInteger.getInstance(LispThread.SEGMENT_SIZE)).nreverse();
663        }
664    }
665   
666    private void ensureStackCapacity(int itemsToPush) {
667        if (stackPtr + (itemsToPush - 1) >= stack.length)
668            grow(itemsToPush);
669    }
670
671    private static final int INITIAL_SEGMENT_SIZE = 1 << 10;
672    private static final int SEGMENT_SIZE = (1 << 19) - 4; // 4 MiB page on x86_64
673
674    private void grow(int numEntries) {
675        topStackSegment.stackPtr = stackPtr;
676        if (spareStackSegment != null) {
677            // Use spare segement if available
678            if (stackPtr > 0 && spareStackSegment.stack.length >= numEntries) {
679                topStackSegment = spareStackSegment;
680                stack = topStackSegment.stack;
681                spareStackSegment = null;
682                stackPtr = 0;
683                return;
684            }
685            spareStackSegment = null;
686        }
687        int newSize = stackPtr + numEntries;
688        if (topStackSegment.stack.length < SEGMENT_SIZE || stackPtr == 0) {
689            // grow initial segment from initial size to standard size
690            int newLength = Math.max(newSize, Math.min(SEGMENT_SIZE, stack.length * 2));
691            StackSegment newSegment = new StackSegment(newLength, topStackSegment.next);
692            System.arraycopy(stack, 0, newSegment.stack, 0, stackPtr);
693            topStackSegment = newSegment;
694            stack = topStackSegment.stack;
695            return;
696        }
697        // Allocate new segment
698        topStackSegment = new StackSegment(Math.max(SEGMENT_SIZE, numEntries), topStackSegment);
699        stack = topStackSegment.stack;
700        stackPtr = 0;
701    }
702
703    private StackFrame getStackTop() {
704        topStackSegment.stackPtr = stackPtr;
705        if (stackPtr == 0) {
706            assert topStackSegment.next == null;
707            return null;
708        }
709        StackFrame prev = null;
710        for (StackSegment segment = topStackSegment; segment != null; segment = segment.next) {
711            Object[] stk = segment.stack;
712            int framePos = segment.stackPtr;
713            while (framePos > 0) {
714                Object stackObj = stk[framePos - 1];
715                if (stackObj instanceof StackFrame) {
716                    if (prev != null) {
717                        prev.setNext((StackFrame) stackObj);
718                    }
719                    return (StackFrame) stack[stackPtr - 1];
720                }
721                StackMarker marker = (StackMarker) stackObj;
722                int numArgs = marker.getNumArgs();
723                LispStackFrame frame = new LispStackFrame(stk, framePos - numArgs - STACK_FRAME_EXTRA, numArgs);
724                stk[framePos - 1] = frame;
725                if (prev != null) {
726                    prev.setNext(frame);
727                }
728                prev = frame;
729                framePos -= numArgs + STACK_FRAME_EXTRA;
730            }
731        }
732        return (StackFrame) stack[stackPtr - 1];
733    }
734   
735    public final void pushStackFrame(JavaStackFrame frame) {
736        frame.setNext(getStackTop());
737        ensureStackCapacity(1);
738        stack[stackPtr] = frame;
739        stackPtr += 1;
740    }
741
742    private void popStackFrame(int numArgs) {
743        // Pop off intervening JavaFrames until we get back to a LispFrame
744        Object stackObj = stack[stackPtr - 1];
745        if (stackObj instanceof StackMarker) {
746            assert numArgs == ((StackMarker) stackObj).getNumArgs();
747        } else {
748            while (stackObj instanceof JavaStackFrame) {
749                stack[--stackPtr] = null;
750                stackObj = stack[stackPtr - 1];
751            }
752            if (stackObj instanceof StackMarker) {
753                assert numArgs == ((StackMarker) stackObj).getNumArgs();
754            } else {
755                assert numArgs == ((LispStackFrame) stackObj).getNumArgs();
756            }
757        }
758        stackPtr -= numArgs + STACK_FRAME_EXTRA;
759        for (int i = 0; i < numArgs + STACK_FRAME_EXTRA; i++) {
760            stack[stackPtr + i] = null;
761        }
762        if (stackPtr == 0) {
763            popStackSegment();
764        }
765    }
766   
767    private void popStackSegment() {
768        topStackSegment.stackPtr = 0;
769        if (topStackSegment.next != null) {
770            spareStackSegment = topStackSegment;
771            topStackSegment = topStackSegment.next;
772            stack = topStackSegment.stack;
773        }
774        stackPtr = topStackSegment.stackPtr;
775    }
776
777    public final Environment setEnv(Environment env) {
778        StackFrame stackTop = getStackTop();
779        return (stackTop != null) ? stackTop.setEnv(env) : null;
780    }
781
782    public void resetStack()
783    {
784        topStackSegment = new StackSegment(INITIAL_SEGMENT_SIZE, null);
785        stack = topStackSegment.stack;
786        spareStackSegment = null;
787        stackPtr = 0;
788    }
789
790    @Override
791    public LispObject execute(LispObject function)
792    {
793        ensureStackCapacity(STACK_FRAME_EXTRA);
794        stack[stackPtr] = function;
795        stack[stackPtr + 1] = STACK_MARKER_0;
796        stackPtr += STACK_FRAME_EXTRA;
797        try {
798            return function.execute();
799        }
800        finally {
801            popStackFrame(0);
802        }
803    }
804
805    @Override
806    public LispObject execute(LispObject function, LispObject arg)
807    {
808        ensureStackCapacity(1 + STACK_FRAME_EXTRA);
809        stack[stackPtr] = function;
810        stack[stackPtr + 1] = arg;
811        stack[stackPtr + 2] = STACK_MARKER_1;
812        stackPtr += 1 + STACK_FRAME_EXTRA;
813        try {
814            return function.execute(arg);
815        }
816        finally {
817            popStackFrame(1);
818        }
819    }
820
821    @Override
822    public LispObject execute(LispObject function, LispObject first,
823                              LispObject second)
824    {
825        ensureStackCapacity(2 + STACK_FRAME_EXTRA);
826        stack[stackPtr] = function;
827        stack[stackPtr + 1] = first;
828        stack[stackPtr + 2] = second;
829        stack[stackPtr + 3] = STACK_MARKER_2;
830        stackPtr += 2 + STACK_FRAME_EXTRA;
831        try {
832            return function.execute(first, second);
833        }
834        finally {
835            popStackFrame(2);
836        }
837    }
838
839    @Override
840    public LispObject execute(LispObject function, LispObject first,
841                              LispObject second, LispObject third)
842    {
843        ensureStackCapacity(3 + STACK_FRAME_EXTRA);
844        stack[stackPtr] = function;
845        stack[stackPtr + 1] = first;
846        stack[stackPtr + 2] = second;
847        stack[stackPtr + 3] = third;
848        stack[stackPtr + 4] = STACK_MARKER_3;
849        stackPtr += 3 + STACK_FRAME_EXTRA;
850        try {
851            return function.execute(first, second, third);
852        }
853        finally {
854            popStackFrame(3);
855        }
856    }
857
858    @Override
859    public LispObject execute(LispObject function, LispObject first,
860                              LispObject second, LispObject third,
861                              LispObject fourth)
862    {
863        ensureStackCapacity(4 + STACK_FRAME_EXTRA);
864        stack[stackPtr] = function;
865        stack[stackPtr + 1] = first;
866        stack[stackPtr + 2] = second;
867        stack[stackPtr + 3] = third;
868        stack[stackPtr + 4] = fourth;
869        stack[stackPtr + 5] = STACK_MARKER_4;
870        stackPtr += 4 + STACK_FRAME_EXTRA;
871        try {
872            return function.execute(first, second, third, fourth);
873        }
874        finally {
875            popStackFrame(4);
876        }
877    }
878
879    @Override
880    public LispObject execute(LispObject function, LispObject first,
881                              LispObject second, LispObject third,
882                              LispObject fourth, LispObject fifth)
883    {
884        ensureStackCapacity(5 + STACK_FRAME_EXTRA);
885        stack[stackPtr] = function;
886        stack[stackPtr + 1] = first;
887        stack[stackPtr + 2] = second;
888        stack[stackPtr + 3] = third;
889        stack[stackPtr + 4] = fourth;
890        stack[stackPtr + 5] = fifth;
891        stack[stackPtr + 6] = STACK_MARKER_5;
892        stackPtr += 5 + STACK_FRAME_EXTRA;
893        try {
894            return function.execute(first, second, third, fourth, fifth);
895        }
896        finally {
897            popStackFrame(5);
898        }
899    }
900
901    @Override
902    public LispObject execute(LispObject function, LispObject first,
903                              LispObject second, LispObject third,
904                              LispObject fourth, LispObject fifth,
905                              LispObject sixth)
906    {
907        ensureStackCapacity(6 + STACK_FRAME_EXTRA);
908        stack[stackPtr] = function;
909        stack[stackPtr + 1] = first;
910        stack[stackPtr + 2] = second;
911        stack[stackPtr + 3] = third;
912        stack[stackPtr + 4] = fourth;
913        stack[stackPtr + 5] = fifth;
914        stack[stackPtr + 6] = sixth;
915        stack[stackPtr + 7] = STACK_MARKER_6;
916        stackPtr += 6 + STACK_FRAME_EXTRA;
917        try {
918            return function.execute(first, second, third, fourth, fifth, sixth);
919        }
920        finally {
921            popStackFrame(6);
922        }
923    }
924
925    @Override
926    public LispObject execute(LispObject function, LispObject first,
927                              LispObject second, LispObject third,
928                              LispObject fourth, LispObject fifth,
929                              LispObject sixth, LispObject seventh)
930    {
931        ensureStackCapacity(7 + STACK_FRAME_EXTRA);
932        stack[stackPtr] = function;
933        stack[stackPtr + 1] = first;
934        stack[stackPtr + 2] = second;
935        stack[stackPtr + 3] = third;
936        stack[stackPtr + 4] = fourth;
937        stack[stackPtr + 5] = fifth;
938        stack[stackPtr + 6] = sixth;
939        stack[stackPtr + 7] = seventh;
940        stack[stackPtr + 8] = STACK_MARKER_7;
941        stackPtr += 7 + STACK_FRAME_EXTRA;
942        try {
943            return function.execute(first, second, third, fourth, fifth, sixth,
944                                    seventh);
945        }
946        finally {
947            popStackFrame(7);
948        }
949    }
950
951    public LispObject execute(LispObject function, LispObject first,
952                              LispObject second, LispObject third,
953                              LispObject fourth, LispObject fifth,
954                              LispObject sixth, LispObject seventh,
955                              LispObject eighth)
956    {
957        ensureStackCapacity(8 + STACK_FRAME_EXTRA);
958        stack[stackPtr] = function;
959        stack[stackPtr + 1] = first;
960        stack[stackPtr + 2] = second;
961        stack[stackPtr + 3] = third;
962        stack[stackPtr + 4] = fourth;
963        stack[stackPtr + 5] = fifth;
964        stack[stackPtr + 6] = sixth;
965        stack[stackPtr + 7] = seventh;
966        stack[stackPtr + 8] = eighth;
967        stack[stackPtr + 9] = STACK_MARKER_8;
968        stackPtr += 8 + STACK_FRAME_EXTRA;
969        try {
970            return function.execute(first, second, third, fourth, fifth, sixth,
971                                    seventh, eighth);
972        }
973        finally {
974            popStackFrame(8);
975        }
976    }
977
978    public LispObject execute(LispObject function, LispObject[] args)
979    {
980        ensureStackCapacity(args.length + STACK_FRAME_EXTRA);
981        stack[stackPtr] = function;
982        System.arraycopy(args, 0, stack, stackPtr + 1, args.length);
983        stack[stackPtr + args.length + 1] = new StackMarker(args.length);
984        stackPtr += args.length + STACK_FRAME_EXTRA;
985        try {
986            return function.execute(args);
987        }
988        finally {
989            popStackFrame(args.length);
990        }
991    }
992
993    public void printBacktrace()
994    {
995        printBacktrace(0);
996    }
997
998    public void printBacktrace(int limit)
999    {
1000        StackFrame stackTop = getStackTop();
1001        if (stackTop != null) {
1002            int count = 0;
1003            Stream out =
1004                checkCharacterOutputStream(Symbol.TRACE_OUTPUT.symbolValue());
1005            out._writeLine("Evaluation stack:");
1006            out._finishOutput();
1007
1008            StackFrame s = stackTop;
1009            while (s != null) {
1010                out._writeString("  ");
1011                out._writeString(String.valueOf(count));
1012                out._writeString(": ");
1013
1014                pprint(s.toLispList(), out.getCharPos(), out);
1015                out.terpri();
1016                out._finishOutput();
1017                if (limit > 0 && ++count == limit)
1018                    break;
1019                s = s.next;
1020            }
1021        }
1022    }
1023
1024    public LispObject backtrace(int limit)
1025    {
1026        StackFrame stackTop = getStackTop();
1027        LispObject result = NIL;
1028        if (stackTop != null) {
1029            int count = 0;
1030            StackFrame s = stackTop;
1031            while (s != null) {
1032                result = result.push(s);
1033                if (limit > 0 && ++count == limit)
1034                    break;
1035                s = s.getNext();
1036            }
1037        }
1038        return result.nreverse();
1039    }
1040
1041    public void incrementCallCounts()
1042    {
1043        topStackSegment.stackPtr = stackPtr;
1044        int depth = 0;
1045        for (StackSegment segment = topStackSegment; segment != null; segment = segment.next) {
1046            Object[] stk = segment.stack;
1047            int framePos = segment.stackPtr;
1048            while (framePos > 0) {
1049                depth++;
1050                Object stackObj = stk[framePos - 1];
1051                int numArgs;
1052                if (stackObj instanceof StackMarker) {
1053                    numArgs = ((StackMarker) stackObj).getNumArgs();
1054                } else if (stackObj instanceof LispStackFrame) {
1055                    numArgs = ((LispStackFrame) stackObj).getNumArgs();
1056                } else {
1057                    assert stackObj instanceof JavaStackFrame;
1058                    framePos--;
1059                    continue;
1060                }
1061                // lisp stack frame
1062                framePos -= numArgs + STACK_FRAME_EXTRA;
1063                LispObject operator = (LispObject) stack[framePos];
1064                if (operator != null) {
1065                    if (depth <= 8) {
1066                        operator.incrementHotCount();
1067                    }
1068                    operator.incrementCallCount();
1069                }
1070            }
1071        }
1072    }
1073
1074    private static void pprint(LispObject obj, int indentBy, Stream stream)
1075
1076    {
1077        if (stream.getCharPos() == 0) {
1078            StringBuffer sb = new StringBuffer();
1079            for (int i = 0; i < indentBy; i++)
1080                sb.append(' ');
1081            stream._writeString(sb.toString());
1082        }
1083        String raw = obj.printObject();
1084        if (stream.getCharPos() + raw.length() < 80) {
1085            // It fits.
1086            stream._writeString(raw);
1087            return;
1088        }
1089        // Object doesn't fit.
1090        if (obj instanceof Cons) {
1091            boolean newlineBefore = false;
1092            LispObject[] array = obj.copyToArray();
1093            if (array.length > 0) {
1094                LispObject first = array[0];
1095                if (first == Symbol.LET) {
1096                    newlineBefore = true;
1097                }
1098            }
1099            int charPos = stream.getCharPos();
1100            if (newlineBefore && charPos != indentBy) {
1101                stream.terpri();
1102                charPos = stream.getCharPos();
1103            }
1104            if (charPos < indentBy) {
1105                StringBuffer sb = new StringBuffer();
1106                for (int i = charPos; i < indentBy; i++)
1107                    sb.append(' ');
1108                stream._writeString(sb.toString());
1109            }
1110            stream.print('(');
1111            for (int i = 0; i < array.length; i++) {
1112                pprint(array[i], indentBy + 2, stream);
1113                if (i < array.length - 1)
1114                   stream.print(' ');
1115            }
1116            stream.print(')');
1117        } else {
1118            stream.terpri();
1119            StringBuffer sb = new StringBuffer();
1120            for (int i = 0; i < indentBy; i++)
1121                sb.append(' ');
1122            stream._writeString(sb.toString());
1123            stream._writeString(raw);
1124            return;
1125        }
1126    }
1127
1128    @Override
1129    public String printObject()
1130    {
1131        StringBuffer sb = new StringBuffer("THREAD");
1132        if (name != NIL) {
1133            sb.append(" \"");
1134            sb.append(name.getStringValue());
1135            sb.append("\"");
1136        }
1137        return unreadableString(sb.toString());
1138    }
1139
1140    @DocString(name="make-thread", args="function &key name")
1141    private static final Primitive MAKE_THREAD =
1142        new Primitive("make-thread", PACKAGE_THREADS, true, "function &key name")
1143    {
1144        @Override
1145        public LispObject execute(LispObject[] args)
1146        {
1147            final int length = args.length;
1148            if (length == 0)
1149                error(new WrongNumberOfArgumentsException(this, 1, -1));
1150            LispObject name = NIL;
1151            if (length > 1) {
1152                if ((length - 1) % 2 != 0)
1153                    program_error("Odd number of keyword arguments.");
1154                if (length > 3)
1155                    error(new WrongNumberOfArgumentsException(this, -1, 2)); // don't count the keyword itself as an argument
1156                if (args[1] == Keyword.NAME)
1157                    name = args[2].STRING();
1158                else
1159                    program_error("Unrecognized keyword argument "
1160                                  + args[1].princToString() + ".");
1161            }
1162            return new LispThread(checkFunction(args[0]), name);
1163        }
1164    };
1165
1166    @DocString(name="threadp", args="object",
1167    doc="Boolean predicate testing if OBJECT is a thread.")
1168    private static final Primitive THREADP =
1169        new Primitive("threadp", PACKAGE_THREADS, true)
1170    {
1171        @Override
1172        public LispObject execute(LispObject arg)
1173        {
1174            return arg instanceof LispThread ? T : NIL;
1175        }
1176    };
1177
1178    @DocString(name="thread-alive-p", args="thread",
1179    doc="Returns T if THREAD is alive.")
1180    private static final Primitive THREAD_ALIVE_P =
1181        new Primitive("thread-alive-p", PACKAGE_THREADS, true, "thread",
1182              "Boolean predicate whether THREAD is alive.")
1183    {
1184        @Override
1185        public LispObject execute(LispObject arg)
1186        {
1187            final LispThread lispThread;
1188            if (arg instanceof LispThread) {
1189                lispThread = (LispThread) arg;
1190            }
1191            else {
1192                return type_error(arg, Symbol.THREAD);
1193            }
1194            return lispThread.javaThread.isAlive() ? T : NIL;
1195        }
1196    };
1197
1198    @DocString(name="thread-name", args="thread",
1199    doc="Return the name of THREAD, if it has one.")
1200    private static final Primitive THREAD_NAME =
1201        new Primitive("thread-name", PACKAGE_THREADS, true)
1202    {
1203        @Override
1204        public LispObject execute(LispObject arg)
1205        {
1206                if (arg instanceof LispThread) {
1207                return ((LispThread)arg).name;
1208            }
1209                 return type_error(arg, Symbol.THREAD);
1210        }
1211    };
1212
1213    private static final Primitive THREAD_JOIN =
1214        new Primitive("thread-join", PACKAGE_THREADS, true, "thread",
1215                      "Waits for thread to finish.")
1216    {
1217        @Override
1218        public LispObject execute(LispObject arg)
1219        {
1220            // join the thread, and returns it's value.  The second return
1221            // value is T if the thread finishes normally, NIL if its
1222            // interrupted.
1223            if (arg instanceof LispThread) {               
1224                final LispThread joinedThread = (LispThread) arg;
1225                final LispThread waitingThread = currentThread();
1226                try {
1227                    joinedThread.javaThread.join();
1228                    return 
1229                        waitingThread.setValues(joinedThread.threadValue, T);
1230                } catch (InterruptedException e) {
1231                    waitingThread.processThreadInterrupts();
1232                    return 
1233                        waitingThread.setValues(joinedThread.threadValue, NIL);
1234                }
1235            } else {
1236                return type_error(arg, Symbol.THREAD);
1237            } 
1238        }
1239    };
1240   
1241    final static DoubleFloat THOUSAND = new DoubleFloat(1000);
1242
1243    static final long sleepMillisPart(LispObject seconds) {
1244      double d
1245        = checkDoubleFloat(seconds.multiplyBy(THOUSAND)).getValue();
1246      if (d < 0) {
1247        type_error(seconds, list(Symbol.REAL, Fixnum.ZERO));
1248      }
1249      return (d < Long.MAX_VALUE ? (long) d : Long.MAX_VALUE);
1250    }
1251
1252    static final int sleepNanosPart(LispObject seconds) {
1253      double d  // d contains millis
1254        = checkDoubleFloat(seconds.multiplyBy(THOUSAND)).getValue();
1255      double n = d * 1000000; // sleep interval in nanoseconds
1256      d = 1.0e6 * ((long)d); //  sleep interval to millisecond precision
1257      n = n - d; 
1258
1259      return (n < Integer.MAX_VALUE ? (int) n : Integer.MAX_VALUE);
1260    }
1261
1262
1263    @DocString(name="sleep", args="seconds",
1264    doc="Causes the invoking thread to sleep for an interveral expressed in SECONDS.\n"
1265      + "SECONDS may be specified as a fraction of a second, with intervals\n"
1266      + "less than or equal to a nanosecond resulting in a yield of execution\n"
1267      + "to other waiting threads rather than an actual sleep.\n"
1268      + "A zero value of SECONDS *may* result in the JVM sleeping indefinitely,\n"
1269      + "depending on the implementation.")
1270    private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true)
1271    {
1272        @Override
1273        public LispObject execute(LispObject arg)
1274        {
1275          long millis = sleepMillisPart(arg);
1276          int nanos = sleepNanosPart(arg);
1277          boolean zeroArgP = arg.ZEROP() != NIL;
1278
1279          try {
1280            if (millis == 0 && nanos == 0) { 
1281              if (zeroArgP) {
1282                Thread.sleep(0, 0);
1283              } else { 
1284                Thread.sleep(0, 1);
1285              }
1286            } else {
1287              Thread.sleep(millis, nanos);
1288            } 
1289          } catch (InterruptedException e) {
1290            currentThread().processThreadInterrupts();
1291          }
1292          return NIL;
1293        }
1294    };
1295
1296    @DocString(name="mapcar-threads", args= "function",
1297    doc="Applies FUNCTION to all existing threads.")
1298    private static final Primitive MAPCAR_THREADS =
1299        new Primitive("mapcar-threads", PACKAGE_THREADS, true)
1300    {
1301        @Override
1302        public LispObject execute(LispObject arg)
1303        {
1304            Function fun = checkFunction(arg);
1305            final LispThread thread = LispThread.currentThread();
1306            LispObject result = NIL;
1307            Iterator it = map.values().iterator();
1308            while (it.hasNext()) {
1309                LispObject[] args = new LispObject[1];
1310                args[0] = (LispThread) it.next();
1311                result = new Cons(funcall(fun, args, thread), result);
1312            }
1313            return result;
1314        }
1315    };
1316
1317    @DocString(name="destroy-thread", args="thread", doc="Mark THREAD as destroyed")
1318    private static final Primitive DESTROY_THREAD =
1319        new Primitive("destroy-thread", PACKAGE_THREADS, true)
1320    {
1321        @Override
1322        public LispObject execute(LispObject arg)
1323        {
1324            final LispThread thread;
1325            if (arg instanceof LispThread) {
1326                thread = (LispThread) arg;
1327            }
1328            else {
1329                return type_error(arg, Symbol.THREAD);
1330            }
1331            thread.setDestroyed(true);
1332            return T;
1333        }
1334    };
1335
1336    // => T
1337    @DocString(name="interrupt-thread", args="thread function &rest args",
1338    doc="Interrupts thread and forces it to apply function to args. When the\n"+
1339        "function returns, the thread's original computation continues. If\n"+
1340        "multiple interrupts are queued for a thread, they are all run, but the\n"+
1341        "order is not guaranteed.")
1342    private static final Primitive INTERRUPT_THREAD =
1343        new Primitive("interrupt-thread", PACKAGE_THREADS, true,
1344              "thread function &rest args",
1345              "Interrupts THREAD and forces it to apply FUNCTION to ARGS.\nWhen the function returns, the thread's original computation continues. If  multiple interrupts are queued for a thread, they are all run, but the order is not guaranteed.")
1346    {
1347        @Override
1348        public LispObject execute(LispObject[] args)
1349        {
1350            if (args.length < 2)
1351                return error(new WrongNumberOfArgumentsException(this, 2, -1));
1352            final LispThread thread;
1353            if (args[0] instanceof LispThread) {
1354                thread = (LispThread) args[0];
1355            }
1356            else {
1357                return type_error(args[0], Symbol.THREAD);
1358            }
1359            LispObject fun = args[1];
1360            LispObject funArgs = NIL;
1361            for (int i = args.length; i-- > 2;)
1362                funArgs = new Cons(args[i], funArgs);
1363            thread.interrupt(fun, funArgs);
1364            return T;
1365        }
1366    };
1367
1368    public static final Primitive CURRENT_THREAD
1369      = new pf_current_thread();
1370    @DocString(name="current-thread",
1371               doc="Returns a reference to invoking thread.")
1372    private static final class pf_current_thread extends Primitive {
1373      pf_current_thread() {
1374        super("current-thread", PACKAGE_THREADS, true);
1375      }
1376      @Override
1377      public LispObject execute() {
1378        return currentThread();
1379      }
1380    };
1381
1382    public static final Primitive BACKTRACE
1383      = new pf_backtrace();
1384    @DocString(name="backtrace",
1385               doc="Returns a Java backtrace of the invoking thread.")
1386    private static final class pf_backtrace extends Primitive {
1387      pf_backtrace() {
1388        super("backtrace", PACKAGE_SYS, true);
1389      }
1390      @Override
1391      public LispObject execute(LispObject[] args) {
1392        if (args.length > 1)
1393          return error(new WrongNumberOfArgumentsException(this, -1, 1));
1394        int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0;
1395        return currentThread().backtrace(limit);
1396      }
1397    };
1398
1399    public static final Primitive FRAME_TO_STRING
1400      = new pf_frame_to_string();
1401    @DocString(name="frame-to-string", 
1402               args="frame",
1403               doc="Convert stack FRAME to a (potentially) readable string.")
1404    private static final class pf_frame_to_string extends Primitive {
1405      pf_frame_to_string() {
1406        super("frame-to-string", PACKAGE_SYS, true);
1407      }
1408      @Override
1409      public LispObject execute(LispObject[] args) {
1410        if (args.length != 1)
1411          return error(new WrongNumberOfArgumentsException(this, 1));
1412        return checkStackFrame(args[0]).toLispString();
1413      }
1414    };
1415
1416    public static final Primitive FRAME_TO_LIST
1417      = new pf_frame_to_list();
1418    @DocString(name="frame-to-list", args="frame")
1419    private static final class pf_frame_to_list extends Primitive {
1420      pf_frame_to_list() {
1421        super("frame-to-list", PACKAGE_SYS, true);
1422      }
1423      @Override
1424      public LispObject execute(LispObject[] args) {
1425        if (args.length != 1)
1426          return error(new WrongNumberOfArgumentsException(this, 1));
1427
1428        return checkStackFrame(args[0]).toLispList();
1429      }
1430    };
1431
1432
1433    public static final SpecialOperator SYNCHRONIZED_ON
1434      = new so_synchronized_on();
1435    @DocString(name="synchronized-on", args="form &body body")
1436    private static final class so_synchronized_on extends SpecialOperator {
1437      so_synchronized_on() {
1438        super("synchronized-on", PACKAGE_THREADS, true, "form &body body");
1439      }
1440      @Override
1441      public LispObject execute(LispObject args, Environment env) {
1442        if (args == NIL)
1443          return error(new WrongNumberOfArgumentsException(this, 1));
1444       
1445        LispThread thread = LispThread.currentThread();
1446        synchronized (eval(args.car(), env, thread).lockableInstance()) {
1447          return progn(args.cdr(), env, thread);
1448        }
1449      }
1450    };
1451
1452 
1453    public static final Primitive OBJECT_WAIT
1454      = new pf_object_wait();
1455    @DocString(
1456    name="object-wait", args="object &optional timeout", 
1457    doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n"
1458       + "Optionally unblock execution after TIMEOUT seconds.  A TIMEOUT of zero\n"
1459       + "means to wait indefinitely.\n"
1460       + "A non-zero TIMEOUT of less than a nanosecond is interpolated as a nanosecond wait."
1461       + "\n"
1462       + "See the documentation of java.lang.Object.wait() for further\n"
1463       + "information.\n"
1464    )
1465    private static final class pf_object_wait extends Primitive {
1466      pf_object_wait() {
1467        super("object-wait", PACKAGE_THREADS, true);
1468      }
1469      @Override
1470      public LispObject execute(LispObject object) {
1471        try {
1472          object.lockableInstance().wait();
1473        } catch (InterruptedException e) {
1474          currentThread().processThreadInterrupts();
1475        } catch (IllegalMonitorStateException e) {
1476          return error(new IllegalMonitorState(e.getMessage()));
1477        }
1478        return NIL;
1479      }
1480
1481      @Override
1482      public LispObject execute(LispObject object, LispObject timeout) {
1483        long millis = sleepMillisPart(timeout);
1484        int nanos = sleepNanosPart(timeout);
1485        boolean zeroArgP = timeout.ZEROP() != NIL;
1486         
1487        try {
1488          if (millis == 0 && nanos == 0) { 
1489            if (zeroArgP) {
1490              object.lockableInstance().wait(0, 0);
1491            } else {
1492              object.lockableInstance().wait(0, 1);
1493            }
1494          } else {
1495            object.lockableInstance().wait(millis, nanos);
1496          }
1497        } catch (InterruptedException e) {
1498          currentThread().processThreadInterrupts();
1499        } catch (IllegalMonitorStateException e) {
1500          return error(new IllegalMonitorState(e.getMessage()));
1501        }
1502        return NIL;
1503      }
1504    };
1505
1506    public static final Primitive OBJECT_NOTIFY
1507      = new pf_object_notify();
1508    @DocString(name="object-notify", 
1509               args="object",
1510               doc="Wakes up a single thread that is waiting on OBJECT's monitor."
1511+ "\nIf any threads are waiting on this object, one of them is chosen to be"
1512+ " awakened. The choice is arbitrary and occurs at the discretion of the"
1513+ " implementation. A thread waits on an object's monitor by calling one"
1514+ " of the wait methods.")
1515    private static final class pf_object_notify extends Primitive {
1516      pf_object_notify() {
1517        super("object-notify", PACKAGE_THREADS, true, "object");
1518      }
1519      @Override
1520      public LispObject execute(LispObject object) {
1521        try {
1522          object.lockableInstance().notify();
1523        } catch (IllegalMonitorStateException e) {
1524          return error(new IllegalMonitorState(e.getMessage()));
1525        }
1526        return NIL;
1527      }
1528    };
1529
1530    public static final Primitive OBJECT_NOTIFY_ALL
1531      = new pf_object_notify_all();
1532    @DocString(name="object-notify-all", 
1533               args="object",
1534               doc="Wakes up all threads that are waiting on this OBJECT's monitor."
1535+ "\nA thread waits on an object's monitor by calling one of the wait methods.")
1536    private static final class pf_object_notify_all extends Primitive {
1537      pf_object_notify_all() {
1538        super("object-notify-all", PACKAGE_THREADS, true);
1539      }
1540      @Override
1541      public LispObject execute(LispObject object) {
1542        try {
1543          object.lockableInstance().notifyAll();
1544        } catch (IllegalMonitorStateException e) {
1545          return error(new IllegalMonitorState(e.getMessage()));
1546        }
1547        return NIL;
1548      }
1549    };
1550}
Note: See TracBrowser for help on using the repository browser.