<![CDATA[
/* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */
/* Structured Programming". Permission is given to reproduce and to use these procedures */
/* as part of a program, and to include them as part of a larger work to be sold for profit. */
/* However, the user is not permitted to sell the procedures separately. Provided always */
/* that these procedures and this copyright notice are reproduced in full. */
/* This function implements the built-in function SUCC. It returns the next-highest */
/* value for the floating-point value x. It is intended for the IBM System /390 only. */
/* Accepts default floating-point and FLOAT(15) arguments only. */
NEXT_HI:
PROCEDURE (FPN) RETURNS (FLOAT (15));
DECLARE FPN BIT(*);
DECLARE FPN_INC BIT (LENGTH(FPN));
DECLARE (FPN1, FPN2,
FPN3, FPN4) FLOAT;
DECLARE L FIXED BINARY;
L = LENGTH (FPN);
IF L = 32 THEN
DO;
UNSPEC (FPN1) = FPN;
FPN_INC = FPN & '01111111'B;
FPN_INC = FPN_INC | ((31)'0'B || '1'B);
UNSPEC(FPN2) = FPN_INC;
RETURN (FPN1 + FPN2);
END;
ELSE IF L = 64 THEN
DO;
UNSPEC(FPN3) = FPN;
FPN_INC = FPN & '01111111'B;
FPN_INC = FPN_INC | ((63)'0'B || '1'B);
UNSPEC(FPN4) = FPN_INC;
RETURN (FPN3 + FPN4);
END;
END NEXT_HI;
/* This macro procedure converts a function reference of the form: */
/* SUCC (FPN) */
/* into the form: */
/* NEXT_HI ( UNSPEC (FPN) ) */
%SUCC: PROCEDURE (ARG) RETURNS (CHARACTER);
DECLARE ARG CHARACTER;
RETURN ( 'NEXT_HI ( UNSPEC (' || ARG || '))' );
%END SUCC;
%ACTIVATE SUCC NORESCAN;
/* This function implements the built-in function PRED. It returns the next-lowest */
/* value for the floating-point value x. It is intended for the IBM System /390 only. */
/* Accepts default floating-point and FLOAT(15) arguments only. */
NEXT_LO:
PROCEDURE (FPN) RETURNS (FLOAT (15));
DECLARE FPN BIT(*);
DECLARE FPN_INC BIT (LENGTH(FPN));
DECLARE (FPN1, FPN2,
FPN3, FPN4) FLOAT;
DECLARE L FIXED BINARY;
L = LENGTH (FPN);
IF L = 32 THEN
DO;
UNSPEC (FPN1) = FPN;
FPN_INC = FPN & '01111111'B;
FPN_INC = FPN_INC | ((31)'0'B || '1'B);
UNSPEC(FPN2) = FPN_INC;
RETURN (FPN1 - FPN2);
END;
ELSE IF L = 64 THEN
DO;
UNSPEC(FPN3) = FPN;
FPN_INC = FPN & '01111111'B;
FPN_INC = FPN_INC | ((63)'0'B || '1'B);
UNSPEC(FPN4) = FPN_INC;
RETURN (FPN3 - FPN4);
END;
END NEXT_LO;
/* This macro procedure converts a function reference of the form: */
/* PRED (FPN) */
/* into the form: */
/* NEXT_LO ( UNSPEC (FPN) ) */
%PRED: PROCEDURE (ARG) RETURNS (CHARACTER);
DECLARE ARG CHARACTER;
RETURN ( 'NEXT_LO ( UNSPEC (' || ARG || '))' );
%END PRED;
%ACTIVATE PRED NORESCAN;
]]>