19.1.4 Example - Define a Built-In Function as a 3GL Program
This section goes through the steps involved in creating a Built-In Function as a program. The example shown is very simple, but should give an insight to how a Built-In Function is plugged into a LANSA system.
SCENARIO: This is a User Defined Built-In Function. The Built-In Function is used to retrieve system values.
A simple CL program. The program will be passed the system value name and will return the system value.
The name will be UD_GET_SYSTEM_VALUE.
The next available identifier at this site is 411.
BIF Definition (as per DC@F47 file)
|
BIF Arguments (as per DC@F48 file)
|
BIF Return Values (as per DC@F48 file)
|
Enter the data into the Built-In Function definition files:
/* Program : UD@P411 */
/* ------- */
/* Builtin name : Get a system value */
/* ------------ */
/* Date written : 03/10/91 */
/* ------------ */
/* Author : Johnny Programmer */
/* ------ */
/* Description : A program to return a system value */
/* ----------- */
/* */
/*=================================================================*/
/* Parameter list specifications */
/*=================================================================*/
/* */
/* Entry parameter list */
/* -------------------- */
/* */
/* Fixed parameters (all built-in functions) */
/* ----------------------------------------- */
/* */
/* DC@IDS : Standard Information data structure */
/* DC@EDS : Standard exchange data structure */
/* PR@IDS : Standard process information data structure */
/* */
/* Variable arguments and return values as per DC@F48 definition */
/* ------------------------------------------------------------- */
/* */
/* B$411A : Built-in function argument descriptor number A. */
/* B@411A : System value to get */
/* B$411B : Built-in function return value descriptor no. */
/* B@411B : Value of system value */
/*=================================================================*/
UD@P411: PGM PARM(&DC@IDS &DC@EDS &PR@IDS &B$411A &B@411A &B$411B +
&B@411B)
/*=================================================================*/
/* Variable declarations */
/*=================================================================*/
DCL &DC@IDS *CHAR 1024
DCL &DC@EDS *CHAR 1024
DCL &PR@IDS *CHAR 1024
DCL &B$411A *CHAR 4
DCL &B@411A *CHAR 10
DCL &B$411B *CHAR 4
DCL &B@411B *CHAR 256
DCL &$PGMNM *CHAR 10
DCL &PR@PGM *CHAR 10
DCL &PR@B@N *CHAR 3
DCL &PR@B@A *CHAR 1
DCL &DC@RET *CHAR 1
DCL &DC@MID *CHAR 7
DCL &DC@MVR *CHAR 132
/*=================================================================*/
/* Global error handler */
/*=================================================================*/
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO ARGERR)
/*=================================================================*/
/* Program mainline */
/*=================================================================*/
/* Set up some fields and map some from the data structures .... */
CHGVAR &$PGMNM 'UD@P411'
CHGVAR &PR@PGM %SST(&PR@IDS 424 10)
CHGVAR &PR@B@N %SST(&PR@IDS 157 3)
CHGVAR &PR@B@A %SST(&PR@IDS 160 1)
/* Initially assume that a "good" return will be the result .... */
CHGVAR &DC@RET 'Y'
/* Perform the required evaluation / action ....... */
/* Retrieve the system value */
RTVSYSVAL SYSVAL(&B@411A) RTNVAR(&B@411B)
MONMSG (CPF0000 MCH0000)
/* End of program processing logic */
ENDPGM: CHGVAR %SST(&DC@EDS 38 1) &DC@RET
CHGVAR %SST(&DC@EDS 39 7) &DC@MID
CHGVAR %SST(&DC@EDS 46 132) &DC@MVR
RETURN
/*==================================================================*/
/* ARGERR :Handle a detected error in argument(s) passed to program */
/* Caller should set DC@MID and DC@MVR to reflect the */
/* cause of the error before executing this logic. Note that */
/* the entire program terminates when this logic is invoked. */
/* It will cause the calling RDML program to fail and issue */
/* the message details returned to it in DC@MID/DC@MVR */
/*==================================================================*/
ARGERR:
/* Route messages any additional messages back to the caller ..... */
CALL PGM(DC@P9007) PARM(&$PGMNM &PR@PGM)
MONMSG (CPF0000 MCH0000)
/* Set up a "bad" return code .... */
CHGVAR &DC@RET 'N'
MONMSG (CPF0000 MCH0000)
/* Return control to the calling program .... */
GOTO ENDPGM
/*==================================================================*/
ENDPGM
/*==================================================================*/