This example uses two programs: foo.pli and foosub.pli. foo.pli calls CBL_GET_PROGRAM_INFO after dynamically loading foosub.pli to obtain information. foosub.pli is a program that can be compiled in various ways to demonstrate API usage.
foo.pli
/* Demonstrate a PL/I Caller using the CBL_GET_PROGRAM_INFO API */
/* For the API to work the PL/I Shared Object or DLL must be loaded */
/* Via a FETCH or Enterprise Server. It will not function if the */
/* program was loaded via the OS Loader as a linker dependency, etc. */
/* If the program being queried is not OPTIONS(MAIN) it must be */
/* compiled with the -proginfo option. There is additional overhead */
/* when compiling with -proginfo so you want to consider if you need */
/* this functionality for subroutines. */
/**********************************************************************/
/* */
/* (C) Copyright 2008-2020 Micro Focus or one of its affiliates. */
/* The only warranties for products and services of Micro Focus and */
/* its affiliates and licensors ("Micro Focus") are set forth in the */
/* express warranty statements accompanying such products and */
/* services. Nothing herein should be construed as constituting an */
/* additional warranty. Micro Focus shall not be liable for */
/* technical or editorial errors or omissions contained herein. The */
/* information contained herein is subject to change without notice. */
/* */
/* The software and information contained herein are proprietary to, */
/* highly confidential information of, and comprise valuable trade */
/* secrets of, Micro Focus, which intends to preserve as trade */
/* secrets such software and information. This software is an */
/* unpublished copyright of Micro Focus and may not be used, copied, */
/* transmitted, or stored in any manner other than as expressly */
/* provided in a written instrument signed by Micro Focus and the */
/* user. This software and information or any other copies thereof */
/* may not be provided or otherwise made available to any other */
/* person. */
/* */
/**********************************************************************/
foo: proc() options(main);
DCL proginfo entry(fixed bin(31) native byvalue, *, char(260), fixed bin(31) native )
returns(fixed bin(31) native)
options(fetchable nodescriptor) ext('CBL_GET_PROGRAM_INFO');
dcl FOOSUB entry() options(fetchable);
DCL FUNC_INFO_CURR FIXED BIN(31) NATIVE VALUE( 0);
DCL FUNC_INFO_NAMED FIXED BIN(31) NATIVE VALUE( 1);
DCL FUNC_INFO_NEXT FIXED BIN(31) NATIVE VALUE( 2);
DCL FUNC_INFO_END FIXED BIN(31) NATIVE VALUE( 3);
DCL FUNC_ENTRY_START FIXED BIN(31) NATIVE VALUE( 4);
DCL FUNC_ENTRY_NEXT FIXED BIN(31) NATIVE VALUE( 5);
DCL FUNC_ENTRY_END FIXED BIN(31) NATIVE VALUE( 6);
DCL FUNC_FULLNAME FIXED BIN(31) NATIVE VALUE( 7);
/* Attribute bits are base 0 */
DCL ATTRIB_AMODE24 FIXED BIN(31) NATIVE VALUE(1); /* Bit 0 */
DCL ATTRIB_AMODE31 FIXED BIN(31) NATIVE VALUE(2); /* Bit 1 */
DCL ATTRIB_EBCDIC FIXED BIN(31) NATIVE VALUE(4); /* Bit 2 */
DCL ATTRIB_PLI FIXED BIN(31) NATIVE VALUE(256); /* Bit 8 */
DCL ATTRIB_BIGENDIAN FIXED BIN(31) NATIVE VALUE(2048); /* Bit 11 */
DCL PROGI_FUNC FIXED BIN(31) NATIVE init(FUNC_INFO_NAMED);
DCL PROGI_NAMEBUF CHAR (260);
DCL PROGI_NAMEBUF_LEN FIXED BIN(31) NATIVE;
DCL PROGI_STATUS FIXED BIN(31) NATIVE;
DCL 1 PROGI_PARMS UNAL,
10 PROGI_PARM_LEN FIXED BIN(31) NATIVE,
10 PROGI_FLAGS FIXED BIN(31) NATIVE,
10 PROGI_HANDLE POINTER,
10 PROGI_PROGID_PTR POINTER,
10 PROGI_ATTRBS FIXED BIN(31) NATIVE;
dcl bitstring bit(32);
on error
begin;
put skip list('Error Triggered - Oncode: ' || ONCODE());
end;
fetch FOOSUB; /* Load info for query by CBL_GET_PROGRAM_INFO */
progi_parms = '';
PROGI_PARM_LEN = STG(PROGI_PARMS);
PROGI_FLAGS = 8; /* Return attributes */
progi_namebuf = 'FOOSUB';
progi_namebuf_len = stg(progi_namebuf);
progi_status = proginfo(progi_func, progi_parms, progi_namebuf, progi_namebuf_len );
if (progi_status = 0) then
do;
/* success */
/* See CBL_GET_PROGRAM_INFO dox for description of bits/placement */
if (iand(progi_attrbs, ATTRIB_EBCDIC) ^= 0) then
put skip list('Program is EBCDIC');
else
put skip list('Program is ASCII');
if (iand(progi_attrbs, ATTRIB_AMODE24) ^= 0) then
put skip list('Program is AMODE24');
if (iand(progi_attrbs, ATTRIB_AMODE31) ^= 0) then
put skip list('Program is AMODE31');
if (iand(progi_attrbs, ATTRIB_PLI) ^= 0) then
put skip list('Program is PL/I');
if (iand(progi_attrbs, ATTRIB_BIGENDIAN) ^= 0) then
put skip list('Program is BIG ENDIAN');
else
put skip list('Program is LITTLE ENDIAN');
put skip;
end;
else
do;
put skip list('Call to CBL_GET_PROGRAM_INFO failed: ' || progi_status);
end;
end;
foosub.pli
foosub: proc(); end;
These are the example commands to build the two programs:
mfplx -deb -defext foo.pli mfplx -dll -proginfo foosub.pli foo mfplx -dll -proginfo -ebcdic foosub.pli foo mfplx -dll -proginfo -bigendian foosub.pli foo mfplx -dll -proginfo -bigendian -ebcdic foosub.pli foo