(FILECREATED "11-Aug-85 15:55:55" {ERIS}<LISPCORE>LIBRARY>CMLPRINT.;4
 2780   

      changes to:  (FNS NEW\MAPCHARS1 DEFPRINT.COMMON)
		   (VARS CMLPRINTCOMS)

      previous date: "11-Aug-85 12:06:25" {ERIS}<LISPCORE>LIBRARY>CMLPRINT.;3)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLPRINTCOMS)

(RPAQQ CMLPRINTCOMS
 ((FNS NEW\MAPCHARS1 DEFPRINT.STREAM DEFPRINT.COMMON)
		     (P (MOVD? (QUOTE \MAPCHARS1)
			       (QUOTE OLD\MAPCHARS1))
			(AND (CCODEP (QUOTE NEW\MAPCHARS1))
			     (MOVD (QUOTE NEW\MAPCHARS1)
				   (QUOTE \MAPCHARS1)))
			(DEFPRINT (QUOTE STREAM)
				  (QUOTE DEFPRINT.STREAM)))
		     (VARS (*PRINT-STRUCTURE*))))
(DEFINEQ

(NEW\MAPCHARS1

  [LAMBDA (X SA FN)                                          (* lmm "11-Aug-85 15:48")

    (
SELECTC
 (
NTYPX
 X)
	     ((
LIST
 \LITATOM \LISTP \SMALLP \FIXP \FLOATP \STRINGP \STACKP)
	       (
OLD\MAPCHARS1
 X SA FN))
	     (
COND

	       ((
ASSOC
 (
TYPENAME
 X)
		       \DEFPRINTFNS)
		 (
OLD\MAPCHARS1
 X SA FN))
	       (T (LET ((
DC
 (DEFPRINT.COMMON
 X)))
		       (
OLD\MAPCHARS1
 (
CAR
 DC)
				      NIL FN)
		       (
AND
 (
CDR
 DC)
			    (
OLD\MAPCHARS1
 (
CDR
 DC)
					   SA FN])

(DEFPRINT.STREAM

(LAMBDA (STR) (* lmm " 7-Aug-85 12:09") (LET ((FN (FULLNAME STR))) (if (AND FN (LITATOM FN)) then (
CONS (CONCAT \CML.READPREFIX ".(GETSTREAM '" FN " '" (GETFILEINFO STR (QUOTE ACCESS)) ")")) else (
DEFPRINT.COMMON STR)))))

(DEFPRINT.COMMON

  [LAMBDA (A)                                                (* lmm "11-Aug-85 15:55")

    (LET ((NAME (
TYPENAME
 A))
	  REC)
         (if
 (
AND
 *PRINT-STRUCTURE* NAME (
RELSTK
 (
STKPOS
 (
QUOTE
 \PRINDATUM)))
		  (
SETQ
 REC (
RECLOOK
 NAME))
		  (
EQ
 (
CAR
 REC)
		      (
QUOTE
 DATATYPE))
		  (
LEQ
 (
STKARG
 4 (
QUOTE
 \PRINDATUM)
			       0)
		       \TCARPRINTLEVEL))
	     then
 [
CONS
 (
CONCAT
 \CML.READPREFIX "S")
			(
CONS
 NAME (for
 FIELD in
 (
RECORDFIELDNAMES
 REC)
				      join
 (
LIST
 FIELD (
RECORDACCESS
 FIELD A REC]
	   else
 (
CONS
 (
CONCAT
 \CML.READPREFIX "<" NAME " " (
\CONVERTNUMBER
 (
\HILOC
 A)
									   8 NIL NIL (
ALLOCSTRING

									     5)
									   (
ALLOCSTRING
 0))
			      ","
			      (
\CONVERTNUMBER
 (
\LOLOC
 A)
					      8 NIL NIL (
ALLOCSTRING
 8)
					      (
ALLOCSTRING
 0))
			      ">"])
)
(MOVD? (QUOTE \MAPCHARS1)
       (QUOTE OLD\MAPCHARS1))
(AND (CCODEP (QUOTE NEW\MAPCHARS1))
     (MOVD (QUOTE NEW\MAPCHARS1)
	   (QUOTE \MAPCHARS1)))
(DEFPRINT (QUOTE STREAM)
	  (QUOTE DEFPRINT.STREAM))

(RPAQQ *PRINT-STRUCTURE*
 NIL)
(PUTPROPS CMLPRINT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (690 2463 (NEW\MAPCHARS1 700 . 1254) (DEFPRINT.STREAM 1256 . 1500) (DEFPRINT.COMMON 1502
 . 2461)))))
STOP