Almost all the restrictions imposed by the older PL/I compilers on fetched modules have been removed. So a FETCHed module can now:
There are, however, a few restrictions on a Enterprise PL/I module that is to be fetched. These restrictions are:
NORENT WRITABLE code is serially usable, and for that reason, the pointer that is used to represent a FFETCHABLE constant is zeroed out in the prologue code of any NORENT WRITABLE routine. While this insures that the code is serially reusable while also providing the correct PL/I semantics, it does impose a restriction on the use of FETCH with TITLE in NORENT WRITABLE code: if a routine that did a FETCH A TITLE('B') is exited and reentered, then it must re-execute the FETCH A TITLE('B'), before executing any CALL A statements (otherwise it would do an implicit FETCH of A (but without any TITLE) before making the CALL).
As an illustration of these restrictions, consider the compiler user exit. If you specify the EXIT compile-time option, the compiler will fetch and call a Enterprise PL/I module named IBMUEXIT.
First note that the compiler user exit must be compiled with the RENT option since the compiler expects it to be a DLL.
In accordance with Item 1 above, the PROCEDURE statement for this routine looks like:
ibmuexit:
proc ( addr_Userexit_Interface_Block,
addr_Request_Area )
options( fetchable );
dcl addr_Userexit_Interface_Block pointer byvalue;
dcl addr_Request_Area pointer byvalue;
In accordance with Item 3 above, the linker option DYNAM=DLL must be specified when linking the user exit into a DLL. The DLL must be linked either into a PDSE or into a temporary dataset (in which case DSNTYPE=LIBRARY must be specified on the SYSLMOD DD statement).
All the JCL to compile, link, and invoke the user exit is given in the JCL below in Figure 16. The one significant difference between the sample below and the code excerpts above is that, in the code below, the fetched user exit does not receive two BYVALUE pointers to structures, but instead it receives the two structures BYADDR. In order to make this change work, the code specifies OPTIONS(NODESCRIPTOR) on each of its PROCEDURE statements.
//*
//*********************************************************************
//* compile the user exit
//*********************************************************************
//PLIEXIT EXEC PGM=IBMZPLI,
// REGION=256K
//STEPLIB DD DSN=IBMZ.V3R8M0.SIBMZCMP,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSSQ,
// SPACE=(CYL,(3,1))
//SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,
// SPACE=(1024,(200,50),,CONTIG,ROUND),DCB=BLKSIZE=1024
//SYSIN DD *
*Process or('|') not('!');
*Process limits(extname(31));
/********************************************************************/
/* */
/* NAME - IBMUEXIT.PLI */
/* */
/* DESCRIPTION */
/* User-exit sample program. */
/* */
/* Licensed Materials - Property of IBM */
/* 5639-A83, 5639-A24 (C) Copyright IBM Corp. 1992,2008. */
/* All Rights Reserved. */
/* US Government Users Restricted Rights-- Use, duplication or */
/* disclosure restricted by GSA ADP Schedule Contract with */
/* IBM Corp. */
/* */
/* DISCLAIMER OF WARRANTIES */
/* The following "enclosed" code is sample code created by IBM */
/* Corporation. This sample code is not part of any standard */
/* IBM product and is provided to you solely for the purpose of */
/* assisting you in the development of your applications. The */
/* code is provided "AS IS", without warranty of any kind. */
/* IBM shall not be liable for any damages arising out of your */
/* use of the sample code, even if IBM has been advised of the */
/* possibility of such damages. */
/* */
/********************************************************************/
/********************************************************************/
/* */
/* During initialization, IBMUEXIT is called. It reads */
/* information about the messages being screened from a text */
/* file and stores the information in a hash table. IBMUEXIT */
/* also sets up the entry points for the message filter service */
/* and termination service. */
/* */
/* For each message generated by the compiler, the compiler */
/* calls the message filter registered by IBMUEXIT. The filter */
/* looks the message up in the hash table previously created. */
/* */
/* The termination service is called at the end of the compile */
/* but does nothing. It could be enhanced to generates reports */
/* or do other cleanup work. */
/* */
/********************************************************************/
pack: package exports(*);
Dcl
1 Uex_UIB native Based( null() ),
2 Uex_UIB_Length fixed bin(31),
2 Uex_UIB_Exit_token pointer, /* for user exit's use*/
2 Uex_UIB_User_char_str pointer, /* to exit option str */
2 Uex_UIB_User_char_len fixed bin(31),
2 Uex_UIB_Filename_str pointer, /* to source filename */
2 Uex_UIB_Filename_len fixed bin(31),
2 Uex_UIB_return_code fixed bin(31), /* set by exit procs */
2 Uex_UIB_reason_code fixed bin(31), /* set by exit procs */
2 Uex_UIB_Exit_Routs, /* exit entries setat
initialization */
3 ( Uex_UIB_Termination,
Uex_UIB_Message_Filter, /* call for each msg */
*, *, *, * )
limited entry (
*, /* to Uex_UIB */
* /* to a request area */
);
/*******************************************************************/
/* */
/* Request Area for Initialization exit */
/* */
/*******************************************************************/
Dcl 1 Uex_ISA native based( null() ),
2 Uex_ISA_Length fixed bin(31);
/*******************************************************************/
/* */
/* Request Area for Message_Filter exit */
/* */
/*******************************************************************/
Dcl 1 Uex_MFA native based( null() ),
2 Uex_MFA_Length fixed bin(31),
2 Uex_MFA_Facility_Id char(3),
2 * char(1),
2 Uex_MFA_Message_no fixed bin(31),
2 Uex_MFA_Severity fixed bin(15),
2 Uex_MFA_New_Severity fixed bin(15); /* set by exit proc */
/*******************************************************************/
/* */
/* Request Area for Terminate exit */
/* */
/*******************************************************************/
Dcl 1 Uex_TSA native based( null() ),
2 Uex_TSA_Length fixed bin(31);
/*******************************************************************/
/* */
/* Severity Codes */
/* */
/*******************************************************************/
dcl uex_Severity_Normal fixed bin(15) value(0);
dcl uex_Severity_Warning fixed bin(15) value(4);
dcl uex_Severity_Error fixed bin(15) value(8);
dcl uex_Severity_Severe fixed bin(15) value(12);
dcl uex_Severity_Unrecoverable fixed bin(15) value(16);
/*******************************************************************/
/* */
/* Return Codes */
/* */
/*******************************************************************/
dcl uex_Return_Normal fixed bin(15) value(0);
dcl uex_Return_Warning fixed bin(15) value(4);
dcl uex_Return_Error fixed bin(15) value(8);
dcl uex_Return_Severe fixed bin(15) value(12);
dcl uex_Return_Unrecoverable fixed bin(15) value(16);
/*******************************************************************/
/* */
/* Reason Codes */
/* */
/*******************************************************************/
dcl uex_Reason_Output fixed bin(15) value(0);
dcl uex_Reason_Suppress fixed bin(15) value(1);
dcl hashsize fixed bin(15) value(97);
dcl hashtable(0:hashsize-1) ptr init((hashsize) null());
dcl 1 message_item native based,
2 message_Info,
3 facid char(3),
3 msgno fixed bin(31),
3 newsev fixed bin(15),
3 reason fixed bin(31),
2 link pointer;
ibmuexit: proc ( ue, ia )
options( fetchable nodescriptor );
dcl 1 ue like uex_Uib byaddr;
dcl 1 ia like uex_Isa byaddr;
dcl sysuexit file stream input env(recsize(80));
dcl p pointer;
dcl bucket fixed bin(31);
dcl based_Chars char(8) based;
dcl title_Str char(8) var;
ue.uex_Uib_Message_Filter = message_Filter;
ue.uex_Uib_Termination = exitterm;
on undefinedfile(sysuexit)
begin;
put edit ('** User exit unable to open exit file ')
(A) skip;
put skip;
signal error;
end;
if ue.uex_Uib_User_Char_Len = 0 then
do;
open file(sysuexit);
end;
else
do;
title_Str
= substr( ue.uex_Uib_User_Char_Str->based_Chars,
1, ue.uex_Uib_User_Char_Len );
open file(sysuexit) title(title_Str);
end;
on error, endfile(sysuexit)
goto done;
allocate message_item set(p);
/***************************************************************/
/* */
/* Skip header lines and read first data line */
/* */
/***************************************************************/
get file(sysuexit) list(p->message_info) skip(3);
do loop;
/*************************************************************/
/* */
/* Put message information in hash table */
/* */
/*************************************************************/
bucket = mod(p->msgno, hashsize);
p->link = hashtable(bucket);
hashtable(bucket) = p;
/*************************************************************/
/* */
/* Read next data line */
/* */
/*************************************************************/
allocate message_item set(p);
get file(sysuexit) skip;
get file(sysuexit) list(p->message_info);
end;
/***************************************************************/
/* */
/* Clean up */
/* */
/***************************************************************/
done:
free p->message_Item;
close file(sysuexit);
end;
message_Filter:
proc ( ue, mf )
options( nodescriptor );
dcl 1 ue like uex_Uib byaddr;
dcl 1 mf like uex_Mfa byaddr;
dcl p pointer;
dcl bucket fixed bin(15);
on error snap system;
ue.uex_Uib_Reason_Code = uex_Reason_Output;
ue.uex_Uib_Return_Code = 0;
mf.uex_Mfa_New_Severity = mf.uex_Mfa_Severity;
/***************************************************************/
/* */
/* Calculate bucket for error message */
/* */
/***************************************************************/
bucket = mod(mf.uex_Mfa_Message_No, hashsize);
/***************************************************************/
/* */
/* Search bucket for error message */
/* */
/***************************************************************/
do p = hashtable(bucket) repeat (p->link) while(p!=null())
until (p->msgno = mf.uex_Mfa_Message_No &
p->facid = mf.Uex_Mfa_Facility_Id);
end;
if p = null() then;
else
do;
/***********************************************************/
/* */
/* Filter error based on information in has table */
/* */
/***********************************************************/
ue.uex_Uib_Reason_Code = p->reason;
if p->newsev < 0 then;
else
mf.uex_Mfa_New_Severity = p->newsev;
end;
end;
exitterm:
proc ( ue, ta )
options( nodescriptor );
dcl 1 ue like uex_Uib byaddr;
dcl 1 ta like uex_Tsa byaddr;
ue.uex_Uib_return_Code = 0;
ue.uex_Uib_reason_Code = 0;
end;
end pack;
//*********************************************************************
//* link the user exit
//*********************************************************************
//LKEDEXIT EXEC PGM=IEWL,PARM='XREF,LIST,LET,DYNAM=DLL',
// COND=(9,LT,PLIEXIT),REGION=5000K
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSLMOD DD DSN=&&EXITLIB(IBMUEXIT),DISP=(NEW,PASS),UNIT=SYSDA,
// SPACE=(TRK,(7,1,1)),DSNTYPE=LIBRARY
//SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(CYL,(3,1)),
// DCB=BLKSIZE=1024
//SYSPRINT DD SYSOUT=X
//SYSDEFSD DD DUMMY
//SYSLIN DD DSN=&&LOADSET,DISP=SHR
// DD DDNAME=SYSIN
//LKED.SYSIN DD *
ENTRY IBMUEXIT
//*********************************************************************
//* compile main
//*********************************************************************
//PLI EXEC PGM=IBMZPLI,PARM='F(I),EXIT',
// REGION=256K
//STEPLIB DD DSN=&&EXITLIB,DISP=SHR
// DD DSN=IBMZ.V3R8M0.SIBMZCMP,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSLIN DD DSN=&&LOADSET2,DISP=(MOD,PASS),UNIT=SYSSQ,
// SPACE=(CYL,(3,1))
//SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,
// SPACE=(1024,(200,50),,CONTIG,ROUND),DCB=BLKSIZE=1024
//SYSIN DD *
*process;
MainFet: Proc Options(Main);
/* the exit will suppress the message for the next dcl */
dcl one_byte_integer fixed bin(7);
End ;
//*
//SYSUEXIT DD *
Fac Id Msg No Severity Suppress Comment
+--------+--------+----------+----------+-------------------------------
'IBM' 1042 -1 1 String spans multiple lines
'IBM' 1044 -1 1 FIXED BIN 7 mapped to 1 byte