Changeset 14756 for trunk/source/level-1


Ignore:
Timestamp:
Apr 29, 2011, 9:49:16 PM (8 years ago)
Author:
gb
Message:

sysutils.lisp: REQUIRE-STRUCTURE-TYPE; basically inlines a
STRUCTURE-TYPEP test and allows the error signalling to happen
out-of-line if the test fails.

optimizers.lisp: if REQUIRE-STRUCTURE-TYPE is defined, transform
(REQUIRE-TYPE thing 'structure-class-name) into a call to
REQUIRE-STRUCTURE-TYPE.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/sysutils.lisp

    r14577 r14756  
    310310      (%kernel-restart $xwrongtype arg type))))
    311311
     312
     313
    312314;;; Might want to use an inverted mapping instead of (satisfies ccl::obscurely-named)
    313315(defun %require-type (arg predsym)
     
    321323    (%kernel-restart $xwrongtype arg (car type-cell))))
    322324
    323 
     325(defun require-structure-type (arg token)
     326  (or(and (= (the fixnum (typecode arg)) target::subtag-struct)
     327           (dolist (x (%svref arg 0))
     328             (declare (optimize (speed 3) (safety 0)))
     329             (when (eq x token) (return arg))))
     330    (%kernel-restart $xwrongtype arg (if (typep token 'class-cell) (class-cell-name token) token))))
    324331
    325332;;; In lieu of an inverted mapping, at least try to find cases involving
Note: See TracChangeset for help on using the changeset viewer.