(FILECREATED " 2-Feb-86 17:20:27" {DSK}<LISPFILES2>FORMAT.LSP;2
 2649   

      changes to:  (VARS FORMATCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT FORMATCOMS)

(RPAQQ FORMATCOMS
 ((ADDVARS (GLOBALVARS QP.FLOAT.FORMAT.SPEC))
		     (FNS QP.CPRINT QP.FLOAT.FORMAT.PRINT QP.INIT.FLOAT.FORMAT.SPEC QP.LEN)
		     (MACROS QP.SET.DEC.PART QP.SET.EXP.PART)
		     (P (QP.INIT.FLOAT.FORMAT.SPEC))))

(ADDTOVAR GLOBALVARS
 QP.FLOAT.FORMAT.SPEC)
(DEFINEQ

(QP.CPRINT

  (LAMBDA (
FLOAT
 TYPE PRECISION)
    (LET* ((STREAM (QIO.STREAM QP.CURRENT.OUTPUT))
	   (START.POSIT (
POSITION
 STREAM)))
          (QP.FLOAT.FORMAT.PRINT
 FLOAT TYPE PRECISION STREAM)
          (LET ((NUMCHARS (
IDIFFERENCE
 (
POSITION
 STREAM)
					 START.POSIT)))
	       (INCF (QIO.CHARPOS QP.CURRENT.OUTPUT)
		     NUMCHARS)
	       (INCF (QIO.LINEPOS QP.CURRENT.OUTPUT)
		     NUMCHARS)))))

(QP.FLOAT.FORMAT.PRINT

  (LAMBDA (
FLOAT
 TYPE PRECISION STREAM)
    (LET ((USE.EXPONENTIAL.FORMAT NIL))
         (
COND

	   ((
OR
 (
EQ
 TYPE (
CHARCODE
 E))
		  (
EQ
 TYPE (
CHARCODE
 e)))
	     (
SETQ
 USE.EXPONENTIAL.FORMAT T))
	   ((
AND
 (
OR
 (
EQ
 TYPE (
CHARCODE
 G))
			 (
EQ
 TYPE (
CHARCODE
 g)))
		   (
OR
 (
GREATERP
 FLOAT 100000.0)
			 (
LESSP
 FLOAT .00001)))
	     (
SETQ
 USE.EXPONENTIAL.FORMAT T)))
         (LET ((EXPPART (
COND

			  (USE.EXPONENTIAL.FORMAT 4)
			  (T NIL)))
	       (DECPART PRECISION))
	      (QP.SET.DEC.PART DECPART)
	      (QP.SET.EXP.PART EXPPART)
	      (
PRINTNUM
 QP.FLOAT.FORMAT.SPEC FLOAT STREAM)))))

(QP.INIT.FLOAT.FORMAT.SPEC

  (LAMBDA NIL
    (
SETQ
 QP.FLOAT.FORMAT.SPEC (
LIST
 (
QUOTE
 FLOAT)
					 NIL 5 4 NIL NIL))))

(QP.LEN

  (LAMBDA (
FLOAT
 TYPE PRECISION)
    (LET* ((STREAM (
OPENFILE
 (
QUOTE
 {CORE}QUINTUS.SCR1;1)
			       (
QUOTE
 OUTPUT)))
	   (START.POSIT (
POSITION
 STREAM)))
          (QP.FLOAT.FORMAT.PRINT
 FLOAT TYPE PRECISION STREAM)
          (LET ((RESULT (
IDIFFERENCE
 (
POSITION
 STREAM)
				       START.POSIT)))
	       (
CLOSEF
 STREAM)
	   RESULT))))
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS QP.SET.DEC.PART MACRO (**MACROARG** (LET ((VALUE (CAR (NTH **MACROARG** 1))))
						   (BQUOTE (RPLACA (NTH QP.FLOAT.FORMAT.SPEC 3)
								   (\, VALUE))))))
(PUTPROPS QP.SET.EXP.PART MACRO (**MACROARG** (LET ((VALUE (CAR (NTH **MACROARG** 1))))
						   (BQUOTE (RPLACA (NTH QP.FLOAT.FORMAT.SPEC 4)
								   (\, VALUE))))))
)
(QP.INIT.FLOAT.FORMAT.SPEC)
(PUTPROPS FORMAT.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (509 2164 (QP.CPRINT 519 . 944) (QP.FLOAT.FORMAT.PRINT 946 . 1641) (
QP.INIT.FLOAT.FORMAT.SPEC 1643 . 1776) (QP.LEN 1778 . 2162)))))
STOP