Changeset 14453


Ignore:
Timestamp:
Nov 23, 2010, 5:10:26 PM (9 years ago)
Author:
rme
Message:

Merge several changes from trunk.

  • r14435, treatment of long float, long double, etc.
  • r14437, fd-stream-listen returns nil when a non-interactive stream is at eof
  • r14438, on ppc, ensure fp exceptions are enabled before callback to lisp
  • r14440, catch :toplevel around startup-ccl
  • r14441, copy pathname-device in ensure-directory-pathname
  • r14444-r14445, custom exp() and expf() for freebsdx8632 (to get fp overflow)
Location:
release/1.6/source
Files:
8 edited
3 copied

Legend:

Unmodified
Added
Removed
  • release/1.6/source

  • release/1.6/source/level-1/l1-boot-lds.lisp

    r13067 r14453  
    2929
    3030(defun startup-ccl (&optional init-file)
    31   (with-simple-restart (abort "Abort startup.")
    32     (let ((init-files (if (listp init-file) init-file (list init-file))))
    33       (dolist (init-file init-files)
    34         (with-simple-restart (continue "Skip loading init file.")
    35           (when (load init-file :if-does-not-exist nil :verbose nil)
    36             (return)))))
    37     (flet ((eval-string (s)
    38              (with-simple-restart (continue "Skip evaluation of ~a" s)
    39                (eval (read-from-string s))))
    40            (load-file (name)
    41              (with-simple-restart (continue "Skip loading ~s" name)
    42                (load name))))
    43       (dolist (p *lisp-startup-parameters*)
    44         (let* ((param (cdr p)))
    45           (case (car p)
    46             (:gc-threshold
    47              (multiple-value-bind (n last) (parse-integer param :junk-allowed t)
    48                (when n
    49                  (if (< last (length param))
    50                    (case (schar param last)
    51                      ((#\k #\K) (setq n (ash n 10)))
    52                      ((#\m #\M) (setq n (ash n 20)))))
    53                  (set-lisp-heap-gc-threshold n)
    54                  (use-lisp-heap-gc-threshold))))
    55             (:eval (eval-string param))
    56             (:load (load-file param))))))))
     31  ;; Many of the things done here could enter a break loop on error.
     32  ;; If that break loop is exited via :q, quietly exit to here.
     33  (catch :toplevel
     34    (with-simple-restart (abort "Abort startup.")
     35      (let ((init-files (if (listp init-file) init-file (list init-file))))
     36        (dolist (init-file init-files)
     37          (with-simple-restart (continue "Skip loading init file.")
     38            (when (load init-file :if-does-not-exist nil :verbose nil)
     39              (return)))))
     40      (flet ((eval-string (s)
     41               (with-simple-restart (continue "Skip evaluation of ~a" s)
     42                 (eval (read-from-string s))))
     43             (load-file (name)
     44               (with-simple-restart (continue "Skip loading ~s" name)
     45                 (load name))))
     46        (dolist (p *lisp-startup-parameters*)
     47          (let* ((param (cdr p)))
     48            (case (car p)
     49              (:gc-threshold
     50               (multiple-value-bind (n last) (parse-integer param :junk-allowed t)
     51                 (when n
     52                   (if (< last (length param))
     53                     (case (schar param last)
     54                       ((#\k #\K) (setq n (ash n 10)))
     55                       ((#\m #\M) (setq n (ash n 20)))))
     56                   (set-lisp-heap-gc-threshold n)
     57                   (use-lisp-heap-gc-threshold))))
     58              (:eval (eval-string param))
     59              (:load (load-file param)))))))))
    5760
    5861
  • release/1.6/source/level-1/l1-files.lisp

    r14381 r14453  
    372372                                      (pathname-type path)
    373373                                      nil)))
    374                        nil nil (pathname-host path)))))
     374                       nil nil (pathname-host path) nil #+windows-target (pathname-device path)))))
    375375
    376376(defun %directory-list-namestring (list &optional logical-p)
  • release/1.6/source/level-1/l1-numbers.lisp

    r14119 r14453  
    762762  (with-stack-double-floats ((temp))
    763763    #+arm-target (%set-fpscr-status 0)
     764    #-freebsdx8632-target
    764765    (%setf-double-float TEMP (#_exp n))
     766    #+freebsdx8632-target
     767    (%setf-double-float TEMP (external-call "__ieee754_exp" :double-float n :double-float))
    765768    (%df-check-exception-1 'exp n (%ffi-exception-status))
    766769    (%setf-double-float result TEMP)))
     
    771774  (target::with-stack-short-floats ((temp))
    772775    #+arm-target (%set-fpscr-status 0)
     776    #-freebsdx8632-target
    773777    (%setf-short-float TEMP (#_expf n))
     778    #+freebsdx8632-target
     779    (%setf-short-float TEMP (external-call "__ieee754_expf" :single-float n :single-float))
    774780    (%sf-check-exception-1 'exp n (%ffi-exception-status))
    775781    (%setf-short-float result TEMP)))
  • release/1.6/source/level-1/l1-streams.lisp

    r14405 r14453  
    56365636 
    56375637(defun fd-stream-listen (s ioblock)
    5638   (declare (ignore s))
    5639   (unread-data-available-p (ioblock-device ioblock)))
     5638  (if (interactive-stream-p s)
     5639    (unread-data-available-p (ioblock-device ioblock))
     5640    (not (fd-stream-eofp s ioblock))))
    56405641
    56415642(defun fd-stream-close (s ioblock)
  • release/1.6/source/lib/db-io.lisp

    r13067 r14453  
    13221322           (:signed `(,encoded-type-signed-32))
    13231323           (:unsigned `(,encoded-type-unsigned-32))
    1324            ((:long-double :complex-int
    1325                         :complex-float :complex-double :complex-long-double)
    1326             (encode-ffi-type `(:struct ,primtype))))
     1324           ((:long-float :long-double) (encode-ffi-type '(:array 2 (:primitive :double))))
     1325           (:complex-int (encode-ffi-type '(:array 2 (:primitive :signed))))
     1326           (:complex-float (encode-ffi-type '(:array 2 (:primitive :float))))
     1327           (:complex-double (encode-ffi-type '(:array 2 (:primitive :double))))
     1328           (:complex-long-double (encode-ffi-type '(:array 4 (:primitive :double)))))
    13271329         (ecase (car primtype)
    13281330           (* `(,encoded-type-pointer ,@(encode-ffi-type
     
    13961398           (:unsigned `(f))
    13971399           ((:long-double :complex-int
    1398                           :complex-float :complex-double :complex-long-double)           
     1400                          :complex-float :complex-double :complex-long-double)
    13991401            #|(encode-ffi-arg-type `(:struct ,primtype))|#
    14001402            `(#\?)))
     
    14281430          (:union #\u)
    14291431          (:transparent-union #\U))
    1430            ,@(encode-name (ffi-struct-reference (cadr spec)))))
     1432           ,@(encode-name
     1433              (if (eq (car spec) :struct)
     1434                (ffi-struct-reference (cadr spec))
     1435                (ffi-union-reference (cadr spec))))))
    14311436    (:typedef
    14321437     `(#\t ,@(encode-name (ffi-typedef-name (cadr spec)))))
  • release/1.6/source/lisp-kernel/freebsdx8632/Makefile

    r14393 r14453  
    2424CDEFINES = -DFREEBSD -D_REENTRANT -DX86 -DX8632 -D_GNU_SOURCE -DHAVE_TLS -DSVN_REVISION=$(SVN_REVISION)
    2525CDEBUG = -g
    26 COPT = -O2
     26COPT = #-O2
    2727# Once in a while, -Wformat says something useful.  The odds are against that,
    2828# however.
     
    4040DEBUGOBJ = lispdcmd.o plprint.o plsym.o xlbt.o x86_print.o
    4141KERNELOBJ= $(COBJ) x86-asmutils32.o  imports.o
     42
     43PLATFORM_OBJ = e_exp.o e_expf.o
     44PLATFORM_HEADERS = fdlibm.h
    4245
    4346SPINC = lisp.s m4macros.m4 x86-constants.s x86-macros.s errors.s x86-uuo.s \
     
    6669LINKSCRIPT =  # -T $(LINKSCRIPTFILE)
    6770
    68 ../../fx86cl:   $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(LINKSCRIPTFILE)
    69         $(CC) -m32 $(CDEBUG)  -Wl,--export-dynamic  $(LINKSCRIPT)  -o $@  $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(OSLIBS)
     71../../fx86cl:   $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(PLATFORM_OBJ) $(LINKSCRIPTFILE)
     72        $(CC) -m32 $(CDEBUG)  -Wl,--export-dynamic  $(LINKSCRIPT)  -o $@  $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(PLATFORM_OBJ) $(OSLIBS)
    7073
    7174
     
    7477$(COBJ): $(CHEADERS)
    7578$(DEBUGOBJ): $(CHEADERS) lispdcmd.h
     79$(PLATFORM_OBJ): $(PLATFORM_HEADERS)
    7680
    7781
    7882cclean:
    79         $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) ../../fx86cl
     83        $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) $(PLATFORM_OBJ) ../../fx86cl
    8084
    8185clean:  cclean
  • release/1.6/source/lisp-kernel/ppc-exceptions.c

    r14197 r14453  
    15411541  tcr->save_tsp = (LispObj*) ptr_from_lispobj(xpGPR(xp, tsp));
    15421542
     1543#ifdef DARWIN
     1544  enable_fp_exceptions();
     1545#endif
    15431546
    15441547
     
    27222725    ts.__srr1 &= ~MSR_FE0_FE1_MASK;
    27232726  }
    2724   /*
    2725      Hack-o-rama warning (isn't it about time for such a warning?):
    2726      pthread_kill() seems to want to lose the MSR's FE0/FE1 bits.
    2727      Our handler for lisp's use of pthread_kill() pushes a phony
    2728      lisp frame on the stack and force the context to resume at
    2729      the UUO in enable_fp_exceptions(); the "saveLR" field of that
    2730      lisp frame contains the -real- address that process_interrupt
    2731      should have returned to, and the fact that it's in a lisp
    2732      frame should convince the GC to notice that address if it
    2733      runs in the tiny time window between returning from our
    2734      interrupt handler and ... here.
    2735      If the top frame on the stack is a lisp frame, discard it
    2736      and set ts.srr0 to the saveLR field in that frame.  Otherwise,
    2737      just adjust ts.srr0 to skip over the UUO.
    2738   */
    2739   {
    2740     lisp_frame *tos = (lisp_frame *)ts.__r1,
    2741       *next_frame = tos->backlink;
    2742    
    2743     if (tos == (next_frame -1)) {
    2744       ts.__srr0 = tos->savelr;
    2745       ts.__r1 = (LispObj) next_frame;
    2746     } else {
    2747       ts.__srr0 += 4;
    2748     }
    2749   }
     2727 
     2728  ts.__srr0 += 4;
    27502729  thread_set_state(thread,
    27512730#ifdef PPC64
Note: See TracChangeset for help on using the changeset viewer.