whole.p 1.1 KB

12345678910111213141516171819202122232425262728293031323334
  1. 99200 #include "rundecs.h"
  2. 99210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
  3. 99220 (**)
  4. 99230 (**)
  5. 99240 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
  6. 99250 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
  7. 99260 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
  8. 99270 (**)
  9. 99280 (**)
  10. 99290 FUNCTION WHOLE(XMODE: INTEGER; VAL: REALTEGER; WIDTH: INTEGER): OBJECTP;
  11. 99300 VAR
  12. 99310 S: OBJECTP;
  13. 99320 SIGN, E: INTEGER;
  14. 99330 BEGIN
  15. 99340 SIGN := ORD((WIDTH>0) OR (VAL.INT<0));
  16. 99350 S := NIL;
  17. 99360 IF NOT SUBFIXED(SIGN,
  18. 99370 ABS(WIDTH)-SIGN-ORD(WIDTH=0), (*-VE FOR WIDTH=0*)
  19. 99380 0, 0, E, FALSE,
  20. 99390 VAL, XMODE=2,
  21. 99400 S, 1) THEN
  22. 99410 ERRORFILL(S, ABS(WIDTH)+ORD(WIDTH=0));
  23. 99420 WHOLE := S;
  24. 99430 END;
  25. 99440 (**)
  26. 99450 (**)
  27. 99460 (*-02()
  28. 99470 BEGIN (*OF A68*)
  29. 99480 END; (*OF A68*)
  30. 99490 ()-02*)
  31. 99500 (*+01()
  32. 99510 BEGIN (*OF MAIN PROGRAM*)
  33. 99520 END (* OF EVERYTHING *).
  34. 99530 ()+01*)