Changeset 15706 for release


Ignore:
Timestamp:
Feb 15, 2013, 7:24:29 AM (6 years ago)
Author:
gb
Message:

Propagate recent trunk changes.

Location:
release/1.9/source
Files:
24 edited

Legend:

Unmodified
Added
Removed
  • release/1.9/source/compiler

  • release/1.9/source/level-0

  • release/1.9/source/level-0/l0-float.lisp

    r15685 r15706  
    745745                    (tx2 (* tx tx))
    746746                    (d (1+ (* tx2 (* ty ty))))
    747                     (n (if (> (abs i) 20)
    748                          (* 4 (exp (* -2 (abs i))))
    749                          (let ((c (cosh i)))
    750                            (/ (* c c))))))
    751                (complex (/ (* n tx) d)
     747                    (c (if (> (abs i) 20)
     748                         (* 2 (exp (- (abs i))))
     749                         (/ (cosh i)))))
     750               (complex (/ (* (* c c) tx) d)
    752751                        (/ (* ty (1+ tx2)) d))))))
    753752        ((or (typep x 'ratio)
     
    849848                      (t (if (minusp y) #.(- single-float-half-pi) single-float-half-pi)))))
    850849          ((= x 1)
    851            (setq ra (if (< y1 1e-9)
    852                       (/ (log-e (/ 2 y1)) 2)
    853                       (/ (log1+ (/ 4 (* y y))) 4)))
    854            (setq ia (/ (atan (/ 2 y) -1) 2)))
    855           (t
     850           (cond ((< y1 1e-9)
     851                  (setq ra (/ (- (if (typep y 'double-float) double-float-log2 single-float-log2)
     852                                 (log-e y1))
     853                              2))
     854                  (setq ia (/ (if (minusp y) (atan -2 y) (atan 2 (- y))) 2)))
     855                 (t
     856                  (setq ra (/ (log1+ (/ 4 (* y y))) 4))
     857                  (setq ia (/ (atan (/ 2 y) -1) 2)))))
     858          ((and (< y1 1)
     859                (< 0.5 x 2))
     860           (let ((x-1 (- x 1))
     861                 (x+1 (+ x 1))
     862                 (y2 (* y y)))
     863             (setq ra (/ (log-e (/ (+ (* x-1 x-1) y2) (+ (* x+1 x+1) y2))) -4))
     864             (setq ia (/ (atan (* 2 y) (- 1 (+ (* x x) y2))) 2))))
     865           (t
    856866           (let ((r2 (+ (* x x) (* y y))))
    857867             (setq ra (/ (log1+ (/ (* -4 x) (1+ (+ (* 2 x) r2)))) -4))
     
    11161126    (double-float (%double-float-exp! x (%make-dfloat)))
    11171127    (t
    1118      #+32-bit-target
    1119      (target::with-stack-short-floats ((sx x))
    1120        (%single-float-exp! sx (%make-sfloat)))
    1121      #+64-bit-target
    1122      (%single-float-exp (%short-float x)))))
     1128     (if (and (typep x 'rational)
     1129              (< x -104))
     1130       0.0s0
     1131       #+32-bit-target
     1132       (target::with-stack-short-floats ((sx x))
     1133         (%single-float-exp! sx (%make-sfloat)))
     1134       #+64-bit-target
     1135       (%single-float-exp (%short-float x))))))
    11231136
    11241137
  • release/1.9/source/level-0/l0-numbers.lisp

    r15685 r15706  
    955955       0.0f0))
    956956    (double-float
    957      (if (minusp number)
     957     (if (%double-float-sign number)
    958958       (%double-float pi)
    959959       0.0d0))
     
    961961     (atan (%imagpart number) (%realpart number)))
    962962    (short-float
    963      (if (minusp number)
     963     (if (%short-float-sign number)
    964964       (%short-float pi)
    965965       0.0s0))))
  • release/1.9/source/level-1

  • release/1.9/source/level-1/l1-error-signal.lisp

    r14844 r15706  
    5454  ;;; The compiler (finally !) won't tail-apply error.  But we kind of
    5555  ;;; expect it to ...
    56   (let* ((err-typ (max (ash err-num -16) 0))
    57          (err-num (%word-to-int err-num))
    58          (format-string (%rsc-string err-num)))
    59     (%err-disp-common err-num err-typ format-string errargs frame-ptr)))
     56  (if (eql err-num $XARRLIMIT)
     57    (%error (make-condition 'vector-size-limitation
     58                            :subtag (cadr errargs)
     59                            :element-count (car errargs))
     60            nil
     61            frame-ptr)
     62    (let* ((err-typ (max (ash err-num -16) 0))
     63           (err-num (%word-to-int err-num))
     64           (format-string (%rsc-string err-num)))
     65      (%err-disp-common err-num err-typ format-string errargs frame-ptr))))
    6066
    6167(defparameter *foreign-error-condition-recognizers* ())
  • release/1.9/source/level-1/l1-error-system.lisp

    r15311 r15706  
    190190  ()
    191191  (:report (lambda (c s) (declare (ignore c)) (format s "Attempt to heap-allocate a lisp object when heap allocation is disabled."))))
    192  
     192
     193(define-condition vector-size-limitation (storage-condition)
     194  ((subtag :initarg :subtag)
     195   (element-count :initarg :element-count))
     196  (:report (lambda (c s)
     197             (let* ((subtag (slot-value c 'subtag))
     198                    (element-count (slot-value c 'element-count))
     199                    (typename (if (eql subtag target::subtag-bignum)
     200                                'bignum
     201                                (if (eql subtag target::subtag-simple-vector)
     202                                  'simple-vector
     203                                  (if (eql subtag target::subtag-simple-base-string)
     204                                    'string
     205                                    (if (> subtag target::subtag-simple-vector)
     206                                      `(simple-array ,(element-subtype-type subtag) (*))
     207                                      `(ccl::uvector ,subtag))))))
     208                    (qualifier (if (eql subtag target::subtag-bignum)
     209                                 "32-bit "
     210                                 "")))
     211               (format s "Cannot allocate a ~s with ~d elements.~&Objects of type ~s can can have at most ~&~d ~aelements in this implementation."
     212                       typename
     213                       element-count
     214                       (copy-tree typename)
     215                       (1- target::array-total-size-limit)
     216                       qualifier)))))
    193217
    194218(define-condition type-error (error)
  • release/1.9/source/level-1/linux-files.lisp

    r15684 r15706  
    10741074;;; Foreign (unix) processes.
    10751075
    1076 (defun call-with-string-vector (function strings)
    1077   (let ((bufsize (reduce #'+ strings
    1078                          :key #'(lambda (s) (1+ (length (string s))))))
    1079         (argvsize (ash (1+ (length strings)) target::word-shift))
    1080         (bufpos 0)
    1081         (argvpos 0))
     1076(defun call-with-string-vector (function strings encoding)
     1077  (let* ((encoding (if (typep encoding 'character-encoding)
     1078                     encoding
     1079                     (get-character-encoding encoding)))
     1080         (bufsize (reduce #'+ strings
     1081                          :key #'(lambda (s)
     1082                                   (let* ((string (string s)))
     1083                                     (cstring-encoded-length-in-bytes encoding
     1084                                                                      string
     1085                                                                      0
     1086                                                                      (length string))))))
     1087         (argvsize (ash (1+ (length strings)) target::word-shift))
     1088         (bufpos 0)
     1089         (argvpos 0))       
    10821090    (%stack-block ((buf bufsize) (argv argvsize))
    10831091      (flet ((init (s)
    1084              (multiple-value-bind (sstr start end) (get-sstring s)
    1085                (declare (fixnum start end))
    1086                (let ((len (- end start)))
    1087                  (declare (fixnum len))
    1088                  (do* ((i 0 (1+ i))
    1089                        (start start (1+ start))
    1090                        (bufpos bufpos (1+ bufpos)))
    1091                       ((= i len))
    1092                    (setf (%get-unsigned-byte buf bufpos)
    1093                          (logand #xff (%scharcode sstr start))))
    1094                  (setf (%get-byte buf (%i+ bufpos len)) 0)
    1095                  (setf (%get-ptr argv argvpos) (%inc-ptr buf bufpos))
    1096                  (setq bufpos (%i+ bufpos len 1))
    1097                  (setq argvpos (%i+ argvpos target::node-size))))))
     1092               (multiple-value-bind (sstr start end) (get-sstring s)
     1093                 (declare (fixnum start end))
     1094                 (let* ((len (- (encode-string-to-memory encoding buf bufpos sstr start end) bufpos)))
     1095                   (declare (fixnum len))
     1096                   (setf (%get-byte buf (%i+ bufpos len)) 0)
     1097                   (setf (%get-ptr argv argvpos) (%inc-ptr buf bufpos))
     1098                   (setq bufpos (%i+ bufpos len 1))
     1099                   (setq argvpos (%i+ argvpos target::node-size))))))
    10981100        (declare (dynamic-extent #'init))
    10991101        (map nil #'init strings))
     
    11011103      (funcall function argv))))
    11021104
    1103 (defmacro with-string-vector ((var strings) &body body)
    1104   `(call-with-string-vector #'(lambda (,var) ,@body) ,strings))
     1105(defmacro with-string-vector ((var strings &optional encoding) &body body)
     1106  `(call-with-string-vector #'(lambda (,var) ,@body) ,strings ,encoding))
    11051107
    11061108(defloadvar *max-os-open-files* #-windows-target (#_getdtablesize) #+windows-target 32)
     
    14531455    (unless (every #'(lambda (a) (typep a 'simple-string)) args)
    14541456      (error "Program args must all be simple strings : ~s" args))
     1457    (setq external-format (normalize-external-format t external-format))
    14551458    (dolist (pair env)
    14561459      (destructuring-bind (var . val) pair
     
    15151518                   #'run-external-process proc in-fd out-fd error-fd argv env)
    15161519                  (wait-on-semaphore (external-process-signal proc)))
    1517               args))
     1520              args
     1521              (external-format-character-encoding external-format)))
    15181522        (dolist (fd close-in-parent) (fd-close fd))
    15191523        (unless (external-process-pid proc)
  • release/1.9/source/lib

  • release/1.9/source/lib/numbers.lisp

    r15685 r15706  
    727727                    (ty2 (* ty ty))
    728728                    (d (1+ (* (* tx tx) ty2)))
    729                     (n (if (> (abs r) 20)
    730                          (* 4 (exp (- (* 2 (abs r)))))
    731                          (let ((c (cosh r)))
    732                            (/ (* c c))))))
     729                    (c (if (> (abs r) 20)
     730                         (* 2 (exp (- (abs r))))
     731                         (/ (cosh r)))))
    733732               (complex (/ (* tx (1+ ty2)) d)
    734                         (/ (* n ty) d))))))
     733                        (/ (* (* c c) ty) d))))))
    735734        ((typep x 'double-float)
    736735         (%double-float-tanh! x (%make-dfloat)))
  • release/1.9/source/library

  • release/1.9/source/lisp-kernel

  • release/1.9/source/lisp-kernel/arm-spentry.s

    r15541 r15706  
    10861086        __(tst arg_y,#unsigned_byte_24_mask)
    10871087        __(beq 1f)
    1088         __(uuo_error_reg_not_xtype(al,arg_y,xtype_unsigned_byte_24))
     1088        __(mov arg_x,#XARRLIMIT)
     1089        __(set_nargs(3))
     1090        __(b _SPksignalerr)
    108910911:             
    10901092        __(unbox_fixnum(imm2,arg_z))
     
    18691871        __(bx lr)
    187018729:
    1871         __(uuo_error_reg_not_xtype(al,arg_y,xtype_unsigned_byte_24))
     1873        __(mov arg_y,#XARRLIMIT)
     1874        __(set_nargs(3))
     1875        __(b _SPksignalerr)
    18721876
    18731877
  • release/1.9/source/lisp-kernel/platform-darwinx8632.h

    r15473 r15706  
    7777
    7878#include "os-darwin.h"
    79 #define SEPARATE_ALTSTACK 1
     79
  • release/1.9/source/lisp-kernel/platform-darwinx8664.h

    r15473 r15706  
    8686
    8787
    88 #define SEPARATE_ALTSTACK 1
     88
  • release/1.9/source/lisp-kernel/platform-freebsdx8632.h

    r15147 r15706  
    6060#define SIGRETURN(context) freebsd_sigreturn(context)
    6161
     62#define AVX_CONTEXT_PRESENT(xp) ((xp)->uc_mcontext.mc_trapno & 4)
     63#define AVX_CONTEXT_PTR(xp) (((xp)->uc_mcontext.mc_fpstate[130]))
     64#define AVX_CONTEXT_SIZE(xp) ((natural)((xp)->uc_mcontext.mc_fpstate[131]))
     65
    6266#include "os-freebsd.h"
  • release/1.9/source/lisp-kernel/platform-freebsdx8664.h

    r15147 r15706  
    6262#define IS_MAYBE_INT_TRAP(info,xp) ((xp->uc_mcontext.mc_trapno == T_PROTFLT) && ((xp->uc_mcontext.mc_err & 7) == 2))
    6363#define IS_PAGE_FAULT(info,xp) (xp->uc_mcontext.mc_trapno == T_PAGEFLT)
    64 #define SIGRETURN(context) freebsd_sigreturn(context)
     64#define SIGRETURN(context) do {freebsd_sigreturn(context); \
     65    Bug(context,"sigreturn returned"); \
     66  } while (0)
     67
     68/* AVX stuff.  Funky, because some of this isn't defined until
     69   fbsd 9.1 headers; if we built on an older OS version, we still need
     70   to know about this if we run on 9.1+ */
     71
     72#define AVX_CONTEXT_PRESENT(xp) ((xp)->uc_mcontext.mc_trapno & 4)
     73#define AVX_CONTEXT_PTR(xp) (((xp)->uc_mcontext.mc_fpstate[66]))
     74#define AVX_CONTEXT_SIZE(xp) ((natural)((xp)->uc_mcontext.mc_fpstate[67]))
    6575
    6676#include "os-freebsd.h"
     77
  • release/1.9/source/lisp-kernel/platform-linuxarm.h

    r15470 r15706  
    4949
    5050#define PROTECT_CSTACK 1
    51 #define SEPARATE_ALTSTACK 1
     51
  • release/1.9/source/lisp-kernel/ppc-spentry.s

    r15376 r15706  
    33103310         __(b 1b)
    331133119:                     
    3312          __(uuo_interr(error_object_not_unsigned_byte_56,arg_y))
     3312         __(li arg_x,XARRLIMIT)
     3313         __(set_nargs(3))
     3314         __(b _SPksignalerr)
    33133315        __else
    33143316         __(extract_unsigned_byte_bits_(imm2,arg_y,24))
     
    33443346         __(b 1b)
    334533479:
    3346          __(uuo_interr(error_object_not_unsigned_byte_24,arg_y))
     3348         __(li arg_x,XARRLIMIT)
     3349         __(set_nargs(3))
     3350         __(b _SPksignalerr)
    33473351        __endif
    33483352       
     
    33513355/* Deprecated */       
    33523356_spentry(poweropen_ffcallX)
     3357_spentry(macro_bind)
     3358_spentry(destructuring_bind)
     3359_spentry(destructuring_bind_inner)
    33533360        .long 0x7c800008        /* debug trap */
    3354 
    3355 
    3356 /* Destructuring-bind, macro-bind.  */
    3357    
    3358 /* OK to use arg_x, arg_y for whatever (tagged) purpose;  */
    3359 /* likewise immX regs.  */
    3360 /* arg_z preserved, nothing else in particular defined on exit.  */
    3361 /* nargs contains req count (0-255) in PPC bits mask_req_start/mask_req_width,  */
    3362 /* opt count (0-255) in PPC bits mask_opt_start/mask_opt_width,  */
    3363 /* key count (0-255) in PPC bits mask_key_start/mask_key_width,  */
    3364 /* opt-supplied-p flag in PPC bit mask_initopt,  */
    3365 /* keyp flag in PPC bit mask_keyp,  */
    3366 /* &allow-other-keys flag in PPC bit mask_aok,  */
    3367 /* &rest flag in PPC bit mask_restp.  */
    3368 /* When mask_keyp bit is set, keyvect contains vector of keyword symbols,  */
    3369 /* length key count.  */
    3370 
    3371 _spentry(macro_bind)
    3372         __ifdef(`PPC64')
    3373          __(mr whole_reg,arg_reg)
    3374          __(extract_fulltag(imm0,arg_reg))
    3375          __(cmpri(cr1,arg_reg,nil_value))
    3376          __(cmpri(cr0,imm0,fulltag_cons))
    3377          __(beq cr1,0f)
    3378          __(bne- cr0,1f)
    3379 0:             
    3380          __(_cdr(arg_reg,arg_reg))
    3381          __(b local_label(destbind1))
    3382         __else
    3383          __(mr whole_reg,arg_reg)
    3384          __(extract_lisptag(imm0,arg_reg))
    3385          __(cmpri(cr0,imm0,tag_list))
    3386          __(bne- cr0,1f)
    3387          __(_cdr(arg_reg,arg_reg))
    3388          __(b (local_label(destbind1)))
    3389         __endif
    3390 1:
    3391         __(li arg_y,XCALLNOMATCH)
    3392         __(mr arg_z,whole_reg)
    3393         __(set_nargs(2))
    3394         __(b _SPksignalerr)
    3395 
    3396 
    3397 _spentry(destructuring_bind)
    3398         __(mr whole_reg,arg_reg)
    3399         __(b local_label(destbind1))
    3400        
    3401 _spentry(destructuring_bind_inner)
    3402         __(mr whole_reg,arg_z)
    3403 local_label(destbind1):
    3404         /* Extract required arg count.  */
    3405         /* A bug in gas: can't handle shift count of "32" (= 0  */
    3406         ifelse(eval(mask_req_width+mask_req_start),eval(32),`
    3407         __(clrlwi. imm0,nargs,mask_req_start)
    3408         ',`
    3409         __(extrwi. imm0,nargs,mask_req_width,mask_req_start)
    3410         ')
    3411         __(extrwi imm1,nargs,mask_opt_width,mask_opt_start)
    3412         __(rlwinm imm2,nargs,0,mask_initopt,mask_initopt)
    3413         __(rlwinm imm4,nargs,0,mask_keyp,mask_keyp)
    3414         __(cmpri(cr4,imm4,0))
    3415         __(rlwinm imm4,nargs,0,mask_restp,mask_restp)
    3416         __(cmpri(cr5,imm4,0))
    3417         __(cmpri(cr1,imm1,0))
    3418         __(cmpri(cr2,imm2,0))
    3419         /* Save entry vsp in case of error.  */
    3420         __(mr imm4,vsp)
    3421         __(beq cr0,2f)
    3422 1:
    3423         __(cmpri(cr7,arg_reg,nil_value))
    3424         __ifdef(`PPC64')
    3425          __(extract_fulltag(imm3,arg_reg))
    3426          __(cmpri(cr3,imm3,fulltag_cons))
    3427         __else       
    3428          __(extract_lisptag(imm3,arg_reg))
    3429          __(cmpri(cr3,imm3,tag_list))
    3430         __endif
    3431         __(subi imm0,imm0,1)
    3432         __(cmpri(cr0,imm0,0))
    3433         __(beq cr7,toofew)
    3434         __(bne cr3,badlist)
    3435         __(ldr(arg_x,cons.car(arg_reg)))
    3436         __(ldr(arg_reg,cons.cdr(arg_reg)))
    3437         __(vpush(arg_x))
    3438         __(bne cr0,1b)
    3439 2:
    3440         __(beq cr1,rest_keys)
    3441         __(bne cr2,opt_supp)
    3442         /* 'simple' &optionals:  no supplied-p, default to nil.  */
    3443 simple_opt_loop:
    3444         __(cmpri(cr0,arg_reg,nil_value))
    3445         __ifdef(`PPC64')
    3446          __(extract_fulltag(imm3,arg_reg))
    3447          __(cmpri(cr3,imm3,fulltag_cons))
    3448         __else
    3449          __(extract_lisptag(imm3,arg_reg))
    3450          __(cmpri(cr3,imm3,tag_list))
    3451         __endif
    3452         __(subi imm1,imm1,1)
    3453         __(cmpri(cr1,imm1,0))
    3454         __(li imm5,nil_value)
    3455         __(beq cr0,default_simple_opt)
    3456         __(bne cr3,badlist)
    3457         __(ldr(arg_x,cons.car(arg_reg)))
    3458         __(ldr(arg_reg,cons.cdr(arg_reg)))
    3459         __(vpush(arg_x))
    3460         __(bne cr1,simple_opt_loop)
    3461         __(b rest_keys)
    3462 default_simple_opt_loop:
    3463         __(subi imm1,imm1,1)
    3464         __(cmpri(cr1,imm1,0))
    3465 default_simple_opt:
    3466         __(vpush(imm5))
    3467         __(bne cr1,default_simple_opt_loop)
    3468         __(b rest_keys)
    3469         /* Provide supplied-p vars for the &optionals.  */
    3470 opt_supp:
    3471         __(li arg_y,t_value)
    3472 opt_supp_loop:
    3473         __(cmpri(cr0,arg_reg,nil_value))
    3474         __ifdef(`PPC64')
    3475          __(extract_fulltag(imm3,arg_reg))
    3476          __(cmpri(cr3,imm3,fulltag_cons))
    3477         __else       
    3478          __(extract_lisptag(imm3,arg_reg))
    3479          __(cmpri(cr3,imm3,tag_list))
    3480         __endif
    3481         __(subi imm1,imm1,1)
    3482         __(cmpri(cr1,imm1,0))
    3483         __(beq cr0,default_hard_opt)
    3484         __(bne cr3,badlist)
    3485         __(ldr(arg_x,cons.car(arg_reg)))
    3486         __(ldr(arg_reg,cons.cdr(arg_reg)))
    3487         __(vpush(arg_x))
    3488         __(vpush(arg_y))
    3489         __(bne cr1,opt_supp_loop)
    3490         __(b rest_keys)
    3491 default_hard_opt_loop:
    3492         __(subi imm1,imm1,1)
    3493         __(cmpri(cr1,imm1,0))
    3494 default_hard_opt:
    3495         __(vpush(imm5))
    3496         __(vpush(imm5))
    3497         __(bne cr1,default_hard_opt_loop)
    3498 rest_keys:
    3499         __(cmpri(cr0,arg_reg,nil_value))
    3500         __(bne cr5,have_rest)
    3501         __(bne cr4,have_keys)
    3502         __(bne cr0,toomany)
    3503         __(blr)
    3504 have_rest:
    3505         __(vpush(arg_reg))
    3506         __(beqlr cr4)
    3507 have_keys:
    3508         /* Ensure that arg_reg contains a proper,even-length list.  */
    3509         /* Insist that its length is <= 512 (as a cheap circularity check.)  */
    3510         __(li imm0,256)
    3511         __(mr arg_x,arg_reg)
    3512 count_keys_loop:
    3513         __ifdef(`PPC64')
    3514          __(extract_fulltag(imm3,arg_x))
    3515          __(cmpri(cr3,imm3,fulltag_cons))
    3516         __else
    3517          __(extract_lisptag(imm3,arg_x))
    3518          __(cmpri(cr3,imm3,tag_list))
    3519         __endif
    3520         __(cmpri(cr0,arg_x,nil_value))
    3521         __(subi imm0,imm0,1)
    3522         __(cmpri(cr4,imm0,0))
    3523         __(beq cr0,counted_keys)
    3524         __(bne cr3,badlist)
    3525         __(ldr(arg_x,cons.cdr(arg_x)))
    3526         __ifdef(`PPC64')
    3527          __(extract_fulltag(imm3,arg_x))
    3528          __(cmpri(cr3,imm3,fulltag_cons))
    3529         __else
    3530          __(extract_lisptag(imm3,arg_x))
    3531          __(cmpri(cr3,imm3,tag_list))
    3532         __endif
    3533         __(blt cr4,toomany)
    3534         __(cmpri(cr0,arg_x,nil_value))
    3535         __(beq cr0,db_badkeys)
    3536         __(bne cr3,badlist)
    3537         __(ldr(arg_x,cons.cdr(arg_x)))
    3538         __(b count_keys_loop)
    3539 counted_keys:
    3540         /* We've got a proper, even-length list of key/value pairs in */
    3541         /* arg_reg. For each keyword var in the lambda-list, push a pair */
    3542         /* of NILs on the vstack.  */
    3543         __(extrwi. imm0,nargs,mask_key_width,mask_key_start )
    3544         __(mr imm2,imm0)        /* save number of keys  */
    3545         __(li imm5,nil_value)
    3546         __(b push_pair_test)
    3547 push_pair_loop:
    3548         __(cmpri(cr0,imm0,1))
    3549         __(subi imm0,imm0,1)
    3550         __(vpush(imm5))
    3551         __(vpush(imm5))
    3552 push_pair_test:
    3553         __(bne cr0,push_pair_loop)
    3554         __(slwi imm2,imm2,dnode_shift)  /* pairs -> bytes  */
    3555         __(add imm2,vsp,imm2)           /* imm2 points below pairs  */
    3556         __(li imm0,0)                   /* count unknown keywords so far  */
    3557         __(extrwi imm1,nargs,1,mask_aok) /* unknown keywords allowed  */
    3558         __(extrwi nargs,nargs,mask_key_width,mask_key_start)
    3559         /* Now, for each keyword/value pair in the list  */
    3560         /*  a) if the keyword is found in the keyword vector, set the  */
    3561         /*     corresponding entry on the vstack to the value and the  */
    3562         /*     associated supplied-p var to T.  */
    3563         /*  b) Regardless of whether or not the keyword is found,  */
    3564         /*     if :ALLOW-OTHER-KEYS is provided with a non-nil value, */
    3565         /*     set the low bit of imm1 to indicate that unknown keywords  */
    3566         /*     are acceptable. (This bit is pre-set above to the value */
    3567         /*     the encoded value of &allow_other_keys.) */
    3568         /*  c) If the keyword is not found (and isn't :ALLOW-OTHER-KEYS), increment  */
    3569         /*     the count of unknown keywords in the high bits of imm1*/
    3570         /* At the end of the list, signal an error if any unknown keywords were seen  */
    3571         /* but not allowed.  Otherwise, return.  */
    3572 
    3573 match_keys_loop:
    3574         __(cmpri(cr0,arg_reg,nil_value))
    3575         __(li imm0,0)
    3576         __(li imm3,misc_data_offset)
    3577         __(beq cr0,matched_keys)
    3578         __(ldr(arg_x,cons.car(arg_reg)))
    3579         __(li arg_y,nrs.kallowotherkeys)
    3580         __(cmpr(cr3,arg_x,arg_y))       /* :ALLOW-OTHER-KEYS ?  */
    3581         __(ldr(arg_reg,cons.cdr(arg_reg)))
    3582         __(ldr(arg_y,cons.car(arg_reg)))
    3583         __(cmpr(cr4,imm0,nargs))
    3584         __(ldr(arg_reg,cons.cdr(arg_reg)))
    3585         __(b match_test)
    3586 match_loop:
    3587         __(ldrx(temp0,keyvect_reg,imm3))
    3588         __(cmpr(cr0,arg_x,temp0))
    3589         __(addi imm0,imm0,1)
    3590         __(cmpr(cr4,imm0,nargs))
    3591         __(addi imm3,imm3,node_size)
    3592         __(bne cr0,match_test)
    3593         /* Got a hit.  Unless this keyword's been seen already, set it.  */
    3594         __(slwi imm0,imm0,dnode_shift)
    3595         __(subf imm0,imm0,imm2)
    3596         __(ldr(temp0,0(imm0)))
    3597         __(cmpri(cr0,temp0,nil_value))
    3598         __(li temp0,t_value)
    3599         __(bne cr0,match_keys_loop)     /* already saw this  */
    3600         __(str(arg_y,node_size*1(imm0)))
    3601         __(str(temp0,node_size*0(imm0)))
    3602         __(bne cr3,match_keys_loop)
    3603         __(b match_keys_check_aok)
    3604 match_test:
    3605         __(bne cr4,match_loop)
    3606         __(beq cr3,match_keys_check_aok)
    3607         __(addi imm1,imm1,node_size)
    3608         __(b match_keys_loop)
    3609 match_keys_check_aok:
    3610         __(andi. imm0,imm1,2)  /* check "seen-aok" bit in imm1 */
    3611         __(cmpri cr1,arg_y,nil_value) /* check value */
    3612         __(ori imm1,imm1,2)
    3613         __(bne cr0,match_keys_loop) /* duplicate aok */
    3614         __(beq cr1,match_keys_loop)
    3615         __(ori imm1,imm1,1)
    3616         __(b match_keys_loop)
    3617 matched_keys:
    3618         __(clrrwi. imm0,imm1,2)
    3619         __(beqlr)
    3620         __(andi. imm1,imm1,1)
    3621         __(bnelr)
    3622         /* Some unrecognized keywords.  Complain generically about  */
    3623         /* invalid keywords.  */
    3624 db_badkeys:
    3625         __(li arg_y,XBADKEYS)
    3626         __(b destructure_error)
    3627 toomany:
    3628         __(li arg_y,XCALLTOOMANY)
    3629         __(b destructure_error)
    3630 toofew:
    3631         __(li arg_y,XCALLTOOFEW)
    3632         __(b destructure_error)
    3633 badlist:
    3634         __(li arg_y,XCALLNOMATCH)
    3635         /* b destructure_error  */
    3636 destructure_error:
    3637         __(mr vsp,imm4)         /* undo everything done to the stack  */
    3638         __(mr arg_z,whole_reg)
    3639         __(set_nargs(2))
    3640         __(b _SPksignalerr)
    36413361       
    36423362/* vpush the values in the value set atop the vsp, incrementing nargs.  */
  • release/1.9/source/lisp-kernel/thread_manager.c

    r15577 r15706  
    13721372      condemn_area_holding_area_lock(cs);
    13731373    }
    1374     /* On some platforms - currently just linuxarm - we have to
    1375        allocate a separate alternate signal stack (rather than just
    1376        using a few pages of the thread's main stack.)  Disable and
    1377        free that alternate stack here.
     1374    /* If we use the sigaltstack mechanism, we always keep the
     1375       altstack separate from other stacks now.
    13781376    */
    1379 #ifdef SEPARATE_ALTSTACK
     1377#ifdef USE_ALTSTACK
    13801378    {
    13811379      stack_t new, current;
  • release/1.9/source/lisp-kernel/x86-asmutils64.s

    r15500 r15706  
    164164_exportfn(C(freebsd_sigreturn))
    165165        __(movl $417,%eax)      /* SYS_sigreturn */
    166         __(syscall)                             
     166        __(syscall)     
     167        __(ret)                 
    167168       
    168169_exportfn(C(get_vector_registers))
  • release/1.9/source/lisp-kernel/x86-exceptions.c

    r15572 r15706  
    15061506#endif
    15071507
     1508
     1509#ifdef FREEBSD
     1510typedef void *FPREGS;
     1511
     1512
     1513LispObj *
     1514copy_avx(ExceptionInformation *xp, LispObj *current, FPREGS *destptr)
     1515{
     1516  natural sp;
     1517
     1518  *destptr = (FPREGS)AVX_CONTEXT_PTR(xp);
     1519
     1520  if (AVX_CONTEXT_PRESENT(xp)) {
     1521    sp = (natural)current;
     1522    sp -= AVX_CONTEXT_SIZE(xp);
     1523    sp = truncate_to_power_of_2(sp,6);
     1524    memcpy((void *)sp,(void *)AVX_CONTEXT_PTR(xp),AVX_CONTEXT_SIZE(xp));
     1525    current = (LispObj *)sp;
     1526    *destptr = (FPREGS)current;
     1527  }
     1528  return current;
     1529}
     1530#endif
     1531
    15081532#ifdef DARWIN
    15091533LispObj *
     
    15521576#ifdef LINUX
    15531577  dest->uc_mcontext.fpregs = (fpregset_t)fp;
     1578#endif
     1579#ifdef FREEBSD
     1580  if (AVX_CONTEXT_PRESENT(context)) {
     1581    AVX_CONTEXT_PTR(context) = (natural)fp;
     1582  }
    15541583#endif
    15551584  dest->uc_stack.ss_sp = 0;
     
    16641693#ifdef LINUX
    16651694  foreign_rsp = copy_fpregs(context, foreign_rsp, &fpregs);
     1695#endif
     1696#ifdef FREEBSD
     1697  foreign_rsp = copy_avx(context, foreign_rsp, &fpregs);
    16661698#endif
    16671699#ifdef DARWIN
     
    23452377  stack.ss_size = SIGSTKSZ*8;
    23462378  stack.ss_flags = 0;
    2347 #ifdef SEPARATE_ALTSTACK
    23482379  stack.ss_sp = mmap(NULL,stack.ss_size, PROT_READ|PROT_WRITE|PROT_EXEC,MAP_ANON|MAP_PRIVATE,-1,0);
    2349 #else
    2350   stack.ss_sp = a->low;
    2351   a->low += SIGSTKSZ*8;
    2352   mmap(stack.ss_sp,stack.ss_size, PROT_READ|PROT_WRITE|PROT_EXEC,MAP_FIXED|MAP_ANON|MAP_PRIVATE,-1,0);
    2353 #endif
    23542380#ifdef LINUX
    23552381  /* The ucontext pushed on the altstack may not contain the (largish)
  • release/1.9/source/lisp-kernel/x86-spentry32.s

    r15572 r15706  
    21202120
    21212121local_label(stack_misc_alloc_not_u24):
    2122         __(uuo_error_reg_not_type(Rarg_y,error_object_not_unsigned_byte_24))
     2122        __(popl %temp0)
     2123        __(pushl $reserved_frame_marker)
     2124        __(pushl $reserved_frame_marker)
     2125        __(pushl $XARRLIMIT)
     2126        __(pushl %temp0)
     2127        __(set_nargs(3))
     2128        __(jmp _SPksignalerr)       
    21232129_endsubp(stack_misc_alloc)
    21242130
     
    29642970        __(ret)
    29652971local_label(misc_alloc_not_u24):
    2966         __(uuo_error_reg_not_type(Rarg_y,error_object_not_unsigned_byte_24))
     2972        __(popl %temp0)
     2973        __(pushl $reserved_frame_marker)
     2974        __(pushl $reserved_frame_marker)
     2975        __(pushl $XARRLIMIT)
     2976        __(pushl %temp0)
     2977        __(set_nargs(3))
     2978        __(jmp _SPksignalerr)       
    29672979_endsubp(misc_alloc)
    29682980
  • release/1.9/source/lisp-kernel/x86-spentry64.s

    r15572 r15706  
    21552155               
    21562156local_label(stack_misc_alloc_not_u56):                         
    2157         __(uuo_error_reg_not_type(Rarg_y,error_object_not_unsigned_byte_56))   
     2157        __(movl $XARRLIMIT,%arg_x_l)
     2158        __(set_nargs(3))
     2159        __(jmp _SPksignalerr)
    21582160_endsubp(stack_misc_alloc)
    21592161
     
    28962898        __(ret)
    28972899local_label(misc_alloc_not_u56):
    2898         __(uuo_error_reg_not_type(Rarg_y,error_object_not_unsigned_byte_56))
     2900        __(movl $XARRLIMIT,%arg_x_l)
     2901        __(set_nargs(3))
     2902        __(jmp _SPksignalerr)
    28992903local_label(misc_alloc_large):
    29002904        /* If we tried to subtract %imm1 from tcr.allocptr, it
Note: See TracChangeset for help on using the changeset viewer.