Processing program modules contain one or more programs; each program processes one function. When a function XDE/VXDE is processed at runtime, the runtime system calls the appropriate processing program module. The module performs the operation, then returns control to the runtime system. The components of the source module RHDCEV01, which contains the processing programs for the CA ADS supplied string functions are shown below.
Processing program load modules are usually stored in the load library. The load modules for the CA ADS supplied built-in functions are named RHDCEV01, RHDCEV02, RHDCEV03, and RHDCEV09.
Components of Processing Program Module RHDCEV01
RHDCEV01 TITLE 'STRING PROCESSOR FOR RHDCEVAL' * RHDCEV01 EP=EV01EP1 06/29/90 14:04:31 *CONTAINS PTF# 90-05-1133 EXG 05/31/90 *CONTAINS PTF# 88-07-1081 JMA 02/26/90 *CONTAINS PTF# 87-06-1031 MCM 08/21/87 *CONTAINS PTF# 85-08-S004 MCM 03/31/86 * CONTAINS PTF # LEFT/RITE JUST SPA CRM 14:37:29 01/14/85 * CONTAINS PTF # 84-11-1067 CRM 13:37:25 12/14/84 SPACE 1 #MOPT CSECT=RHDCEV01,ENV=USER SPACE 3 ********************************************************************** * * * RHDCEV01 IS THE STRING PROCESSOR FOR RHDCEVAL. ALL * * EVAL STRING-HANDLING FUNCTIONS ARE CONTAINED HEREIN. * * * * THESE FUNCTIONS ARE: * * LENGTH - RETURN LENGTH OF A CHARACTER STRING * * SUBSTRING - RETURN A SUBSET OF A STRING * * INDEX - FIND POSITION OF A SUBSTRING * * VERIFY - INSURE ONE STRING CONTAINS ANOTHER * * REPLACE - TRANSLATE CHARACTERS * * CONCATENATE - SHOVE TWO OR MORE STRINGS TOGETHER * * LIKE - STRING PATTERN MATCHING * * * * UPON ENTRY, R1 MUST CONTAIN THE ADDRESS OF THE OPERATION * * VXDE, WHICH IS BACK-CHAINED TO ALL OPERAND VXDE'S. * * * * ALL STRING INPUT AND OUTPUT WILL BE VARYING-CHARACTER. * * ALL NUMERIC INPUT AND OUTPUT WILL BE HALFWORD-BINARY. * * * ********************************************************************** ┌─ EJECT │RHDCEV01 CSECT * │RHDCEV01 AMODE ANY │RHDCEV01 RMODE 24 │ USING EV01EP1,R12 PROGRAM BASE │ USING EV01EP1+4096,R10 USE SECOND BASE REGISTER │ USING WORKAREA,R11 WORKAREA BASE │ USING XDE,R8 │ USING VXDE,R7 │ SPACE 1 │ ENTRY EV01EP1 Initialization │EV01EP1 DS 0H statements ─────────────────► STM R14,R12,12(R13) SAVE REGISTERS │ LR R12,R15 SET PROGRAM BASE │ L R10,BASE SET UP SECOND BASE REGISTER │ B EV01STRT AND GO START UP │BASE DC A(EV01EP1+4096) │EV01STRT DS 0H │ LR R7,R1 GET RESULT VXDE ADDR │ L R8,VXDEXDEA AND XDE ADDR │ L R11,VXDEUWKA GET WORKAREA ADDR │ STM R7,R8,WKRESADR AND SAVE THEM │ SPACE 1 │ MVI WKERRMSG,C' ' NOW BLANK OUT └─ MVC WKERRMSG+1(L'WKERRMSG-1),WKERRMSG ERROR MSG FIELD ┌─ SPACE 1 │ SLR R2,R2 CLEAR FOR NEXT INST │ IC R2,XDEUFUNC GET FUNCTION NUMBER │ CLI XDEUFUNC,15 CK AGAINST MAX FUNCTION JMA90179 │ BH EV01NFC BIF HIGH TO ERR EXIT │ SLL R2,2 MAKE FUNCT NBR MULTIPLE OF 4 │ B EV01BTB1(R2) AND GO SELECT FUNCTION │ SPACE 1 │EV01BTB1 DS 0H │ B LENGTH FUNC 0 │ B SUBSTRNG FUNC 1 │ B INDEX FUNC 2 Branching statements ──────────────────────► B VERIFY FUNC 3 │ B TRANSLAT FUNC 4 │ B CONCATEN FUNC 5 │ B REPEAT FUNC 6 │ B EXTRACT FUNC 7 │ B REPLACE FUNC 8 │ B LEFTJUS FUNC 9 │ B RITEJUS FUNC 10 │ B INSERT FUNC 11 │ B LIKE FUNC 12 │ B GOODTRL FUNC 13 │ B TRAILZN FUNC 14 │ B ZNTRAIL FUNC 15 └─ ┌─ EJECT │EV01NFC DS 0H NO FUNCTION EXIT │ LA R15,4 SET ERROR CODE │ MVC WKERRMSG(L'ERMSG01),ERMSG01 SET ERROR MSG │ B EV01RET AND GET OUT │ SPACE 3 │EV01NVAL DS 0H *MCM86253* Final processing statements────────────────► OI VXDEFLAG,VXDEFNVL RESULT IS NON─VALUED *MCM86253* │ SPACE 3 *MCM86253* │EV01RET0 DS 0H GOOD EXIT │ SLR R15,R15 SET GOOD RETURN CODE │ SPACE 1 │EV01RET DS 0H │ L R14,12(R13) RESTORE R14 │ LM R0,R12,20(R13) RESTORE REGS 0-12 └─ BR R14 AND RETURN TO CALLER ┌─ EJECT │********************************************************************** │* ERROR MESSAGES * │********************************************************************** │ SPACE 2 │ERMSG01 DC C'UNSUPPORTED STRING FUNCTION REQUESTED' │ERMSG02 DC C'INVALID OBJECT STRING LENGTH' │ERMSG03 DC C'INVALID START VALUE' │ERMSG04 DC C'INVALID LENGTH VALUE' Error messages ────────────────────────────►ERMSG05 DC C'STRING TO BE EXTRACTED EXCEEDS OBJECT LENGTH' │ERMSG06 DC C'RESULT STRING TOO SMALL TO CONTAIN SUBSTRING' │ERMSG07 DC C'INVALID SEARCH STRING LENGTH' │ERMSG08 DC C'SEARCH STRING LENGTH EXCEEDS OBJECT STRING LENGTH' │ERMSG09 DC C'INVALID STRING LENGTH' │ERMSG10 DC C'RESULT STRING NOT LARGE ENOUGH' │ERMSG11 DC C'INVALID INSERTION VALUE' │ERMSG12 DC C'INVALID PATTERN FOR LIKE COMPARISON' │ERMSG13 DC C'ESCAPE CHARACTER LENGTH GREATER THAN 1' │ERMSG14 DC C'INVALID ESCAPE CHARACTER STRING' └─ EJECT ┌─********************************************************************** │* * │* LENGTH - STRING FUNCTION TO RETURN THE LENGTH OF * │* A VARYING-CHARACTER FIELD. * │* * │* ONLY REQUIRES ONE OPERAND, THE VARYING-CHAR FIELD. * │* THE RESULT FIELD MUST BE HALFWORD-BINARY. * │* * │********************************************************************** │ SPACE 2 │LENGTH DS 0H │ L R5,VXDESNXT GET ADDR OF OPERAND VXDE │ L R6,VXDEXDEA-VXDE(,R5) AND OPERAND XDE *MCM86253* │ BAL R14,CHKNOVAL *MCM86254* │ LTR R15,R15 *MCM86254* │ BNZ EV01NVAL *MCM86254* │ L R4,VXDEDADR-VXDE(,R5) GET ADDR OF VC FLD │ MVC WKFULL(2),0(R4) MOVE HALFWORD TO ALIGN │ LH R4,WKFULL GET LENGTH OF FIELD │ L R5,VXDEDADR GET ADDR OF RESULT FLD │ STCM R4,3,0(R5) SET ANSWER -STCM FOR BS2K*MCM86090* │ B EV01RET0 USE GOOD EXIT │ LTORG │ EJECT │********************************************************************** │* * │* SUBSTRING - STRING FUNCTION TO RETURN A SPECIFIED * │* SUBSET OF A GIVEN STRING * │* * │* THIS FUNCTION REQUIRES 3 OPERANDS - * │* 1 OBJECT STRING (VARYING-CHARACTER) * │* 2 START DISPLACEMENT (HALFWORD) * │* 3 LENGTH (OPTIONAL) (HALFWORD) * │* THE RESULT FIELD MUST BE VARYING-CHARACTER ALSO. * │* * │* THE OBJECT STRING MAY NOT BE LENGTH ZERO. * │* IF AN ERROR IS DETECTED, THE RESULT STRING LENGTH * Processing program ────────────────────────►* IS SET TO ZERO, AND AN ERROR RETURNED TO RHDCEVAL. * │* * │* REQUIREMENTS OF THE OPERANDS ARE: * │* K = OBJECT STRING LENGTH, I = START DISPLACEMENT, * │* J = LENGTH * │* * │* 0 LE J LE K 1 LE I LE K * │* I+J-1 LE K * │* * │* IF J IS NOT GIVEN, J = K-I+1 * │* * │* THE OMISSION OF J (3RD OPERAND - LENGTH) IS INDICATED * │* BY A NON-VALUED XDE. * │* * │********************************************************************** │ SPACE 3 │SUBSTRNG DS 0H │* NOTE : SUBSTRING OP3 IS AN OPTIONAL PARAMETER. 4* │* MUST DIFFERENTIATE BETWEEN OP3 OMITTED 4* │* AND OP3 SPECIFIED BUT NON-VALUED. 4* │ L R5,VXDESNXT BACK UP TO OP3 VXDE │ L R6,VXDEXDEA-VXDE(,R5) AND XDE │ TM VXDEFLAG-VXDE(R5),VXDEFNVL IF OP3 VXDE NON-VA *MCM86260* │ BO EV01NVAL THEN SO IS RESULT *MCM86260* │ TM XDEFLAG-XDE(R6),XDEFNVL IF OP3 XDE NON-VAL *MCM86260* │ BO SUBS0010 THEN CHK FURTHER *MCM86260* │ B SUBS0040 CONTINUE WITH OP2 *MCM86260* │ SPACE 1 *MCM86260* │SUBS0010 DS 0H *MCM86260* │ CLC XDEDATAD-XDE(,R6),=X'80000000' OP3 OMIITED?*MCM86260* │ BE SUBS0040 YES - CONTINUE *MCM86260* │ B EV01NVAL NO - OP3 NON-VALUED *MCM86260* │ SPACE 1 *MCM86260* │SUBS0040 DS 0H *MCM86260* │ STM R5,R6,WKOP3SV SAVE OP3 XDE,VXDE *MCM86260* │ L R5,VXDESNXT-VXDE(,R5) BACK UP TO OP2 VXDE │ L R6,VXDEXDEA-VXDE(,R5) AND XDE │ BAL R14,CHKNOVAL │ *MCM86254* │ LTR R15,R15 │ *MCM86254* │ BNZ EV01NVAL │ *MCM86254* │ STM R5,R6,WKOP2SV SAVE OP2 XDE,VXDE │ *MCM86253* │ SPACE 1 │ L R5,VXDESNXT-VXDE(,R5) BACK UP TO OP1 VXDE │ L R6,VXDEXDEA-VXDE(,R5) AND XDE │ BAL R14,CHKNOVAL │ *MCM86254* │ LTR R15,R15 │ *MCM86254* │ BNZ EV01NVAL │ *MCM86254* │ STM R5,R6,WKOP1SV SAVE OP1 XDE,VXDE │ *MCM86253* │ EJECT Processing program (cont'd)────────────────►******* OBJECT STRING LENGTH MUST BE GREATER THAN ZERO ********** │ L R4,VXDEDADR-VXDE(,R5) GET OP1 DATA ADDR │ MVC WKFULL,0(R4) GET HALFWORD LNG FROM VC FLD │ LH R4,WKFULL PUT INTO A REGISTER │ LTR R4,R4 CK IT FOR ZERO │ BP SUBS0050 GTR ZERO IS OKAY - BRANCH │ SPACE 1 │ MVC WKERRMSG(L'ERMSG02),ERMSG02 SET ERROR MSG │ B SUBS0950 USE ERROR EXIT │ SPACE 1 │SUBS005 DS 0H R4 NOW CONTAINS LENGTH OF OBJECT STRING │******* CHECK STARTING DISPLACEMENT ************* │ LM R7,R8,WKOP2SV GET VXDE/XDE ADDRS, OP2 │ L R3,VXDEDADR GET OP2 DATA ADDR │ MVC WKFULL,0(R3) GET HALFWORD DATA FIELD │ LH R3,WKFULL GET THE VALUE │ LTR R3,R3 CK FOR ZERO OR LESS │ BP SUBS0080 IF POSITIVE, BRANCH │ SPACE 1 │SUBS0075 DS 0H INVALID START FIELD │ MVC WKERRMSG(L'ERMSG03),ERMSG03 SET ERROR MSG │ B SUBS0950 USE ERROR EXIT │ SPACE 1 │SUBS0080 DS 0H │ CR R3,R4 COMPARE TO MAX START │ BH SUBS0075 ERR IF START GTR LENGTH │ SPACE 1 Processing program (cont'd)────────────────►******** R3 NOW HAS STARTING DISPLACEMENT RELATIVE TO ONE ******** │******** NOW GET EXTRACT LENGTH, WHICH MIGHT HAVE BEEN OMITTED *** │ LM R7,R8,WKOP3SV GET VXDE/XDE ADDRS │ TM XDEFLAG,XDEFNVL CK FOR PARMETER OMITTED │ BZ SUBS0090 BIF IT IS PRESENT │ SPACE 1 │SUBS0085 DS 0H │ LR R2,R4 ELSE SET │ SR R2,R3 EXTRACT LNG TO │ LA R2,1(,R2) TOTAL-START+1 │ B SUBS0120 AND BYPASS NEXT EDIT │ SPACE 1 │SUBS0090 DS 0H │ L R2,VXDEDADR GET DATA ADDR, OP3 │ MVC WKFULL,0(R2) GET HALFWORD LENGTH │ LH R2,WKFULL PUT INTO A REGISTER │ LTR R2,R2 CK FOR ZERO OR LESS │ BZ SUBS0085 ZERO - TAKE DEFAULT ABOVE │ BP SUBS0100 POSITIVE IS OKAY - BRANCH │ SPACE 1 │SUBS0095 DS 0H INVALID LENGTH FIELD │ MVC WKERRMSG(L'ERMSG04),ERMSG04 SET ERROR MESSAGE │ B SUBS0950 USE ERROR EXIT │ SPACE 1 │SUBS0100 DS 0H │ CR R2,R4 MUST BE LESS THAN OBJECT-LNG │ BH SUBS0095 IF NOT, ERROR │ EJECT │SUBS0120 DS 0H │******** INSURE START + EXTRACT LNG DOESN'T EXCEED OBJECT STRING │LNG** │ LR R1,R3 GET START DISPLACEMENT │ AR R1,R2 ADD EXTRACT LENGTH │ BCTR R1,0 DECREMENT BY ONE │ CR R1,R4 COMPARE TO TOTAL AVAIL │ BNH SUBS0140 EQ OR LOW IS OKAY - BRANCH │ SPACE 1 │ MVC WKERRMSG(L'ERMSG05),ERMSG05 SET ERROR MESSAGE │ B SUBS0950 USE ERROR EXIT │ SPACE 1 │SUBS0140 DS 0H │******** R4 HAS TOTAL STRING LENGTH OF OBJECT ******** │******** R3 HAS DISPLACEMENT TO START OF EXTRACT ******** │******** R2 HAS LENGTH TO EXTRACT ******** │******** MUST NOW TEST RESULT FIELD SIZE TO INSURE IT CAN ******** │******** CONTAIN THE EXTRACTED SUBSTRING ******** │ SPACE 1 │ LM R7,R8,WKRESADR GET VXDE/XDE ADDRS OF RESULT │ LH R5,XDEDATLN GET MAX RESULT SIZE │ CR R2,R5 EXTRACT LNG CAN'T EXCEED TARG LEN │ BNH SUBS0150 BRANCH IF OKAY │ SPACE 1 │ MVC WKERRMSG(L'ERMSG06),ERMSG06 SET ERROR MESSAGE │ B SUBS0950 USE ERROR EXIT │ SPACE 1 │SUBS0150 DS 0H NOW READY TO EXTRACT THE SUBSTRING │ L R5,VXDEDADR GET RESULT FLD ADDR │ STH R2,WKFULL ALIGN THE SUBSTRING LENGTH │ MVC 0(2,R5),WKFULL PUT LENGTH FIELD INTO RESULT (VC) │ LA R5,2(,R5) AND ADVANCE RESULT FIELD POINTER Processing program (cont'd)────────────────► SPACE 1 │ L R6,WKOP1SV GET VXDE ADDR OBJECT STRING │ L R6,VXDEDADR-VXDE(,R6) GET DATA ADDR │ LA R6,2(,R6) BUMP PAST LENGTH FIELD │ BCTR R3,0 MAKE START RELATIVE TO ZERO │ AR R6,R3 CALC ADDR OF SUBSTRING │ SPACE 1 │ LR R4,R2 GET LENGTH IN RIGHT REGISTER │ BAL R14,MOVEIT MOVE THE SUBSTRING │ B SUBS0980 AND USE SUCCESS EXIT │ EJECT │SUBS0950 DS 0H ERROR EXIT │ LM R7,R8,WKRESADR GET RESULT VXDE/XDE ADDRS │ L R6,VXDEDADR GET DATA FIELD ADDR │ XC 0(2,R6),0(R6) SET LNG TO NULL │ LA R15,4 SET ERROR RETURN CODE │ B EV01RET AND USE ERROR EXIT │ SPACE 2 │SUBS0980 DS 0H SUCCESS EXIT │ B EV01RET0 USE GOOD EXIT │ LTORG │ EJECT └─ ┌─ │********************************************************************* │* │* │* │* WORKAREA — PASSED BY CALLER │* │* │* │********************************************************************* │* │ SPACE 2 │WORKAREA DSECT │WKERRMSG DS CL80 │WKFULL DS F │ ORG WKFULL │WKHALF DS H *THIS CAN'T BE USED WITH WKFULL !! │WKFLAG1 DS CL1 WORK FLAG1 │WKF1ASTR EQU X'80' GOT ME AN ARBITRARY STRING WORKING │WKF1OP3O EQU X'40' ESCAPE CHAR IN REQUEST │WKF1OP3S EQU X'20' ESCAPE CHAR ENCOUNTERED │WKF1FX10 EQU X'10' X'10' BIT FOR FLAG1 │WKF1PON EQU X'08' PROCESSING % OPERATOR │WKF1PSET EQU X'04' 1ST CHAR IN % STR MATCHED IN OBJ Work area storage definition────────────────►WKF1FX02 EQU X'02' X'02' BIT FOR FLAG1 │WKF1FX01 EQU X'01' X'01' BIT FOR FLAG1 │WKFLAG2 DS CL1 WORK FLAG2 │WKRESADR DS 2F VXDE/XDE ADDRS, RESULT FIELD │WKRSLADR DS F RESULT ADDR │WKRSLLNG DS F RESULT LENGTH │WKOP1SV DS 2F VXDE/XDE ADDRS, OPERAND 1 FIELD │WKOP2SV DS 2F VXDE/XDE ADDRS, OPERAND 2 FIELD │ ORG WKOP2SV │WKPATCNT DS F STARTING COUNT FOR % PATTERN │WKPATADR DS F STARTING POSITION FOR % PATTERN │WKOP3SV DS 2F VXDE/XDE ADDRS, OPERAND 3 FIELD │ ORG WKOP3SV │WKOBJCNT DS F STARTING COUNT FOR % PATTERN │WKOBJADR DS F STARTING POSITION FOR % PATTERN │WKOP1LNG DS F OPERAND 1 LENGTH │WKOP2LNG DS F OPERAND 2 LENGTH │WKOP3LNG DS F OPERAND 3 LENGTH │WKOP1ADR DS F OPERAND 1 ADDRESS │WKOP2ADR DS F OPERAND 2 ADDRESS │WKOP3ADR DS F OPERAND 3 ADDRESS │ SPACE 2 │WKLENGTH EQU *-WORKAREA LENGTH OF WORKAREA │ EJECT │ COPY #XDEDS │ END EV01EP1 └─
|
Copyright © 2014 CA.
All rights reserved.
|
|