TITLE 'IEFIMASK, CONVERT BIT MASK ' 00001000 IEFIMASK CSECT , 0001 00002000 @MAINENT DS 0H 0001 00003000 USING *,@15 0001 00004000 B @PROLOG 0001 00005000 DC AL1(16) 0001 00006000 DC C'IEFIMASK 73.143' 0001 00007000 DROP @15 00008000 @PROLOG STM @14,@12,12(@13) 0001 00009000 BALR @12,0 0001 00010000 @PSTART DS 0H 0001 00011000 USING @PSTART,@12 0001 00012000 L @00,@SIZDATD 0001 00013000 GETMAIN R,LV=(0) 00014000 LR @11,@01 0001 00015000 USING @DATD,@11 0001 00016000 LM @00,@01,20(@13) 0001 00017000 MVC @PC00001(16),0(@01) 0001 00018000 * BITSLOCL=BITS; /* COPY SO THE ORIGINAL VERSION 00019000 * WILL BE PRESERVED */ 00020000 L @10,@PC00001 0011 00021000 MVC BITSLOCL(2),BITS(@10) 0011 00022000 * LISTPOS=0; 0012 00023000 SR LISTPOS,LISTPOS 0012 00024000 * DO BITPOS=1 TO NUMBITS; /* BITPOS REPRESENTS THE ORIGINAL 00025000 * POSITION OF THE BIT NOW AT 0013 00026000 * BITONE */ 00027000 LA BITPOS,1 0013 00028000 B @DE00013 0013 00029000 @DL00013 DS 0H 0014 00030000 * IF BITONE='1'B THEN 0014 00031000 TM BITONE,B'10000000' 0014 00032000 BNO @RF00014 0014 00033000 * DO; /* IF BIT IS ON SET ITS INDEX IN 00034000 * THE LIST */ 00035000 * 0015 00036000 * /***********************************************************/ 00037000 * /* */ 00038000 * /* SOME SPECIAL PROCESSING IS REQUIRED TO ACCOUNT FOR THE */ 00039000 * /* FACT THAT THE NUMBER OF COMMAS IS ONE LESS THAN THE */ 00040000 * /* NUMBER OF ELEMENTS IN THE LIST. THIS MODULE HAS SPECIAL */ 00041000 * /* PROCESSING FOR THE SETTING OF THE FIRST ELEMENT OF THE */ 00042000 * /* LIST. OTHER SOLUTIONS WERE REJECTED FOR ONE OF THE */ 00043000 * /* FOLLOWING REASONS: (1) ONE OR MORE EXTRA COMMAS WOULD BE*/ 00044000 * /* SET AFTER THE LAST ELEMENT IF NOT ALL THE BITS ARE ON. */ 00045000 * /* (2) AN EXTRA LOOP WOULD BE REQUIRED TO COUNT THE NUMBER */ 00046000 * /* OF COMMAS REQUIRED OR TO SET THE COMMAS SEPARATELY. */ 00047000 * /* */ 00048000 * /***********************************************************/ 00049000 * 0016 00050000 * IF LISTPOS=0 THEN 0016 00051000 LTR LISTPOS,LISTPOS 0016 00052000 BNZ @RF00016 0016 00053000 * CPUZERO=CONVCHAR(BITPOS);/* SET FIRST ELEMENT IN LIST */ 00054000 L @10,@PC00001+8 0017 00055000 LA @01,CONVCHAR-1(BITPOS) 0017 00056000 MVC CPUZERO(1,@10),0(@01) 0017 00057000 * ELSE 0018 00058000 * DO; /* SET ELEMENT WHICH IS NOT FIRST 00059000 * ELEMENT IN LIST (PRECEEDED BY 00060000 * A COMMA) */ 00061000 B @RC00016 0018 00062000 @RF00016 DS 0H 0019 00063000 * COMMA(LISTPOS)=COMMAC; 0019 00064000 LR @10,LISTPOS 0019 00065000 AR @10,@10 0019 00066000 L @15,@PC00001+8 0019 00067000 ST @10,@TF00001 0019 00068000 ALR @10,@15 0019 00069000 AL @10,@CF00063 0019 00070000 MVI COMMA-1(@10),C',' 0019 00071000 * ELEMENT(LISTPOS)=CONVCHAR(BITPOS); 0020 00072000 AL @15,@TF00001 0020 00073000 LA @10,CONVCHAR-1(BITPOS) 0020 00074000 MVC ELEMENT-2(1,@15),0(@10) 0020 00075000 * END; 0021 00076000 * LISTPOS=LISTPOS+1; /* INCREMENT INDEX IN OUTPUT 0022 00077000 * LIST, AFTER SETTING AN ELEMENT*/ 00078000 @RC00016 AH LISTPOS,@CH00043 0022 00079000 * END; 0023 00080000 * BITSLOCL=2*BITSLOCL; /* SHIFT LEFT ONE POSITION, SO WE 00081000 * CAN CHECK THE HIGH ORDER BIT */ 00082000 @RF00014 SR @10,@10 0024 00083000 ICM @10,3,BITSLOCL 0024 00084000 AR @10,@10 0024 00085000 STH @10,BITSLOCL 0024 00086000 * END; 0025 00087000 AH BITPOS,@CH00043 0025 00088000 @DE00013 L @10,@PC00001+4 0025 00089000 CH BITPOS,NUMBITS(,@10) 0025 00090000 BNH @DL00013 0025 00091000 * NUMLIST=LISTPOS; /* RETURN NUMBER OF ELEMENTS PUT 00092000 * IN LIST. (THIS IS ONE GREATER 00093000 * THAN THE LAST INDEX USED 0026 00094000 * BECAUSE THE COUNT MUST START 00095000 * AT 1 INSTEAD OF 0.) */ 00096000 L @10,@PC00001+12 0026 00097000 STH LISTPOS,NUMLIST(,@10) 0026 00098000 * END; 0027 00099000 @EL00001 DS 0H 0027 00100000 @EF00001 L @00,@SIZDATD 0027 00101000 LR @01,@11 0027 00102000 FREEMAIN R,LV=(0),A=(1) 00103000 @ER00001 LM @14,@12,12(@13) 0027 00104000 BR @14 0027 00105000 @DATA DS 0H 00106000 @CH00043 DC H'1' 00107000 @DATD DSECT 00108000 DS 0F 00109000 @PC00001 DS 4F 00110000 @TF00001 DS F 00111000 IEFIMASK CSECT 00112000 DS 0F 00113000 @CF00063 DC F'-1' 00114000 @DATD DSECT 00115000 DS 0D 00116000 BITSLOCL DS CL2 00117000 ORG BITSLOCL 00118000 BITONE DS BL1 00119000 @NM00002 EQU BITSLOCL+0 00120000 ORG BITSLOCL+2 00121000 IEFIMASK CSECT 00122000 DS 0F 00123000 @SIZDATD DC AL1(0) 00124000 DC AL3(@ENDDATD-@DATD) 00125000 DS 0D 00126000 CONVCHAR DC CL16'0123456789ABCDEF' 00127000 IEFIMASK CSECT 00128000 DS 0H 00129000 PATCHLOC DC (25)X'00' 00130000 @DATD DSECT 00131000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00132000 @ENDDATD EQU * 00133000 IEFIMASK CSECT 00134000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00135000 @01 EQU 01 00136000 @02 EQU 02 00137000 @03 EQU 03 00138000 @04 EQU 04 00139000 @05 EQU 05 00140000 @06 EQU 06 00141000 @07 EQU 07 00142000 @08 EQU 08 00143000 @09 EQU 09 00144000 @10 EQU 10 00145000 @11 EQU 11 00146000 @12 EQU 12 00147000 @13 EQU 13 00148000 @14 EQU 14 00149000 @15 EQU 15 00150000 LISTPOS EQU @02 00151000 BITPOS EQU @03 00152000 BITS EQU 0 00153000 NUMBITS EQU 0 00154000 LIST EQU 0 00155000 CPUZERO EQU LIST 00156000 @NM00001 EQU LIST+1 00157000 COMMA EQU @NM00001 00158000 ELEMENT EQU @NM00001+1 00159000 NUMLIST EQU 0 00160000 @ENDDATA EQU * 00161000 END IEFIMASK 00162000