Changeset 12105


Ignore:
Timestamp:
08/19/09 14:51:56 (12 years ago)
Author:
Mark Evenson
Message:

Split StackFrame? abstraction into Java and Lisp stack frames.

From the original patch/idea from Tobias Rittweiler this introduces
more information of primary interest to ABCL implemnters such as when
a form like (make-thread #'(lambda ())) is evaluated

All users of EXT:BACKTRACE-AS-LIST should now use SYS:BACKTRACE, the
results of which is a list of the new builtin classes JAVA_STACK_FRAME
or LISP_STACK_FRAME. The methods SYS:FRAME-TO-STRING and
SYS:FRAME-TO-LIST are defined to break these new objects into
inspectable parts. As a convenience, there is a SYS:BACKTRACE-AS-LIST
which calls SYS:FRAME-TO-LIST to each element of the computed
backtrace.

Refactorings have occurred on the Java side: the misnamed
LispThread?.backtrace() is now LispThread?.printBacktrace().
LispThread?.backtraceAsList() is now LispThread?.backtrace() as it is
a shorter name, and more to the point.

Java stack frames only appear after a call through Lisp.error(), which
has only the top level as a restart as an option.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 added
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java

    r12053 r12105  
    143143  public static final BuiltInClass TWO_WAY_STREAM       = addClass(Symbol.TWO_WAY_STREAM);
    144144  public static final BuiltInClass VECTOR               = addClass(Symbol.VECTOR);
     145  public static final BuiltInClass STACK_FRAME          = addClass(Symbol.STACK_FRAME);
     146  public static final BuiltInClass LISP_STACK_FRAME     = addClass(Symbol.LISP_STACK_FRAME);
     147  public static final BuiltInClass JAVA_STACK_FRAME     = addClass(Symbol.JAVA_STACK_FRAME);
     148
    145149
    146150  public static final StructureClass STRUCTURE_OBJECT =
     
    276280    VECTOR.setDirectSuperclasses(list(ARRAY, SEQUENCE));
    277281    VECTOR.setCPL(VECTOR, ARRAY, SEQUENCE, CLASS_T);
     282    STACK_FRAME.setDirectSuperclasses(CLASS_T);
     283    STACK_FRAME.setCPL(STACK_FRAME, CLASS_T);
     284    LISP_STACK_FRAME.setDirectSuperclasses(STACK_FRAME);
     285    LISP_STACK_FRAME.setCPL(LISP_STACK_FRAME, STACK_FRAME, CLASS_T);
     286    JAVA_STACK_FRAME.setDirectSuperclasses(STACK_FRAME);
     287    JAVA_STACK_FRAME.setCPL(JAVA_STACK_FRAME, STACK_FRAME, CLASS_T);
    278288  }
    279289
  • trunk/abcl/src/org/armedbear/lisp/Interpreter.java

    r11745 r12105  
    390390                    getStandardInput().clearInput();
    391391                    out.printStackTrace(t);
    392                     thread.backtrace();
     392                    thread.printBacktrace();
    393393                }
    394394            }
     
    409409                           condition.writeToString());
    410410            if (thread != null)
    411                 thread.backtrace();
     411                thread.printBacktrace();
    412412        }
    413413        catch (Throwable t) {
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r12063 r12105  
    272272          {
    273273            thread.setSpecialVariable(_SAVED_BACKTRACE_,
    274                                       thread.backtraceAsList(0));
     274                                      thread.backtrace(0));
    275275            return error(new StorageCondition("Stack overflow."));
    276276          }
     
    288288            Debug.trace(t);
    289289            thread.setSpecialVariable(_SAVED_BACKTRACE_,
    290                                       thread.backtraceAsList(0));
     290                                      thread.backtrace(0));
    291291            return error(new LispError("Caught " + t + "."));
    292292          }
     
    321321    };
    322322
     323  private static final void pushJavaStackFrames() throws ConditionThrowable
     324  {
     325      final LispThread thread = LispThread.currentThread();
     326      final StackTraceElement[] frames = thread.getJavaStackTrace();
     327
     328      // Search for last Primitive in the StackTrace; that was the
     329      // last entry point from Lisp.
     330      int last = frames.length - 1;
     331      for (int i = 0; i<= last; i++) {
     332          if (frames[i].getClassName().startsWith("org.armedbear.lisp.Primitive"))
     333      last = i;
     334      }
     335      // Do not include the first three frames:
     336      //   Thread.getStackTrace, LispThread.getJavaStackTrace,
     337      //   Lisp.pushJavaStackFrames.
     338      while (last > 2) {
     339        thread.pushStackFrame(new JavaStackFrame(frames[last]));
     340        last--;
     341      }
     342  }
     343
     344
    323345  public static final LispObject error(LispObject condition)
    324346    throws ConditionThrowable
    325347  {
     348    pushJavaStackFrames();
    326349    return Symbol.ERROR.execute(condition);
    327350  }
     
    330353    throws ConditionThrowable
    331354  {
     355    pushJavaStackFrames();
    332356    return Symbol.ERROR.execute(condition, Keyword.FORMAT_CONTROL, message);
    333357  }
     
    853877  }
    854878
     879  public static final StackFrame checkStackFrame(LispObject obj)
     880    throws ConditionThrowable
     881  {
     882          if (obj instanceof StackFrame)     
     883                  return (StackFrame) obj;         
     884          return (StackFrame)// Not reached.       
     885      type_error(obj, Symbol.STACK_FRAME);
     886  }
    855887
    856888  static
  • trunk/abcl/src/org/armedbear/lisp/LispThread.java

    r12082 r12105  
    118118    }
    119119
     120    public StackTraceElement[] getJavaStackTrace() {
     121        return javaThread.getStackTrace();
     122    }
     123
    120124    @Override
    121125    public LispObject typeOf()
     
    448452    }
    449453
    450     private static class StackFrame
    451     {
    452         public final LispObject operator;
    453         private final LispObject first;
    454         private final LispObject second;
    455         private final LispObject third;
    456         private final LispObject[] args;
    457         final StackFrame next;
    458 
    459         public StackFrame(LispObject operator, StackFrame next)
    460         {
    461             this.operator = operator;
    462             first = null;
    463             second = null;
    464             third = null;
    465             args = null;
    466             this.next = next;
    467         }
    468 
    469         public StackFrame(LispObject operator, LispObject arg, StackFrame next)
    470         {
    471             this.operator = operator;
    472             first = arg;
    473             second = null;
    474             third = null;
    475             args = null;
    476             this.next = next;
    477         }
    478 
    479         public StackFrame(LispObject operator, LispObject first,
    480                           LispObject second, StackFrame next)
    481         {
    482             this.operator = operator;
    483             this.first = first;
    484             this.second = second;
    485             third = null;
    486             args = null;
    487             this.next = next;
    488         }
    489 
    490         public StackFrame(LispObject operator, LispObject first,
    491                           LispObject second, LispObject third, StackFrame next)
    492         {
    493             this.operator = operator;
    494             this.first = first;
    495             this.second = second;
    496             this.third = third;
    497             args = null;
    498             this.next = next;
    499         }
    500 
    501         public StackFrame(LispObject operator, LispObject[] args, StackFrame next)
    502         {
    503             this.operator = operator;
    504             first = null;
    505             second = null;
    506             third = null;
    507             this.args = args;
    508             this.next = next;
    509         }
    510 
    511         public LispObject toList() throws ConditionThrowable
    512         {
    513             LispObject list = NIL;
    514             if (args != null) {
    515                 for (int i = 0; i < args.length; i++)
    516                     list = list.push(args[i]);
    517             } else {
    518                 do {
    519                     if (first != null)
    520                         list = list.push(first);
    521                     else
    522                         break;
    523                     if (second != null)
    524                         list = list.push(second);
    525                     else
    526                         break;
    527                     if (third != null)
    528                         list = list.push(third);
    529                     else
    530                         break;
    531                 } while (false);
    532             }
    533             list = list.nreverse();
    534             if (operator instanceof Operator) {
    535                 LispObject lambdaName = ((Operator)operator).getLambdaName();
    536                 if (lambdaName != null && lambdaName != NIL)
    537                     return list.push(lambdaName);
    538             }
    539             return list.push(operator);
    540         }
    541     }
    542454
    543455    private StackFrame stack = null;
     
    554466    }
    555467
    556     public final void pushStackFrame(LispObject operator)
    557         throws ConditionThrowable
    558     {
    559         stack = new StackFrame(operator, stack);
    560     }
    561 
    562     public final void pushStackFrame(LispObject operator, LispObject arg)
    563         throws ConditionThrowable
    564     {
    565         stack = new StackFrame(operator, arg, stack);
    566     }
    567 
    568     public final void pushStackFrame(LispObject operator, LispObject first,
    569                                LispObject second)
    570         throws ConditionThrowable
    571     {
    572         stack = new StackFrame(operator, first, second, stack);
    573     }
    574 
    575     public final void pushStackFrame(LispObject operator, LispObject first,
    576                                LispObject second, LispObject third)
    577         throws ConditionThrowable
    578     {
    579         stack = new StackFrame(operator, first, second, third, stack);
    580     }
    581 
    582     public final void pushStackFrame(LispObject operator, LispObject... args)
    583         throws ConditionThrowable
    584     {
    585         stack = new StackFrame(operator, args, stack);
    586     }
     468    public final void pushStackFrame(StackFrame frame)
     469  throws ConditionThrowable
     470    {
     471  frame.setNext(stack);
     472  stack = frame;
     473    }
     474
    587475
    588476    public final void popStackFrame()
    589477    {
    590478        if (stack != null)
    591             stack = stack.next;
     479            stack = stack.getNext();
    592480    }
    593481
     
    603491            return function.execute();
    604492
    605         pushStackFrame(function);
     493        pushStackFrame(new LispStackFrame(function));
    606494        try {
    607495            return function.execute();
     
    619507            return function.execute(arg);
    620508
    621         pushStackFrame(function, arg);
     509        pushStackFrame(new LispStackFrame(function, arg));
    622510        try {
    623511            return function.execute(arg);
     
    636524            return function.execute(first, second);
    637525
    638         pushStackFrame(function, first, second);
     526        pushStackFrame(new LispStackFrame(function, first, second));
    639527        try {
    640528            return function.execute(first, second);
     
    653541            return function.execute(first, second, third);
    654542
    655         pushStackFrame(function, first, second, third);
     543        pushStackFrame(new LispStackFrame(function, first, second, third));
    656544        try {
    657545            return function.execute(first, second, third);
     
    671559            return function.execute(first, second, third, fourth);
    672560
    673         pushStackFrame(function, first, second, third, fourth);
     561        pushStackFrame(new LispStackFrame(function, first, second, third, fourth));
    674562        try {
    675563            return function.execute(first, second, third, fourth);
     
    689577            return function.execute(first, second, third, fourth, fifth);
    690578
    691         pushStackFrame(function, first, second, third, fourth, fifth);
     579        pushStackFrame(new LispStackFrame(function, first, second, third, fourth, fifth));
    692580        try {
    693581            return function.execute(first, second, third, fourth, fifth);
     
    708596            return function.execute(first, second, third, fourth, fifth, sixth);
    709597
    710         pushStackFrame(function, first, second, third, fourth, fifth, sixth);
     598        pushStackFrame(new LispStackFrame(function, first, second,
     599            third, fourth, fifth, sixth));
    711600        try {
    712601            return function.execute(first, second, third, fourth, fifth, sixth);
     
    728617                                    seventh);
    729618
    730         pushStackFrame(function, first, second, third, fourth, fifth, sixth,
    731                                     seventh);
     619        pushStackFrame(new LispStackFrame(function, first, second, third,
     620            fourth, fifth, sixth, seventh));
    732621        try {
    733622            return function.execute(first, second, third, fourth, fifth, sixth,
     
    750639                                    seventh, eighth);
    751640
    752         pushStackFrame(function, first, second, third, fourth, fifth, sixth,
    753                                     seventh, eighth);
     641        pushStackFrame(new LispStackFrame(function, first, second, third,
     642            fourth, fifth, sixth, seventh, eighth));
    754643        try {
    755644            return function.execute(first, second, third, fourth, fifth, sixth,
     
    767656            return function.execute(args);
    768657
    769         pushStackFrame(function, args);
     658        pushStackFrame(new LispStackFrame(function, args));
    770659        try {
    771660            return function.execute(args);
     
    776665    }
    777666
    778     public void backtrace()
    779     {
    780         backtrace(0);
    781     }
    782 
    783     public void backtrace(int limit)
     667    public void printBacktrace()
     668    {
     669        printBacktrace(0);
     670    }
     671
     672    public void printBacktrace(int limit)
    784673    {
    785674        if (stack != null) {
     
    797686                    out._writeString(": ");
    798687                   
    799                     pprint(s.toList(), out.getCharPos(), out);
     688                    pprint(s.toLispList(), out.getCharPos(), out);
    800689                    out.terpri();
    801690                    out._finishOutput();
     
    811700    }
    812701
    813     public LispObject backtraceAsList(int limit) throws ConditionThrowable
     702    public LispObject backtrace(int limit) throws ConditionThrowable
    814703    {
    815704        LispObject result = NIL;
     
    819708                StackFrame s = stack;
    820709                while (s != null) {
    821                     result = result.push(s.toList());
     710                    result = result.push(s);
    822711                    if (limit > 0 && ++count == limit)
    823712                        break;
    824                     s = s.next;
     713                    s = s.getNext();
    825714                }
    826715            }
     
    839728            if (s == null)
    840729                break;
    841             LispObject operator = s.operator;
    842             if (operator != null) {
    843                 operator.incrementHotCount();
    844                 operator.incrementCallCount();
    845             }
    846             s = s.next;
     730      if (s instanceof LispStackFrame) {
     731    LispObject operator = ((LispStackFrame)s).getOperator();
     732    if (operator != null) {
     733        operator.incrementHotCount();
     734        operator.incrementCallCount();
     735    }
     736    s = s.getNext();
     737      }
    847738        }
    848739
    849740        while (s != null) {
    850             LispObject operator = s.operator;
    851             if (operator != null)
    852                 operator.incrementCallCount();
    853             s = s.next;
     741      if (s instanceof LispStackFrame) {
     742    LispObject operator = ((LispStackFrame)s).getOperator();
     743    if (operator != null)
     744        operator.incrementCallCount();
     745      }
     746      s = s.getNext();
    854747        }
    855748    }
     
    11111004    };
    11121005
    1113     // ### backtrace-as-list
    1114     private static final Primitive BACKTRACE_AS_LIST =
    1115         new Primitive("backtrace-as-list", PACKAGE_EXT, true, "",
    1116           "Returns a backtrace of the invoking thread as a list.")
     1006    // ### backtrace
     1007    private static final Primitive BACKTRACE =
     1008        new Primitive("backtrace", PACKAGE_SYS, true, "",
     1009          "Returns a backtrace of the invoking thread.")
    11171010    {
    11181011        @Override
     
    11231016                return error(new WrongNumberOfArgumentsException(this));
    11241017            int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0;
    1125             return currentThread().backtraceAsList(limit);
    1126         }
    1127     };
     1018            return currentThread().backtrace(limit);
     1019        }
     1020    };
     1021    // ### frame-to-string
     1022    private static final Primitive FRAME_TO_STRING =
     1023        new Primitive("frame-to-string", PACKAGE_SYS, true, "frame")
     1024    {
     1025        @Override
     1026        public LispObject execute(LispObject[] args)
     1027            throws ConditionThrowable
     1028        {
     1029            if (args.length != 1)
     1030                return error(new WrongNumberOfArgumentsException(this));
     1031           
     1032            return checkStackFrame(args[0]).toLispString();
     1033        }
     1034    };
     1035
     1036    // ### frame-to-list
     1037    private static final Primitive FRAME_TO_LIST =
     1038        new Primitive("frame-to-list", PACKAGE_SYS, true, "frame")
     1039    {
     1040        @Override
     1041        public LispObject execute(LispObject[] args)
     1042            throws ConditionThrowable
     1043        {
     1044            if (args.length != 1)
     1045                return error(new WrongNumberOfArgumentsException(this));
     1046
     1047            return checkStackFrame(args[0]).toLispList();
     1048        }
     1049    };
     1050
    11281051
    11291052    static {
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r12079 r12105  
    30403040  public static final Symbol STRING_OUTPUT_STREAM =
    30413041    PACKAGE_SYS.addInternalSymbol("STRING-OUTPUT-STREAM");
     3042  public static final Symbol STACK_FRAME =
     3043    PACKAGE_SYS.addInternalSymbol("STACK-FRAME");
     3044  public static final Symbol LISP_STACK_FRAME =
     3045    PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
     3046  public static final Symbol JAVA_STACK_FRAME =
     3047    PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
    30423048
    30433049  // CDR6
  • trunk/abcl/src/org/armedbear/lisp/boot.lisp

    r12017 r12105  
    335335(load-system-file "package")
    336336
    337 
    338337(defun preload-package (pkg)
    339338  (%format t "Preloading ~S~%" (find-package pkg))
  • trunk/abcl/src/org/armedbear/lisp/debug.lisp

    r11391 r12105  
    101101
    102102(defun invoke-debugger (condition)
    103   (let ((*saved-backtrace* (backtrace-as-list)))
     103  (let ((*saved-backtrace* (sys:backtrace)))
    104104    (when *debugger-hook*
    105105      (let ((hook-function *debugger-hook*)
     
    130130                              :format-arguments format-arguments))))
    131131    nil))
     132
     133(defun backtrace-as-list (&optional (n 0))
     134  "Return BACKTRACE with each element converted to a list."
     135  (mapcar #'sys::frame-to-list (sys:backtrace n)))
  • trunk/abcl/src/org/armedbear/lisp/signal.lisp

    r11391 r12105  
    5050           (*break-on-signals* nil))
    5151      (when (typep condition old-bos)
    52         (let ((*saved-backtrace* (backtrace-as-list)))
     52        (let ((*saved-backtrace* (sys:backtrace)))
    5353          (break "~A~%BREAK called because of *BREAK-ON-SIGNALS* (now rebound to NIL)."
    5454                 condition))))
  • trunk/abcl/src/org/armedbear/lisp/top-level.lisp

    r11667 r12105  
    103103    (show-restarts (compute-restarts) *debug-io*)))
    104104
     105(defun print-frame (frame stream &key prefix)
     106  (when prefix
     107    (write-string prefix stream))
     108  (etypecase frame
     109    (sys::lisp-stack-frame
     110     (pprint-logical-block (stream nil :prefix "(" :suffix ")")
     111       (setq frame (sys:frame-to-list frame))
     112       (ignore-errors
     113         (prin1 (car frame) stream)
     114         (let ((args (cdr frame)))
     115           (if (listp args)
     116               (format stream "~{ ~_~S~}" args)
     117               (format stream " ~S" args))))))
     118    (sys::java-stack-frame
     119     (write-string (sys:frame-to-string frame) stream))))
     120
     121
    105122(defun backtrace-command (args)
    106123  (let ((count (or (and args (ignore-errors (parse-integer args)))
     
    114131        (dolist (frame *saved-backtrace*)
    115132          (fresh-line *debug-io*)
    116           (let ((prefix (format nil "~3D: (" n)))
    117             (pprint-logical-block (*debug-io* nil :prefix prefix :suffix ")")
    118               (ignore-errors
    119                (prin1 (car frame) *debug-io*)
    120                (let ((args (cdr frame)))
    121                  (if (listp args)
    122                      (format *debug-io* "~{ ~_~S~}" args)
    123                      (format *debug-io* " ~S" args))))))
     133          (print-frame frame *debug-io* :prefix (format nil "~3D: " n))
    124134          (incf n)
    125135          (when (>= n count)
     
    137147              (*print-structure* nil))
    138148          (fresh-line *debug-io*)
    139           (pprint-logical-block (*debug-io* nil :prefix "(" :suffix ")")
    140             (prin1 (car frame) *debug-io*)
    141             (let ((args (cdr frame)))
    142               (if (listp args)
    143                   (format *debug-io* "~{ ~_~S~}" args)
    144                   (format *debug-io* " ~S" args))))))
     149    (print-frame frame *debug-io*)))
    145150      (setf *** **
    146151            ** *
Note: See TracChangeset for help on using the changeset viewer.