/* 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. */ %DECLARE (UNSIGNED, SIGNED) CHARACTER; %UNSIGNED = 'BINARY';; %SIGNED = 'BINARY';; /* This macro implements the SUBTRACT built-in function. */ /* Four possibilities are taken, even though the first two are */ /* illegal. This is to allow syntactically correct code to be */ /* generated, which will be diagnosed by the compiler with a message */ /* about using the wrong number of arguments. */ %SUBTRACT: PROCEDURE (A, B, P, Q) RETURNS (CHARACTER); DECLARE (A, B, P, Q) CHARACTER; IF B = '' THEN DO; NOTE ( 'The SUBTRACT built-in function requires at least 3 arguments', 8); RETURN ('ADD(' || A || ')' ); END; ELSE IF P = '' THEN DO; NOTE ( 'The SUBTRACT built-in function requires at least 3 arguments', 8); RETURN ('ADD(' || A || ', -' || B || ', 15)'); END; ELSE IF Q = ' ' THEN RETURN ('ADD(' || A || ', -' || B || ', ' || P || ')'); ELSE RETURN ('ADD(' || A || ', -' || B || ', ' || P || ', ' || Q || ')'); %END SUBTRACT; %ACTIVATE SUBTRACT;; %DIMENSION: PROCEDURE (A, B, C) RETURNS (CHARACTER); DECLARE (A, B, C) CHARACTER; IF B = '' THEN RETURN ('DIM(' || A || ', 1)' ); ELSE IF C = '' THEN RETURN ('DIM(' || A || ', ' || B || ')' ); ELSE NOTE ('The DIMENSION built-in function must have 1 or 2 arguments.', 8); %END DIMENSION; %ACTIVATE DIMENSION;; /* This macro procedure will un-implement the built-in function */ /* SOURCELINE. It is required for a program developed on */ /* PL/I for OS/2, and run on other systems that do not have the */ /* function, or vice-versa. */ %SOURCELINE: PROCEDURE (L) RETURNS (CHARACTER); DECLARE L FIXED; RETURN ('0'); %END SOURCELINE; %ACTIVATE SOURCELINE;; /* This macro procedure will un-implement the built-in function */ /* PROCEDURENAME. It is required for a program developed on */ /* PL/I for OS/2, and run on other systems that do not have the */ /* function, or vice-versa. */ %PROCEDURENAME: PROCEDURE (L) RETURNS (CHARACTER); DECLARE L FIXED; RETURN (' null '); %END PROCEDURENAME; %ACTIVATE PROCEDURENAME;;