#-NIL
(DECLARE (*expr makestring1)(SPECIAL $FLOATFORMAT FLOATMAX FLOATMIN FLOATSMALL
		  FLOATBIG FLOATBIGBIG FLOAT-ENOTE)) 


(defmvar $FLOATFORMAT T) 

;;; defaults

(defmvar FLOATMAX 6. )
(defmvar FLOATMIN -4. )
(defmvar FLOATBIG 2. )
(defmvar FLOATBIGBIG 1. )
(defmvar FLOATSMALL 3. )
(defmvar FLOAT-ENOTE 2.) 

(PUTPROP 'MAKESTRING1
	 (GET 'MAKESTRING 'SUBR)
	 'SUBR) 

(DEFUN MAKESTRING (FORM) 
       (COND ((AND $FLOATFORMAT (FLOATP FORM)) (NICEFLOAT FORM))
	     ((MAKESTRING1 FORM)))) 

(DEFUN NICEFLOAT (FLT) 
       (DECLARE (FLONUM FLT))
       (COND ((= FLT 0.0) (LIST 48. 46. 48.))
	     ((< FLT 0.0) (CONS 45. (NICEFLT (ABS FLT))))
	     ((NICEFLT (ABS FLT))))) 

(DEFUN NICEFLT (AFLT) 
       (DECLARE (FIXNUM I) (FLONUM SIMFLT FAC AFLT))
       (DO ((I 0.)
	    (SIMFLT AFLT)
	    (FAC (COND ((< AFLT 1.0) 10.0) (0.1)))
	    (INC (COND ((< AFLT 1.0) -1.) (1.))))
	   ((AND (< SIMFLT 10.0) (NOT (< SIMFLT 1.0)))
	    (FLOATCHECK (EXPLODEN SIMFLT) I))
	   (SETQ SIMFLT (TIMES SIMFLT FAC))
	   (SETQ I (+ I INC)))) 
(DEFUN FLOATCHECK (REPRES PWR) 
       (DECLARE (FIXNUM PWR))
       (COND
	((OR (> PWR (1- FLOATMAX)) (< PWR FLOATMIN))
	 (CONS (CAR REPRES)
	       (CONS 46.
		     (APPEND (FRACGEN (CDDR REPRES) FLOAT-ENOTE NIL)
			     (CONS 69.(COND ((> PWR 0.)
						(CONS 43.
						      (EXPLODEN PWR)))
					       ((EXPLODEN PWR))))))))
	((< PWR 0.)
	 ((LAMBDA (FRAC) 
	   (CONS 48.
		 (CONS 46.
		       (COND ((EQUAL FRAC '(48.)) FRAC)
			     ((APPEND (FRACZEROS (1- (ABS PWR)))
				      FRAC))))))
	  (FRACGEN (DELQ 46. REPRES) FLOATSMALL NIL)))
	((CONS (CAR REPRES)
	       (FLOATNONE (CDDR REPRES)
			  PWR
			  (COND ((< PWR 3.) FLOATBIG)
				(FLOATBIGBIG))))))) 

(DEFUN FRACZEROS (N) 
       (DECLARE (FIXNUM N))
       (COND ((= N 0.) NIL) ((CONS 48. (FRACZEROS (1- N)))))) 

(DEFUN FLOATNONE (REPRES PWR FLOATFRAC) 
       (DECLARE (FIXNUM PWR FLOATFRAC))
       (COND ((= PWR 0.) (CONS 46. (FRACGEN REPRES FLOATFRAC NIL)))
	     ((CONS (COND (REPRES (CAR REPRES)) (48.))
		    (FLOATNONE (CDR REPRES) (1- PWR) FLOATFRAC))))) 

(DEFUN FELIMIN (REVREP) 
       (COND ((NULL REVREP) (NCONS 48.))
	     ((= (CAR REVREP) 48.) (FELIMIN (CDR REVREP)))
	     ((REVERSE REVREP)))) 

(DEFUN FRACGEN (REPRES FLOATFRAC RESULT) 
       (DECLARE (FIXNUM FLOATFRAC))
       (COND ((NULL REPRES) (FELIMIN RESULT))
	     ((= FLOATFRAC 0.) (FELIMIN RESULT))
	     ((FRACGEN (CDR REPRES)
		       (1- FLOATFRAC)
		       (CONS (CAR REPRES) RESULT))))) 

#-NIL
(sstatus uuolinks)