MACRO 00001000
&N DMSLNZ &T,&LAST,&STATV,&VAL,&STATL,&LEN 00002000
GBLA &DMSLNGA 00003000
LCLA &TCODE,&B 00004000
LCLB &S1,&LOK,&A,&L,&VR,&LR,&TB 00005000
.* THIS MACRO GENERATES A SUBSTITUTION LIST ELEMENT FOR THE DMSLN MACRO 00006000
&S1 SETB ('&N' NE '') ON IF ONLY ONE SUBSTITUTION 00007000
&TCODE SETA 5 THIS WILL BE SUBSTITUTION CODE 00008000
AIF ('&T' EQ 'HEX').HEX 00009000
AIF ('&T' EQ 'HEXA').HEXA 00010000
AIF ('&T' EQ 'DEC').DEC 00011000
AIF ('&T' EQ 'DECA').DECA 00012000
AIF ('&T' EQ 'CHAR').CHAR 00013000
AIF ('&T' EQ 'CHARA').CHARA 00014000
AIF ('&T' EQ 'HEX4A').HEX4A 00015000
AIF ('&T' EQ 'CHAR8A').CHAR8A 00016000
MNOTE 8,'DMSLNZ008E ILLEGAL ''SUB'' CODE ''&T''' 00017000
AGO .HEX4A 00018000
.HEXA ANOP 00019000
&A SETB 1 00020000
.HEX ANOP 00021000
&TCODE SETA 0 00022000
AGO .TE 00023000
.DECA ANOP 00024000
&A SETB 1 00025000
.DEC ANOP 00026000
&TCODE SETA 1 00027000
AGO .TE 00028000
.CHAR ANOP 00029000
MNOTE 4,'DMSLNZ009W WARNING -- ''CHAR'' WAS CHANGED TO ''CHARA*00030000
''' 00031000
.CHARA ANOP 00032000
&A SETB 1 ADDRESS BIT 00033000
&LOK SETB 1 LENGTH IS OK 00034000
&TCODE SETA 2 00035000
AGO .TE 00036000
.HEX4A ANOP 00037000
&A SETB 1 00038000
&LOK SETB 1 00039000
&TCODE SETA 3 00040000
AGO .TE 00041000
.CHAR8A ANOP 00042000
&A SETB 1 00043000
&LOK SETB 1 00044000
&TCODE SETA 4 00045000
AGO .TE 00046000
.TE ANOP 00047000
&L SETB (&STATL GT 0) WAS LENGTH SPECIFIED? 00048000
AIF (&LOK OR (NOT &L)).LOK LENGTH LEGAL? 00049000
MNOTE 8,'DMSLNZ010E ILLEGAL LENGTH SPECIFIED WITH ''&T'' SUB' 00050000
&L SETB 0 RESET TO IGNORE LENGTH 00051000
.LOK ANOP 00052000
&VR SETB (&STATV EQ 2) (REG) IN VALUE FIELD? 00053000
&LR SETB ((&STATL EQ 2) AND &L) (REG) IN LENGTH FIELD? 00054000
.RE ANOP 00055000
&TCODE SETA &TCODE+X'80'*&LAST+X'40'*&A+X'20'*&L CODE FOR THIS SUB 00056000
.* 00057000
.* GENERATE CODE FOR ONLY ONE SUBSTITUTION. DATA/ADDRESS VALUE GOES 00058000
.* INTO REG 0, WITH LENGTH, IF ANY, IN HIGH BYTE. 00059000
AIF (NOT &S1).NOS1 00060000
&N EQU &TCODE SUBSTITUTION CODE 00061000
AIF (&LR AND (NOT &VR)).S1LRNA 00062000
AIF (&LR AND &VR).S1LRA 00063000
.* DROP THRU IF LENGTH IS NOT IN A REGISTER. 00064000
&B SETA 1-&VR 00065000
DMSLNP &B,LA,0,&VAL 00066000
&B SETA &VR 00067000
DMSLNP &B,LR,0,&VAL 00068000
&B SETA &L 00069000
DMSLNP &B,ICM,0,B'1000',=AL1(&LEN) 00070000
MEXIT 00071000
.* 00072000
.* COME HERE IN CASE OF -ADDRESS,(REG)- 00073000
.S1LRNA ANOP 00074000
LR 0,&LEN GET LENGTH VALUE 00075000
SLL 0,24 SHIFT LENGTH INTO HIGH BYTE 00076000
LA 15,&VAL COMPUTE ADDRESS OF DATA 00077000
OR 0,15 AND PLACE INTO REG 0 00078000
MEXIT 00079000
.* 00080000
.* COME HERE IN CASE OF -(REG),(REG)- 00081000
.S1LRA ANOP 00082000
LR 15,&LEN GET LENGTH VALUE 00083000
SLL 15,24 SHIFT INTO HIGH BYTE 00084000
LR 0,&VAL GET ADDRESS 00085000
N 0,=X'00FFFFFF' ZERO OUT HIGH BYTE 00086000
OR 0,15 OR IN LENGTH 00087000
MEXIT 00088000
.NOS1 ANOP 00089000
.* 00090000
.* COME HERE TO GENERATE CODE TO INSERT INTO SUBSTITUTION LIST 00091000
.* ONE SUBSTITUTION OF MANY. 00092000
MVI &DMSLNGA.(1),&TCODE SET OPTION CODE 00093000
&DMSLNGA SETA &DMSLNGA+1 00094000
&B SETA &L*(1-&LR) 00095000
DMSLNP &B,MVI,&DMSLNGA.(1),&LEN SET LENGTH CODE 00096000
&B SETA &LR 00097000
DMSLNP &B,STC,&LEN,&DMSLNGA.(1) SET LENGTH CODE 00098000
&DMSLNGA SETA &DMSLNGA+&L INCREMENT IF LENGTH INSERTED 00099000
&TB SETB (NOT &A) 00100000
&B SETA 1-&VR 00101000
DMSLNP &B,LA,15,&VAL LOAD NUMBER/ADDRESS VALUE 00102000
&B SETA 1-&VR 00103000
DMSLNP &B,STCM,15,B'&TB.111',&DMSLNGA.(1) STORE VALUE 00104000
&B SETA &VR 00105000
DMSLNP &B,STCM,&VAL,B'&TB.111',&DMSLNGA.(1) STORE NUM/ADDR VA 00106000
&DMSLNGA SETA &DMSLNGA+3+&TB INCR BY LENGTH OF STORED VALUE 00107000
MEND 00108000