-;;; Given a cold representation of an FDEFN name, return a warm representation.
-;;;
-;;; Note: Despite the name, this actually has little to do with
-;;; FDEFNs, it's just a function for warming up values, and the only
-;;; values it knows how to warm up are symbols and lists. (The
-;;; connection to FDEFNs is that symbols and lists are the only
-;;; possible names for functions.)
-(declaim (ftype (function (descriptor) (or symbol list)) warm-fdefn-name))
-(defun warm-fdefn-name (des)
- (ecase (descriptor-lowtag des)
- (#.sb!vm:list-pointer-type ; FIXME: no #.
- (if (= (descriptor-bits des) (descriptor-bits *nil-descriptor*))
- nil
- ;; FIXME: If we cold-intern this again, we might get a different
- ;; name. Check to make sure that any hash tables along the way
- ;; are 'EQUAL not 'EQL.
- (cons (warm-fdefn-name (read-wordindexed des sb!vm:cons-car-slot))
- (warm-fdefn-name (read-wordindexed des sb!vm:cons-cdr-slot)))))
- (#.sb!vm:other-pointer-type ; FIXME: no #.
- (or (gethash (descriptor-bits des) *cold-symbols*)
- (descriptor-bits des)))))
+;;; Given a cold representation of a symbol, return a warm
+;;; representation.
+(defun warm-symbol (des)
+ ;; Note that COLD-INTERN is responsible for keeping the
+ ;; *COLD-SYMBOLS* table up to date, so if DES happens to refer to an
+ ;; uninterned symbol, the code below will fail. But as long as we
+ ;; don't need to look up uninterned symbols during bootstrapping,
+ ;; that's OK..
+ (multiple-value-bind (symbol found-p)
+ (gethash (descriptor-bits des) *cold-symbols*)
+ (declare (type symbol symbol))
+ (unless found-p
+ (error "no warm symbol"))
+ symbol))
+
+;;; like CL:CAR, CL:CDR, and CL:NULL but for cold values
+(defun cold-car (des)
+ (aver (= (descriptor-lowtag des) sb!vm:list-pointer-lowtag))
+ (read-wordindexed des sb!vm:cons-car-slot))
+(defun cold-cdr (des)
+ (aver (= (descriptor-lowtag des) sb!vm:list-pointer-lowtag))
+ (read-wordindexed des sb!vm:cons-cdr-slot))
+(defun cold-null (des)
+ (= (descriptor-bits des)
+ (descriptor-bits *nil-descriptor*)))
+
+;;; Given a cold representation of a function name, return a warm
+;;; representation.
+(declaim (ftype (function (descriptor) (or symbol list)) warm-fun-name))
+(defun warm-fun-name (des)
+ (let ((result
+ (ecase (descriptor-lowtag des)
+ (#.sb!vm:list-pointer-lowtag
+ (aver (not (cold-null des))) ; function named NIL? please no..
+ ;; Do cold (DESTRUCTURING-BIND (COLD-CAR COLD-CADR) DES ..).
+ (let* ((car-des (cold-car des))
+ (cdr-des (cold-cdr des))
+ (cadr-des (cold-car cdr-des))
+ (cddr-des (cold-cdr cdr-des)))
+ (aver (cold-null cddr-des))
+ (list (warm-symbol car-des)
+ (warm-symbol cadr-des))))
+ (#.sb!vm:other-pointer-lowtag
+ (warm-symbol des)))))
+ (unless (legal-fun-name-p result)
+ (error "not a legal function name: ~S" result))
+ result))