对新函数进行编码
如果程序不允许处理此功能,那么来自 IBM 的新功能可能会导致程序失败。 以下是显示使用新函数的不正确和正确方法的程序示例。
假设引入了新的对象类型 *SRVPGM ,这可以采用所有者权限。
此示例的常规主题从不假定 API 返回的值是静态的。 IBM® i 操作系统正在不断发展。 虽然此示例基于添加新对象类型,但此哲学应应用于 API 的任何输出。 例如,如果今天的 API 可以返回 *YES 或 *NO ,那么需要离散地检查这些值,因为*可能在将来有效。 同样,如果应用程序假定特定整数输出具有正非零值 (例如,偏移量) ,那么需要检查正非零值,因为未来发行版可能会返回负值以指示新函数。
注: 通过使用代码示例,您同意 代码许可证和免责声明信息的条款。
不正确的程序示例: 新函数的编码
在此示例程序中,将进行检查以确定对象类型。 这显示在 (1)中。 该示例程序仅考虑对象类型 *SQLPKG 或 *PGM。 这是因为它们是唯一可以采用版本 2 发行版 3 之前的所有者权限的对象类型。 自那时以来,引入了新的对象类型 *SRVPGM。 *SRVPGM 可采用所有者权限。 因此,此示例程序处理 *SRVPGM 对象,就像它们是 *PGM 对象一样。 正确的编码显示在 (2)上。
D*****************************************************************
D*
D*Program Name: PGM1
D*
D*Program Language: ILE RPG
D*
D*Description: This example program demonstrates how a program can
D* be "broken" by new functions introduced on the system.
D*
D*
D*
D*Header Files Included: QUSGEN - Generic Header of a User Space
D* (Copied Into Program)
D* QUSEC - Error Code Parameter
D* (Copied Into Program)
D* QSYLOBJP - List Objects API
D* (Copied Into Program)
D*
D*APIs Used: QUSCRTUS - Create User Space
D* QSYLOBJP - List Objects That Adopt Owner Authority
D* QUSROBJD - Retrieve Object Description
D* QUSPTRUS - Retrieve Pointer to User Space
D*****************************************************************
D*****************************************************************
D*
D* This program demonstrates how a program can be "broken" by
C* new functions introduced on the system.
D*
D*****************************************************************
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
DSPC_NAME S 20 INZ('ADOPTS QTEMP ')
DSPC_SIZE S 9B 0 INZ(1)
DSPC_INIT S 1 INZ(X'00')
DLSTPTR S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
DRCVVAR S 8
DRCVVARSIZ S 9B 0 INZ(%SIZE(RCVVAR))
D*****************************************************************
D*
D* The following QUSGEN include is copied into this program so
D* that it can be declared as BASED on SPCPTR, as shown at (3)
D* in the incorrect programs and at (4) in the correct program.
D*
D*****************************************************************
D*
D*Header File Name: H/QUSGEN
D*
D*Descriptive Name: Format structures for User Space for ILE/C
D*
D*5763-SS1, 5722-SS1 (C) Copyright IBM Corp. 1994, 2001
D*All rights reserved.
D*US Government Users Restricted Rights -
D*Use, duplication or disclosure restricted
D*by GSA ADP Schedule Contract with IBM Corp.
D*
D*Description: Contains the Generic Record format headers
D* for the user space.
D*
D*Header Files Included: none.
D*
D*Macros List: none.
D*
D*Structure List: Qus_Generic_Header_0100
D* Qus_Generic_Header_0300
D*
D*Function Prototype List: none.
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 940213 LUPA: New Include
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Type Definition for the User Space Generic Header.
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR) (3)
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Partial List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QSYLOBJP include is copied into this program so
D* that it can be declared as BASED on LSTPTR, as shown at (5)
D* in the incorrect coding and (6) in the correct coding.
D*
D*****************************************************************
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QSYLOBJP
D*
D*Descriptive Name: List Objects That Adopt Owner Authority.
D*
D*
D*Description: Include header file for the QSYLOBJP API.
D*
D*Header Files Included: H/QSYLOBJP
D* H/QSY
D*
D*Macros List: None.
D*
D*Structure List: OBJP0100
D* OBJP0200
D* Qsy_OBJP_Header
D*
D*Function Prototype List: QSYLOBJP
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 931222 XZY0432: New Include
D*
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Prototype for calling Security API QSYLOBJP
D*****************************************************************
D QSYLOBJP C 'QSYLOBJP'
D*****************************************************************
D*Header structure for QSYLOBJP
D*****************************************************************
DQSYOBJPH DS BASED(LSTPTR) (5)
D* Qsy OBJP Header
D QSYUN00 1 10
D* User name
D QSYCV00 11 30
D* Continuation Value
D*****************************************************************
D*Record structure for OBJP0100 format
D*****************************************************************
DQSY0100L02 DS BASED(LSTPTR) (5)
D* Qsy OBJP0100 List
D QSYNAME05 1 10
D QSYBRARY05 11 20
D* Qualified object name
D QSYOBJT12 21 30
D* Object type
D QSYOBJIU 31 31
D* Object in use
C*
C* Start of mainline
C*
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* Start of subroutines
C*
C*****************************************************************
C PROCES BEGSR
C*
C* This subroutine processes each entry returned by QSYLOBJP
C*
C*
C* Do until the list is complete
C*
C MOVE QUSIS LST_STATUS 1
C LST_STATUS DOUEQ 'C'
C*
C* If valid information was returned
C*
C QUSIS IFEQ 'C'
C QUSIS OREQ 'P'
C*
C* and list entries were found
C*
C QUSNBRLE IFGT 0
C*
C* set LSTPTR to the first byte of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* increment LSTPTR to the first list entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOLD + 1))
C*
C* and process all of the entries
C*
C DO QUSNBRLE
C QSYOBJT12 IFEQ '*SQLPKG'
C*
C* Process *SQLPKG type
C*
C ELSE (1)
C* |
C* This 'ELSE' logic is the potential bug in this program. In |
C* releases prior to V2R3 only *SQLPKGs and *PGMs could adopt |
C* owner authority, and this program is assuming that if the |
C* object type is not *SQLPKG then it must be a *PGM. In V2R3 |
C* a new type of object (the *SRVPGM) was introduced. As this |
C* program is written, all *SRVPGMs that adopt the owner profile |
C* will be processed as if they were *PGMs -- this erroneous |
C* processing could definitely cause problems. |
C* |
C QSYNAME05 DSPLY |
C END V
C*
C* after each entry, increment LSTPTR to the next entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSSEE + 1))
C END
C END
C*
C* When all entries in this user space have been processed, check
C* if more entries exist than can fit in one user space
C*
C QUSIS IFEQ 'P'
C*
C* by resetting LSTPTR to the start of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* and then incrementing LSTPTR to the input parameter header
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOIP + 1))
C*
C* If the continuation handle in the input parameter header is
C* blank, then set the list status to Complete
C*
C QSYCV00 IFEQ *BLANKS
C MOVE 'C' LST_STATUS
C ELSE
C*
C* Else, call QSYLOBJP reusing the User Space to get more
C* List entries
C*
C MOVE QSYCV00 CONTIN_HDL
C EXSR GETLST
C MOVE QUSIS LST_STATUS
C END
C END
C ELSE
C*
C* And if an unexpected status, log an error (not shown) and exit
C*
C EXSR DONE
C END
C END
C ENDSR
C*****************************************************************
C GETLST BEGSR
C*
C* Call QSYLOBJP to generate a list
C* The continuation handle is set by the caller of this subroutine.
C*
C CALL QSYLOBJP
C PARM SPC_NAME
C PARM 'OBJP0100' MBR_LIST 8
C PARM '*CURRENT' USR_PRF 10
C PARM '*ALL' OBJ_TYPE 10
C PARM CONTIN_HDL 20
C PARM QUSEC
C*
C* Check for errors on QSYLOBJP
C*
C QUSBAVL IFGT 0
C MOVEL 'QSYLOBJP' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C INIT BEGSR
C*
C* One-time initialization code for this program
C*
C* Set error code structure to not use exceptions
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Check to see if the user space was previously created in
C* QTEMP. If it was, simply reuse it.
C*
C CALL 'QUSROBJD'
C PARM RCVVAR
C PARM RCVVARSIZ
C PARM 'OBJD0100' ROBJD_FMT 8
C PARM SPC_NAME
C PARM '*USRSPC' OBJ_TYPE 10
C PARM QUSEC
C*
C* Check for errors on QUSROBJD
C*
C QUSBAVL IFGT 0
C*
C* If CPF9801, then user space was not found
C*
C QUSEI IFEQ 'CPF9801'
C*
C* So create a user space for the list generated by QSYLOBJP
C*
C CALL 'QUSCRTUS'
C PARM SPC_NAME
C PARM 'QSYLOBJP ' EXT_ATTR 10
C PARM SPC_SIZE
C PARM SPC_INIT
C PARM '*ALL' SPC_AUT 10
C PARM *BLANKS SPC_TEXT 50
C PARM '*YES' SPC_REPLAC 10
C PARM QUSEC
C PARM '*USER' SPC_DOMAIN 10
C*
C* Check for errors on QUSCRTUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSCRTUS' APINAM 10
C EXSR APIERR
C END
C*
C* Else, an error occurred accessing the user space
C*
C ELSE
C MOVEL 'QUSROBJD' APINAM 10
C EXSR APIERR
C END
C END
C*
C* Set QSYLOBJP (using GETLST) to start a new list
C*
C MOVE *BLANKS CONTIN_HDL
C EXSR GETLST
C*
C* Get a resolved pointer to the user space for performance
C*
C CALL 'QUSPTRUS'
C PARM SPC_NAME
C PARM SPCPTR
C PARM QUSEC
C*
C* Check for errors on QUSPTRUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSPTRUS' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C APIERR BEGSR
C*
C* Log any error encountered, and exit the program
C*
C APINAM DSPLY QUSEI
C EXSR DONE
C ENDSR
C*****************************************************************
C DONE BEGSR
C*
C* Exit the program
C*
C EVAL *INLR = '1'
C RETURN
C ENDSR
正确的程序示例: 新函数的编码
在以下示例程序中,已编写用于检查对象类型 *SRVPGM , *PGM 和 *SQLPKG 的代码。 如果迂到未知的对象类型 (它与 *SRVPGM , *PGM 或 *SQLPKG 不匹配) ,那么将记录错误并从程序中退出。
在 (2)上显示了用于处理新函数集成的编码 (在本例中为可采用所有者权限的新对象类型)。
C*****************************************************************
C*
C*Program Name: PGM2
C*
C*Program Language: ILE RPG
C*
C*Description: This example program demonstrates how a program can
C* be coded to accept new functions introduced on the system.
C*
C*
C*
C*Header Files Included: QUSGEN - Generic Header of a User Space
D* (Copied Into Program)
C* QUSEC - Error Code Parameter
D* (Copied Into Program)
C* QSYLOBJP - List Objects API
D* (Copied Into Program)
C*
C*APIs Used: QUSCRTUS - Create User Space
C* QSYLOBJP - List Objects That Adopt Owner Authority
C* QUSROBJD - Retrieve Object Description
C* QUSPTRUS - Retrieve Pointer to User Space
C*****************************************************************
H
C*****************************************************************
C*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
DSPC_NAME S 20 INZ('ADOPTS QTEMP ')
DSPC_SIZE S 9B 0 INZ(1)
DSPC_INIT S 1 INZ(X'00')
DLSTPTR S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
DRCVVAR S 8
DRCVVARSIZ S 9B 0 INZ(%SIZE(RCVVAR))
D*****************************************************************
D*
D* The following QUSGEN include is copied into this program so
D* that it can be declared as BASED on SPCPTR, as shown at (3)
D* in the incorrect program and at (4) in the correct program.
D*
D*****************************************************************
D*
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QUSGEN
D*
D*Descriptive Name: Format structures for User Space for ILE/C
D*
D*
D*5763-SS1, 5722-SS1 (C) Copyright IBM Corp. 1994, 2001
D*All rights reserved.
D*US Government Users Restricted Rights -
D*Use, duplication or disclosure restricted
D*by GSA ADP Schedule Contract with IBM Corp.
D*
D*Description: Contains the Generic Record format headers
D* for the user space.
D*
D*Header Files Included: none.
D*
D*Macros List: none.
D*
D*Structure List: Qus_Generic_Header_0100
D* Qus_Generic_Header_0300
D*
D*Function Prototype List: none.
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 940213 LUPA: New Include
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Type Definition for the User Space Generic Header.
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR) (4)
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Partial List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QSYLOBJP include is copied into this program so
D* that it can be declared as BASED on LSTPTR, as shown at (5)
D* in the incorrect coding and at (6) in the correct coding.
D*
D*
D*****************************************************************
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QSYLOBJP
D*
D*Descriptive Name: List Objects That Adopt Owner Authority.
D*
D*
D*Description: Include header file for the QSYLOBJP API.
D*
D*Header Files Included: H/QSYLOBJP
D* H/QSY
D*
D*Macros List: None.
D*
D*Structure List: OBJP0100
D* OBJP0200
D* Qsy_OBJP_Header
D*
D*Function Prototype List: QSYLOBJP
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 931222 XZY0432: New Include
D*
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Prototype for calling Security API QSYLOBJP
D*****************************************************************
D QSYLOBJP C 'QSYLOBJP'
D*****************************************************************
D*Header structure for QSYLOBJP
D*****************************************************************
DQSYOBJPH DS BASED(LSTPTR) (6)
D* Qsy OBJP Header
D QSYUN00 1 10
D* User name
D QSYCV00 11 30
D* Continuation Value
D*****************************************************************
D*Record structure for OBJP0100 format
D*****************************************************************
DQSY0100L02 DS BASED(LSTPTR) (6)
D* Qsy OBJP0100 List
D QSYNAME05 1 10
D QSYBRARY05 11 20
D* Qualified object name
D QSYOBJT12 21 30
D* Object type
D QSYOBJIU 31 31
D* Object in use
C*
C* Start of mainline
C*
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* Start of subroutines
C*
C*****************************************************************
C PROCES BEGSR
C*
C* This subroutine processes each entry returned by QSYLOBJP
C*
C*
C* Do until the list is complete
C*
C MOVE QUSIS LST_STATUS 1
C*
C LST_STATUS DOUEQ 'C'
C*
C* If valid information was returned
C*
C QUSIS IFEQ 'C'
C QUSIS OREQ 'P'
C*
C* and list entries were found
C*
C QUSNBRLE IFGT 0
C*
C* set LSTPTR to the first byte of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* increment LSTPTR to the first list entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOLD + 1))
C*
C* and process all of the entries
C*
C DO QUSNBRLE
C QSYOBJT12 IFEQ '*SQLPKG'
C*
C* Process *SQLPKG type (2)
C* |
C ELSE |
C QSYOBJT12 IFEQ '*PGM' |
C* |
C* Process *PGM type |
C* |
C QSYNAME05 DSPLY |
C ELSE |
C QSYOBJT12 IFEQ '*SRVPGM' |
C* |
C* Process *SRVPGM type |
C* |
C ELSE |
C* V
C*
C* Unknown type, log an error and exit from program (maybe..)
C*
C EXSR DONE
C END
C END
C END
C*
C* after each entry, increment LSTPTR to the next entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSSEE + 1))
C END
C END
C*
C* When all entries in this user space have been processed, check
C* if more entries exist than can fit in one user space
C*
C QUSIS IFEQ 'P'
C*
C* by resetting LSTPTR to the start of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* and then incrementing LSTPTR to the input parameter header
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOIP + 1))
C*
C* If the continuation handle in the input parameter header is
C* blank, then set the list status to complete.
C*
C QSYCV00 IFEQ *BLANKS
C MOVE 'C' LST_STATUS
C ELSE
C*
C* Else, call QSYLOBJP reusing the user space to get more
C* list entries
C*
C MOVE QSYCV00 CONTIN_HDL
C EXSR GETLST
C MOVE QUSIS LST_STATUS
C END
C END
C ELSE
C*
C* And if an unexpected status, log an error (not shown) and exit
C*
C EXSR DONE
C END
C END
C ENDSR
C*****************************************************************
C GETLST BEGSR
C*
C* Call QSYLOBJP to generate a list
C* The continuation handle is set by the caller of this subroutine.
C*
C CALL QSYLOBJP
C PARM SPC_NAME
C PARM 'OBJP0100' MBR_LIST 8
C PARM '*CURRENT' USR_PRF 10
C PARM '*ALL' OBJ_TYPE 10
C PARM CONTIN_HDL 20
C PARM QUSEC
C*
C* Check for errors on QSYLOBJP
C*
C QUSBAVL IFGT 0
C MOVEL 'QSYLOBJP' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C INIT BEGSR
C*
C* One time initialization code for this program
C*
C* Set error code structure to not use exceptions
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Check to see if the user space was previously created in
C* QTEMP. If it was, simply reuse it.
C*
C CALL 'QUSROBJD'
C PARM RCVVAR
C PARM RCVVARSIZ
C PARM 'OBJD0100' ROBJD_FMT 8
C PARM SPC_NAME
C PARM '*USRSPC' OBJ_TYPE 10
C PARM QUSEC
C*
C* Check for errors on QUSROBJD
C*
C QUSBAVL IFGT 0
C*
C* If CPF9801, then user space was not found
C*
C QUSEI IFEQ 'CPF9801'
C*
C* So create a user space for the list generated by QSYLOBJP
C*
C CALL 'QUSCRTUS'
C PARM SPC_NAME
C PARM 'QSYLOBJP ' EXT_ATTR 10
C PARM SPC_SIZE
C PARM SPC_INIT
C PARM '*ALL' SPC_AUT 10
C PARM *BLANKS SPC_TEXT 50
C PARM '*YES' SPC_REPLAC 10
C PARM QUSEC
C PARM '*USER' SPC_DOMAIN 10
C*
C* Check for errors on QUSCRTUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSCRTUS' APINAM 10
C EXSR APIERR
C END
C*
C* Else, an error occurred accessing the user space
C*
C ELSE
C MOVEL 'QUSROBJD' APINAM 10
C EXSR APIERR
C END
C END
C*
C* Set QSYLOBJP (using GETLST) to start a new list
C*
C MOVE *BLANKS CONTIN_HDL
C EXSR GETLST
C*
C* Get a resolved pointer to the user space for performance
C*
C CALL 'QUSPTRUS'
C PARM SPC_NAME
C PARM SPCPTR
C PARM QUSEC
C*
C* Check for errors on QUSPTRUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSPTRUS' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C APIERR BEGSR
C*
C* Log any error encountered, and exit the program
C*
C APINAM DSPLY QUSEI
C EXSR DONE
C ENDSR
C*****************************************************************
C DONE BEGSR
C*
C* Exit the program
C*
C EVAL *INLR = '1'
C RETURN
C ENDSR