40 lines
1.4 KiB
OpenEdge ABL
40 lines
1.4 KiB
OpenEdge ABL
74200 #include "rundecs.h"
|
|
74210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
74220 (**)
|
|
74230 (**)
|
|
74240 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
|
|
74250 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
|
|
74260 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
|
|
74270 (**)
|
|
74280 (**)
|
|
74290 FUNCTION FIXED(XMODE: INTEGER; VAL: REALTEGER; WIDTH, AFTER: INTEGER): OBJECTP;
|
|
74300 VAR
|
|
74310 S: OBJECTP;
|
|
74320 SIGN, ABSWIDTH, BEFORE, POINT, E: INTEGER;
|
|
74330 OK: BOOLEAN;
|
|
74340 BEGIN
|
|
74350 ABSWIDTH := ABS(WIDTH);
|
|
74360 SIGN := ORD((WIDTH>0) OR (VAL.INT<0));
|
|
74370 IF ABSWIDTH-AFTER=1 THEN
|
|
74380 IF (WIDTH<0) AND (VAL.INT<0) THEN AFTER := AFTER-1;
|
|
74390 S := NIL;
|
|
74400 REPEAT
|
|
74410 POINT := ORD(AFTER>0);
|
|
74420 BEFORE := ABSWIDTH-SIGN-POINT-AFTER-ORD(WIDTH=0); (*-VE FOR WIDTH=0*)
|
|
74430 IF (WIDTH<>0) AND (BEFORE<0) THEN AFTER := -1; (*WILL CAUSE SUBFIXED TO FAIL*)
|
|
74440 OK := SUBFIXED(SIGN, BEFORE, POINT, AFTER, E, FALSE, VAL, XMODE=2, S, 1);
|
|
74450 AFTER := AFTER-1
|
|
74460 UNTIL OK OR (AFTER<0);
|
|
74470 IF NOT OK THEN ERRORFILL(S, ABSWIDTH+ORD(WIDTH=0));
|
|
74480 FIXED := S;
|
|
74490 END;
|
|
74500 (**)
|
|
74510 (**)
|
|
74520 (*-02()
|
|
74530 BEGIN (*OF A68*)
|
|
74540 END; (*OF A68*)
|
|
74550 ()-02*)
|
|
74560 (*+01()
|
|
74570 BEGIN (*OF MAIN PROGRAM*)
|
|
74580 END (* OF EVERYTHING *).
|
|
74590 ()+01*)
|