Index: /trunk/source/lisp-kernel/x86-constants32.h =================================================================== --- /trunk/source/lisp-kernel/x86-constants32.h (revision 14990) +++ /trunk/source/lisp-kernel/x86-constants32.h (revision 14991) @@ -216,4 +216,10 @@ #define function_boundary_marker subtag_function_boundary_marker +/* The 32-bit immediate value in the instruction + * "(mov ($ 0x12345678) (% fn))" at a tagged return address + * refers to the associated function. + */ +#define RECOVER_FN_OPCODE 0xbf +#define RECOVER_FN_LENGTH 5 Index: /trunk/source/lisp-kernel/x86-constants64.h =================================================================== --- /trunk/source/lisp-kernel/x86-constants64.h (revision 14990) +++ /trunk/source/lisp-kernel/x86-constants64.h (revision 14991) @@ -253,4 +253,15 @@ #define function_boundary_marker SUBTAG(fulltag_imm_1,15) + +/* + * To determine the function associated with a tagged return + * address, we attempt to recognize an the instruction + * (lea (@ disp (% rip)) (% fn)) at the tra. + */ +#define RECOVER_FN_FROM_RIP_LENGTH 7 /* the instruction is 7 bytes long */ +#define RECOVER_FN_FROM_RIP_DISP_OFFSET 3 /* displacement word is 3 bytes in */ +#define RECOVER_FN_FROM_RIP_WORD0 0x8d4c /* 0x4c 0x8d, little-endian */ +#define RECOVER_FN_FROM_RIP_BYTE2 0x2d /* third byte of opcode */ + /* The objects themselves look something like this: */ Index: /trunk/source/lisp-kernel/x86-exceptions.c =================================================================== --- /trunk/source/lisp-kernel/x86-exceptions.c (revision 14990) +++ /trunk/source/lisp-kernel/x86-exceptions.c (revision 14991) @@ -18,4 +18,5 @@ #include "lisp-exceptions.h" #include "lisp_globals.h" +#include "x86-utils.h" #include "threads.h" #include @@ -409,47 +410,11 @@ f = xpGPR(xp,Ifn); tra = *(LispObj*)(xpGPR(xp,Isp)); - -#ifdef X8664 - if (tag_of(tra) == tag_tra) { - if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) && - (*((unsigned char *)(tra+2)) == RECOVER_FN_FROM_RIP_BYTE2)) { - int sdisp = (*(int *) (tra+3)); - tra_f = RECOVER_FN_FROM_RIP_LENGTH+tra+sdisp; - } - if (fulltag_of(tra_f) != fulltag_function) { - tra_f = 0; - } - } else { - tra = 0; - } -#endif -#ifdef X8632 - if (fulltag_of(tra) == fulltag_tra) { - if (*(unsigned char *)tra == RECOVER_FN_OPCODE) { - tra_f = (LispObj)*(LispObj *)(tra + 1); - } - if (tra_f && header_subtag(header_of(tra_f)) != subtag_function) { - tra_f = 0; - } - } else { - tra = 0; - } -#endif - + tra_f = tra_function(tra); abs_pc = (LispObj)xpPC(xp); -#ifdef X8664 - if (fulltag_of(f) == fulltag_function) -#else - if (fulltag_of(f) == fulltag_misc && - header_subtag(header_of(f)) == subtag_function) -#endif - { - nominal_function = f; - } else { - if (tra_f) { - nominal_function = tra_f; - } - } + if (functionp(f)) + nominal_function = f; + else if (tra_f) + nominal_function = tra_f; f = xpGPR(xp,Ifn); @@ -474,4 +439,8 @@ } else { containing_uvector = lisp_nil; + /* + * An absolute PC will not necessarily fit into a fixnum, + * so encode it as two fixnums and let lisp reassemble it. + */ #if WORD_SIZE == 64 relative_pc = ((abs_pc >> 32) & 0xffffffff) << fixnumshift; Index: /trunk/source/lisp-kernel/x86-exceptions.h =================================================================== --- /trunk/source/lisp-kernel/x86-exceptions.h (revision 14990) +++ /trunk/source/lisp-kernel/x86-exceptions.h (revision 14991) @@ -91,25 +91,7 @@ #endif -/* recognizing the function associated with a tagged return address */ -/* now involves recognizinig an "(lea (@ disp (% rip)) (% rn))" */ -/* instruction at the tra */ - -#define RECOVER_FN_FROM_RIP_LENGTH 7 /* the instruction is 7 bytes long */ -#define RECOVER_FN_FROM_RIP_DISP_OFFSET 3 /* displacement word is 3 bytes in */ -#define RECOVER_FN_FROM_RIP_WORD0 0x8d4c /* 0x4c 0x8d, little-endian */ -#define RECOVER_FN_FROM_RIP_BYTE2 0x2d /* third byte of opcode */ - extern natural get_mxcsr(); extern void set_mxcsr(natural); void enable_fp_exceptions(void); - -#ifdef X8632 -/* The 32-bit immediate value in the instruction - * "(mov ($ 0x12345678) (% fn))" at a tagged return address - * refers to the associated function. - */ -#define RECOVER_FN_OPCODE 0xbf -#define RECOVER_FN_LENGTH 5 -#endif void callback_for_gc_notification(ExceptionInformation *xp, TCR *tcr); Index: /trunk/source/lisp-kernel/x86-utils.c =================================================================== --- /trunk/source/lisp-kernel/x86-utils.c (revision 14990) +++ /trunk/source/lisp-kernel/x86-utils.c (revision 14991) @@ -0,0 +1,53 @@ +/* + Copyright (C) 2011 Clozure Associates + This file is part of Clozure CL. + + Clozure CL is licensed under the terms of the Lisp Lesser GNU Public + License , known as the LLGPL and distributed with Clozure CL as the + file "LICENSE". The LLGPL consists of a preamble and the LGPL, + which is distributed with Clozure CL as the file "LGPL". Where these + conflict, the preamble takes precedence. + + Clozure CL is referenced in the preamble as the "LIBRARY." + + The LLGPL is also available online at + http://opensource.franz.com/preamble.html +*/ + +#include "lisp.h" +#include "x86-utils.h" + +LispObj +tra_function(LispObj tra) +{ + LispObj f = 0; + +#ifdef X8664 + if (tag_of(tra) == tag_tra) { + if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) && + (*((unsigned char *)(tra + 2)) == RECOVER_FN_FROM_RIP_BYTE2)) { + int sdisp = (*(int *)(tra + RECOVER_FN_FROM_RIP_DISP_OFFSET)); + f = RECOVER_FN_FROM_RIP_LENGTH + tra + sdisp; + } + } +#else + if (fulltag_of(tra) == fulltag_tra) { + if (*((unsigned char *)tra) == RECOVER_FN_OPCODE) { + natural n = *((natural *)(tra + 1)); + f = (LispObj)n; + } + } +#endif + return f; +} + +int +tra_offset(LispObj tra) +{ + LispObj f = tra_function(tra); + int disp = 0; + + if (functionp(f)) + disp = tra - f; + return disp; +} Index: /trunk/source/lisp-kernel/x86-utils.h =================================================================== --- /trunk/source/lisp-kernel/x86-utils.h (revision 14990) +++ /trunk/source/lisp-kernel/x86-utils.h (revision 14991) @@ -0,0 +1,54 @@ +/* + Copyright (C) 2011 Clozure Associates + This file is part of Clozure CL. + + Clozure CL is licensed under the terms of the Lisp Lesser GNU Public + License , known as the LLGPL and distributed with Clozure CL as the + file "LICENSE". The LLGPL consists of a preamble and the LGPL, + which is distributed with Clozure CL as the file "LGPL". Where these + conflict, the preamble takes precedence. + + Clozure CL is referenced in the preamble as the "LIBRARY." + + The LLGPL is also available online at + http://opensource.franz.com/preamble.html +*/ + +#ifndef X86_UTILS_H +#define X86_UTILS_H + +extern LispObj tra_function(LispObj tra); +extern int tra_offset(LispObj tra); + +static inline LispObj +function_to_function_vector(LispObj f) +{ +#ifdef X8664 + return f - fulltag_function + fulltag_misc; +#else + return f; +#endif +} + +static inline int +tra_p(LispObj thing) +{ +#ifdef X8664 + return tag_of(thing) == tag_tra; +#else + return fulltag_of(thing) == fulltag_tra; +#endif +} + +static inline int +functionp(LispObj f) +{ +#ifdef X8664 + return fulltag_of(f) == fulltag_function; +#else + return fulltag_of(f) == fulltag_misc && + header_subtag(header_of(f)) == subtag_function; +#endif +} + +#endif Index: /trunk/source/lisp-kernel/xlbt.c =================================================================== --- /trunk/source/lisp-kernel/xlbt.c (revision 14990) +++ /trunk/source/lisp-kernel/xlbt.c (revision 14991) @@ -16,81 +16,7 @@ #include "lispdcmd.h" +#include "x86-utils.h" #include #include - -static LispObj -function_to_function_vector(LispObj f) -{ -#ifdef X8664 - return f - fulltag_function + fulltag_misc; -#else - return f; -#endif -} - -static Boolean -functionp(LispObj f) -{ -#ifdef X8664 - return fulltag_of(f) == fulltag_function; -#else - return fulltag_of(f) == fulltag_misc && - header_subtag(header_of(f)) == subtag_function; -#endif -} - -static LispObj -tra_function(LispObj tra) -{ - LispObj f = 0; - -#ifdef X8664 - if (tag_of(tra) == tag_tra) { - if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) && - (*((unsigned char *)(tra+2)) == RECOVER_FN_FROM_RIP_BYTE2)) { - int sdisp = (*(int *) (tra+3)); - f = RECOVER_FN_FROM_RIP_LENGTH+tra+sdisp; - } - } -#else - if (fulltag_of(tra) == fulltag_tra) { - if (*((unsigned char *)tra) == RECOVER_FN_OPCODE) { - natural n = *((natural *)(tra + 1)); - f = (LispObj)n; - } - } -#endif - return f; -} - -#if 0 -/* untested */ -static int -tra_offset(LispObj tra) -{ -#ifdef X8664 - if (tag_of(tra) == tag_tra) { - if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) && - (*((unsigned char *)(tra+2)) == RECOVER_FN_FROM_RIP_BYTE2)) { - int sdisp = (*(int *) (tra+3)); - - sdisp = - sdisp; - sdisp -= RECOVER_FN_FROM_RIP_LENGTH; - return sdisp; - } - } -#else - if (fulltag_of(tra) == fulltag_tra) { - if (*((unsigned char *)tra) == RECOVER_FN_OPCODE) { - int n = *((int *)(tra + 1)); - n = n - tra; - n = -n; - return n; - } - } -#endif - return 0; -} -#endif natural