Changeset 15026


Ignore:
Timestamp:
Oct 17, 2011, 4:51:11 PM (8 years ago)
Author:
rme
Message:

From trunk: Lisp kernel backtrace printer improvments; alter
the way create_exception_callback_frame() passes an absolute pc
to lisp.

Location:
release/1.7/source
Files:
20 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/1.7/source

  • release/1.7/source/compiler/X86/X8632/x8632-arch.lisp

    r14621 r15026  
    539539  foreign-sp                            ;value of tcr.foreign_sp
    540540  prev-xframe                           ;tcr.xframe before exception
    541   )                                     ;(last 2 needed by apply-in-frame)
     541                                        ;(last 2 needed by apply-in-frame)
     542  pc-low                                ;fixnum low half of absolute pc
     543  pc-high                               ;and the high half
     544  )
    542545
    543546;;; The kernel uses these (rather generically named) structures
  • release/1.7/source/compiler/X86/X8664/x8664-arch.lisp

    r14175 r15026  
    635635  prev-xframe                           ; tcr.xframe before exception
    636636                                        ; (last 2 needed by apply-in-frame)
     637  pc-low                                ;fixnum low half of absolute pc
     638  pc-high                               ;and the high half
    637639  )
    638640
  • release/1.7/source/level-0/l0-cfm-support.lisp

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • release/1.7/source/level-1/x86-trap-support.lisp

    r14842 r15026  
    342342                        (type (simple-array (unsigned-byte 8) (*)) containing-object))
    343343        (aref containing-object (the fixnum (+ byte-offset delta))))
    344       ;; xcf.relative-pc is a fixnum, but it might be negative.
    345       (let* ((encoded-pc (%get-ptr xcf-ptr target::xcf.relative-pc))
    346              (pc (ash (%ptr-to-int encoded-pc) (- target::fixnumshift))))
     344      (let* ((high-half (%get-object xcf-ptr target::xcf.pc-high))
     345             (low-half (%get-object xcf-ptr target::xcf.pc-low))
     346             (pc #+64-bit-target (dpb high-half (byte 32 32) low-half)
     347                 #+32-bit-target (dpb high-half (byte 16 16) low-half)))
    347348        (%get-unsigned-byte (%int-to-ptr pc) delta)))))
    348349
  • release/1.7/source/lisp-kernel/darwinx8632/Makefile

    r14701 r15026  
    5252COBJ  = pmcl-kernel.o gc-common.o bits.o  \
    5353        thread_manager.o lisp-debug.o image.o memory.o x86-gc.o \
     54        x86-utils.o \
    5455        x86-exceptions.o unix-calls.o mach-o-image.o
    5556
     
    6263        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    6364        threads.h lisptypes.h x86-constants32.h x86-exceptions.h \
     65        x86-utils.h \
    6466        $(PLATFORM_H) constants.h os-darwin.h
    6567
  • release/1.7/source/lisp-kernel/darwinx8664/Makefile

    r14702 r15026  
    7272
    7373COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     74        x86-utils.o \
    7475        thread_manager.o lisp-debug.o image.o memory.o unix-calls.o \
    7576        mach-o-image.o
     
    8485        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    8586        threads.h lisptypes.h x86-constants64.h x86-exceptions.h \
     87        x86-utils.h \
    8688        $(PLATFORM_H) constants.h os-darwin.h
    8789
  • release/1.7/source/lisp-kernel/freebsdx8632/Makefile

    r14444 r15026  
    3636
    3737COBJ  = pmcl-kernel.o gc-common.o  x86-gc.o bits.o  x86-exceptions.o \
     38        x86-utils.o \
    3839        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    3940
     
    4950CHEADERS = area.h bits.h x86-constants.h lisp-errors.h gc.h lisp.h \
    5051        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
     52        x86-utils.h \
    5153        threads.h x86-constants32.h x86-exceptions.h $(PLATFORM_H)
    5254
  • release/1.7/source/lisp-kernel/freebsdx8664/Makefile

    r14391 r15026  
    3737
    3838COBJ  = pmcl-kernel.o gc-common.o  x86-gc.o bits.o  x86-exceptions.o \
     39        x86-utils.o \
    3940        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    4041
     
    4748CHEADERS = area.h bits.h x86-constants.h lisp-errors.h gc.h lisp.h \
    4849        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
     50        x86-utils.h \
    4951        threads.h x86-constants64.h x86-exceptions.h $(PLATFORM_H)
    5052
  • release/1.7/source/lisp-kernel/linuxx8632/Makefile

    r14347 r15026  
    5050
    5151COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     52        x86-utils.o \
    5253        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    5354
     
    6162        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    6263        threads.h x86-constants32.h x86-exceptions.h lisptypes.h \
     64        x86-utils.h \
    6365        $(PLATFORM_H) constants.h os-linux.h
    6466
  • release/1.7/source/lisp-kernel/linuxx8664/Makefile

    r14347 r15026  
    5050
    5151COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     52        x86-utils.o \
    5253        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    5354
     
    6162        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    6263        threads.h x86-constants64.h x86-exceptions.h lisptypes.h \
     64        x86-utils.h \
    6365        $(PLATFORM_H) constants.h os-linux.h
    6466
  • release/1.7/source/lisp-kernel/solarisx64/Makefile

    r14391 r15026  
    4646
    4747COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     48        x86-utils.o \
    4849        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    4950
     
    5758        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    5859        threads.h x86-constants64.h x86-exceptions.h lisptypes.h \
     60        x86-utils.h \
    5961        $(PLATFORM_H) constants.h os-solaris.h
    6062
  • release/1.7/source/lisp-kernel/solarisx86/Makefile

    r14391 r15026  
    4545
    4646COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     47        x86-utils.o \
    4748        image.o thread_manager.o lisp-debug.o memory.o unix-calls.o
    4849
     
    5657        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    5758        threads.h x86-constants32.h x86-exceptions.h lisptypes.h \
     59        x86-utils.h \
    5860        $(PLATFORM_H) constants.h os-solaris.h
    5961
  • release/1.7/source/lisp-kernel/win32/Makefile

    r14619 r15026  
    6565
    6666COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     67        x86-utils.o \
    6768        image.o thread_manager.o lisp-debug.o memory.o windows-calls.o
    6869
     
    7677        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    7778        threads.h x86-constants32.h x86-exceptions.h lisptypes.h \
     79        x86-utils.h \
    7880        $(PLATFORM_H) constants.h os-windows.h
    7981
  • release/1.7/source/lisp-kernel/win64/Makefile

    r14391 r15026  
    6464
    6565COBJ  = pmcl-kernel.o gc-common.o x86-gc.o bits.o  x86-exceptions.o \
     66        x86-utils.o \
    6667        image.o thread_manager.o lisp-debug.o memory.o windows-calls.o
    6768
     
    7576        lisp-exceptions.h lisp_globals.h macros.h memprotect.h image.h \
    7677        threads.h x86-constants64.h x86-exceptions.h lisptypes.h \
     78        x86-utils.h \
    7779        $(PLATFORM_H) constants.h os-windows.h
    7880
  • release/1.7/source/lisp-kernel/x86-constants32.h

    r14619 r15026  
    216216#define function_boundary_marker subtag_function_boundary_marker
    217217
     218/* The 32-bit immediate value in the instruction
     219 * "(mov ($ 0x12345678) (% fn))" at a tagged return address
     220 * refers to the associated function.
     221 */
     222#define RECOVER_FN_OPCODE 0xbf
     223#define RECOVER_FN_LENGTH 5
    218224
    219225
     
    241247    LispObj tra;                /* ALWAYS 0 FOR AN XCF */
    242248    LispObj nominal_function;   /* the current function at the time of the exception */
    243     LispObj relative_pc;        /* Boxed byte offset within actual function or absolute address */
     249    LispObj relative_pc;        /* Boxed byte offset within actual function */
    244250    LispObj containing_uvector; /* the uvector that contains the relative PC or NIL */
    245251    LispObj xp;                 /* exception context */
     
    247253    LispObj foreign_sp;         /* foreign sp at the time that exception occurred */
    248254    LispObj prev_xframe;        /* so %apply-in-frame can unwind it */
     255    LispObj pc_low;             /* fixnum low half of absolute pc */
     256    LispObj pc_high;            /* and the high half */
    249257} xcf;
    250258
  • release/1.7/source/lisp-kernel/x86-constants64.h

    r14207 r15026  
    254254#define function_boundary_marker SUBTAG(fulltag_imm_1,15)       
    255255
     256/*
     257 * To determine the function associated with a tagged return
     258 * address, we attempt to recognize an the instruction
     259 * (lea (@ disp (% rip)) (% fn)) at the tra.
     260 */
     261#define RECOVER_FN_FROM_RIP_LENGTH 7 /* the instruction is 7 bytes long */
     262#define RECOVER_FN_FROM_RIP_DISP_OFFSET 3 /* displacement word is 3 bytes in */
     263#define RECOVER_FN_FROM_RIP_WORD0 0x8d4c /* 0x4c 0x8d, little-endian */
     264#define RECOVER_FN_FROM_RIP_BYTE2 0x2d  /* third byte of opcode */
     265
     266
    256267/* The objects themselves look something like this: */
    257268
     
    278289  LispObj tra;                  /* ALWAYS 0 FOR AN XCF */
    279290  LispObj nominal_function;     /* the current function at the time of the exception */
    280   LispObj relative_pc;          /* Boxed byte offset within actual
    281                                    function or absolute address */
     291  LispObj relative_pc;          /* Boxed byte offset within actual function */
    282292  LispObj containing_uvector;   /* the uvector that contains the relative PC or NIL */
    283293  LispObj xp;                   /* exception context */
     
    285295  LispObj foreign_sp;           /* foreign sp at the time that exception occurred */
    286296  LispObj prev_xframe;          /* so %apply-in-frame can unwind it */
     297  LispObj pc_low;               /* fixnum low half of absolute pc */
     298  LispObj pc_high;              /* and the high half */
    287299} xcf;
    288300
  • release/1.7/source/lisp-kernel/x86-exceptions.c

    r14880 r15026  
    1818#include "lisp-exceptions.h"
    1919#include "lisp_globals.h"
     20#include "x86-utils.h"
    2021#include "threads.h"
    2122#include <ctype.h>
     
    403404{
    404405  LispObj containing_uvector = 0,
    405     relative_pc,
     406    relative_pc = lisp_nil,
    406407    nominal_function = lisp_nil,
    407408    f, tra, tra_f = 0, abs_pc;
     409  LispObj pc_low, pc_high;
    408410
    409411  f = xpGPR(xp,Ifn);
    410412  tra = *(LispObj*)(xpGPR(xp,Isp));
    411 
    412 #ifdef X8664
    413   if (tag_of(tra) == tag_tra) {
    414     if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) &&
    415         (*((unsigned char *)(tra+2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
    416       int sdisp = (*(int *) (tra+3));
    417       tra_f = RECOVER_FN_FROM_RIP_LENGTH+tra+sdisp;
    418     }
    419     if (fulltag_of(tra_f) != fulltag_function) {
    420       tra_f = 0;
    421     }
    422   } else {
    423     tra = 0;
    424   }
    425 #endif
    426 #ifdef X8632
    427   if (fulltag_of(tra) == fulltag_tra) {
    428     if (*(unsigned char *)tra == RECOVER_FN_OPCODE) {
    429       tra_f = (LispObj)*(LispObj *)(tra + 1);
    430     }
    431     if (tra_f && header_subtag(header_of(tra_f)) != subtag_function) {
    432       tra_f = 0;
    433     }
    434   } else {
    435     tra = 0;
    436   }
    437 #endif
    438 
     413  tra_f = tra_function(tra);
    439414  abs_pc = (LispObj)xpPC(xp);
    440 
    441 #ifdef X8664
    442   if (fulltag_of(f) == fulltag_function)
    443 #else
    444     if (fulltag_of(f) == fulltag_misc &&
    445         header_subtag(header_of(f)) == subtag_function)
    446 #endif
    447       {
    448         nominal_function = f;
    449       } else {
    450       if (tra_f) {
    451         nominal_function = tra_f;
    452       }
    453     }
     415#if WORD_SIZE == 64
     416  pc_high = ((abs_pc >> 32) & 0xffffffff) << fixnumshift;
     417  pc_low = (abs_pc & 0xffffffff) << fixnumshift;
     418#else
     419  pc_high = ((abs_pc >> 16) & 0xffff) << fixnumshift;
     420  pc_low = (abs_pc & 0xffff) << fixnumshift;
     421#endif
     422
     423
     424  if (functionp(f))
     425    nominal_function = f;
     426  else if (tra_f)
     427    nominal_function = tra_f;
    454428 
    455429  f = xpGPR(xp,Ifn);
     
    474448  } else {
    475449    containing_uvector = lisp_nil;
    476     relative_pc = abs_pc << fixnumshift;
    477   }
     450  }
     451  push_on_lisp_stack(xp, pc_high);
     452  push_on_lisp_stack(xp, pc_low);
    478453  push_on_lisp_stack(xp,(LispObj)(tcr->xframe->prev));
    479454  push_on_lisp_stack(xp,(LispObj)(tcr->foreign_sp));
  • release/1.7/source/lisp-kernel/x86-exceptions.h

    r14295 r15026  
    9191#endif
    9292
    93 /* recognizing the function associated with a tagged return address */
    94 /* now involves recognizinig an "(lea (@ disp (% rip)) (% rn))" */
    95 /* instruction at the tra */
    96 
    97 #define RECOVER_FN_FROM_RIP_LENGTH 7 /* the instruction is 7 bytes long */
    98 #define RECOVER_FN_FROM_RIP_DISP_OFFSET 3 /* displacement word is 3 bytes in */
    99 #define RECOVER_FN_FROM_RIP_WORD0 0x8d4c /* 0x4c 0x8d, little-endian */
    100 #define RECOVER_FN_FROM_RIP_BYTE2 0x2d  /* third byte of opcode */
    101 
    10293extern natural get_mxcsr();
    10394extern void set_mxcsr(natural);
    10495void enable_fp_exceptions(void);
    105 
    106 #ifdef X8632
    107 /* The 32-bit immediate value in the instruction
    108  * "(mov ($ 0x12345678) (% fn))" at a tagged return address
    109  * refers to the associated function.
    110  */
    111 #define RECOVER_FN_OPCODE 0xbf
    112 #define RECOVER_FN_LENGTH 5
    113 #endif
    11496
    11597void callback_for_gc_notification(ExceptionInformation *xp, TCR *tcr);
  • release/1.7/source/lisp-kernel/x86-utils.c

    r14990 r15026  
     1/*
     2   Copyright (C) 2011 Clozure Associates
     3   This file is part of Clozure CL. 
     4
     5   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
     6   License , known as the LLGPL and distributed with Clozure CL as the
     7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
     8   which is distributed with Clozure CL as the file "LGPL".  Where these
     9   conflict, the preamble takes precedence. 
     10
     11   Clozure CL is referenced in the preamble as the "LIBRARY."
     12
     13   The LLGPL is also available online at
     14   http://opensource.franz.com/preamble.html
     15*/
     16
     17#include "lisp.h"
     18#include "x86-utils.h"
     19
     20LispObj
     21tra_function(LispObj tra)
     22{
     23  LispObj f = 0;
     24
     25#ifdef X8664
     26  if (tag_of(tra) == tag_tra) {
     27    if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) &&
     28        (*((unsigned char *)(tra + 2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
     29      int sdisp = (*(int *)(tra + RECOVER_FN_FROM_RIP_DISP_OFFSET));
     30      f = RECOVER_FN_FROM_RIP_LENGTH + tra + sdisp;
     31    }
     32  }
     33#else
     34  if (fulltag_of(tra) == fulltag_tra) {
     35    if (*((unsigned char *)tra) == RECOVER_FN_OPCODE) {
     36      natural n = *((natural *)(tra + 1));
     37      f = (LispObj)n;
     38    }
     39  }
     40#endif
     41  return f;
     42}
     43
     44int
     45tra_offset(LispObj tra)
     46{
     47  LispObj f = tra_function(tra);
     48  int disp = 0;
     49
     50  if (functionp(f))
     51    disp = tra - f;
     52  return disp;
     53}
  • release/1.7/source/lisp-kernel/x86-utils.h

    r14990 r15026  
     1/*
     2   Copyright (C) 2011 Clozure Associates
     3   This file is part of Clozure CL. 
     4
     5   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
     6   License , known as the LLGPL and distributed with Clozure CL as the
     7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
     8   which is distributed with Clozure CL as the file "LGPL".  Where these
     9   conflict, the preamble takes precedence. 
     10
     11   Clozure CL is referenced in the preamble as the "LIBRARY."
     12
     13   The LLGPL is also available online at
     14   http://opensource.franz.com/preamble.html
     15*/
     16
     17#ifndef X86_UTILS_H
     18#define X86_UTILS_H
     19
     20extern LispObj tra_function(LispObj tra);
     21extern int tra_offset(LispObj tra);
     22
     23static inline LispObj
     24function_to_function_vector(LispObj f)
     25{
     26#ifdef X8664
     27  return f - fulltag_function + fulltag_misc;
     28#else
     29  return f;
     30#endif
     31}
     32
     33static inline int
     34tra_p(LispObj thing)
     35{
     36#ifdef X8664
     37  return tag_of(thing) == tag_tra;
     38#else
     39  return fulltag_of(thing) == fulltag_tra;
     40#endif
     41}
     42
     43static inline int
     44functionp(LispObj f)
     45{
     46#ifdef X8664
     47  return fulltag_of(f) == fulltag_function;
     48#else
     49  return fulltag_of(f) == fulltag_misc &&
     50    header_subtag(header_of(f)) == subtag_function;
     51#endif
     52}
     53
     54#endif
  • release/1.7/source/lisp-kernel/xlbt.c

    r14619 r15026  
    1616
    1717#include "lispdcmd.h"
     18#include "x86-utils.h"
    1819#include <stdio.h>
    1920#include <signal.h>
    2021
    21 
     22natural
     23pc_from_xcf(xcf *xcf)
     24{
     25  if (functionp(xcf->nominal_function)) {
     26    LispObj fv = function_to_function_vector(xcf->nominal_function);
     27    if (fv == xcf->containing_uvector) {
     28      unsigned tag;
     29
     30#ifdef X8664
     31      tag = tag_function;
     32#else
     33      tag = fulltag_misc;
     34#endif
     35      return unbox_fixnum(xcf->relative_pc) - tag;
     36    } else {
     37      LispObj tra = xcf->ra0;
     38      LispObj f = tra_function(tra);
     39
     40      if (f && f == xcf->nominal_function)
     41        return tra_offset(tra);
     42    }
     43  }
     44  return 0;
     45}
    2246
    2347void
     
    4367  }
    4468  if (pc == 0) {
     69    natural rpc = pc_from_xcf((xcf *)frame);
     70
    4571    fun = ((xcf *)frame)->nominal_function;
    46     Dprintf("(#x%08X) #x%08X : %s + ??", frame, pc, print_lisp_object(fun));
     72    fprintf(dbgout, "(#x%08X) #x%08X : %s + ", frame, pc,
     73            print_lisp_object(fun));
     74    if (rpc)
     75      fprintf(dbgout, "%d\n", rpc);
     76    else
     77      fprintf(dbgout, "??\n", rpc);
    4778    return;
    4879  }
     
    6192  }
    6293  if (pc == 0) {
     94    natural rpc = pc_from_xcf((xcf *)frame);
     95
    6396    fun = ((xcf *)frame)->nominal_function;
    64     Dprintf("(#x%016lX) #x%016lX : %s + ??", frame, pc, print_lisp_object(fun));
     97    fprintf(dbgout, "(#x%016lX) #x%016lX : %s + ", frame, pc,
     98            print_lisp_object(fun));
     99    if (rpc)
     100      fprintf(dbgout, "%d\n", rpc);
     101    else
     102      fprintf(dbgout, "??\n");
    65103    return;
    66104  }
Note: See TracChangeset for help on using the changeset viewer.