Changeset 13502


Ignore:
Timestamp:
Mar 9, 2010, 5:23:48 PM (10 years ago)
Author:
gz
Message:

From trunk: formatting tweaks, non-linux changes, doc and error message fixes

Location:
branches/working-0711/ccl
Files:
16 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl

  • branches/working-0711/ccl/compiler/X86/X8632/x8632-vinsns.lisp

    r13332 r13502  
    21972197                                   ((val :u32)
    21982198                                    (v :lisp)
    2199                                     (scaled-idx :s32))
     2199                                    (scaled-idx :imm))
    22002200                                   ())
    22012201  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
     
    22112211                                   ((val :s32)
    22122212                                    (v :lisp)
    2213                                     (scaled-idx :s32))
     2213                                    (scaled-idx :imm))
    22142214                                   ())
    22152215  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
  • branches/working-0711/ccl/compiler/X86/x86-asm.lisp

    r13306 r13502  
    18451845     #x0f7e #o000 #x0 #x66)
    18461846
     1847   ;; movdqa
     1848   (def-x86-opcode (movdqa :cpu64)  ((:regxmm :insert-xmm-reg) (:anymem :insert-memory))
     1849     #x0f7f #o300 #x0 #x66)
     1850   (def-x86-opcode (movdqa :cpu64) ((:anymem :insert-memory) (:regxmm :insert-xmm-reg))
     1851     #x0f6f #o000 #x0 #x66)
     1852   
     1853
    18471854   ;; sign-extending mov
    18481855   (def-x86-opcode movsbl ((:reg8 :insert-modrm-rm) (:reg32 :insert-modrm-reg))
     
    30263033   (def-x86-opcode movapd ((:regxmm :insert-xmm-reg) (:anymem :insert-memory))
    30273034     #x0f29 #o000 #x0 #x66)
     3035
     3036   ;; movaps
     3037   (def-x86-opcode movaps ((:regxmm :insert-xmm-rm) (:regxmm :insert-xmm-reg))
     3038     #x0f28 #o300 #x0)
     3039   (def-x86-opcode movaps ((:anymem :insert-memory) (:regxmm :insert-xmm-reg))
     3040     #x0f28 #o000 #x0)
     3041   (def-x86-opcode movaps ((:regxmm :insert-xmm-reg) (:anymem :insert-memory))
     3042     #x0f29 #o000 #x0)
    30283043   
    30293044   ;; mulsd
     
    32093224     #x0fdf #o000 #x0 #x66)
    32103225
     3226   ;; pcmpeqb
     3227   (def-x86-opcode pcmpeqb ((:regxmm :insert-modrm-rm) (:regxmm :insert-modrm-reg))
     3228     #x0f74 #o300 #x0 #x66)
     3229   
    32113230   ;; por
    32123231   (def-x86-opcode por ((:regmmx :insert-mmx-rm) (:regmmx :insert-mmx-reg))
  • branches/working-0711/ccl/compiler/nx0.lisp

    r13304 r13502  
    28322832  '(sort stable-sort delete delete-if delete-if-not remf nreverse
    28332833    nunion nset-intersection)
    2834   "Names of functions whos result(s) should ordinarily be used, because of their side-effects or lack of them.")
     2834  "Names of functions whose result(s) should ordinarily be used, because of their side-effects or lack of them.")
  • branches/working-0711/ccl/level-0/l0-numbers.lisp

    r13339 r13502  
    18061806;;; too bad in a 64-bit CCL, but the generator pretty much has to be
    18071807;;; in LAP for 32-bit ports.
    1808 #-(or x8632-target ppc32-target x8664-target)
     1808#-(or x8632-target ppc32-target x8664-target ppc64-target)
    18091809(defun %mrg31k3p (state)
    18101810  (let* ((v (random.mrg31k3p-state state)))
  • branches/working-0711/ccl/level-1/l1-files.lisp

    r13070 r13502  
    226226    (if (< fd 0)
    227227      (if (and (null if-exists)
    228                (eql fd (- #$EEXIST)))
     228               (or (eql fd (- #$EEXIST))
     229                   #+windows-target
     230                   (and (eql fd (- #$EPERM))
     231                        (probe-file path))))
    229232        (return-from %create-file nil)
    230233        (signal-file-error fd path))
  • branches/working-0711/ccl/level-1/l1-numbers.lisp

    r13339 r13502  
    448448    (declare (dynamic-extent args))
    449449    (dolist (a args)
    450       (unless (and (fixnump a) (%i<= 0 a) (< a mrg31k3p-limit))
     450      (unless (and (integerp a) (<= 0 a) (< a mrg31k3p-limit))
    451451        (report-bad-arg a `(integer 0 (,mrg31k3p-limit)))))
    452452    (when (and (zerop x0) (zerop x1) (zerop x2))
  • branches/working-0711/ccl/level-1/l1-sockets.lisp

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • branches/working-0711/ccl/level-1/l1-sysio.lisp

    r13070 r13502  
    125125          (default-character-encoding domain)))
    126126  (unless (lookup-character-encoding character-encoding)
    127     (error "~S is not the name of a known characer encoding."
     127    (error "~S is not the name of a known character encoding."
    128128           character-encoding))
    129129  (let* ((pair (cons character-encoding line-termination)))
  • branches/working-0711/ccl/level-1/x86-trap-support.lisp

    r13179 r13502  
    7979
    8080#+darwinx8664-target
    81 ;;; Apple has decided that compliance with some Unix standard or other
    82 ;;; requires gratuitously renaming ucontext/mcontext structures and
    83 ;;; their components.  Do you feel more compliant now ?
    84 (progn
    85   (eval-when (:compile-toplevel :execute)
    86     (def-foreign-type nil
    87         (:struct :portable_mcontext64
    88                  (:es :x86_exception_state64_t)
    89                  (:ss :x86_thread_state64_t)
    90                  (:fs :x86_float_state64_t)))
    91     (def-foreign-type nil
    92         (:struct :portable_uc_stack
    93                  (:ss_sp (:* :void))
    94                  (:ss_size (:unsigned 64))
    95                  (:ss_flags  (:signed 32))))
    96     (def-foreign-type nil
    97         (:struct :portable_ucontext64
    98                  (:onstack (:signed 32))
    99                  (:sigmask (:unsigned 32))
    100                  (:stack (:struct :portable_uc_stack))
    101                  (:link :address)
    102                  (:uc_mcsize (:unsigned 64))
    103                  (:uc_mcontext64 (:* (:struct :portable_mcontext64))))))
    104   (defun xp-mxcsr (xp)
    105     (%get-unsigned-long
    106      (pref (pref xp :portable_ucontext64.uc_mcontext64) :portable_mcontext64.fs) 32))
    107   (defconstant gp-regs-offset 0)
    108   (defmacro xp-gp-regs (xp)
    109     `(pref (pref ,xp :portable_ucontext64.uc_mcontext64) :portable_mcontext64.ss))
     81(progn
     82  (defconstant gp-regs-offset 0)
     83  (defun xp-mxcsr (xp)
     84     (pref xp :ucontext_t.uc_mcontext.__fs.__fpu_mxcsr))
     85  (defmacro xp-gp-regs (xp)
     86    `(pref ,xp :ucontext_t.uc_mcontext.__ss))
    11087
    11188  (defconstant flags-register-offset 17)
     
    188165  (defconstant gp-regs-offset 0)
    189166  (defmacro xp-gp-regs (xp)
    190     `(pref (pref ,xp :ucontext.uc_mcontext) :mcontext.ss))
    191   (defun xp-mxcsr (xp)
    192     (%get-unsigned-long (pref (pref xp :ucontext.uc_mcontext) :mcontext.fs) 32))
     167    `(pref ,xp :ucontext_t.uc_mcontext.__ss))
     168  (defun xp-mxcsr (xp)
     169    (pref xp :ucontext_t.uc_mcontext.__fs.__fpu_mxcsr))
    193170  (defconstant flags-register-offset 9)
    194171  (defconstant eip-register-offset 10)
  • branches/working-0711/ccl/lib/misc.lisp

    r13467 r13502  
    898898                              (start nil)
    899899                              (threshold (and classes 0.00005)))
    900   "Show statistic about types of objects in the heap.
     900  "Show statistics about types of objects in the heap.
    901901   If :GC-FIRST is true (the default), do a full gc before scanning the heap.
    902902   If :START is non-nil, it should be an object returned by GET-ALLOCATION-SENTINEL, only
  • branches/working-0711/ccl/library/core-files.lisp

    r13476 r13502  
    6666
    6767
     68(eval-when (load eval #-BOOTSTRAPPED compile)
     69
    6870(defstruct core-info
    6971  pathname
     
    7880  process-class
    7981  )
    80 
     82)
    8183
    8284(defmethod print-object :around ((core core-info) (stream t))
  • branches/working-0711/ccl/library/dominance.lisp

    r13493 r13502  
    1919;(setq *print-array* nil)
    2020;(setq *print-simple-bit-vector* nil)
     21
     22#+:linuxx8664-target
     23(progn
    2124
    2225(export '(idom-heap-utilization))
     
    512515                           (descend-pointers next)))))))
    513516            finally (report-idom-heap-utilization type-infos :unit unit :sort sort :threshold threshold)))))
     517
     518)
  • branches/working-0711/ccl/lisp-kernel/Threads.h

    r13070 r13502  
    183183
    184184
    185 LispObj create_system_thread(size_t stack_size,
     185Boolean create_system_thread(size_t stack_size,
    186186                             void* stackaddr,
    187187#ifdef WINDOWS
  • branches/working-0711/ccl/lisp-kernel/pmcl-kernel.c

    r13070 r13502  
    19911991xGetSharedLibrary(char *path, int *resultType)
    19921992{
    1993 #if 0
    1994   NSObjectFileImageReturnCode code;
    1995   NSObjectFileImage              moduleImage;
    1996   NSModule                       module;
    1997   const struct mach_header *     header;
    1998   const char *                   error;
    1999   void *                         result;
    2000   /* not thread safe */
    2001   /*
    2002   static struct {
    2003     const struct mach_header  *header;
    2004     NSModule                  *module;
    2005     const char                *error;
    2006   } results;   
    2007   */
    2008   result = NULL;
    2009   error = NULL;
    2010 
    2011   /* first try to open this as a bundle */
    2012   code = NSCreateObjectFileImageFromFile(path,&moduleImage);
    2013   if (code != NSObjectFileImageSuccess &&
    2014       code != NSObjectFileImageInappropriateFile &&
    2015       code != NSObjectFileImageAccess)
    2016     {
    2017       /* compute error strings */
    2018       switch (code)
    2019         {
    2020         case NSObjectFileImageFailure:
    2021           error = "NSObjectFileImageFailure";
    2022           break;
    2023         case NSObjectFileImageArch:
    2024           error = "NSObjectFileImageArch";
    2025           break;
    2026         case NSObjectFileImageFormat:
    2027           error = "NSObjectFileImageFormat";
    2028           break;
    2029         case NSObjectFileImageAccess:
    2030           /* can't find the file */
    2031           error = "NSObjectFileImageAccess";
    2032           break;
    2033         default:
    2034           error = "unknown error";
    2035         }
    2036       *resultType = 0;
    2037       return (void *)error;
    2038     }
    2039   if (code == NSObjectFileImageInappropriateFile ||
    2040       code == NSObjectFileImageAccess ) {
    2041     /* the pathname might be a partial pathane (hence the access error)
    2042        or it might be something other than a bundle, if so perhaps
    2043        it is a .dylib so now try to open it as a .dylib */
    2044 
    2045     /* protect against redundant loads, Gary Byers noticed possible
    2046        heap corruption if this isn't done */
    2047     header = NSAddImage(path, NSADDIMAGE_OPTION_RETURN_ON_ERROR |
    2048                         NSADDIMAGE_OPTION_WITH_SEARCHING |
    2049                         NSADDIMAGE_OPTION_RETURN_ONLY_IF_LOADED);
    2050     if (!header)
    2051       header = NSAddImage(path, NSADDIMAGE_OPTION_RETURN_ON_ERROR |
    2052                           NSADDIMAGE_OPTION_WITH_SEARCHING);
    2053     result = (void *)header;
    2054     *resultType = 1;
    2055   }
    2056   else if (code == NSObjectFileImageSuccess) {
    2057     /* we have a sucessful module image
    2058        try to link it, don't bind symbols privately */
    2059 
    2060     module = NSLinkModule(moduleImage, path,
    2061                           NSLINKMODULE_OPTION_RETURN_ON_ERROR | NSLINKMODULE_OPTION_BINDNOW);
    2062     NSDestroyObjectFileImage(moduleImage);     
    2063     result = (void *)module;
    2064     *resultType = 2;
    2065   }
    2066   if (!result)
    2067     {
    2068       /* compute error string */
    2069       NSLinkEditErrors ler;
    2070       int lerno;
    2071       const char* file;
    2072       NSLinkEditError(&ler,&lerno,&file,&error);
    2073       if (error) {
    2074         result = (void *)error;
    2075         *resultType = 0;
    2076       }
    2077     }
    2078   return result;
    2079 #else
    2080   const char *                   error;
    2081   void *                         result;
     1993  const char *error;
     1994  void *result;
    20821995
    20831996  result = dlopen(path, RTLD_NOW | RTLD_GLOBAL);
     
    20902003  *resultType = 1;
    20912004  return result;
    2092 #endif
    20932005}
    20942006#endif
     
    21992111  }
    22002112  if (image_nil == 0) {
     2113#ifdef WINDOWS
     2114    char *fmt = "Couldn't load lisp heap image from %ls";
     2115#else
     2116    char *fmt = "Couldn't load lisp heap image from %s";
     2117#endif
     2118
     2119    fprintf(dbgout, fmt, path);
    22012120    if (err == 0) {
    2202       fprintf(dbgout, "Couldn't load lisp heap image from %s\n", path);
     2121      fprintf(dbgout, "\n");
    22032122    } else {
    2204       fprintf(dbgout, "Couldn't load lisp heap image from %s:\n%s\n", path, strerror(err));
     2123      fprintf(dbgout, ": %s\n", strerror(err));
    22052124    }
    22062125    exit(-1);
     
    22492168#endif
    22502169#ifdef DARWIN
    2251 #if 1
    22522170  void *result;
    22532171
     
    22602178  }
    22612179  return result;
    2262 #else
    2263   natural address = 0;
    2264 
    2265   if ((handle == NULL) ||
    2266       (handle == (void *)-1) ||
    2267       (handle == (void *)-2)){
    2268     if (NSIsSymbolNameDefined(name)) { /* Keep dyld_lookup from crashing */
    2269       _dyld_lookup_and_bind(name, (void *) &address, (void*) NULL);
    2270     }
    2271     return (void *)address;
    2272   }
    2273   Bug(NULL, "How did this happen ?");
    2274 #endif
    22752180#endif
    22762181#ifdef WINDOWS
  • branches/working-0711/ccl/lisp-kernel/thread_manager.c

    r13144 r13502  
    14261426    free(tcr->tlb_pointer);
    14271427    tcr->tlb_pointer = NULL;
     1428#ifdef WINDOWS
     1429    if (tcr->osid != 0) {
     1430      CloseHandle((HANDLE)(tcr->osid));
     1431    }
     1432#endif
    14281433    tcr->osid = 0;
    14291434    tcr->interrupt_pending = 0;
     
    16061611count_cpus()
    16071612{
    1608 #ifdef DARWIN
    1609   /* As of OSX 10.4, Darwin doesn't define _SC_NPROCESSORS_ONLN */
    1610 #include <mach/host_info.h>
    1611 
    1612   struct host_basic_info info;
    1613   mach_msg_type_number_t count = HOST_BASIC_INFO_COUNT;
    1614  
    1615   if (KERN_SUCCESS == host_info(mach_host_self(), HOST_BASIC_INFO,(host_info_t)(&info),&count)) {
    1616     if (info.max_cpus > 1) {
    1617       spin_lock_tries = 1024;
    1618     }
    1619   }
    1620 #else
    16211613  int n = sysconf(_SC_NPROCESSORS_ONLN);
    16221614 
     
    16241616    spin_lock_tries = 1024;
    16251617  }
    1626 #endif
    16271618}
    16281619#endif
     
    18201811
    18211812#ifdef WINDOWS
    1822 LispObj
     1813Boolean
    18231814create_system_thread(size_t stack_size,
    18241815                     void* stackaddr,
     
    18271818{
    18281819  HANDLE thread_handle;
     1820  Boolean won = false;
    18291821
    18301822  stack_size = ((stack_size+(((1<<16)-1)))&~((1<<16)-1));
    18311823
    18321824  thread_handle = (HANDLE)_beginthreadex(NULL,
    1833                                          0/*stack_size*/,
     1825                                         stack_size,
    18341826                                         start_routine,
    18351827                                         param,
     
    18391831  if (thread_handle == NULL) {
    18401832    wperror("CreateThread");
    1841   }
    1842   return (LispObj) ptr_to_lispobj(thread_handle);
    1843 }
    1844 #else
    1845 LispObj
    1846 create_system_thread(size_t stack_size,
    1847                      void* stackaddr,
    1848                      void* (*start_routine)(void *),
    1849                      void* param)
     1833  } else {
     1834    won = true;
     1835    CloseHandle(thread_handle);
     1836  }
     1837  return won;
     1838}
     1839#else
     1840Boolean
     1841create_system_thread(size_t stack_size,  void *stackaddr,
     1842                     void *(*start_routine)(void *), void *param)
    18501843{
    18511844  pthread_attr_t attr;
    1852   pthread_t returned_thread = (pthread_t) 0;
     1845  pthread_t returned_thread;
     1846  int err;
    18531847  TCR *current = get_tcr(true);
    18541848
     
    18631857  if (stackaddr != NULL) {
    18641858    /* Size must have been specified.  Sort of makes sense ... */
    1865 #ifdef DARWIN
    1866     Fatal("no pthread_attr_setsetstack. "," Which end of stack does address refer to?");
    1867 #else
    18681859    pthread_attr_setstack(&attr, stackaddr, stack_size);
    1869 #endif
    18701860  } else if (stack_size != DEFAULT_THREAD_STACK_SIZE) {
    18711861    pthread_attr_setstacksize(&attr,stack_size);
     
    18841874  */
    18851875  LOCK(lisp_global(TCR_AREA_LOCK),current);
    1886   pthread_create(&returned_thread, &attr, start_routine, param);
     1876  err = pthread_create(&returned_thread, &attr, start_routine, param);
    18871877  UNLOCK(lisp_global(TCR_AREA_LOCK),current);
    18881878  pthread_attr_destroy(&attr);
    1889   return (LispObj) ptr_to_lispobj(returned_thread);
     1879  return (err == 0);
    18901880}
    18911881#endif
     
    21272117      result = true;
    21282118#ifdef WINDOWS
    2129       /* What we really want to de hear is (something like)
     2119      /* What we really want to do here is (something like)
    21302120         forcing the thread to run quit_handler().  For now,
    2131          mark the TCR as dead and kill thw Windows thread. */
     2121         mark the TCR as dead and kill the Windows thread. */
    21322122      tcr->osid = 0;
    21332123      if (!TerminateThread((HANDLE)osid, 0)) {
     2124        CloseHandle((HANDLE)osid);
    21342125        result = false;
    21352126      } else {
     2127        CloseHandle((HANDLE)osid);
    21362128        shutdown_thread_tcr(tcr);
    21372129      }
Note: See TracChangeset for help on using the changeset viewer.