* bug fix: non-required arguments were not passed correctly when a method
defined using DEFMETHOD was called from a mop-generated method using
CALL-NEXT-METHOD (reported by Pascal Costanza)
+ * bug fix: recursion is now permitted in accessors through
+ SLOT-UNBOUND. (reported by Pascal Costanza)
* bug fix: an error was signaled at startup if the HOME environment
variable was defined, but had an empty value (reported by Peter Van Eynde)
* optimization: loading generic functions no longer takes O(n^2) time,
(t
(make-final-caching-dfun gf classes-list new-class)))))
-(defvar *accessor-miss-history* nil)
(defun accessor-miss (gf new object dfun-info)
- (let ((wrapper (wrapper-of object))
- (previous-miss (assq gf *accessor-miss-history*)))
- (when (eq wrapper (cdr previous-miss))
- (error "~@<Vicious metacircle: The computation of a ~
- dfun of ~s for argument ~s uses the dfun being ~
- computed.~@:>"
- gf object))
- (let* ((*accessor-miss-history* (acons gf wrapper *accessor-miss-history*))
- (ostate (type-of dfun-info))
- (otype (dfun-info-accessor-type dfun-info))
- oindex ow0 ow1 cache
- (args (ecase otype
- ((reader boundp) (list object))
- (writer (list new object)))))
- (dfun-miss (gf args wrappers invalidp nemf ntype nindex)
- ;; The following lexical functions change the state of the
- ;; dfun to that which is their name. They accept arguments
- ;; which are the parameters of the new state, and get other
- ;; information from the lexical variables bound above.
- (flet ((two-class (index w0 w1)
+ (let* ((ostate (type-of dfun-info))
+ (otype (dfun-info-accessor-type dfun-info))
+ oindex ow0 ow1 cache
+ (args (ecase otype
+ ((reader boundp) (list object))
+ (writer (list new object)))))
+ (dfun-miss (gf args wrappers invalidp nemf ntype nindex)
+ ;; The following lexical functions change the state of the
+ ;; dfun to that which is their name. They accept arguments
+ ;; which are the parameters of the new state, and get other
+ ;; information from the lexical variables bound above.
+ (flet ((two-class (index w0 w1)
(when (zerop (random 2 *pcl-misc-random-state*))
(psetf w0 w1 w1 w0))
(dfun-update gf
(setq cache (dfun-info-cache dfun-info))
(if (consp nindex)
(caching)
- (do-fill #'n-n)))))))))))
+ (do-fill #'n-n))))))))))
(defun checking-miss (generic-function args dfun-info)
(let ((oemf (dfun-info-function dfun-info))
extern void *handle_fun_end_breakpoint(int signal, siginfo_t *info,
os_context_t *context);
-extern void handle_single_step_trap(os_context_t *context, int kind,
- int register_offset);
+extern void handle_single_step_trap(os_context_t *context, int kind,
+ int register_offset);
#endif
* unwinding in Lisp.
*/
-EXCEPTION_DISPOSITION
+EXCEPTION_DISPOSITION
sigtrap_emulator(CONTEXT *context,
- struct lisp_exception_frame *exception_frame)
+ struct lisp_exception_frame *exception_frame)
{
if (*((char *)context->Eip + 1) == trap_ContextRestore) {
/* This is the cleanup for what is immediately below, and
/* set_seh_frame(handler.handler[0]); */
}
-EXCEPTION_DISPOSITION
+EXCEPTION_DISPOSITION
handle_exception(EXCEPTION_RECORD *exception_record,
- struct lisp_exception_frame *exception_frame,
- CONTEXT *context,
- void *dc) /* FIXME: What's dc again? */
+ struct lisp_exception_frame *exception_frame,
+ CONTEXT *context,
+ void *dc) /* FIXME: What's dc again? */
{
/* For EXCEPTION_ACCESS_VIOLATION only. */
void *fault_address = (void *)exception_record->ExceptionInformation[1];
- if (single_stepping &&
- exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
- /* We are doing a displaced instruction. At least function
- * end breakpoints uses this. */
- restore_breakpoint_from_single_step(context);
- return ExceptionContinueExecution;
- }
+ if (single_stepping &&
+ exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
+ /* We are doing a displaced instruction. At least function
+ * end breakpoints uses this. */
+ restore_breakpoint_from_single_step(context);
+ return ExceptionContinueExecution;
+ }
if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
/* Pick off sigtrap case first. */
#endif
/* Re-install the breakpoint if possible. */
if (*os_context_pc_addr(context) == (int)single_stepping + 1) {
- fprintf(stderr, "warning: couldn't reinstall breakpoint\n");
+ fprintf(stderr, "warning: couldn't reinstall breakpoint\n");
} else {
- *((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */
- *((char *)single_stepping+1) = trap_Breakpoint;
+ *((char *)single_stepping) = BREAKPOINT_INST; /* x86 INT3 */
+ *((char *)single_stepping+1) = trap_Breakpoint;
}
-
+
single_stepping = NULL;
return;
}
#ifndef LISP_FEATURE_WIN32
/* On Windows this is done in the SE handler. */
if (single_stepping && (signal==SIGTRAP)) {
- restore_breakpoint_from_single_step(context);
- return;
+ restore_breakpoint_from_single_step(context);
+ return;
}
#endif
#include "validate.h"
size_t os_vm_page_size;
-int arch_os_thread_init(struct thread *thread)
+int arch_os_thread_init(struct thread *thread)
{
{
void *top_exception_frame;
void *cur_stack_end;
void *cur_stack_start;
- MEMORY_BASIC_INFORMATION stack_memory;
-
+ MEMORY_BASIC_INFORMATION stack_memory;
+
asm volatile ("movl %%fs:0,%0": "=r" (top_exception_frame));
asm volatile ("movl %%fs:4,%0": "=r" (cur_stack_end));
* because that's only what currently has memory behind
* it from being used, so do a quick VirtualQuery() and
* grab the AllocationBase. -AB 2006/11/25
- */
+ */
- if (!VirtualQuery(&stack_memory, &stack_memory, sizeof(stack_memory))) {
- fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
- lose("Could not query stack memory information.");
- }
- cur_stack_start = stack_memory.AllocationBase;
+ if (!VirtualQuery(&stack_memory, &stack_memory, sizeof(stack_memory))) {
+ fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
+ lose("Could not query stack memory information.");
+ }
+ cur_stack_start = stack_memory.AllocationBase;
/* We use top_exception_frame rather than cur_stack_end to
* elide the last few (boring) stack entries at the bottom of
(defvar *indent-level* 0)
(defvar *sbcl-source-root*
- (truename
+ (truename
(merge-pathnames (make-pathname :directory (list :relative :up))
(make-pathname :name nil :type nil :defaults *load-truename*))))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.0.10"
+"1.0.0.11"