[Openmcl-cvs-notifications] r11814 - in /release/1.3/source: compiler/X86/X8632/ examples/cocoa/easygui/ level-1/ lib/ lisp-kernel/

rme at clozure.com rme at clozure.com
Sat Mar 14 00:42:20 EDT 2009


Author: rme
Date: Sat Mar 14 00:42:20 2009
New Revision: 11814

Log:
Merge trunk changes r11790-r11794, r11796, r11801, r11803

(GC fixes, additional x8632 vinsns, easygui enhancements, x8632 callback fi=
x)

Added:
    release/1.3/source/examples/cocoa/easygui/dialogs.lisp
      - copied unchanged from r11801, trunk/source/examples/cocoa/easygui/d=
ialogs.lisp
Modified:
    release/1.3/source/compiler/X86/X8632/x8632-vinsns.lisp
    release/1.3/source/examples/cocoa/easygui/easygui.asd
    release/1.3/source/examples/cocoa/easygui/events.lisp
    release/1.3/source/examples/cocoa/easygui/package.lisp
    release/1.3/source/level-1/l1-boot-1.lisp
    release/1.3/source/level-1/l1-events.lisp
    release/1.3/source/level-1/l1-readloop-lds.lisp
    release/1.3/source/level-1/level-1.lisp
    release/1.3/source/lib/macros.lisp
    release/1.3/source/lib/nfcomp.lisp
    release/1.3/source/lib/source-files.lisp
    release/1.3/source/lisp-kernel/x86-exceptions.c
    release/1.3/source/lisp-kernel/x86-gc.c
    release/1.3/source/lisp-kernel/x86-spentry32.s
    release/1.3/source/lisp-kernel/x86-spentry64.s

Modified: release/1.3/source/compiler/X86/X8632/x8632-vinsns.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/compiler/X86/X8632/x8632-vinsns.lisp (original)
+++ release/1.3/source/compiler/X86/X8632/x8632-vinsns.lisp Sat Mar 14 00:4=
2:20 2009
@@ -1857,6 +1857,21 @@
   (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
   (jmp (:@ .SPnmkunwind)))
 =

+(define-x8632-vinsn u16->u32 (((dest :u32))
+			      ((src :u16)))
+  (movzwl (:%w src) (:%l dest)))
+
+(define-x8632-vinsn u8->u32 (((dest :u32))
+			     ((src :u8)))
+  (movzbl (:%b src) (:%l dest)))
+
+(define-x8632-vinsn s16->s32 (((dest :s32))
+			      ((src :s16)))
+  (movswl (:%w src) (:%l dest)))
+
+(define-x8632-vinsn s8->s32 (((dest :s32))
+			     ((src :s8)))
+  (movsbl (:%b src) (:%l dest)))
 =

 (define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
 =


Modified: release/1.3/source/examples/cocoa/easygui/easygui.asd
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/examples/cocoa/easygui/easygui.asd (original)
+++ release/1.3/source/examples/cocoa/easygui/easygui.asd Sat Mar 14 00:42:=
20 2009
@@ -27,6 +27,7 @@
                (:file "events" :depends-on ("new-cocoa-bindings"))
                (:file "views" :depends-on ("events"))
                (:file "action-targets" :depends-on ("views"))
+               (:file "dialogs" :depends-on ("new-cocoa-bindings"))
                (:module "example"
                         :depends-on ("action-targets")
                         :components

Modified: release/1.3/source/examples/cocoa/easygui/events.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/examples/cocoa/easygui/events.lisp (original)
+++ release/1.3/source/examples/cocoa/easygui/events.lisp Sat Mar 14 00:42:=
20 2009
@@ -1,4 +1,10 @@
 (in-package :easygui)
+
+;;; Changed by AWSC Feb 2009:
+;;; Modified define-chaining-responder-method to allow subclasses of easyg=
ui
+;;; views to inherit mouse handling behaviour.
+;;; Original work by an unknown author.
+;;; Permission to use the change is granted.
 =

 ;;; Event handling basics
 =

@@ -8,9 +14,10 @@
                                             &body arg-compute-forms)
   `(objc:defmethod (,objc-name :void) ((,self-arg ,class-name)
                                        ,event-arg)
-     (let ((ev-class (class-name
-                      (class-of (easygui-view-of ,self-arg)))))
-       (if (find-method #',lisp-name nil `(,ev-class) nil) ; TODO: doesn't=
 consider subclasses.
+     (let ((superclasses (ccl:class-precedence-list (class-of (easygui-vie=
w-of ,self-arg)))))
+       (if (some #'(lambda (super)
+                     (find-method #',lisp-name nil (list (class-name super=
)) nil))
+                 superclasses)
            (,lisp-name (easygui-view-of ,self-arg)
                      , at arg-compute-forms)
            (,objc-name (#/nextResponder ,self-arg) ,event-arg)))))

Modified: release/1.3/source/examples/cocoa/easygui/package.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/examples/cocoa/easygui/package.lisp (original)
+++ release/1.3/source/examples/cocoa/easygui/package.lisp Sat Mar 14 00:42=
:20 2009
@@ -21,7 +21,10 @@
            #:draw-view-rectangle
            #:entry-text #:cell-count #:nth-cell #:selection #:redisplay
            #:string-value-of #:integer-value-of #:float-value-of
-           #:double-value-of))
+           #:double-value-of
+           #:y-or-n-dialog
+           #:choose-file-dialog #:choose-new-file-dialog
+           #:user-pick-color))
 =

 (cl:defpackage :easygui-demo
   (:use :cl :easygui)

Modified: release/1.3/source/level-1/l1-boot-1.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/l1-boot-1.lisp (original)
+++ release/1.3/source/level-1/l1-boot-1.lisp Sat Mar 14 00:42:20 2009
@@ -113,8 +113,6 @@
 =

 =

 (catch :toplevel
-  (setq *loading-file-source-file* nil)  ;Reset from last %fasload...
-  (setq *loading-toplevel-location* nil)
   (init-logical-directories)
   )
 =


Modified: release/1.3/source/level-1/l1-events.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/l1-events.lisp (original)
+++ release/1.3/source/level-1/l1-events.lisp Sat Mar 14 00:42:20 2009
@@ -129,12 +129,18 @@
 (defun cmain ()
   (thread-handle-interrupts))
 =

-(defun select-interactive-abort-process ()
-  (or *interactive-abort-process*
+(defun select-interactive-abort-process (&aux proc)
+  (or (and (setq proc *interactive-abort-process*)
+           (process-active-p proc)
+           proc)
       (let* ((sr (input-stream-shared-resource *terminal-input*)))
-	(if sr
-	  (or (shared-resource-current-owner sr)
-	      (shared-resource-primary-owner sr))))))
+        (when sr
+          (or (and (setq proc (shared-resource-current-owner sr))
+                   (process-active-p proc)
+                   proc)
+              (and (setq proc (shared-resource-primary-owner sr))
+                   (process-active-p proc)
+                   proc))))))
 =

 (defun handle-gc-hooks ()
   (let ((bits *gc-event-status-bits*))

Modified: release/1.3/source/level-1/l1-readloop-lds.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/l1-readloop-lds.lisp (original)
+++ release/1.3/source/level-1/l1-readloop-lds.lisp Sat Mar 14 00:42:20 2009
@@ -471,8 +471,7 @@
             (format s "~s" oldval))
           (format s ", was reset to ~s ." (symbol-value bogusness)))))
     (if (and *break-on-errors* (not *batch-flag*))
-      (with-terminal-input
-          (break-loop condition error-pointer))
+      (break-loop condition error-pointer)
       (if *batch-flag*
         (abnormal-application-exit)
         (abort)))))
@@ -513,8 +512,7 @@
             (*debugger-hook* nil))
         (funcall hook c hook)))
     (%break-message "Debug" c fp)
-    (with-terminal-input
-	(break-loop c fp))))
+    (break-loop c fp)))
 =

 (defun %break-message (msg condition error-pointer &optional (prefixchar #=
\>))
   (let ((*print-circle* *error-print-circle*)
@@ -547,11 +545,10 @@
 (defun cbreak-loop (msg cont-string condition error-pointer)
   (let* ((*print-readably* nil))
     (%break-message msg condition error-pointer)
-    (with-terminal-input
-      (restart-case (break-loop condition error-pointer)
-		    (continue () :report (lambda (stream) (write-string cont-string stre=
am))))
-      (fresh-line *error-output*)
-      nil)))
+    (restart-case (break-loop condition error-pointer)
+      (continue () :report (lambda (stream) (write-string cont-string stre=
am))))
+    (fresh-line *error-output*)
+    nil))
 =

 (defun warn (condition-or-format-string &rest args)
   "Warn about a situation by signalling a condition formed by DATUM and
@@ -618,23 +615,24 @@
          (*standard-output* *debug-io*)
          (*signal-printing-errors* nil)
          (*read-suppress* nil)
-         (*print-readably* nil))
-    (let* ((context (new-backtrace-info nil
-                                        frame-pointer
-                                        (if *backtrace-contexts*
-                                          (or (child-frame
-                                               (bt.youngest (car *backtrac=
e-contexts*))
-                                               nil)
-                                              (last-frame-ptr))
-                                          (last-frame-ptr))
-                                        (%current-tcr)
-                                        condition
-                                        (%current-frame-ptr)
-                                        #+ppc-target *fake-stack-frames*
-                                        #+x86-target (%current-frame-ptr)
-                                        (db-link)
-                                        (1+ *break-level*)))
-           (*backtrace-contexts* (cons context *backtrace-contexts*)))
+         (*print-readably* nil)
+         (context (new-backtrace-info nil
+                                      frame-pointer
+                                      (if *backtrace-contexts*
+                                        (or (child-frame
+                                             (bt.youngest (car *backtrace-=
contexts*))
+                                             nil)
+                                            (last-frame-ptr))
+                                        (last-frame-ptr))
+                                      (%current-tcr)
+                                      condition
+                                      (%current-frame-ptr)
+                                      #+ppc-target *fake-stack-frames*
+                                      #+x86-target (%current-frame-ptr)
+                                      (db-link)
+                                      (1+ *break-level*)))
+         (*backtrace-contexts* (cons context *backtrace-contexts*)))
+    (with-terminal-input
       (with-toplevel-commands :break
         (if *continuablep*
           (let* ((*print-circle* *error-print-circle*)

Modified: release/1.3/source/level-1/level-1.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/level-1.lisp (original)
+++ release/1.3/source/level-1/level-1.lisp Sat Mar 14 00:42:20 2009
@@ -94,14 +94,12 @@
   (l1-load "l1-boot-2")
   (l1-load "l1-boot-3")
 =

-  ;; Without this, forms from the -e command line parameter would run with
-  ;; *loading-file-source-file* set to "l1-boot-3".
-  (setq *loading-file-source-file* nil)
-  (setq *loading-toplevel-location* nil)
   )
 =

 (require "PREPARE-MCL-ENVIRONMENT")
 (progn
   (%set-toplevel #'toplevel-loop)
   (set-user-environment t)
+  (setq *loading-file-source-file* nil
+        *loading-toplevel-location* nil)
   (toplevel))

Modified: release/1.3/source/lib/macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lib/macros.lisp (original)
+++ release/1.3/source/lib/macros.lisp Sat Mar 14 00:42:20 2009
@@ -1903,7 +1903,8 @@
     (setq superclasses (mapcar #'(lambda (s) (require-type s 'symbol)) sup=
erclasses))
     (let* ((options-seen ())
            (signatures ())
-           (slot-names))
+           (slot-names ())
+           (slot-initargs ()))
       (flet ((canonicalize-defclass-option (option)
                (let* ((option-name (car option)))
                  (if (member option-name options-seen :test #'eq)
@@ -1978,7 +1979,12 @@
                           (push (cons (setf-function-name name) writer-inf=
o) signatures)
                           (push setf-name writers))))
                      (:initarg
-                      (push (require-type (cadr options) 'symbol) initargs=
))
+                      (let* ((initarg (require-type (cadr options) 'symbol=
))
+                             (other (position initarg slot-initargs :test =
#'memq)))
+                        (when other
+                          (warn "Initarg ~s occurs in both ~s and ~s slots"
+                                initarg (nth (1+ other) slot-names) slot-n=
ame))
+                        (push initarg initargs)))
                      (:type
                       (if type-p
 			(duplicate-options slot)
@@ -2012,6 +2018,7 @@
                       (let* ((pair (or (assq (car options) other-options)
                                        (car (push (list (car options)) oth=
er-options)))))
                         (push (cadr options) (cdr pair))))))
+                 (push initargs slot-initargs)
                  `(list :name ',slot-name
 		   ,@(when allocation `(:allocation ',allocation))
 		   ,@(when initform-p `(:initform ,initform

Modified: release/1.3/source/lib/nfcomp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lib/nfcomp.lisp (original)
+++ release/1.3/source/lib/nfcomp.lisp Sat Mar 14 00:42:20 2009
@@ -238,7 +238,7 @@
         (setf (defenv.defined defenv) (deferred-warnings.defs *outstanding=
-deferred-warnings*))
 =

         (setq forms (fcomp-file src
-                                (or compile-file-original-truename orig-sr=
c)
+                                (or compile-file-original-truename (namest=
ring orig-src))
                                 compile-file-original-buffer-offset
                                 lexenv))
 =

@@ -458,7 +458,7 @@
            (*fasl-source-file* filename)
            (*fcomp-toplevel-forms* nil)
            (*fasl-eof-forms* nil)
-           (*loading-file-source-file* (namestring orig-file))
+           (*loading-file-source-file* orig-file)
            (*fcomp-source-note-map* (and *save-source-locations*
                                          (make-hash-table :test #'eq :shar=
ed nil)))
            (*loading-toplevel-location* nil)

Modified: release/1.3/source/lib/source-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lib/source-files.lisp (original)
+++ release/1.3/source/lib/source-files.lisp Sat Mar 14 00:42:20 2009
@@ -590,8 +590,8 @@
 (defun find-definitions-for-name (name &optional (type-name t))
   "Returns a list of (TYPE . DEFINITION-SOURCE) for all the known definiti=
ons of NAME."
   (let ((definitions ()))
-    (loop for ((dt . full-name) last-source . nil)
-            in (find-definition-sources name type-name)
+    (loop for ((dt . full-name) . sources) in (find-definition-sources nam=
e type-name)
+          as last-source =3D (find-if-not #'null sources)
           do (when last-source
                (push (list dt full-name last-source) definitions)))
     definitions))
@@ -652,6 +652,8 @@
                                    (or (equal x y)
                                        (and x
                                             y
+                                            (or (stringp x) (pathnamep x))
+                                            (or (stringp y) (pathnamep y))
                                             (equal
                                              (or (probe-file x) (full-path=
name x))
                                              (or (probe-file y) (full-path=
name y)))))))

Modified: release/1.3/source/lisp-kernel/x86-exceptions.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-exceptions.c (original)
+++ release/1.3/source/lisp-kernel/x86-exceptions.c Sat Mar 14 00:42:20 2009
@@ -588,6 +588,8 @@
   unsigned old_mxcsr =3D get_mxcsr();
 #ifdef X8632
   natural saved_node_regs_mask =3D tcr->node_regs_mask;
+  natural saved_unboxed0 =3D tcr->unboxed0;
+  natural saved_unboxed1 =3D tcr->unboxed1;
   LispObj *vsp =3D (LispObj *)xpGPR(xp, Isp);
 #endif
 =

@@ -628,6 +630,8 @@
   xpGPR(xp, Isp) =3D (LispObj)vsp;
 =

   tcr->node_regs_mask =3D saved_node_regs_mask;
+  tcr->unboxed0 =3D saved_unboxed0;
+  tcr->unboxed1 =3D saved_unboxed1;
 #endif
   set_mxcsr(old_mxcsr);
   return delta;
@@ -2260,7 +2264,8 @@
 =

 extern opcode egc_write_barrier_start, egc_write_barrier_end,
   egc_set_hash_key_conditional, egc_set_hash_key_conditional_success_test,
-  egc_store_node_conditional_success_end,
+  egc_set_hash_key_conditional_retry,
+  egc_store_node_conditional_success_end, egc_store_node_conditional_retry,
   egc_store_node_conditional_success_test,egc_store_node_conditional,
   egc_set_hash_key, egc_gvset, egc_rplacd;
 =

@@ -2545,11 +2550,14 @@
     Boolean need_store =3D true, need_check_memo =3D true, need_memoize_ro=
ot =3D false;
 =

     if (program_counter >=3D &egc_set_hash_key_conditional) {
+      if (program_counter <=3D &egc_set_hash_key_conditional_retry) {
+        return;
+      }
       if ((program_counter < &egc_set_hash_key_conditional_success_test) ||
           ((program_counter =3D=3D &egc_set_hash_key_conditional_success_t=
est) &&
            !(eflags_register(xp) & (1 << X86_ZERO_FLAG_BIT)))) {
         /* Back up the PC, try again */
-        xpPC(xp) =3D (LispObj) &egc_set_hash_key_conditional;
+        xpPC(xp) =3D (LispObj) &egc_set_hash_key_conditional_retry;
         return;
       }
       /* The conditional store succeeded.  Set the refbit, return to ra0 */
@@ -2565,11 +2573,14 @@
       need_store =3D false;
       xpGPR(xp,Iarg_z) =3D t_value;
     } else if (program_counter >=3D &egc_store_node_conditional) {
+      if (program_counter <=3D &egc_store_node_conditional_retry) {
+        return;
+      }
       if ((program_counter < &egc_store_node_conditional_success_test) ||
           ((program_counter =3D=3D &egc_store_node_conditional_success_tes=
t) &&
            !(eflags_register(xp) & (1 << X86_ZERO_FLAG_BIT)))) {
         /* Back up the PC, try again */
-        xpPC(xp) =3D (LispObj) &egc_store_node_conditional;
+        xpPC(xp) =3D (LispObj) &egc_store_node_conditional_retry;
         return;
       }
       if (program_counter >=3D &egc_store_node_conditional_success_end) {

Modified: release/1.3/source/lisp-kernel/x86-gc.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-gc.c (original)
+++ release/1.3/source/lisp-kernel/x86-gc.c Sat Mar 14 00:42:20 2009
@@ -1155,7 +1155,7 @@
       if (intergen_ref =3D=3D false) {        =

         x1 =3D start[1];
         tag =3D fulltag_of(x1);
-      if (is_node_fulltag(tag)) {        =

+        if (is_node_fulltag(tag)) {        =

           node_dnode =3D gc_area_dnode(x1);
           if (node_dnode < GCndnodes_in_area) {
             intergen_ref =3D true;

Modified: release/1.3/source/lisp-kernel/x86-spentry32.s
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-spentry32.s (original)
+++ release/1.3/source/lisp-kernel/x86-spentry32.s Sat Mar 14 00:42:20 2009
@@ -1731,7 +1731,7 @@
 	__(ret)
 _endsubp(rplacd)
 =

-/* Storing into a gvector can be handles the same way as storing into a CO=
NS. */
+/* Storing into a gvector can be handled the same way as storing into a CO=
NS. */
 /* args (src, unscaled-idx, val) in temp0, arg_y, arg_z */
 _spentry(gvset)
         .globl C(egc_gvset)
@@ -1785,7 +1785,8 @@
 /* This is a little trickier: if this is interrupted, we need to know  */
 /* whether or not the STORE-CONDITIONAL (cmpxchgq) has won or not.    */
 /* If we're interrupted   before the PC has reached the "success_test" lab=
el, */
-/* repeat (luser the PC back to .SPstore_node_conditional.)  If we're at t=
hat */
+/* repeat (luser the PC back to store_node_conditional_retry.)  If
+	we're at that */
 /* label with the Z flag set, we won and (may) need to memoize.  */
 =

 /* %temp0 =3D offset, %temp1 =3D object, %arg_y =3D old, %arg_z =3D new */
@@ -1794,6 +1795,8 @@
 C(egc_store_node_conditional):
 	__(subl $misc_data_offset*fixnumone,%temp0) /* undo pre-added offset */
 	__(sarl $fixnumshift,%temp0)	/* will be fixnum-tagged */
+        .globl C(egc_store_node_conditional_retry)
+C(egc_store_node_conditional_retry):      =

 0:	__(cmpl %arg_y,misc_data_offset(%temp1,%temp0))
 	__(movl misc_data_offset(%temp1,%temp0),%imm0)
 	__(jne 3f)
@@ -1825,6 +1828,8 @@
 C(egc_set_hash_key_conditional):
 	__(subl $misc_data_offset*fixnumone,%temp0) /* undo pre-added offset */
 	__(sarl $fixnumshift,%temp0)	/* will be fixnum-tagged */
+        .globl C(egc_set_hash_key_conditional_retry)
+C(egc_set_hash_key_conditional_retry):          =

 0:	__(cmpl %arg_y,misc_data_offset(%temp1,%temp0))
 	__(movl misc_data_offset(%temp1,%temp0),%imm0)
 	__(jne 3f)

Modified: release/1.3/source/lisp-kernel/x86-spentry64.s
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-spentry64.s (original)
+++ release/1.3/source/lisp-kernel/x86-spentry64.s Sat Mar 14 00:42:20 2009
@@ -1853,13 +1853,15 @@
 /* This is a little trickier: if this is interrupted, we need to know  */
 /* whether or not the STORE-CONDITIONAL (cmpxchgq) has won or not.    */
 /* If we're interrupted   before the PC has reached the "success_test" lab=
el,   */
-/* repeat (luser the PC back to .SPstore_node_conditional.)  If we're at t=
hat  */
+/* repeat (luser the PC back to store_node_conditional_retry.)  If we're a=
t that  */
 /* label with the Z flag set, we won and (may) need to memoize.  */
 =

 _spentry(store_node_conditional)
         .globl C(egc_store_node_conditional)
 C(egc_store_node_conditional):
 	__(unbox_fixnum(%temp0,%imm1))
+        .globl C(egc_store_node_conditional_retry)
+C(egc_store_node_conditional_retry):      =

 0:	__(movq (%arg_x,%imm1),%temp1)
 	__(cmpq %arg_y,%temp1)
 	__(movq %temp1,%imm0)
@@ -1889,6 +1891,8 @@
 	_spentry(set_hash_key_conditional)
         .globl C(egc_set_hash_key_conditional)
 C(egc_set_hash_key_conditional):
+        .globl C(egc_set_hash_key_conditional_retry)
+C(egc_set_hash_key_conditional_retry):          =

 	__(unbox_fixnum(%temp0,%imm1))
 0:	__(movq (%arg_x,%imm1),%temp1)
 	__(cmpq %arg_y,%temp1)



More information about the Openmcl-cvs-notifications mailing list