Changeset 9256


Ignore:
Timestamp:
Apr 24, 2008, 9:01:39 AM (11 years ago)
Author:
gb
Message:

X862-TYPED-FORM takes an optional "check" argument, does runtime
typechecking if it's passsed as T.

The typechecking is about what'd be produced by REQUIRE-TYPE, and
may share any problems that REQUIRE-TYPE has at runtime. If there
isn't builtin support for REQUIRE-TYPE on a given type, calls TYPEP
and maybe signals an error at runtime.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r9163 r9256  
    57815781   (x862-vset seg vreg xfer :simple-vector vector  index value (nx-lookup-target-uvector-subtag :simple-vector)))
    57825782
    5783 (defx862 x862-typed-form typed-form (seg vreg xfer typespec form)
    5784   (declare (ignore typespec)) ; Boy, do we ever !
    5785   (x862-form seg vreg xfer form))
     5783(defx862 x862-typed-form typed-form (seg vreg xfer typespec form &optional check)
     5784  (if check
     5785    (x862-typechecked-form seg vreg xfer typespec form)
     5786    (x862-form seg vreg xfer form)))
    57865787
    57875788(defx862 x862-%primitive %primitive (seg vreg xfer &rest ignore)
     
    82648265  (def-x862-require x862-require-s8 require-s64)
    82658266  (def-x862-require x862-require-s8 require-u64))
     8267
     8268(defun x862-typechecked-form (seg vreg xfer typespec form)
     8269  (with-x86-local-vinsn-macros (seg vreg xfer)
     8270    (let* ((op
     8271            (cond ((eq typespec 'fixnum) (%nx1-operator require-fixnum))
     8272                  ((eq typespec 'integer) (%nx1-operator require-integer))
     8273                  ((memq typespec '(base-char character))
     8274                   (%nx1-operator require-character))
     8275                  ((eq typespec 'symbol) (%nx1-operator require-symbol))
     8276                  ((eq typespec 'list) (%nx1-operator require-list))
     8277                  ((eq typespec 'real) (%nx1-operator require-real))
     8278                  ((memq typespec '(simple-base-string simple-string))
     8279                   (%nx1-operator require-simple-string))
     8280                  ((eq typespec 'number) (%nx1-operator require-number))
     8281                  ((eq typespec 'simple-vector) (%nx1-operator require-simple-vector))
     8282                  (t
     8283                   (let* ((ctype (specifier-type typespec)))
     8284                     (cond ((type= ctype (load-time-value (specifier-type '(signed-byte 8))))
     8285                            (%nx1-operator require-s8))
     8286                           ((type= ctype (load-time-value (specifier-type '(unsigned-byte 8))))
     8287                            (%nx1-operator require-u8))
     8288                           ((type= ctype (load-time-value (specifier-type '(signed-byte 16))))
     8289                            (%nx1-operator require-s16))
     8290                           ((type= ctype (load-time-value (specifier-type '(unsigned-byte 16))))
     8291                            (%nx1-operator require-u16))
     8292                           ((type= ctype (load-time-value (specifier-type '(signed-byte 32))))                           
     8293                            (%nx1-operator require-s32))
     8294                           ((type= ctype (load-time-value (specifier-type '(unsigned-byte 32))))
     8295                            (%nx1-operator require-u32))
     8296                           ((type= ctype (load-time-value (specifier-type '(signed-byte 64))))
     8297                            (%nx1-operator require-s64))
     8298                           ((type= ctype (load-time-value (specifier-type '(unsigned-byte 64))))
     8299                            (%nx1-operator require-u64))))))))
     8300      (if op
     8301        (x862-use-operator op seg vreg xfer form)
     8302        (if (or (eq typespec t)
     8303                (eq typespec '*))
     8304          (x862-form seg vreg xfer form)
     8305          (let* ((ok (backend-get-next-label)))
     8306            (x862-one-targeted-reg-form seg form ($ x8664::arg_y))
     8307            (x862-store-immediate seg typespec ($ x8664::arg_z))
     8308            (x862-store-immediate seg 'typep ($ x8664::fname))
     8309            (x862-set-nargs seg 2)
     8310            (x862-vpush-register seg ($ x8664::arg_y))
     8311            (! call-known-symbol ($ x8664::arg_z))
     8312            (! compare-to-nil ($ x8664::arg_z))
     8313            (x862-vpop-register seg ($ x8664::arg_y))
     8314            (! cbranch-false (aref *backend-labels* ok) x86::x86-e-bits)
     8315            (x862-lri seg ($ x8664::arg_x) (ash $XWRONGTYPE *x862-target-fixnum-shift*))
     8316            (x862-store-immediate seg typespec ($ x8664::arg_z))
     8317            (x862-set-nargs seg 3)
     8318            (! ksignalerr)
     8319            (@ ok)
     8320            (<- ($ x8664::arg_y))
     8321            (^)))))))
     8322         
     8323         
     8324                 
     8325                 
     8326                   
    82668327
    82678328(defx862 x862-%badarg2 %badarg2 (seg vreg xfer badthing goodthing)
Note: See TracChangeset for help on using the changeset viewer.