Title : General purpose IMS Secondary Index Maintenance Routine Submitter : Ray Folwell Rolls Royce plc PO Box 31 Derby DE2 8BJ Phone : 0332-249814 Release Submitter Details - Y Text :- This routine has been kindly supplied by Ray as a followup to the talk he gave at a meeting of the UK GUIDE IMS Working Group at Manchester in September 1992. For further documentation see his foils that were distributed with the minutes of that meeting. This entry contains 3 files A1105.DOC - a write-up for the routine and Macro. A1105.ASM - the assembler source for the routine. IXMCODE.MAC - the MACRO code. There are a few Rolls-Royce specifics that you may want to change. The name A1105 is to RR standards, you may want to change it to something more meaningful or to meet your own standards. The macro generates a constant of '£A1105' in the CSECT extension and the routine checks for this. You can change this to any distinctive 6-byte string. The reference to 'SYS2.MACLIB' in the write-up should be changed to the library that you use for the macro, unless you put it on IMS.MACLIB. You will need to replace the call to the 'REGISTER' macro with your favourite macro to generate Register Equates. I had some problem with the translation of '£' (pound sign) when downloading to a PC. Anyway, the character in front of the various labels in the MACRO (£NDX etc) should be a £. A1105.DOC :- A1105 - GENERAL PURPOSE IMS SECONDARY INDEX MAINTENANCE ROUTINE. ________________________________________________________________ A1105 has been written to avoid the requirement for writing specific secondary index maintenance routines for each IMS sparse secondary index. It is a general purpose routine with the actual rules for whether or not an index entry is required being contained in a table held part of the DBD. A1105 is invoked by specifying 'EXTRTN=A1105' on the XDFLD statement in the DBD. For each secondary index for which A1105 is defined as the 'EXTRTN' a set of 'IXMCODE' statements must be included in the DBD to define the rules for index maintenance. The IXMCODE statements must immediately follow the DBDGEN statements and follow the normal syntax rules for DBD statements. For each secondary index there must be an 'IXMCODE BEGIN' statement , one or more 'IXMCODE' condition statements that define the rules to be used and finally an 'IXMCODE END' statement. SYNTAX. _______ IXMCODE BEGIN statement. IXMCODE BEGIN,NAME=fldname This identifies the start of a set of IMXCODE statements for a secondary index. 'fldname' must match the 'NAME=' operand on the corresponding 'XDFLD' statement for this secondary index and is used to identify the particular index to which these rules apply. IXMCODE test statements. These specify a condition to be tested and an action to be performed if that condition is satisfied. That action may be either to immediately return with or without causing the Index to be created or to continue with a later test in the set. If the condition is not satisfied the next sequential test is performed. If the end of the set of tests is reached an index entry will be created. label IXMCODE COND=condition,INDEX=YES³NO ,NEXT=label 'condition' specifies the condition to be tested for this statement. 88257IC10051 It is of the form (position,operand,constant) where position is either a number giving the position of a field in the index source segment or of the form '(position,I)' giving the position of a field in the indexing segment. In both cases the first byte of the segment is number 1. The length of the field is given by the length of the constant. 'operand' is either 'EQ','NE','LT','LE',GT' or 'GE'. 'constant' is any valid assembler literal constant eg C'TEST', CL8' ' or XL4'00' etc. Note that the comparison is always done as a character comparison, whatever the format specified. If 'condition' is omitted then it is assumed to always be satisfied. INDEX=YES specifies that the index segment is to be created without any further tests being performed. INDEX=NO specifies that the index segment is to be suppressed without any further tests being performed. NEXT=label specifies that the tests are to continue from the later IXMCODE statement with that label in position 1. Note that only forward 'branches' are allowed. IXMCODE END statement. IXMCODE END This identifies the end of a set of statements for a secondary index. EXAMPLE. ________ The follow set of statements would cause a secondary index entry to be created only if bytes 4-7 of the source segment were 'TEST' or byte 12 of the index segment was not hexadecimal zero. IXMCODE BEGIN,NAME=XPART IXMCODE COND=(4,EQ,C'TEST'),INDEX=YES IXMCODE COND=((12,I),NE,X'00'),INDEX=YES IXMCODE INDEX=NO IXMCODE END 88257IC10051 -2- JCL requirements. _________________ The JCL for the DBDGEN must include 'SYS2.MACLIB' as part of the SYSLIB concatenation for the assembler step. A1105.ASM :- TITLE 'A1105 - IMS INDEX MAINTENANCE ROUTINE' 00010000 * THIS ROUTINE SUPPORTS ALL SPARSE SECONDARY INDICES 00020000 * DEFINED USING THE IXMCODE MACRO AS PART OF THE DBD. 00030012 * THAT MACRO CREATES AN EXTENSION TO THE PARAMETER CSECT 00031006 * IN THE DBD WHICH DEFINES THE TESTS TO BE PERFORMED. 00032006 * THE FIRST 8 BYTES OF THE EXTENSION ARE OF THE FORM:- 00032112 * OFFSET TO END OF THE TESTS (2 BYTES) 00032206 * CONSTANT '£A1105' (6 BYTES) 00032306 * EACH TEST HAS AN EIGHT BYTE ENTRY OF THE FOLLOWING 00033010 * FORMAT ASSEMBLED AS PART OF THE EXTENSION:- 00034011 * CLC =CONST,OFFSET(R4) 6 BYTES 00035011 * R3 IS USED AS A BASE FOR THE CONSTANTS WHICH 00036006 * ARE ASSEMBLED AFTER THE TESTS 00037006 * IF THE FIELD IS IN THE INDEX SEGMENT R2 IS 00038006 * USED AS A BASE INSTEAD OF R4 00038111 * 00038206 * CC MASK FOR THE TEST TO BE SATISFIED ( 4 BITS ) 00038306 * 00038406 * ACTION TO TAKE IF TEST IS SATISFIED ( 12 BITS ) 00038506 * 0 - RETURN WITH RC=0 (CREATE INDEX ENTRY) 00038607 * 4 - RETURN WITH RC=4 (SUPPRESS INDEX) 00038706 * >4 - OFFSET OF NEXT TEST TO PERFORM 00038806 * 00038906 * IF A TEST IS NOT SATISFIED THE NEXT SEQUENTIAL 00039008 * TEST IS PERFORMED. WHEN THE END OF THE TESTS IS REACHED 00039108 * THE ROUTINE ENDS WITH RC=0 AS IT DOES IF THE FORMAT OF 00039208 * THE CSECT EXTENSION IS INCORRECT. 00039308 * 00039407 * VERSION DATE REF COMMENT 00039906 * 1 01/09/88 GVN/FOL FIRST GO RR06277 00040013 EJECT 00210000 * REGISTERS ON ENTRY 00220000 * 00230000 * R1 PST ADDRESS 00240000 * R2 POINTER TO PROPOSED OR EXISTING INDEX SEGMENT 00250000 * R3 POINTER TO PARAMETER CSECT ASSEMBLED IN DBD 00260000 * R4 POINTER TO INDEX SOURCE SEGMENT 00270000 * R13 SAVE AREA IN PREFORMATTED IMS CHAIN 00280000 * R14 RETURN ADDRESS 00290000 * R15 EP ADDRESS 00300000 * 00310000 * INTERNAL REGISTER USE 00320000 * 00330000 * R5 OFFSET IN PARM CSECT 00370001 * R6 ADDRESS OF CLC ENTRY IN PARM CSECT 00370106 * R12 BASE 00371001 * R13 SAVE AREA 00380000 * 00390000 * REGISTERS ON EXIT 00400000 * 00410000 * R1-R14 MUST BE RESTORED 00420000 * R15=0 CREATE INDEXING SEGMENT 00430000 * R15=4 SUPPRESS INDEXING SEGMENT 00440000 * 00450000 * NOTES 00460000 * 00470000 * THE INDEXING SEGMENT AND THE INDEX SOURCE SEGMENT ARE 00500000 * AVAILABLE. 00510000 * 00530000 * THE SAVE AREA PASSED IS IN THE IMS PREFORMATTED CHAIN. 00540010 * YOU ARE ENTITLED TO SAVE REGS AND THEN STEP 00550010 * DOWN TO ONE FOR YOUR OWN USE IF REQUIRED. 00560000 * 00570000 TITLE 'ENTRY AND HOUSEKEEPING' 00580000 A1105 CSECT 00590000 SAVE (14,12),,A1105_RR06277 00600013 USING A1105,R12 SET BASE 00610003 USING PARM,R3 POINT TO INPUT PARAMETER 00620000 USING PARM2,R6 BASE FOR TABLE 00621001 USING IMSAVE,R13 00630000 LR R12,R15 LOAD BASE REG 00640000 L R13,LOWER STEP DOWN SAVE AREA CHAIN 00650000 MVC SR6(24),IDXSEG LEAVE FOOT PRINT 00660000 TITLE 'CHECK CORRECT PARM FORMAT' 00670000 LA R5,TABLE-PARM MIN LENGTH OF CSECT 00680001 CH R5,CSLEN LONG ENOUGH ? 00690001 BH RETIDX NO SO RETURN TO IMS 00700001 CLC IDENT,=C'£A1105' CORRECT ID ? 00710001 BNE RETIDX NO 00720001 SPACE 00721009 LA R8,X'F0' INITIALISE MASKS 00722009 LA R9,X'FFF' 00723009 TITLE 'PROCESS THE COMPARE TABLE IN THE PARM CSECT' 00730001 TABLOOP DS 0H 00740001 CH R5,LTOFF END OF TABLE ? 00750001 BNL RETIDX YES SO RETURN WITH INDEXING 00760001 LA R6,0(R5,R3) ADDRESS OF TABLE ENTRY 00770001 CLI COMPARE,X'D5' IS IT CLC INSTRUCTION ? 00780001 BNE RETIDX NO SO SOMETHING WRONG 00790001 IC R7,ACTION PICK UP BC MASK 00800002 NR R7,R8 GET CORRECT BITS 00820002 EX 0,COMPARE EXECUTE COMPARE INSTRUCTION 00830002 EX R7,BRCOND AND BC INSTRUCTION 00840002 * COMPARE NOT SATISFIED 00850002 LA R5,8(,R5) NEXT TABLE ENTRY 00860002 B TABLOOP 00870002 SPACE 00880002 COMPOK DS 0H TARGET OF EXECUTE BC 00881002 LH R7,ACTION GET ACTION 00881102 NR R7,R9 REMOVE MASK 00881309 BZ RETIDX ZERO SO INDEX REQUIRED 00881402 CH R7,=H'4' 4 ? 00881502 BE RETNIDX SUPPRESS INDEX 00881602 * MUST BE 'BRANCH IN TABLE' 00881702 CR R7,R5 ONLY ALLOW BRANCH FORWARD 00881802 BNH RETIDX 00881904 LR R5,R7 POINT AT NEW ENTRY 00882004 B TABLOOP 00882104 SPACE 00882202 BRCOND BC 0,COMPOK EXECUTED BC 00883002 TITLE 'RETURN TO IMS' 00890000 RETIDX EQU * REQUEST INDEXING 00900000 LA R15,IDXREQ 00910000 B RETIMS 00911000 RETNIDX EQU * SUPRESS INDEXING 00912000 LA R15,NOIDX 00913000 RETIMS L R13,HIGHER STEP BACK UP SAVE AREA CHAIN 00920000 RETURN (14,12),,RC=(15) RETURN WITH R15 SET 00930000 SPACE 4 00940005 LTORG 00950005 TITLE 'INDEX PARAMETER DATA' 01150000 PARM DSECT 01160000 IDXSEG DS CL8 NAME OF INDEX SOURCE SEGMENT 01170000 XFLDNAME DS CL8 XFLDNAME FROM INDEXED DBD 01180000 RTNAME DS CL8 INDEX MAINT ROUTINE NAME 01190000 EPADDR DS A ROUTINE EP 01200000 CSLEN DS H PARAMETER CSECT LENGTH 01210000 RSVD DS H RESERVED 01220000 USERDATA DS 0C USERDATA FROM DBD IF ANY 01230000 LTOFF DS H OFFSET TO LITERALS IN TABLE 01240000 IDENT DS CL6 IDENTIFIER '£A1105' 01250000 TABLE DS 0CL8 TABLE OF COMPARES AND ACTIONS 01260000 PARM2 DSECT , TABLE ENTRY 01270000 COMPARE DS CL6 CLC INSTRUCTION 01271000 ACTION DS H MASK AND ACTION 01272000 TITLE 'IMS PREFORMATTED SAVE AREA' 01280000 IMSAVE DSECT 01290000 WD1 DS F DO NOT ALTER ANYTHING IN THE FIRST 01300000 HIGHER DS F THREE WORDS OF THIS SAVE AREA 01310000 LOWER DS F IT BELONGS TO IMS 01320000 SR14 DS F SAVE AREA FOR USE IF REQUIRED 01330000 SR15 DS F 01340000 SR0 DS F 01350000 SR1 DS F 01360000 SR2 DS F 01370000 SR3 DS F 01380000 SR4 DS F 01390000 SR5 DS F 01400000 SR6 DS F 01410000 SR7 DS F 01420000 SR8 DS F 01430000 SR9 DS F 01440000 SR10 DS F 01450000 SR11 DS F 01460000 SR12 DS F 01470000 ENDSAVE DS 0F 01480000 TITLE 'VARIOUS EQUATES' 01490000 REGISTER 01500005 NOIDX EQU 4 01650000 IDXREQ EQU 0 01660000 END 01670000 IXMCODE.MAC :- MACRO 00010000 &LABEL IXMCODE &TYPE,&NAME=,&COND=,&INDEX=,&NEXT= 00020005 .* GLOBAL SET SYMBOLS 00030000 GBLA &SL 00040000 GBLA &SD(300) 00050000 GBLB &STAT 00060000 GBLC &DBN 00070000 GBLC &SS(300) 00080000 GBLC &FN1(1000) 00090000 GBLA &E 00100000 LCLA &X,&Y 00110000 AIF ('&TYPE' EQ 'END').END 00120000 AIF ('&TYPE' EQ 'BEGIN').BEGIN 00130002 AIF ('&TYPE' EQ '' OR '&TYPE' EQ 'TEST').TEST 00140002 MNOTE 8,'''&TYPE'' IS INVALID' 00150000 MEXIT 00160000 .BEGIN ANOP 00170000 AIF (&STAT).ERR2 BEGIN OUT OF ORDER 00180000 &STAT SETB 1 00190000 .* SEARCH GLOBAL TABLES FOR THIS KEY 00200013 .* BASED ON CODE IN IMS MACRO 'SOURSEG' 00201013 AIF ('&NAME' EQ '').ERR1 00210000 &Y SETA 1 00220000 .LOOP1 AIF (&Y GT &SL).ERR1 NO MORE ENTRIES 00230000 AIF (&SD(&Y)/65536/16384 NE 1).NEXT1 TARGET XDFLD ENTRY 00240000 &X SETA &SD(&Y)/65536-16384 XDFLD STMT NO 00250000 AIF ('&FN1(&X)' EQ '&NAME').FOUND1 00260000 .NEXT1 ANOP 00270000 &Y SETA &Y+1 00280000 AGO .LOOP1 00290000 .ERR1 MNOTE 8,'''&NAME'' NOT VALID XDLDF NAME' 00300000 MEXIT 00310000 .FOUND1 ANOP 00320000 .* FIND THE LAST ENTRY FOR THIS XDFLD STMT 00330013 .* THIS HAS THE EXTRTN NAME AND CSECT NUMBER 00340013 &E SETA &Y 00350000 .LOOP2 ANOP 00360000 &E SETA &E+1 00370000 AIF (&SD(&E)/65536-16384 EQ &X).LOOP2 SAME STMT 00380000 &E SETA &E-1 00390000 AIF ((&SD(&E)-&SD(&E)/65536*65536)/256 GE 64).G1 00400000 MNOTE 8,'EXTRTN NOT SPECIFIED FOR XDFLD' 00410000 MEXIT 00420000 .G1 ANOP 00430000 .* GENERATE CSECT NAME 00440000 £NDX&E CSECT 00450000 * 00451014 * SECONDARY INDEX MAINTAINENCE ROUTINE TABLE EXTENSION 00452016 * 00453014 ORG £NDX&E+28 RESET CSECT LENGTH 00460016 DC AL2(£NDXE&E-£NDX&E,0) CSECT LENGTH,RESVD 00470012 DC AL2(£NDXL&E-£NDX&E) OFFSET TO END OF TESTS 00480012 DC CL6'£A1105' IDENTIFIER 00490012 USING £NDX&E,3 00500008 MEXIT 00510000 .END ANOP 00520000 AIF (NOT &STAT).ERR2 00530000 &STAT SETB 0 00540000 .* GENERATE CSECT NAME 00550000 £NDX&E CSECT 00560000 £NDXL&E DS 0H END OF TESTS FOR THIS INDEX 00570015 LTORG 00580005 £NDXE&E DS 0D 00590000 DROP 3 00600008 &DBN CSECT 00610000 MEXIT 00620000 .TEST ANOP 00630002 AIF (NOT &STAT).ERR2 00640002 AIF (T'&COND NE 'O').T1 00650006 &LABEL CLC 0(1,4),0(4) DUMMY COMPARE 00660007 &MASK SETA 15 00670006 AGO .T10 00680006 .T1 AIF (N'&COND NE 3).T9 00690006 &R1 SETA 4 00700006 AIF (N'&COND(1) EQ 1).T2 00710006 AIF (N'&COND(1) NE 2).T9 00720006 AIF ('&COND(1,2)' NE 'I').T9 00730007 &R1 SETA 2 00740006 .T2 AIF (T'&COND(1,1) NE 'N').T9 00750006 AIF (&COND(1,1) EQ 0).T9 00760006 &OFFSET SETA &COND(1,1)-1 00770006 AIF ('&COND(2)' NE 'EQ').T3 00780007 &MASK SETA 8 00790007 AGO .T8 00800007 .T3 AIF ('&COND(2)' NE 'NE').T4 00810007 &MASK SETA 7 00820007 AGO .T8 00830010 .T4 AIF ('&COND(2)' NE 'GT').T5 00840010 &MASK SETA 4 00850007 AGO .T8 00860007 .T5 AIF ('&COND(2)' NE 'LT').T6 00870007 &MASK SETA 2 00880007 AGO .T8 00890007 .T6 AIF ('&COND(2)' NE 'GE').T7 00900007 &MASK SETA 13 00910007 AGO .T8 00920007 .T7 AIF ('&COND(2)' NE 'LE').T9 00930007 &MASK SETA 11 00940007 .T8 ANOP 00950007 &LABEL CLC =&COND(3),&OFFSET.(&R1) 00960015 .T10 ANOP 00970006 AIF (T'&INDEX NE 'O' OR T'&NEXT NE 'O').T20 00980009 MNOTE 8,'''INDEX'' OR ''NEXT'' MUST BE SPECIFIED' 00990009 MEXIT 01000009 .T20 AIF (T'&INDEX EQ 'O').T30 01010009 AIF (T'&NEXT EQ 'O').T21 01020009 MNOTE 8,'ONLY ONE OF ''INDEX'' AND ''NEXT'' MAY BE SPECIFIED' 01030009 MEXIT 01040009 .T21 AIF ('&INDEX' NE 'YES').T22 01050009 &RC SETA 0 01060009 AGO .T24 01070009 .T22 AIF ('&INDEX' NE 'NO').T29 01080009 &RC SETA 4 01090009 .T24 ANOP 01100009 DC AL2(4096*&MASK+&RC) MASK AND RETURN CODE 01110009 MEXIT 01120009 .T29 MNOTE 8,'INVALID INDEX VALUE ''&INDEX''' 01130009 MEXIT 01140009 .T30 AIF (D'&NEXT).T39 01150009 DC AL2(4096*&MASK+&NEXT-£NDX&E) MASK AND NEXT COMP 01160012 MEXIT 01170004 .T39 MNOTE 8,'INVALID LABEL ''&NEXT''' 01180009 MEXIT 01190009 .T9 MNOTE 8,'INVALID CONDITION SPECIFICATION' 01200006 MEXIT 01210006 .ERR2 MNOTE 8,'IXMCODE USED OUT OF ORDER' 01220006 MEND 01230000