Changeset 14433


Ignore:
Timestamp:
Nov 16, 2010, 6:01:19 PM (9 years ago)
Author:
rme
Message:

Merge r14425 through r14432 from trunk.

Addresses:

  • foreign FPE handling (see ticket:776 and ticket:715)
  • %get-xcf-byte on x8632 (r14428)
  • make IDE "open selection" slightly smarter (r14429)
  • ensure advapi32.dll is loaded on 64-bit Windows (r14431)
  • Windows shared library improvements (r14432)
Location:
release/1.6/source
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • release/1.6/source

  • release/1.6/source/cocoa-ide/cocoa-editor.lisp

    r14381 r14433  
    18021802  "Return a pathname that STRING might designate."
    18031803  ;; We could get fancy here, but for now just be stupid.
    1804   (let ((pathname (ignore-errors (probe-file string))))
     1804  (let* ((rfs (ignore-errors (read-from-string string nil nil)))
     1805         (pathname (or (ignore-errors (probe-file string))
     1806                       (ignore-errors (probe-file rfs))
     1807                       (ignore-errors (probe-file (merge-pathnames *.lisp-pathname* string)))
     1808                       (ignore-errors (probe-file (merge-pathnames *.lisp-pathname* rfs))))))
    18051809    (if (and (pathnamep pathname)
    18061810             (not (directory-pathname-p pathname)))
  • release/1.6/source/level-0/l0-cfm-support.lisp

    r14288 r14433  
    479479  (defvar *get-module-handle-ex-addr*)
    480480
     481  (defun nbackslash-to-forward-slash (namestring)
     482    (dotimes (i (length namestring) namestring)
     483      (when (eql (schar namestring i) #\\)
     484        (setf (schar namestring i) #\/))))
    481485
    482486  (defun init-windows-ffi ()
     
    491495 
    492496  (defun hmodule-pathname (hmodule)
    493     (do* ((bufsize 64))
     497    (do* ((bufsize 128))
    494498         ()
    495499      (%stack-block ((name bufsize))
    496500        (let* ((needed (ff-call *get-module-file-name-addr*
    497                                 :address *current-process-handle*
    498501                                :address hmodule
    499502                                :address name
     
    502505          (if (eql 0 needed)
    503506            (return nil)
    504             (if (< bufsize needed)
    505               (setq bufsize needed)
    506               (return (%str-from-ptr name needed))))))))
     507            (if (<= bufsize needed)
     508              (setq bufsize (+ bufsize bufsize))
     509              (return (nbackslash-to-forward-slash (%str-from-ptr name needed)))))))))
    507510
    508511  (defun hmodule-basename (hmodule)
     
    594597        (values nil (%windows-error-string (get-last-windows-error))))))
    595598
    596 (init-shared-libraries)
     599  (init-shared-libraries)
     600
     601  (defun revive-shared-libraries ()
     602    (dolist (lib *shared-libraries*)
     603      (setf (shlib.map lib) nil
     604            (shlib.handle lib) nil
     605            (shlib.pathname lib) nil
     606            (shlib.base lib) nil)
     607      (let* ((soname (shlib.soname lib))
     608             (soname-len (length soname)))
     609        (block found
     610          (for-each-loaded-module
     611           (lambda (m)
     612             (let* ((module-soname (hmodule-basename m)))
     613               (when (%simple-string= soname module-soname 0 0 soname-len (length module-soname))
     614                 (let* ((m (%inc-ptr m 0)))
     615                   (setf (shlib.base lib) m
     616                         (shlib.map lib) m
     617                         (shlib.pathname lib) (hmodule-pathname m)))
     618                 (return-from found)))))))))
     619
     620  (defun reopen-user-libraries ()
     621    (dolist (lib *shared-libraries*)
     622      (unless (shlib.map lib)
     623        (let* ((handle (with-cstrs ((name (shlib.soname lib)))
     624                         (ff-call
     625                          (%kernel-import target::kernel-import-GetSharedLibrary)
     626                          :address name
     627                          :unsigned-fullword 0
     628                          :address))))
     629          (unless (%null-ptr-p handle)
     630            (setf (shlib.handle lib) handle
     631                  (shlib.base lib) handle
     632                  (shlib.map lib) handle
     633                  (shlib.pathname lib) (hmodule-pathname handle)
     634                  (shlib.opencount lib) 1))))))
     635           
     636             
    597637
    598638;;; end windows-target
    599 
     639 
    600640
    601641
     
    959999    (reopen-user-libraries))
    9601000  #+windows-target
    961   (init-windows-ffi)
     1001  (progn
     1002    (init-windows-ffi)
     1003    (revive-shared-libraries)
     1004    (reopen-user-libraries))
    9621005  (when *eeps*
    9631006    (without-interrupts
  • release/1.6/source/level-1/linux-files.lisp

    r14405 r14433  
    2626           
    2727
    28 (defun nbackslash-to-forward-slash (namestring)
    29   (dotimes (i (length namestring) namestring)
    30     (when (eql (schar namestring i) #\\)
    31       (setf (schar namestring i) #\/))))
     28
    3229
    3330(defconstant univeral-time-start-in-windows-seconds 9435484800)
  • release/1.6/source/level-1/x86-trap-support.lisp

    r13896 r14433  
    318318                        (type (simple-array (unsigned-byte 8) (*)) containing-object))
    319319        (aref containing-object (the fixnum (+ byte-offset delta))))
    320       (%get-unsigned-byte (%int-to-ptr byte-offset) delta))))
     320      ;; xcf.relative-pc is a fixnum, but it might be negative.
     321      (let* ((encoded-pc (%get-ptr xcf-ptr target::xcf.relative-pc))
     322             (pc (ash (%ptr-to-int encoded-pc) (- target::fixnumshift))))
     323        (%get-unsigned-byte (%int-to-ptr pc) delta)))))
    321324
    322325;;; If the byte following a uuo (which is "skip" bytes long, set
  • release/1.6/source/lisp-kernel/darwinx8632/Makefile

    r14347 r14433  
    2929CDEFINES = -DDARWIN -DX86 -DX8632 -DSVN_REVISION=$(SVN_REVISION)
    3030CDEBUG = -g
    31 COPT = -O2
     31COPT = #-O2
    3232# Once in a while, -Wformat says something useful.  The odds are against that,
    3333# however.
  • release/1.6/source/lisp-kernel/imports.s

    r14206 r14433  
    115115        __endif
    116116
     117        /* Need to be sure that the kernel links against advapi32.dll ;
     118           the random number generator needs to call into that library */
     119        __ifdef(`WIN_64')
     120        .globl C(SystemFunction036)
     121        .long C(SystemFunction036)
     122        __endif
     123
    117124
    118125
  • release/1.6/source/lisp-kernel/x86-exceptions.c

    r14295 r14433  
    16951695{
    16961696  TCR* tcr = get_tcr(true);
    1697 #if 0
    1698   if (tcr->valence != TCR_STATE_LISP) {
    1699     lisp_Debugger(context, info, signum, true, "exception in foreign context");
    1700   }
    1701 #endif
     1697
     1698#if WORD_SIZE==64
     1699  if ((signum == SIGFPE) && (tcr->valence != TCR_STATE_LISP)) {
     1700    if (handle_foreign_fpe(tcr,context,info)) {
     1701      return;
     1702    }
     1703  }
     1704#endif
     1705     
    17021706  handle_signal_on_foreign_stack(tcr,signal_handler,signum,info,context,(LispObj)__builtin_return_address(0)
    17031707#ifdef DARWIN_GS_HACK
     
    34143418        break;
    34153419      }
     3420#if WORD_SIZE==64
     3421      if ((signum==SIGFPE) &&
     3422          (code != FPE_INTDIV) &&
     3423          (tcr->valence != TCR_STATE_LISP)) {
     3424        mach_msg_type_number_t thread_state_count = x86_FLOAT_STATE64_COUNT;
     3425        x86_float_state64_t fs;
     3426
     3427        thread_get_state(thread,
     3428                         x86_FLOAT_STATE64,
     3429                         (thread_state_t)&fs,
     3430                         &thread_state_count);
     3431       
     3432        if (! (tcr->flags & (1<<TCR_FLAG_BIT_FOREIGN_FPE))) {
     3433          tcr->flags |= (1<<TCR_FLAG_BIT_FOREIGN_FPE);
     3434          tcr->lisp_mxcsr = (fs.__fpu_mxcsr & ~MXCSR_STATUS_MASK);
     3435        }
     3436        fs.__fpu_mxcsr &= ~MXCSR_STATUS_MASK;
     3437        fs.__fpu_mxcsr |= MXCSR_CONTROL_MASK;
     3438        thread_set_state(thread,
     3439                         x86_FLOAT_STATE64,
     3440                         (thread_state_t)&fs,
     3441                         x86_FLOAT_STATE64_COUNT);
     3442        return 0;
     3443      }
     3444#endif
    34163445      if (signum) {
    34173446        kret = setup_signal_frame(thread,
  • release/1.6/source/lisp-kernel/x86-spentry64.s

    r13994 r14433  
    39903990        __(movq %rbp,rcontext(tcr.save_rbp))
    39913991        __(movq $TCR_STATE_FOREIGN,rcontext(tcr.valence))
     3992        __(movq rcontext(tcr.foreign_sp),%rsp)
     3993        __ifdef(`WINDOWS')
     3994        __(stmxcsr rcontext(tcr.lisp_mxcsr))
     3995        __else
    39923996        __(movq $0,rcontext(tcr.ffi_exception))
    3993         __(movq rcontext(tcr.foreign_sp),%rsp)
     3997        __endif
    39943998        __(emms)
     3999        __ifdef(`WINDOWS')
     4000        __(ldmxcsr rcontext(tcr.foreign_mxcsr))
     4001        __endif
    39954002        __(movq (%rsp),%rbp)
    39964003        __ifdef(`DARWIN_GS_HACK')
     
    40704077        __(pxor %fpzero,%fpzero)
    40714078
     4079        __ifndef(`WINDOWS')
    40724080        /* If we got a floating-point exception during the ff-call,
    40734081           our handler will have set a flag, preserved lisp's MXCSR,
     
    40754083        __(btrq $TCR_FLAG_BIT_FOREIGN_FPE,rcontext(tcr.flags))
    40764084        __(jnc 1f)
     4085        __endif
    40774086        __(cmpb $0,C(bogus_fp_exceptions)(%rip))
    40784087        __(je 0f)
     
    40804089        __(jmp 1f)
    408140900:      __(stmxcsr rcontext(tcr.ffi_exception))
     4091        __ifndef(`WINDOWS')
    40824092        __(ldmxcsr rcontext(tcr.lisp_mxcsr)) /* preserved by the handler */
     4093        __endif
    408340941:      __(movq rcontext(tcr.save_vsp),%rsp)
    40844095        __(movq rcontext(tcr.save_rbp),%rbp)
     
    40964107        __(pop %temp2)
    40974108        __(pop %temp1)
     4109        __ifdef(`WINDOWS')
     4110        __(ldmxcsr rcontext(tcr.lisp_mxcsr))
     4111        __endif
    40984112        __(check_pending_interrupt(%temp0))
    40994113        __(pop %temp0)
Note: See TracChangeset for help on using the changeset viewer.