Changeset 11814 for release/1.3


Ignore:
Timestamp:
Mar 14, 2009, 4:42:20 AM (10 years ago)
Author:
rme
Message:

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

(GC fixes, additional x8632 vinsns, easygui enhancements, x8632 callback fix)

Location:
release/1.3/source
Files:
15 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/1.3/source/compiler/X86/X8632/x8632-vinsns.lisp

    r11556 r11814  
    18581858  (jmp (:@ .SPnmkunwind)))
    18591859
     1860(define-x8632-vinsn u16->u32 (((dest :u32))
     1861                              ((src :u16)))
     1862  (movzwl (:%w src) (:%l dest)))
     1863
     1864(define-x8632-vinsn u8->u32 (((dest :u32))
     1865                             ((src :u8)))
     1866  (movzbl (:%b src) (:%l dest)))
     1867
     1868(define-x8632-vinsn s16->s32 (((dest :s32))
     1869                              ((src :s16)))
     1870  (movswl (:%w src) (:%l dest)))
     1871
     1872(define-x8632-vinsn s8->s32 (((dest :s32))
     1873                             ((src :s8)))
     1874  (movsbl (:%b src) (:%l dest)))
    18601875
    18611876(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
  • release/1.3/source/examples/cocoa/easygui/easygui.asd

    r7802 r11814  
    2828               (:file "views" :depends-on ("events"))
    2929               (:file "action-targets" :depends-on ("views"))
     30               (:file "dialogs" :depends-on ("new-cocoa-bindings"))
    3031               (:module "example"
    3132                        :depends-on ("action-targets")
  • release/1.3/source/examples/cocoa/easygui/events.lisp

    r11306 r11814  
    11(in-package :easygui)
     2
     3;;; Changed by AWSC Feb 2009:
     4;;; Modified define-chaining-responder-method to allow subclasses of easygui
     5;;; views to inherit mouse handling behaviour.
     6;;; Original work by an unknown author.
     7;;; Permission to use the change is granted.
    28
    39;;; Event handling basics
     
    915  `(objc:defmethod (,objc-name :void) ((,self-arg ,class-name)
    1016                                       ,event-arg)
    11      (let ((ev-class (class-name
    12                       (class-of (easygui-view-of ,self-arg)))))
    13        (if (find-method #',lisp-name nil `(,ev-class) nil) ; TODO: doesn't consider subclasses.
     17     (let ((superclasses (ccl:class-precedence-list (class-of (easygui-view-of ,self-arg)))))
     18       (if (some #'(lambda (super)
     19                     (find-method #',lisp-name nil (list (class-name super)) nil))
     20                 superclasses)
    1421           (,lisp-name (easygui-view-of ,self-arg)
    1522                     ,@arg-compute-forms)
  • release/1.3/source/examples/cocoa/easygui/package.lisp

    r7802 r11814  
    2222           #:entry-text #:cell-count #:nth-cell #:selection #:redisplay
    2323           #:string-value-of #:integer-value-of #:float-value-of
    24            #:double-value-of))
     24           #:double-value-of
     25           #:y-or-n-dialog
     26           #:choose-file-dialog #:choose-new-file-dialog
     27           #:user-pick-color))
    2528
    2629(cl:defpackage :easygui-demo
  • release/1.3/source/level-1/l1-boot-1.lisp

    r11373 r11814  
    114114
    115115(catch :toplevel
    116   (setq *loading-file-source-file* nil)  ;Reset from last %fasload...
    117   (setq *loading-toplevel-location* nil)
    118116  (init-logical-directories)
    119117  )
  • release/1.3/source/level-1/l1-events.lisp

    r11450 r11814  
    130130  (thread-handle-interrupts))
    131131
    132 (defun select-interactive-abort-process ()
    133   (or *interactive-abort-process*
     132(defun select-interactive-abort-process (&aux proc)
     133  (or (and (setq proc *interactive-abort-process*)
     134           (process-active-p proc)
     135           proc)
    134136      (let* ((sr (input-stream-shared-resource *terminal-input*)))
    135         (if sr
    136           (or (shared-resource-current-owner sr)
    137               (shared-resource-primary-owner sr))))))
     137        (when sr
     138          (or (and (setq proc (shared-resource-current-owner sr))
     139                   (process-active-p proc)
     140                   proc)
     141              (and (setq proc (shared-resource-primary-owner sr))
     142                   (process-active-p proc)
     143                   proc))))))
    138144
    139145(defun handle-gc-hooks ()
  • release/1.3/source/level-1/l1-readloop-lds.lisp

    r11594 r11814  
    472472          (format s ", was reset to ~s ." (symbol-value bogusness)))))
    473473    (if (and *break-on-errors* (not *batch-flag*))
    474       (with-terminal-input
    475           (break-loop condition error-pointer))
     474      (break-loop condition error-pointer)
    476475      (if *batch-flag*
    477476        (abnormal-application-exit)
     
    514513        (funcall hook c hook)))
    515514    (%break-message "Debug" c fp)
    516     (with-terminal-input
    517         (break-loop c fp))))
     515    (break-loop c fp)))
    518516
    519517(defun %break-message (msg condition error-pointer &optional (prefixchar #\>))
     
    548546  (let* ((*print-readably* nil))
    549547    (%break-message msg condition error-pointer)
    550     (with-terminal-input
    551       (restart-case (break-loop condition error-pointer)
    552                     (continue () :report (lambda (stream) (write-string cont-string stream))))
    553       (fresh-line *error-output*)
    554       nil)))
     548    (restart-case (break-loop condition error-pointer)
     549      (continue () :report (lambda (stream) (write-string cont-string stream))))
     550    (fresh-line *error-output*)
     551    nil))
    555552
    556553(defun warn (condition-or-format-string &rest args)
     
    619616         (*signal-printing-errors* nil)
    620617         (*read-suppress* nil)
    621          (*print-readably* nil))
    622     (let* ((context (new-backtrace-info nil
    623                                         frame-pointer
    624                                         (if *backtrace-contexts*
    625                                           (or (child-frame
    626                                                (bt.youngest (car *backtrace-contexts*))
    627                                                nil)
    628                                               (last-frame-ptr))
    629                                           (last-frame-ptr))
    630                                         (%current-tcr)
    631                                         condition
    632                                         (%current-frame-ptr)
    633                                         #+ppc-target *fake-stack-frames*
    634                                         #+x86-target (%current-frame-ptr)
    635                                         (db-link)
    636                                         (1+ *break-level*)))
    637            (*backtrace-contexts* (cons context *backtrace-contexts*)))
     618         (*print-readably* nil)
     619         (context (new-backtrace-info nil
     620                                      frame-pointer
     621                                      (if *backtrace-contexts*
     622                                        (or (child-frame
     623                                             (bt.youngest (car *backtrace-contexts*))
     624                                             nil)
     625                                            (last-frame-ptr))
     626                                        (last-frame-ptr))
     627                                      (%current-tcr)
     628                                      condition
     629                                      (%current-frame-ptr)
     630                                      #+ppc-target *fake-stack-frames*
     631                                      #+x86-target (%current-frame-ptr)
     632                                      (db-link)
     633                                      (1+ *break-level*)))
     634         (*backtrace-contexts* (cons context *backtrace-contexts*)))
     635    (with-terminal-input
    638636      (with-toplevel-commands :break
    639637        (if *continuablep*
  • release/1.3/source/level-1/level-1.lisp

    r11373 r11814  
    9595  (l1-load "l1-boot-3")
    9696
    97   ;; Without this, forms from the -e command line parameter would run with
    98   ;; *loading-file-source-file* set to "l1-boot-3".
    99   (setq *loading-file-source-file* nil)
    100   (setq *loading-toplevel-location* nil)
    10197  )
    10298
     
    105101  (%set-toplevel #'toplevel-loop)
    106102  (set-user-environment t)
     103  (setq *loading-file-source-file* nil
     104        *loading-toplevel-location* nil)
    107105  (toplevel))
  • release/1.3/source/lib/macros.lisp

    r11747 r11814  
    19041904    (let* ((options-seen ())
    19051905           (signatures ())
    1906            (slot-names))
     1906           (slot-names ())
     1907           (slot-initargs ()))
    19071908      (flet ((canonicalize-defclass-option (option)
    19081909               (let* ((option-name (car option)))
     
    19791980                          (push setf-name writers))))
    19801981                     (:initarg
    1981                       (push (require-type (cadr options) 'symbol) initargs))
     1982                      (let* ((initarg (require-type (cadr options) 'symbol))
     1983                             (other (position initarg slot-initargs :test #'memq)))
     1984                        (when other
     1985                          (warn "Initarg ~s occurs in both ~s and ~s slots"
     1986                                initarg (nth (1+ other) slot-names) slot-name))
     1987                        (push initarg initargs)))
    19821988                     (:type
    19831989                      (if type-p
     
    20132019                                       (car (push (list (car options)) other-options)))))
    20142020                        (push (cadr options) (cdr pair))))))
     2021                 (push initargs slot-initargs)
    20152022                 `(list :name ',slot-name
    20162023                   ,@(when allocation `(:allocation ',allocation))
  • release/1.3/source/lib/nfcomp.lisp

    r11687 r11814  
    239239
    240240        (setq forms (fcomp-file src
    241                                 (or compile-file-original-truename orig-src)
     241                                (or compile-file-original-truename (namestring orig-src))
    242242                                compile-file-original-buffer-offset
    243243                                lexenv))
     
    459459           (*fcomp-toplevel-forms* nil)
    460460           (*fasl-eof-forms* nil)
    461            (*loading-file-source-file* (namestring orig-file))
     461           (*loading-file-source-file* orig-file)
    462462           (*fcomp-source-note-map* (and *save-source-locations*
    463463                                         (make-hash-table :test #'eq :shared nil)))
  • release/1.3/source/lib/source-files.lisp

    r11420 r11814  
    591591  "Returns a list of (TYPE . DEFINITION-SOURCE) for all the known definitions of NAME."
    592592  (let ((definitions ()))
    593     (loop for ((dt . full-name) last-source . nil)
    594             in (find-definition-sources name type-name)
     593    (loop for ((dt . full-name) . sources) in (find-definition-sources name type-name)
     594          as last-source = (find-if-not #'null sources)
    595595          do (when last-source
    596596               (push (list dt full-name last-source) definitions)))
     
    653653                                       (and x
    654654                                            y
     655                                            (or (stringp x) (pathnamep x))
     656                                            (or (stringp y) (pathnamep y))
    655657                                            (equal
    656658                                             (or (probe-file x) (full-pathname x))
  • release/1.3/source/lisp-kernel/x86-exceptions.c

    r11780 r11814  
    589589#ifdef X8632
    590590  natural saved_node_regs_mask = tcr->node_regs_mask;
     591  natural saved_unboxed0 = tcr->unboxed0;
     592  natural saved_unboxed1 = tcr->unboxed1;
    591593  LispObj *vsp = (LispObj *)xpGPR(xp, Isp);
    592594#endif
     
    629631
    630632  tcr->node_regs_mask = saved_node_regs_mask;
     633  tcr->unboxed0 = saved_unboxed0;
     634  tcr->unboxed1 = saved_unboxed1;
    631635#endif
    632636  set_mxcsr(old_mxcsr);
     
    22612265extern opcode egc_write_barrier_start, egc_write_barrier_end,
    22622266  egc_set_hash_key_conditional, egc_set_hash_key_conditional_success_test,
    2263   egc_store_node_conditional_success_end,
     2267  egc_set_hash_key_conditional_retry,
     2268  egc_store_node_conditional_success_end, egc_store_node_conditional_retry,
    22642269  egc_store_node_conditional_success_test,egc_store_node_conditional,
    22652270  egc_set_hash_key, egc_gvset, egc_rplacd;
     
    25462551
    25472552    if (program_counter >= &egc_set_hash_key_conditional) {
     2553      if (program_counter <= &egc_set_hash_key_conditional_retry) {
     2554        return;
     2555      }
    25482556      if ((program_counter < &egc_set_hash_key_conditional_success_test) ||
    25492557          ((program_counter == &egc_set_hash_key_conditional_success_test) &&
    25502558           !(eflags_register(xp) & (1 << X86_ZERO_FLAG_BIT)))) {
    25512559        /* Back up the PC, try again */
    2552         xpPC(xp) = (LispObj) &egc_set_hash_key_conditional;
     2560        xpPC(xp) = (LispObj) &egc_set_hash_key_conditional_retry;
    25532561        return;
    25542562      }
     
    25662574      xpGPR(xp,Iarg_z) = t_value;
    25672575    } else if (program_counter >= &egc_store_node_conditional) {
     2576      if (program_counter <= &egc_store_node_conditional_retry) {
     2577        return;
     2578      }
    25682579      if ((program_counter < &egc_store_node_conditional_success_test) ||
    25692580          ((program_counter == &egc_store_node_conditional_success_test) &&
    25702581           !(eflags_register(xp) & (1 << X86_ZERO_FLAG_BIT)))) {
    25712582        /* Back up the PC, try again */
    2572         xpPC(xp) = (LispObj) &egc_store_node_conditional;
     2583        xpPC(xp) = (LispObj) &egc_store_node_conditional_retry;
    25732584        return;
    25742585      }
  • release/1.3/source/lisp-kernel/x86-gc.c

    r11780 r11814  
    11571157        x1 = start[1];
    11581158        tag = fulltag_of(x1);
    1159       if (is_node_fulltag(tag)) {       
     1159        if (is_node_fulltag(tag)) {       
    11601160          node_dnode = gc_area_dnode(x1);
    11611161          if (node_dnode < GCndnodes_in_area) {
  • release/1.3/source/lisp-kernel/x86-spentry32.s

    r11780 r11814  
    17321732_endsubp(rplacd)
    17331733
    1734 /* Storing into a gvector can be handles the same way as storing into a CONS. */
     1734/* Storing into a gvector can be handled the same way as storing into a CONS. */
    17351735/* args (src, unscaled-idx, val) in temp0, arg_y, arg_z */
    17361736_spentry(gvset)
     
    17861786/* whether or not the STORE-CONDITIONAL (cmpxchgq) has won or not.    */
    17871787/* If we're interrupted   before the PC has reached the "success_test" label, */
    1788 /* repeat (luser the PC back to .SPstore_node_conditional.)  If we're at that */
     1788/* repeat (luser the PC back to store_node_conditional_retry.)  If
     1789        we're at that */
    17891790/* label with the Z flag set, we won and (may) need to memoize.  */
    17901791
     
    17951796        __(subl $misc_data_offset*fixnumone,%temp0) /* undo pre-added offset */
    17961797        __(sarl $fixnumshift,%temp0)    /* will be fixnum-tagged */
     1798        .globl C(egc_store_node_conditional_retry)
     1799C(egc_store_node_conditional_retry):     
    179718000:      __(cmpl %arg_y,misc_data_offset(%temp1,%temp0))
    17981801        __(movl misc_data_offset(%temp1,%temp0),%imm0)
     
    18261829        __(subl $misc_data_offset*fixnumone,%temp0) /* undo pre-added offset */
    18271830        __(sarl $fixnumshift,%temp0)    /* will be fixnum-tagged */
     1831        .globl C(egc_set_hash_key_conditional_retry)
     1832C(egc_set_hash_key_conditional_retry):         
    182818330:      __(cmpl %arg_y,misc_data_offset(%temp1,%temp0))
    18291834        __(movl misc_data_offset(%temp1,%temp0),%imm0)
  • release/1.3/source/lisp-kernel/x86-spentry64.s

    r11314 r11814  
    18541854/* whether or not the STORE-CONDITIONAL (cmpxchgq) has won or not.    */
    18551855/* If we're interrupted   before the PC has reached the "success_test" label,   */
    1856 /* repeat (luser the PC back to .SPstore_node_conditional.)  If we're at that  */
     1856/* repeat (luser the PC back to store_node_conditional_retry.)  If we're at that  */
    18571857/* label with the Z flag set, we won and (may) need to memoize.  */
    18581858
     
    18611861C(egc_store_node_conditional):
    18621862        __(unbox_fixnum(%temp0,%imm1))
     1863        .globl C(egc_store_node_conditional_retry)
     1864C(egc_store_node_conditional_retry):     
    186318650:      __(movq (%arg_x,%imm1),%temp1)
    18641866        __(cmpq %arg_y,%temp1)
     
    18901892        .globl C(egc_set_hash_key_conditional)
    18911893C(egc_set_hash_key_conditional):
     1894        .globl C(egc_set_hash_key_conditional_retry)
     1895C(egc_set_hash_key_conditional_retry):         
    18921896        __(unbox_fixnum(%temp0,%imm1))
    189318970:      __(movq (%arg_x,%imm1),%temp1)
Note: See TracChangeset for help on using the changeset viewer.