r453 - trunk/tools/cold

[rswindells at common-lisp.net]

Author: rswindells
Date: Sun Jun 12 18:12:41 2016
New Revision: 453

Log:
Add fasl op for characters.

Modified:
   trunk/tools/cold/coldld.lisp

Modified: trunk/tools/cold/coldld.lisp
==============================================================================
--- trunk/tools/cold/coldld.lisp	Sun Jun 12 18:10:13 2016	(r452)
+++ trunk/tools/cold/coldld.lisp	Sun Jun 12 18:12:41 2016	(r453)
@@ -304,18 +304,17 @@
 		 (m-enter-fasl-table ans))
     (setq ans (lispm-dpb (qfasl-next-nibble) (+ (ash pos 6) #o20) ans))))
 
-;Generate a FIXNUM (or BIGNUM) value.
+;Generate a CHARACTER value.
 (defun m-fasl-op-character ()
-  (error "m-fasl-op-character"))
-
-;  (do ((pos (* (1- fasl-group-length) #o20) (- pos #o20))
-;       (c fasl-group-length (1- c))
-;       (ans 0))
-;      ((zerop c)
-;       (cond (fasl-group-flag (setq ans (- 0 ans))))
-;       (setq ans (%make-pointer sym:dtp-character ans))
-;       (m-enter-fasl-table ans))
-;    (setq ans (lispm-dpb (qfasl-next-nibble) (+ (ash pos 6) #o20) ans))))
+  (do ((pos (* (1- fasl-group-length) #o20) (- pos #o20))
+       (c fasl-group-length (1- c))
+       (ans 0))
+      ((zerop c)
+       (cond (fasl-group-flag (setq ans (- 0 ans))))
+       ;; comment out next line if building earlier than system 99
+       (setq ans (%make-pointer sym:dtp-character ans))
+       (m-enter-fasl-table ans))
+      (setq ans (lispm-dpb (qfasl-next-nibble) (+ (ash pos 6) #o20) ans))))
 
 ;;; NEW FLOAT OP!! not yet written. See sys; qfasl