KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > LispThread


1 /*
2  * LispThread.java
3  *
4  * Copyright (C) 2003-2004 Peter Graves
5  * $Id: LispThread.java,v 1.58 2004/09/09 12:43:23 piso Exp $
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
22 package org.armedbear.lisp;
23
24 import java.util.HashMap JavaDoc;
25 import java.util.Iterator JavaDoc;
26 import java.util.Stack JavaDoc;
27
28 public final class LispThread extends LispObject
29 {
30     private static final Object JavaDoc lock = new Object JavaDoc();
31
32     private static HashMap JavaDoc map = new HashMap JavaDoc();
33
34     public static final LispThread currentThread()
35     {
36         Thread JavaDoc currentJavaThread = Thread.currentThread();
37         LispThread lispThread = get(currentJavaThread);
38         if (lispThread == null) {
39             lispThread = new LispThread(currentJavaThread);
40             put(currentJavaThread, lispThread);
41         }
42         return lispThread;
43     }
44
45     private static void put(Thread JavaDoc javaThread, LispThread lispThread)
46     {
47         synchronized (lock) {
48             HashMap JavaDoc m = (HashMap JavaDoc) map.clone();
49             m.put(javaThread, lispThread);
50             map = m;
51         }
52     }
53
54     private static LispThread get(Thread JavaDoc javaThread)
55     {
56         return (LispThread) map.get(javaThread);
57     }
58
59     private static void remove(Thread JavaDoc javaThread)
60     {
61         synchronized (lock) {
62             HashMap JavaDoc m = (HashMap JavaDoc) map.clone();
63             m.remove(javaThread);
64             map = m;
65         }
66     }
67
68     private final Thread JavaDoc javaThread;
69     private boolean destroyed;
70     private final LispObject name;
71     public Environment dynEnv;
72     public LispObject[] _values;
73     private boolean threadInterrupted;
74     private LispObject pending = NIL;
75
76     private LispThread(Thread JavaDoc javaThread)
77     {
78         this.javaThread = javaThread;
79         name = new SimpleString(javaThread.getName());
80     }
81
82     private LispThread(final Function fun, LispObject name)
83     {
84         Runnable JavaDoc r = new Runnable JavaDoc() {
85             public void run()
86             {
87                 try {
88                     funcall(fun, new LispObject[0], LispThread.this);
89                 }
90                 catch (ThreadDestroyed ignored) {
91                     ; // Might happen.
92
}
93                 catch (Throwable JavaDoc t) {
94                     if (isInterrupted()) {
95                         try {
96                             processThreadInterrupts();
97                         }
98                         catch (ConditionThrowable c) {
99                             Debug.trace(c);
100                         }
101                     }
102                 }
103                 finally {
104                     remove(javaThread);
105                 }
106             }
107         };
108         javaThread = new Thread JavaDoc(r);
109         put(javaThread, this);
110         this.name = name;
111         javaThread.start();
112     }
113
114     public final synchronized boolean isDestroyed()
115     {
116         return destroyed;
117     }
118
119     private final synchronized boolean isInterrupted()
120     {
121         return threadInterrupted;
122     }
123
124     private final synchronized void setDestroyed(boolean b)
125     {
126         destroyed = b;
127     }
128
129     private final synchronized void interrupt(LispObject function, LispObject args)
130     {
131         pending = new Cons(args, pending);
132         pending = new Cons(function, pending);
133         threadInterrupted = true;
134         javaThread.interrupt();
135     }
136
137     private final synchronized void processThreadInterrupts()
138         throws ConditionThrowable
139     {
140         while (pending != NIL) {
141             LispObject function = pending.car();
142             LispObject args = pending.cadr();
143             pending = pending.cddr();
144             Primitives.APPLY.execute(function, args);
145         }
146         threadInterrupted = false;
147     }
148
149     public final LispObject[] getValues()
150     {
151         return _values;
152     }
153
154     public final LispObject[] getValues(LispObject result, int count)
155     {
156         if (_values == null) {
157             LispObject[] values = new LispObject[count];
158             if (count > 0)
159                 values[0] = result;
160             for (int i = 1; i < count; i++)
161                 values[i] = NIL;
162             return values;
163         }
164         // If the caller doesn't want any extra values, just return the ones
165
// we've got.
166
if (count <= _values.length)
167             return _values;
168         // The caller wants more values than we have. Pad with NILs.
169
LispObject[] values = new LispObject[count];
170         for (int i = _values.length; i-- > 0;)
171             values[i] = _values[i];
172         for (int i = _values.length; i < count; i++)
173             values[i] = NIL;
174         return values;
175     }
176
177     // Used by the JVM compiler for MULTIPLE-VALUE-CALL.
178
public final LispObject[] accumulateValues(LispObject result,
179                                                LispObject[] oldValues)
180     {
181         if (oldValues == null) {
182             if (_values != null)
183                 return _values;
184             LispObject[] values = new LispObject[1];
185             values[0] = result;
186             return values;
187         }
188         if (_values != null) {
189             if (_values.length == 0)
190                 return oldValues;
191             final int totalLength = oldValues.length + _values.length;
192             LispObject[] values = new LispObject[totalLength];
193             System.arraycopy(oldValues, 0,
194                              values, 0,
195                              oldValues.length);
196             System.arraycopy(_values, 0,
197                              values, oldValues.length,
198                              _values.length);
199             return values;
200         }
201         // _values is null.
202
final int totalLength = oldValues.length + 1;
203         LispObject[] values = new LispObject[totalLength];
204         System.arraycopy(oldValues, 0,
205                          values, 0,
206                          oldValues.length);
207         values[totalLength - 1] = result;
208         return values;
209     }
210
211     public final LispObject setValues()
212     {
213         _values = new LispObject[0];
214         return NIL;
215     }
216
217     public final LispObject setValues(LispObject value1)
218     {
219         _values = null;
220         return value1;
221     }
222
223     public final LispObject setValues(LispObject value1, LispObject value2)
224     {
225         _values = new LispObject[2];
226         _values[0] = value1;
227         _values[1] = value2;
228         return value1;
229     }
230
231     public final LispObject setValues(LispObject value1, LispObject value2,
232                                       LispObject value3)
233     {
234         _values = new LispObject[3];
235         _values[0] = value1;
236         _values[1] = value2;
237         _values[2] = value3;
238         return value1;
239     }
240
241     public final LispObject setValues(LispObject[] values)
242     {
243         if (values == null) {
244             Debug.assertTrue(false);
245             _values = null;
246         } else
247             _values = values;
248         return values.length > 0 ? values[0] : NIL;
249     }
250
251     public final void clearValues()
252     {
253         _values = null;
254     }
255
256     public final LispObject nothing()
257     {
258         _values = new LispObject[0];
259         return NIL;
260     }
261
262     // Forces a single value, for situations where multiple values should be
263
// ignored.
264
public final LispObject value(LispObject obj)
265     {
266         _values = null;
267         return obj;
268     }
269
270     public final Environment getDynamicEnvironment()
271     {
272         return dynEnv;
273     }
274
275     public final void setDynamicEnvironment(Environment env)
276     {
277         dynEnv = env;
278     }
279
280     public final void bindSpecial(Symbol symbol, LispObject value)
281     {
282         dynEnv = new Environment(dynEnv, symbol, value);
283     }
284
285     public final LispObject lookupSpecial(LispObject symbol)
286     {
287         return dynEnv != null ? dynEnv.lookup(symbol) : null;
288     }
289
290     private LispObject catchTags = NIL;
291
292     public void pushCatchTag(LispObject tag) throws ConditionThrowable
293     {
294         catchTags = new Cons(tag, catchTags);
295     }
296
297     public void popCatchTag() throws ConditionThrowable
298     {
299         if (catchTags != NIL)
300             catchTags = catchTags.cdr();
301         else
302             Debug.assertTrue(false);
303     }
304
305     public void throwToTag(LispObject tag, LispObject result)
306         throws ConditionThrowable
307     {
308         LispObject rest = catchTags;
309         while (rest != NIL) {
310             if (rest.car() == tag)
311                 throw new Throw(tag, result, this);
312             rest = rest.cdr();
313         }
314         signal(new ControlError("Attempt to throw to the nonexistent tag " +
315                                 tag.writeToString() + "."));
316     }
317
318     private static class StackFrame extends LispObject
319     {
320         private final LispObject functional;
321         private final LispObject[] argv;
322
323         public StackFrame(LispObject functional, LispObject[] argv)
324         {
325             this.functional = functional;
326             this.argv = argv;
327         }
328
329         public LispObject getFunctional()
330         {
331             return functional;
332         }
333
334         public LispObject[] getArgumentVector()
335         {
336             return argv;
337         }
338     }
339
340     private LispObject stack = NIL;
341
342     public LispObject getStack()
343     {
344         return stack;
345     }
346
347     public void setStack(LispObject stack)
348     {
349         this.stack = stack;
350     }
351
352     public void pushStackFrame(LispObject fun, LispObject[] args)
353         throws ConditionThrowable
354     {
355         if (profiling && sampling) {
356             if (sampleNow)
357                 Profiler.sample(this);
358         }
359         stack = new Cons((new StackFrame(fun, args)), stack);
360     }
361
362     public void resetStack()
363     {
364         stack = NIL;
365     }
366
367     public LispObject execute(LispObject function) throws ConditionThrowable
368     {
369         LispObject oldStack = stack;
370         pushStackFrame(function, new LispObject[0]);
371         try {
372             return function.execute();
373         }
374         finally {
375             if (profiling && sampling) {
376                 if (sampleNow)
377                     Profiler.sample(this);
378             }
379             stack = oldStack;
380         }
381     }
382
383     public LispObject execute(LispObject function, LispObject arg)
384         throws ConditionThrowable
385     {
386         LispObject oldStack = stack;
387         LispObject[] args = new LispObject[1];
388         args[0] = arg;
389         pushStackFrame(function, args);
390         try {
391             return function.execute(arg);
392         }
393         finally {
394             if (profiling && sampling) {
395                 if (sampleNow)
396                     Profiler.sample(this);
397             }
398             stack = oldStack;
399         }
400     }
401
402     public LispObject execute(LispObject function, LispObject first,
403                               LispObject second)
404         throws ConditionThrowable
405     {
406         LispObject oldStack = stack;
407         LispObject[] args = new LispObject[2];
408         args[0] = first;
409         args[1] = second;
410         pushStackFrame(function, args);
411         try {
412             return function.execute(first, second);
413         }
414         finally {
415             if (profiling && sampling) {
416                 if (sampleNow)
417                     Profiler.sample(this);
418             }
419             stack = oldStack;
420         }
421     }
422
423     public LispObject execute(LispObject function, LispObject first,
424                               LispObject second, LispObject third)
425         throws ConditionThrowable
426     {
427         LispObject oldStack = stack;
428         LispObject[] args = new LispObject[3];
429         args[0] = first;
430         args[1] = second;
431         args[2] = third;
432         pushStackFrame(function, args);
433         try {
434             return function.execute(first, second, third);
435         }
436         finally {
437             if (profiling && sampling) {
438                 if (sampleNow)
439                     Profiler.sample(this);
440             }
441             stack = oldStack;
442         }
443     }
444
445     public LispObject execute(LispObject function, LispObject first,
446                               LispObject second, LispObject third,
447                               LispObject fourth)
448         throws ConditionThrowable
449     {
450         LispObject oldStack = stack;
451         LispObject[] args = new LispObject[4];
452         args[0] = first;
453         args[1] = second;
454         args[2] = third;
455         args[3] = fourth;
456         pushStackFrame(function, args);
457         try {
458             return function.execute(first, second, third, fourth);
459         }
460         finally {
461             if (profiling && sampling) {
462                 if (sampleNow)
463                     Profiler.sample(this);
464             }
465             stack = oldStack;
466         }
467     }
468
469     public LispObject execute(LispObject function, LispObject[] args)
470         throws ConditionThrowable
471     {
472         LispObject oldStack = stack;
473         pushStackFrame(function, args);
474         try {
475             return function.execute(args);
476         }
477         finally {
478             if (profiling && sampling) {
479                 if (sampleNow)
480                     Profiler.sample(this);
481             }
482             stack = oldStack;
483         }
484     }
485
486     public void backtrace()
487     {
488         backtrace(0);
489     }
490
491     public void backtrace(int limit)
492     {
493         if (stack != NIL) {
494             try {
495                 int count = 0;
496                 Stream out =
497                     checkCharacterOutputStream(_TRACE_OUTPUT_.symbolValue());
498                 out._writeLine("Evaluation stack:");
499                 out._finishOutput();
500                 while (stack != NIL) {
501                     out._writeString(" ");
502                     out._writeString(String.valueOf(count));
503                     out._writeString(": ");
504                     StackFrame frame = (StackFrame) stack.car();
505                     stack = stack.cdr();
506                     LispObject obj = NIL;
507                     LispObject[] argv = frame.getArgumentVector();
508                     for (int j = argv.length; j-- > 0;)
509                         obj = new Cons(argv[j], obj);
510                     LispObject functional = frame.getFunctional();
511                     if (functional instanceof Functional &&
512                         ((Functional)functional).getLambdaName() != null)
513                         obj = new Cons(((Functional)functional).getLambdaName(), obj);
514                     else
515                         obj = new Cons(functional, obj);
516                     pprint(obj, out.getCharPos(), out);
517                     out.terpri();
518                     out._finishOutput();
519                     if (limit > 0 && ++count == limit)
520                         break;
521                 }
522             }
523             catch (Throwable JavaDoc t) {
524                 t.printStackTrace();
525             }
526         }
527     }
528
529     public LispObject backtraceAsList(int limit) throws ConditionThrowable
530     {
531         LispObject result = NIL;
532         if (stack != NIL) {
533             int count = 0;
534             try {
535                 LispObject s = stack;
536                 while (s != NIL) {
537                     StackFrame frame = (StackFrame) s.car();
538                     if (frame != null) {
539                         LispObject obj = NIL;
540                         LispObject[] argv = frame.getArgumentVector();
541                         for (int j = argv.length; j-- > 0;) {
542                             if (argv[j] != null)
543                                 obj = new Cons(argv[j], obj);
544                         }
545                         LispObject functional = frame.getFunctional();
546                         if (functional instanceof Functional &&
547                             ((Functional)functional).getLambdaName() != null)
548                             obj = new Cons(((Functional)functional).getLambdaName(), obj);
549                         else
550                             obj = new Cons(functional, obj);
551                         result = new Cons(obj, result);
552                         if (limit > 0 && ++count == limit)
553                             break;
554                     }
555                     s = s.cdr();
556                 }
557             }
558             catch (Throwable JavaDoc t) {
559                 t.printStackTrace();
560             }
561         }
562         return result.nreverse();
563     }
564
565     public void incrementCallCounts() throws ConditionThrowable
566     {
567         LispObject s = stack;
568         while (s != NIL) {
569             StackFrame frame = (StackFrame) s.car();
570             if (frame != null) {
571                 LispObject functional = frame.getFunctional();
572                 if (functional != null)
573                     functional.incrementCallCount();
574             }
575             s = s.cdr();
576         }
577     }
578
579     private static void pprint(LispObject obj, int indentBy, Stream stream)
580         throws ConditionThrowable
581     {
582         if (stream.getCharPos() == 0) {
583             StringBuffer JavaDoc sb = new StringBuffer JavaDoc();
584             for (int i = 0; i < indentBy; i++)
585                 sb.append(' ');
586             stream._writeString(sb.toString());
587         }
588         String JavaDoc raw = obj.writeToString();
589         if (stream.getCharPos() + raw.length() < 80) {
590             // It fits.
591
stream._writeString(raw);
592             return;
593         }
594         // Object doesn't fit.
595
if (obj instanceof Cons) {
596             try {
597                 boolean newlineBefore = false;
598                 LispObject[] array = obj.copyToArray();
599                 if (array.length > 0) {
600                     LispObject first = array[0];
601                     if (first == Symbol.LET) {
602                         newlineBefore = true;
603                     }
604                 }
605                 int charPos = stream.getCharPos();
606                 if (newlineBefore && charPos != indentBy) {
607                     stream.terpri();
608                     charPos = stream.getCharPos();
609                 }
610                 if (charPos < indentBy) {
611                     StringBuffer JavaDoc sb = new StringBuffer JavaDoc();
612                     for (int i = charPos; i < indentBy; i++)
613                         sb.append(' ');
614                     stream._writeString(sb.toString());
615                 }
616                 stream.print('(');
617                 for (int i = 0; i < array.length; i++) {
618                     pprint(array[i], indentBy + 2, stream);
619                     if (i < array.length - 1)
620                         stream.print(' ');
621                 }
622                 stream.print(')');
623             }
624             catch (ConditionThrowable t) {
625                 Debug.trace(t);
626             }
627         } else {
628             stream.terpri();
629             StringBuffer JavaDoc sb = new StringBuffer JavaDoc();
630             for (int i = 0; i < indentBy; i++)
631                 sb.append(' ');
632             stream._writeString(sb.toString());
633             stream._writeString(raw);
634             return;
635         }
636     }
637
638     public String JavaDoc writeToString() throws ConditionThrowable
639     {
640         StringBuffer JavaDoc sb = new StringBuffer JavaDoc("#<THREAD ");
641         if (name != NIL) {
642             sb.append('"');
643             sb.append(name.getStringValue());
644             sb.append("\" ");
645         }
646         sb.append("@ #x");
647         sb.append(Integer.toHexString(System.identityHashCode(this)));
648         sb.append(">");
649         return sb.toString();
650     }
651
652     // ### make-thread
653
private static final Primitive MAKE_THREAD =
654         new Primitive("make-thread", PACKAGE_EXT, true, "function &key name")
655     {
656         public LispObject execute(LispObject[] args) throws ConditionThrowable
657         {
658             final int length = args.length;
659             if (length == 0)
660                 signal(new WrongNumberOfArgumentsException(this));
661             LispObject name = NIL;
662             if (length > 1) {
663                 if ((length - 1) % 2 != 0)
664                     signal(new ProgramError("Odd number of keyword arguments."));
665                 if (length > 3)
666                     signal(new WrongNumberOfArgumentsException(this));
667                 if (args[1] == Keyword.NAME)
668                     name = args[2].STRING();
669                 else
670                     signal(new ProgramError("Unrecognized keyword argument " +
671                                             args[1].writeToString() + "."));
672             }
673             return new LispThread(checkFunction(args[0]), name);
674         }
675     };
676
677     // ### thread-alive-p
678
private static final Primitive1 THREAD_ALIVE_P =
679         new Primitive1("thread-alive-p", PACKAGE_EXT, true, "thread")
680     {
681         public LispObject execute(LispObject arg) throws ConditionThrowable
682         {
683             try {
684                 return ((LispThread)arg).javaThread.isAlive() ? T : NIL;
685             }
686             catch (ClassCastException JavaDoc e) {
687                 return signal(new TypeError(arg, "Lisp thread"));
688             }
689         }
690     };
691
692     // ### thread-name
693
private static final Primitive1 THREAD_NAME =
694         new Primitive1("thread-name", PACKAGE_EXT, true, "thread")
695     {
696         public LispObject execute(LispObject arg) throws ConditionThrowable
697         {
698             try {
699                 return ((LispThread)arg).name;
700             }
701             catch (ClassCastException JavaDoc e) {
702                 return signal(new TypeError(arg, "Lisp thread"));
703             }
704         }
705     };
706
707     // ### sleep
708
private static final Primitive1 SLEEP = new Primitive1("sleep", "seconds")
709     {
710         public LispObject execute(LispObject arg) throws ConditionThrowable
711         {
712             double d =
713                 ((LispFloat)arg.multiplyBy(new LispFloat(1000))).getValue();
714             if (d < 0)
715                 return signal(new TypeError(arg, "non-negative real"));
716             long millis = d < Long.MAX_VALUE ? (long) d : Long.MAX_VALUE;
717             try {
718                 Thread.currentThread().sleep(millis);
719             }
720             catch (InterruptedException JavaDoc e) {
721                 currentThread().processThreadInterrupts();
722             }
723             return NIL;
724         }
725     };
726
727     // ### mapcar-threads
728
private static final Primitive1 MAPCAR_THREADS =
729         new Primitive1("mapcar-threads", PACKAGE_EXT, true)
730     {
731         public LispObject execute(LispObject arg) throws ConditionThrowable
732         {
733             Function fun = checkFunction(arg);
734             final LispThread thread = LispThread.currentThread();
735             LispObject result = NIL;
736             Iterator JavaDoc it = map.values().iterator();
737             while (it.hasNext()) {
738                 LispObject[] args = new LispObject[1];
739                 args[0] = (LispThread) it.next();
740                 result = new Cons(funcall(fun, args, thread), result);
741             }
742             return result;
743         }
744     };
745
746     // ### destroy-thread
747
private static final Primitive1 DESTROY_THREAD =
748         new Primitive1("destroy-thread", PACKAGE_EXT, true)
749     {
750         public LispObject execute(LispObject arg) throws ConditionThrowable
751         {
752             if (arg instanceof LispThread) {
753                 LispThread thread = (LispThread) arg;
754                 thread.setDestroyed(true);
755                 return T;
756             } else
757                 return signal(new TypeError(arg, "Lisp thread"));
758         }
759     };
760
761     // ### interrupt-thread thread function &rest args => T
762
// Interrupts thread and forces it to apply function to args. When the
763
// function returns, the thread's original computation continues. If
764
// multiple interrupts are queued for a thread, they are all run, but the
765
// order is not guaranteed.
766
private static final Primitive INTERRUPT_THREAD =
767         new Primitive("interrupt-thread", PACKAGE_EXT, true)
768     {
769         public LispObject execute(LispObject[] args) throws ConditionThrowable
770         {
771             if (args.length < 2)
772                 return signal(new WrongNumberOfArgumentsException(this));
773             if (args[0] instanceof LispThread) {
774                 LispThread thread = (LispThread) args[0];
775                 LispObject fun = args[1];
776                 LispObject funArgs = NIL;
777                 for (int i = args.length; i-- > 2;)
778                     funArgs = new Cons(args[i], funArgs);
779                 thread.interrupt(fun, funArgs);
780                 return T;
781             } else
782                 return signal(new TypeError(args[0], "Lisp thread"));
783         }
784     };
785
786     // ### current-thread
787
private static final Primitive0 CURRENT_THREAD =
788         new Primitive0("current-thread", PACKAGE_EXT, true)
789     {
790         public LispObject execute() throws ConditionThrowable
791         {
792             return currentThread();
793         }
794     };
795
796     // ### backtrace
797
private static final Primitive BACKTRACE =
798         new Primitive("backtrace", PACKAGE_EXT, true)
799     {
800         public LispObject execute(LispObject[] args)
801             throws ConditionThrowable
802         {
803             if (args.length > 1)
804                 return signal(new WrongNumberOfArgumentsException(this));
805             int count = args.length > 0 ? Fixnum.getValue(args[0]) : 0;
806             LispThread thread = currentThread();
807             thread.backtrace(count);
808             return thread.nothing();
809         }
810     };
811
812     // ### backtrace-as-list
813
private static final Primitive BACKTRACE_AS_LIST =
814         new Primitive("backtrace-as-list", PACKAGE_EXT, true)
815     {
816         public LispObject execute(LispObject[] args)
817             throws ConditionThrowable
818         {
819             if (args.length > 1)
820                 return signal(new WrongNumberOfArgumentsException(this));
821             int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0;
822             return currentThread().backtraceAsList(limit);
823         }
824     };
825 }
826
Popular Tags