(FILECREATED " 8-Feb-86 15:24:49" {DSK}<LISPFILES2>IMPROVEDDCOMS>FORMAT.;1
 2220   

      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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (501 1777 (QP.CPRINT 511 . 853) (QP.FLOAT.FORMAT.PRINT 855 . 1375) (
QP.INIT.FLOAT.FORMAT.SPEC 1377 . 1486) (QP.LEN 1488 . 1775)))))
STOP