+#!+sb-ldb
+(defun write-tagnames-h (&optional (out *standard-output*))
+ (labels
+ ((pretty-name (symbol strip)
+ (let ((name (string-downcase symbol)))
+ (substitute #\Space #\-
+ (subseq name 0 (- (length name) (length strip))))))
+ (list-sorted-tags (tail)
+ (loop for symbol being the external-symbols of "SB!VM"
+ when (and (constantp symbol)
+ (tailwise-equal (string symbol) tail))
+ collect symbol into tags
+ finally (return (sort tags #'< :key #'symbol-value))))
+ (write-tags (kind limit ash-count)
+ (format out "~%static const char *~(~A~)_names[] = {~%"
+ (subseq kind 1))
+ (let ((tags (list-sorted-tags kind)))
+ (dotimes (i limit)
+ (if (eql i (ash (or (symbol-value (first tags)) -1) ash-count))
+ (format out " \"~A\"" (pretty-name (pop tags) kind))
+ (format out " \"unknown [~D]\"" i))
+ (unless (eql i (1- limit))
+ (write-string "," out))
+ (terpri out)))
+ (write-line "};" out)))
+ (write-tags "-LOWTAG" sb!vm:lowtag-limit 0)
+ ;; this -2 shift depends on every OTHER-IMMEDIATE-?-LOWTAG
+ ;; ending with the same 2 bits. (#b10)
+ (write-tags "-WIDETAG" (ash (1+ sb!vm:widetag-mask) -2) -2))
+ (values))