74700 #include "rundecs.h"
74710     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
74720 (**)
74730 (**)
74740 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
74750 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER  : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
74760                 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
74770 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
74780 (**)
74790 (**)
74800 FUNCTION FLOAT(XMODE: INTEGER; VAL: REALTEGER; WIDTH, AFTER, EXP: INTEGER): OBJECTP;
74810   VAR E: REALTEGER;
74820       S: OBJECTP;
74830       ABSWIDTH, BEFORE, POINT, ABSEXP, EXPSIGN: INTEGER;
74840       OK, OK1: BOOLEAN;
74850   BEGIN
74860     ABSWIDTH := ABS(WIDTH)+ORD(WIDTH=0);
74870     ABSEXP := ABS(EXP)+ORD(EXP=0);
74880     S := CRSTRING(ABSWIDTH);
74890     REPEAT
74900       POINT := ORD(AFTER>0);
74910       BEFORE := ABSWIDTH-1-POINT-AFTER-1-ABSEXP;
74920       IF BEFORE<0 THEN AFTER := -1; (*WILL CAUSE SUBFIXED TO FAIL*)
74930       OK := SUBFIXED(ORD((WIDTH>0) OR (VAL.INT<0))-ORD((WIDTH<0) AND (VAL.INT>=0)),
74940                      BEFORE, POINT, AFTER, E.INT, TRUE, VAL, XMODE=2, S, 1)
74950             AND (BEFORE+AFTER>0);
74960       S^.CHARVEC[1+BEFORE+POINT+AFTER+1] := 'E';
74970       EXPSIGN := ORD((EXP>0) OR (E.INT<0));
74980       OK1 := SUBFIXED(EXPSIGN, ABSEXP-EXPSIGN, 0, 0, E.INT, FALSE, E, FALSE,
74990                       S, 1+BEFORE+POINT+AFTER+2);
75000       AFTER := AFTER-ORD(AFTER<>0); ABSEXP := ABSEXP+1
75010     UNTIL NOT OK OR OK1;
75020     IF NOT OK THEN ERRORFILL(S, ABSWIDTH);
75030     FLOAT := S;
75040   END;
75050 (**)
75060 (**)
75070 (*+01() (*$X4*) ()+01*)
75080 (**)
75090 (**)
75100 (*-02()
75110 BEGIN (*OF A68*)
75120 END; (*OF A68*)
75130 ()-02*)
75140 (*+01()
75150 BEGIN (*OF MAIN PROGRAM*)
75160 END (* OF EVERYTHING *).
75170 ()+01*)