*********************************************************************** 00020000 * * 00040002 * MODULE NAME= IEFVGK * 00090002 * DESCRIPTIVE NAME= GET KEY/POSITIONAL UTILITY ROUTINE * 00140002 * COPYRIGHT= NONE * 00190002 * STATUS= REL. 037 PTF @ZA27750* 00240003 * * 00290002 * FUNCTION/OPERATION THIS UTILITY ROUTINE GETS THE NEXT KEYWORD * 00340002 * OR POSITIONAL PARAMETER IN THE INTERNAL TEXT BUFFER FOR * 00390002 * THE CALLING PROCESSOR ROUTINE (IEFVDA, IEFVEA OR IEFVJA). * 00440002 * IT ALSO HANDLES THE GETTING OF CHAINED BUFFERS FROM DISK * 00490002 * WHEN A LONG JCL STATEMENT CAUSES OVERFLOW. * 00540002 * * 00590002 * NOTES * 00640002 * CHARACTER CODE DEPENDENCIES= EBCDIC * 00690002 * DEPENDENCIES= NONE * 00740002 * RESTRICTIONS= NONE * 00790002 * REGISTER CONVENTIONS= IWASL (NAME OF AREA IN IWA WHERE * 00800002 * REGISTER CONVENTIONS ARE FOUND) * 00810002 * PATCH-LABEL= N/A * 00812002 * * 00814002 * MODULE TYPE= PROCEDURE * 00816002 * PROCESSOR= ASSEMBLER * 00818002 * MODULE SIZE= N/A * 00818402 * ATTRIBUTES= READ ONLY / REENTRANT / PAGED LPA * 00818802 * * 00819202 * ENTRY POINT= IEFVGK * 00819602 * PURPOSE= MAIN ENTRY * 00819702 * LINKAGE= NONE * 00819802 * INPUT DATA= 1. PTR. TO JOB,EXEC,OR DD WORK AREA * 00819902 * 2. BASE REGISTER OF JOB,EXEC,OR DD WORK AREA * 00826602 * 3. PTR TO IWA * 00828602 * 4. PTR TO THE CURRENT REGISTER SAVE AREA * 00830602 * 5. RETURN ADDRESS * 00832602 * REGISTERS SAVED= NONE * 00833002 * REGISTER CONTENTS DURING PROCESSING= * 00833102 * R6= CURRENT KEY POINTER * 00833202 * R7= CURRENT NUMBER POINTER * 00839902 * R8= CURRENT LENGTH * 00841902 * R9= CURRENT LENGTH POINTER * 00843902 * R10 - RF= SAME AS INPUT * 00845902 * REGISTERS RESTORED= NONE * 00846302 * * 00846402 * EXIT - NORMAL= KEYWORD PROCESSING ROUTINE * 00846502 * CONDITIONS= WHEN KEY HAS BEEN RECEIVED AND VALIDATED * 00851202 * OUTPUT DATA= 1. R2= LENGTH OF CURRENT POSITIONAL PARAMETER * 00853202 * 2. R3= PTR TO LENGTH BYTE OF CURRENT PARAMETER * 00855202 * 3. R4= PTR TO PARAMETER DESCRIPTOR TABLE * 00855602 * RETURN CODES= NONE * 00855702 * EXIT - ERROR= THE CLEANUP PORTION OF THE PROCESSING ROUTINE * 00855802 * CONDITIONS= WHEN ERROR HAS BEEN DETECTED * 00857202 * OUTPUT DATA= ERROR MESSAGE * 00859202 * RETURN CODES= NONE * 00859602 * * 00859702 * EXTERNAL REFERENCES= * 00859802 * ROUTINES= IEFVHQ * 00859902 * DATA AREAS= IWA,LWA * 00863202 * CONTROL BLOCKS= QMPA - U,M * 00865202 * KEY: C=CREATE, U=USED, M=MODIFY, D=DELETE * 00865602 * TABLES= IEFVKEYS ( TABLE OF VALID KEYS ) * 00866002 * MACROS= NONE * 00866402 * ENQUEUE RESOURCES= NONE * 00866502 * * 00866602 * MESSAGES= IEF640I- EXCESSIVE NBR OF POSITIONAL SUBPARAMETERS * 00866702 * IEF641I- IMPROPER SUBPARAMETER LIST * 00867802 * * 00869802 * CHANGE LEVEL = Z40MPTH,Z40RPSM,ZA27750 @ZA27750* 00869903 * * 00870503 * * 00871903 *********************************************************************** 00874202 * * 00876202 IEFTXTFT 00891402 TITLE 'IEFVGK - KEYS' 00895702 IEFVKEYS 00900000 TITLE 'IEFVGK - IEFQMNGR' 00920000 IEFQMNGR 00940000 TITLE 'IEFVGK - IWA' 00960000 IEFCOMWA 00980002 IEFVMIWA 00990002 TITLE 'IEFVGK - AWA' 01000000 GKWORK DSECT 01020000 IEFVMAWA 01040000 TITLE 'IEFVGK - CSECT' 01060000 * * 01080000 *********************************************************************** 01100000 * * 01120000 * EQUATES - ERROR MESSAGE NUMBERS. * 01140000 * * 01160000 *********************************************************************** 01180000 * * 01200000 GKER1 EQU X'28' IEF640I EXCESSIVE NBR OF POS. SUBPARAMETERS. 01220000 GKER2 EQU X'29' IEF641I IMPROPER SUBPARAMETER LIST. 01240000 *****************************************************************Y02668 01242002 * *Y02668 01244002 * GENERAL EQUATES *Y02668 01246002 * *Y02668 01248002 *****************************************************************Y02668 01250002 SPACE 2 Y02668 01252002 EJECT 01260000 IEFVGK CSECT 01280000 *********************************************************************** 01300000 * * 01320000 * INPUT TO THIS ROUTINE: * 01340000 * * 01360000 * RA POINTS TO JOB, EXEC OR DD WORK AREA. * 01380000 * RB IS BASE REGISTER OF JOB, EXEC OR DD ROUTINE. * 01400000 * RC POINTS TO INTERPRETER WORK AREA. * 01420000 * RD POINTS TO CURRENT REGISTER SAVE AREA. * 01440000 * RE RETURN ADDRESS. * 01460000 * * 01480000 *********************************************************************** 01500000 * 01520000 SPACE 2 01540000 STM R5,R1,12(RD) SAVE ALL REGISTERS BUT R2,R3 & R4. 01560000 SPACE 01580000 BALR RB,0 REGISTER 11 IS THE BASE 01600000 USING *,RB OF THIS ROUTINE. 01620000 *****************************************************************Y02668 01622002 * MODULE TRACE CODE - FOR TESTING. Y02668 01624002 L RF,TRACEV LOAD TRACE RTNE ADDR. Y02668 01626002 BALR RE,RF ENTER MOD ID IN TRACE RECORD. Y02668 01628002 TRACEV DC V(TRACE) TRACE RTNE ADDR. Y02668 01630002 DC C'VGK ' MOD ID USED BY TRACE. Y02668 01632002 * TRACE RETURNS HERE. Y02668 01634002 *****************************************************************Y02668 01636002 GKBASE EQU * 01640000 B GKB1A Y02668 01690002 MODID BRANCH=NO Y02668 01700002 * DC C'SPLT' FUNCTION ID AND Y02668 01710003 * DC C'05' LEVEL # (TEXT PFX FIX). Y02668 01712003 * DC C'REL37' FUNCTION ID AND @Z40MPTH 01714003 * DC C'02' LEV # (RACF) @Z40RPSM 01716003 DC C'03' LEV # (MERGE SU4,10,16 CODE TO 037 PTF) @ZA27750 01718003 GKB1A DS 0H Y02668 01730002 USING GKWORK,RA LOCAL WORK AREA (GOTTEN IN CALLING 01780000 * PROGRAM). 01800000 LM R2,R5,TNUM GET CURRENT PARAM/SUBPARAM STATUS. 01820000 CLR R2,R3 PARAMETERS TO PROCESS. 01840000 BNE GKB2 YES. GO TO GET POSITIONAL. 01860000 CLR R4,R5 SUBPARAMETER TO PROCESS. 01880000 BNE GKB2 YES. GO TO GET POSITIONAL. 01900000 EJECT 01920000 *********************************************************************** 01940000 ** ** 01960000 ** GET KEY PROCESSING. ** 01980000 ** ** 02000000 *********************************************************************** 02020000 GKB4 DS 0H 02040000 LM R6,R9,TKEYPX R6 = CURRENT KEY POINTER. 02060000 * R7 = CURRENT NUMBER POINTER. 02080000 * R8 = CURRENT LENGTH. 02100000 * R9 = CURRENT LENGTH POINTER. 02120000 LTR R6,R6 CURRENT KEY POINTER = ZERO. 02140000 BE GKB5A YES. INITIAL ENTRY TO GET KEY. 02160000 LR R6,R9 TAKE TLENP. 02180000 AR R6,R8 ADD TLEN. 02200000 LA R6,1(R6,0) PLUS ONE. R6 NOW POINTS TO NEXT KEY. 02220000 GKF3 DS 0H 02360000 CLI 0(R6),ENDK END KEY 19378 02366017 BE AOGK5 YES,GO TO CLEANUP Y02668 02372002 BAL RE,GKL1 GO PROCESS DEFAULT TABLE Y02668 02376002 LA R7,1(R6,0) R7 NOW POINTS TO NEW NBR. 02380000 LR R9,R7 SET R9 (TLENP) TO BE INCREMENTED 02400000 * BY GET POS. 02420000 L R4,TBRANCH BRANCH TABLE ADDRESS TO R4. 02440000 SR R5,R5 02460000 IC R5,0(R6) THIS KEY TO R5. 02480000 STC R5,MSGKEY STORE KEY IN IWA FOR POSS ERROR MSG. 02500000 SR R1,R1 02520000 IC R1,TBASE COMPUTE TABLE ENTRY ADDRESS FROM BASE 02540000 SR R1,R5 KEY AND CURRENT KEY. 02560000 MH R1,GK06 02580000 LA R1,0(R1,R4) R1 NOW POINTS AT TABLE ENTRY. 02600000 CLC 0(1,R7),0(R1) TOO MANY PARAMETERS FOR THIS KEY. 02620000 BH GKG5 YES. GO TO SET ERROR MSG. 02640000 XC TNUM(16),TNUM ZERO STATUS TABLE. 02660000 MVC TNUM+3(1),0(R7) MOVE NBR OF PARAMS TO TABLE. 02680000 SR R8,R8 SET LENGTH SLOT TO ZERO. 02700000 STM R6,R9,TKEYPX STORE UPDATED STATUS OF KEY,NUM & LEN 02720000 LH R9,2(R1) BRANCH RETURN RELATIVE ADDRESS TO R9. 02740000 L R8,36(RD) JOB,EXEC OR DD BASE TO R8. 02760000 LA R9,0(R9,R8) ABSOLUTE BRANCH RTN ADDR TO R9. 02780000 ST R9,48(RD) STORE INTO R14 RETURN SLOT. 02800000 LH R9,4(R1) PDT RELATIVE ADDRESS TO R9. 02820000 LA R9,0(R9,R8) PDT ADDRESS TO R9. 02840000 ST R9,TPDTSAVE SAVE TO PICK UP ON EXIT. 02860000 MVC TSUBPARM(1),1(R1) SAVE SUBPARM CHECK FIELD FOR GET POS. 02880000 CLI TNUM+3,X'00' DOES NBR PARAMS EQUAL ZERO. 02900000 BE GKJ2A YES. GO TO EXIT. 02920000 B GKB2 GO TO GET POS. 02940000 * 02960000 * INITIALIZE WORK AREA. 02980000 * 03000000 GKB5A DS 0H 03020000 L R6,TEXTBUFP GET POINTER TO TEXT AND Y02668 03040002 USING TEXT,R6 ADDRESSABILITY FOR TEXT PREFIXY02668 03041002 TM STRINDCS,PROCSTR Q. PROC STMT TEXT STRING Y02668 03042002 BO AOGK2 YES, PROCESS AS EXEC STMT Y02668 03042602 TM STRINDCS,JOBSTR Q. JOB STMT TEXT STRING Y02668 03043202 BZ AOGK1 NO, CHECK IF EXEC STMT Y02668 03043802 LA R6,STRJPFXL(R6) INCRE BY JOB PFX LTH Y02668 03044402 B AOGK4 EXIT TO STORE JOB KEY PTR Y02668 03045002 AOGK1 DS 0H Y02668 03046002 TM STRINDCS,EXECSTR Q. EXEC STMT TEXT STRING Y02668 03049002 BZ AOGK3 NO, ASSUME DD STMT TXT STRING Y02668 03050002 AOGK2 DS 0H Y02668 03051002 LA R6,STREPFXL(R6) INCRE PTR BY EXEC/PROC PFX LTHY02668 03052002 B AOGK4 GO TO STORE PTR Y02668 03053002 AOGK3 DS 0H Y02668 03054002 LA R6,STRDPFXL(R6) INCRE PTR BY DD PREFIX LENGTH Y02668 03055002 AOGK4 DS 0H Y02668 03056002 ST R6,TBEGPX SAVE POINTER. Y02668 03070002 MVC TBASE(1),0(R6) MOVE BASE KEY TO LWA. Y02668 03100002 B GKF3 GO TO PROCESS KEY. 03140000 SPACE 03160000 AOGK5 DS 0H Y02668 03180002 OI AOSW1,AOENDKSW SET END KEY SW TO INDICATE Y02668*03183002 TEXT STRING PROCESSED TO END. Y02668 03186002 XC MSGKEY,MSGKEY TELL VGM NO SECONDARY MSG YM00393 03192002 B GKE4 GET READY TO EXIT Y02668 03198002 GKG5 DS 0H Y02668 03207002 MVI MSGSEC,GKER1 ERROR:'TOO MANY PARMS' Y02668 03216002 LA R6,1(R6) POINT BEYOND KEY IN ERROR Y02668 03225002 GKE4 DS 0H Y02668 03234002 MVC 48(4,RD),TCLEANUP MOVE CLEANUP ADDR TO R14 SLOT Y02668 03243002 B GKK2 GO TO EXIT. 03260000 EJECT 03280000 *********************************************************************** 03300000 ** ** 03320000 ** GET POSITIONAL PROCESSING. ** 03340000 ** ** 03360000 *********************************************************************** 03380000 SPACE 03400000 GKB2 DS 0H 03420000 LM R2,R5,TNUM 03440000 * R2 = TNUM 03460000 * R3 = TCT 03480000 * R4 = TNUM1 03500000 * R5 = TCT1 03520000 SPACE 03540000 LM R8,R9,TLEN 03560000 * R8 = TLEN 03580000 * R9 = TLENPX 03600000 SPACE 03620000 CLR R4,R5 SUBPARAMETERS TO PROCESS. 03640000 BNE GKB1 YES. GO TO INCREMENT TCT1. 03660000 LA R3,1(R3,0) NO. PROCESSING PARAMETER. INCR. TCT. 03680000 B GKD1 GO TO INCREMENT TO NEXT LENGTH. 03700000 SPACE 03720000 GKE2 DS 0H 03740000 SR R8,R8 03760000 IC R8,0(R9) PUT CURRENT LENGTH INTO R8. 03780000 LR R7,R8 TLEN OR N' TO R7. 03800000 SRL R7,7 03820000 LTR R7,R7 IS THERE A HIGH ORDER ONE. 03840000 BNE GKE1 YES. SUBPARAMETER. GO TO SET UP 03860000 SPACE 03880000 GKH2 DS 0H 03900000 SPACE 2 04000000 * S A V E S T A T U S A N D R E T U R N O N R E G 1 4. 04020000 GKJ2 DS 0H 04040000 STM R8,R9,TLEN STORE LENGTH AND LENGTH POINTER. 04060000 STM R2,R5,TNUM STORE PARAM/SUBPARAM STATUS. 04080000 GKJ2A DS 0H 04100000 LM R2,R4,TLEN R2 = LENGTH. 04120000 * R3 = LENGTH POINTER. 04140000 * R4 = PDT POINTER. 04160000 GKK2 DS 0H 04180000 LM R5,R1,12(RD) RESTORE REGISTERS. 04200000 BR RE RETURN. 04220000 SPACE 2 04240000 GKB1 DS 0H 04260000 LA R5,1(R5,0) INCREMENT TCT1. 04280000 GKD1 DS 0H 04300000 AR R9,R8 ADD OLD LENGTH. 04320000 LA R9,1(R9,0) POINT AT NEXT LENGTH SLOT. 04340000 B GKE2 04360000 SPACE 04380000 GKE1 DS 0H 04400000 LR R4,R8 PICK UP NBR SUBPARAMS. 04420000 N R4,GKPATRN2 TURN OFF HIGH ORDER BIT. 04440000 LA R5,1 SET TCT1 TO ONE. 04460000 LA R9,1(R9,0) INCREMENT POINTER TO LENGTH. 04480000 IC R8,0(R9) PUT CURRENT LENGTH IN R8. 04500000 CLI TSUBPARM,X'FF' IF SUBPARAMETERS ARE ALLOWED IN AABA 04504016 BE GKH2 THE FIRST 8 PARAMETERS, ALLOW AABA 04508016 * THEM ANYWHERE. AABA 04512016 SPACE 04516016 SPACE 04520000 SR R6,R6 * THIS SEQUENCE CHECKS TO SEE 04540000 IC R6,TSUBPARM * IF A SUBPARAMETER IS OK IN 04560000 LH R7,GKPATRN1 * THIS POSITION OF THE PARAM 04580000 SRL R7,0(R3) * FIELD. R3 IS THE NUMBER OF THE 04600000 NR R7,R6 * CURRENT PARAM UNDER THIS KEY. 04620000 BC 4,GKH2 SUBPARAMETER IS OK. CONTINUE. 04640000 MVI MSGSEC,GKER2 ERROR. SET ERROR CODE. SUBPARM ERROR. 04660000 B GKE4 GO TO GET CLEANUP ADDRESS. 04680000 EJECT 04700000 *********************************************************************** 04720002 * * 05241202 * DEFAULT TABLE PROCESSING ROUTINE * 05241802 * * 05242402 *********************************************************************** 05243002 SPACE 05243602 * R6= PTR TO KEY Y02668 05244202 GKL1 DS 0H Y02668 05244802 LA R3,GKDFLT GET DEFAULT TABLE ADDRESS Y02668 05245402 LA R4,GKTLTH GET LENGTH OF TABLE Y02668 05246002 GKL2 DS 0H Y02668 05246602 CLC 0(1,R3),0(R6) COMPARE KEYS Y02668 05247202 BE GKL3 YES, GO SET BIT IN IWA Y02668 05247802 LA R3,1(R3) NO, INDEX INTO TABLE Y02668 05248402 BCT R4,GKL2 LOOP BACK UNTIL END OF TABLE Y02668 05249002 * KEYWORD IS NOT IN DEFAULT TABLE. YM00368 05249102 NI AOSW2,255-AODFLTKW CLEAR SW, IF ON FROM THE YM00368*05249202 PREVIOUS KEYWORD. YM00368 05249302 BR RE RETURN TO CALLER Y02668 05249602 GKL3 DS 0H Y02668 05250202 OI AOSW2,AODFLTKW SET BIT INDICATING DEFAULT Y02668 05250802 BR RE RETURN TO CALLER Y02668 05251402 EJECT 05252002 * TABLE OF KEYWORDS FOR WHICH DEFAULTS ARE SUPPLIED. Y02668 05252602 GKDFLT DS 0H Y02668 05253002 DC AL1(HOLDK) HOLD Y02668 05253402 DC AL1(FREEK) FREE Y02668 05253802 DC AL1(COPIESK) COPIES Y02668 05254202 DC AL1(DYNMPEK) DYNAMNBR. Y02668 05254602 DC AL1(DYNMEEK) DYNAMNBR= Y02668 05255002 DC AL1(PRFMPEK) PERFORM. - EXEC STMT Y02668 05255402 DC AL1(PRFMEEK) PERFORM= - EXEC STMT Y02668 05255802 DC AL1(PRFMJK) PERFORM - JOB STMT Y02668 05256202 GKTLTH EQU *-GKDFLT TABLE LENGTH Y02668 05257402 *********************************************************************** 05260000 * * 05280000 * CONSTANTS * 05300000 * * 05320000 *********************************************************************** 05340000 GK06 DC H'6' 05360000 GKPATRN1 DS 0H CHECK HIGH ORDER ONE PATTERN. 05380000 DC XL2'0100' 05400000 GKPATRN2 DS 0F TURN OFF HIGH ORDER ONE PATTERN. 05420000 DC XL4'0000007F' 05440000 PATCH DC 25F'0' **********PATCH SPACE*********Y02668 05450002 END 05460000