MACRO 00001000
&NM DMSLN &MF=I, I|L|(E,ADDR)|(E,(REG)) *00002000
&DMSHDR=YES, YES (DMSERR) OR NO (LINEDIT) *00003000
&NUM=*-*, NUM | (REG) *00004000
&NUMA=*-*, ADDR | (REG) *00005000
&LET=*, LETTER | (REG) *00006000
&LETA=*-*, ADDR | (REG) *00007000
&CSECT=*, * | NAME *00008000
&TEXT=, 'MESSAGE-TEXT' *00009000
&TEXTA=*-*, ADDR | (REG) *00010000
&COMP=YES, YES | NO *00011000
&DOT=YES, YES | NO *00012000
&SUB=, (TYPE,VALUE,...) *00013000
&MAXSUBS=0, NUMBER *00014000
&DISP=ERRMSG, ERRMSG|TYPE|SIO|NONE|PRINT|CPCOMM *00015000
&BUFFA=*-*, ADDR | (REG) *00016000
&DIE=NO, YES | NO *00017000
&HALT=NO, YES | NO (SAME AS DIE) *00018000
&RENT=YES, YES | NO *00019000
&TYPCALL=SVC SVC | BALR | SVC202 | NONE 00020000
.* CALLED BY DMSERR AND LINEDIT MACROS TO DO ALL THE WORK. 00021000
GBLA &DMSLNGA FOR INTER-MACRO COMMUNICATION 00022000
LCLA &$DPV,&FLAG1,&FLAG2,&NSUBS,&I 00023000
LCLA &B 00024000
LCLA &LFL,<X,&LHD,&LBF,&LSB 00025000
LCLB &TB 00026000
LCLB &$MFI,&$MFL,&$MFE,&$HD,&$MFES 00027000
LCLB &$NM,&$NMA,&$NMR,&$NMAR 00028000
LCLB &$LT,&$LTA,&$LTR,&$LTAR 00029000
LCLB &$TX,&$TXA,&$TXAR,&$CM,&$DT 00030000
LCLB &$SB1,&$SBN,&$BFA,&$BFAR 00031000
LCLB &$DI,&$TPS,&$TPB,&$TP2,&$TPN,&GENR,&$RN 00032000
LCLC &S,&$CS 00033000
&NSUBS SETA N'&SUB 00034000
&NSUBS SETA N'&SUB/2 00035000
AIF (&MAXSUBS LT &NSUBS).NSOK 00036000
&NSUBS SETA &MAXSUBS GET MAX(NSUBS,MAXSUBS) 00037000
.NSOK ANOP 00038000
&$MFI SETB ('&MF' EQ 'I') 00039000
&$MFL SETB ('&MF' EQ 'L') 00040000
&$MFE SETB ('&MF(1)' EQ 'E') 00041000
&$MFES SETB (&$MFE AND '&MF(2)' EQ '''SYS''') 00042000
&B SETA &$MFI+&$MFL+&$MFE 00043000
DMSLNC 1,MF,&B 00044000
AIF (&$MFL).MFL 00045000
DMSLNY &DMSHDR,DMSHDR 00046000
&$HD SETB ('&DMSHDR' EQ 'YES') 00047000
&$NM SETB (('&NUM' NE '*-*') AND &$HD) 00048000
&$NMA SETB (('&NUMA' NE '*-*') AND &$HD) 00049000
&$NMR SETB (('&NUM'(1,1) EQ '(') AND &$HD) 00050000
&$NMAR SETB (('&NUMA'(1,1) EQ '(') AND &$HD) 00051000
&B SETA &$NM+&$NMA 00052000
DMSLNC &$HD,NUM/NUMA,&B 00053000
&$LT SETB (('&LET' NE '*') AND &$HD) 00054000
&$LTA SETB (('&LETA' NE '*-*') AND &$HD) 00055000
&$LTR SETB (('&LET'(1,1) EQ '(') AND &$HD) 00056000
&$LTAR SETB (('&LETA'(1,1) EQ '(') AND &$HD) 00057100
&B SETA &$LT+&$LTA 00058000
DMSLNC &$HD,LET/LETA,&B 00059000
&$TX SETB ('&TEXT' NE '') 00060000
&$TXA SETB ('&TEXTA' NE '*-*') 00061000
&$TXAR SETB ('&TEXTA'(1,1) EQ '(') 00062000
&B SETA &$TX+&$TXA 00063000
DMSLNC 1,TEXT/TEXTA,&B 00064000
DMSLNY &COMP,COMP 00065000
&$CM SETB ('&COMP' EQ 'YES') 00066000
DMSLNY &DOT,DOT 00067000
&$DT SETB ('&DOT' EQ 'YES') 00068000
&$SB1 SETB (N'&SUB EQ 2) 00069000
&$SBN SETB (N'&SUB GT 2) 00070000
DMSLND &DISP 00071000
&$DPV SETA &DMSLNGA SET CODE FOR 'DISP' VALUE 00072000
&$BFA SETB ('&BUFFA' NE '*-*') 00073000
&$BFAR SETB ('&BUFFA'(1,1) EQ '(') 00074000
DMSLNY &DIE,DIE 00075000
DMSLNY &HALT,HALT 00076000
&$DI SETB ('&DIE' EQ 'YES' OR '&HALT' EQ 'YES') 00077000
DMSLNY &RENT,RENT 00078000
&$RN SETB ('&RENT' EQ 'YES') 00079000
&$TPS SETB ('&TYPCALL' EQ 'SVC') 00080000
&$TPB SETB ('&TYPCALL' EQ 'BALR') 00081000
&$TP2 SETB ('&TYPCALL' EQ 'SVC202') 00082000
&$TPN SETB ('&TYPCALL' EQ 'NONE') 00083000
&B SETA &$TPS+&$TPB+&$TP2+&$TPN 00084000
DMSLNC 1,TYPCALL,&B 00085000
&FLAG1 SETA X'80'*((&$MFE+&$TXA+1)/2) 00086000
&FLAG1 SETA &FLAG1+X'40'*&$HD+X'20'*&$BFA+X'10'*&$SB1+X'08'*&$SBN 00087000
&FLAG2 SETA X'80'*&$CM+X'40'*&$DT+X'20'*&$DI+&$DPV 00088000
.* 00089000
.* DETERMINE THE LOCATION OF EACH ITEM IN THE PLIST. 00090000
&LFL SETA 8*&$TP2 BEGINNING OF PLIST 00091000
<X SETA &LFL+2 LOCATION OF TEXT ADDRESS 00092000
&LHD SETA <X+3*((&$MFE+&$TXA+1)/2) LOCATION OF HEADER INFO 00093000
&LBF SETA &LHD+6*&$HD LOCATION OF 'BUFFA' ADDRESS 00094000
&LSB SETA &LBF+3*&$BFA LOCATION OF SUB LIST 00095000
&S SETC '&SYSNDX' FOR EASIER SUBSTITUTION LATER 00097000
AIF ('&NM' EQ '').NONM 00098000
&NM DS 0H 00099000
.NONM ANOP 00100000
.* 00101000
.* DETERMINE THREE CHARACTER CSECT NAME. 00102000
.* IF LINEDIT CALL, IGNORE THIS ROUTINE. @VA01360 00102100
AIF ('&DMSHDR' EQ 'NO').CSE @VA01360 00102200
&$CS SETC '&CSECT' 00103000
AIF ('&CSECT' NE '*').CSE 00104000
&$CS SETC '&SYSECT'(1,3) FIRST THREE CHARS OF &SYSECT 00105000
AIF ('&$CS' NE 'DMS').CSE BUT DON'T JUST USE 'DMS' 00106000
&$CS SETC '&SYSECT'(4,3) NEXT THREE CHARS OF &SYSECT 00107000
.CSE ANOP 00108000
.* 00109000
.* FOR STANDARD FORM (MF=I) WE GENERATE THE IN-LINE PLIST. 00110000
AIF (NOT &$MFI).NOPL 00111000
DMSLNP &$TP2,CNOP,0,4 00112000
BAL 1,DMSA&S 00113000
DMSLNP &$TP2,DC,CL8'DMSERR' 00114000
DC AL1(&FLAG1,&FLAG2) FLAG BYTES 00115000
&B SETA 1-&$TX 00116000
DMSLNP &B,DC,AL3(&TEXTA) TEXT ADDRESS 00117000
&B SETA &$HD 00118000
DMSLNP &B,DC,AL2(&NUM),CL1'&LET',CL3'&$CS' HEADER 00119000
&B SETA &$BFA 00120000
DMSLNP &B,DC,AL3(&BUFFA) BUFFER ADDRESS 00121000
&B SETA &$SB1 00122000
DMSLNP &B,DC,AL1(DMSC&S) SINGLE SUBSTITUTION CODE 00123000
&B SETA &$SBN 00124000
DMSLNP &B,DC,(&NSUBS)XL5'00' SPACE FOR SUB LIST 00125000
.NOPL ANOP 00126000
.* 00127000
.* FOR EXECUTE, LOAD ADDRESS OF PARAMETER LIST. 00128000
AIF (NOT &$MFE).NOES 00129000
DMSLNP &$MFES,USING,NUCON,0 00130000
DMSLNP &$MFES,L,1,ADMSERL 00131000
&TB SETB ('&MF(2)'(1,1) NE '(') 00132000
&B SETA &TB*(1-&$MFES) 00133000
DMSLNP &B,LA,1,&MF(2) 00134000
&TB SETB (NOT(&TB OR ('&MF(2)' EQ '(1)'))) 00135000
&B SETA &TB 00136000
DMSLNP &B,LR,1,&MF(2) 00137000
&B SETA &$TX 00138000
DMSLNP &B,BAL,15,DMSA&S 00139000
.NOES ANOP 00140000
.* 00141000
.* GENERATE IN-LINE TEXT STRING. 00142000
AIF (NOT &$TX).NOTX 00143000
DMST&S DC AL1(DMSL&S) LENGTH OF MESSAGE TEXT 00144000
&I SETA 1 00145000
.TXLOOP ANOP 00146000
DC C&TEXT(&I) 00147000
&I SETA &I+1 00148000
AIF (&I LE N'&TEXT).TXLOOP 00149000
DMSL&S EQU *-DMST&S-1 TEXT LENGTH 00150000
.NOTX ANOP 00151000
DMSA&S DS 0H 00152000
.* GENERATE FIRST GROUP OF EXECUTE FORM SUBSTITUTIONS (NO REGISTERS 00153000
.* SPECIFIED) 00154000
AIF (NOT &$MFE).NOET 00155000
DMSLNP &$TP2,MVC,0(8,1),=CL8'DMSERR' 00156000
MVI &LFL.(1),&FLAG1 SET FIRST FLAG BYTE 00157000
MVI &LFL+1(1),&FLAG2 SET SECOND FLAG BYTE 00158000
&B SETA &$TXA*(1-&$TXAR) 00159000
DMSLNP &B,LA,15,&TEXTA SET TEXT ADDRESS 00160000
&B SETA &$TX+&$TXA*(1-&$TXAR) 00161000
DMSLNP &B,STCM,15,B'0111',<X.(1) 00162000
&B SETA &$NM*(1-&$NMR) 00163000
DMSLNP &B,MVC,&LHD.(2,1),=AL2(&NUM) 00164000
&B SETA &$LT*(1-&$LTR) 00165000
DMSLNP &B,MVI,&LHD+2(1),C'&LET' SET MESSAGE LETTER 00166000
&B SETA &$HD 00167000
DMSLNP &B,MVC,&LHD+3(3,1),=CL3'&$CS' SET CSECT NAME 00168000
&B SETA &$BFA*(1-&$BFAR) 00169000
DMSLNP &B,LA,15,&BUFFA SET BUFFER ADDRESS 00170000
&B SETA &$BFA*(1-&$BFAR) 00171000
DMSLNP &B,STCM,15,B'0111',&LBF.(1) 00172000
&B SETA &$SB1 00173000
DMSLNP &B,MVI,&LSB.(1),DMSC&S 00174000
.NOET ANOP 00175000
.* 00176000
.* THE FOLLOWING GROUP OF SUBSTITUTIONS WILL BE GENERATED FOR 00177000
.* THE EXECUTE FORM, OR FOR THE STANDARD FORM WHEN NON-RE-ENTRANT 00178000
.* CODE IS TO BE GENERATED. 00179000
AIF (&$NMA OR &$NMR OR &$LTA OR &$LTR).NORENT 00180000
AIF (&$BFAR OR &$TXAR OR &$SBN).NORENT 00181000
AGO .RENT 00182000
.NORENT ANOP 00183000
&GENR SETB 1 00184000
AIF (&$MFE OR NOT &$RN).RENT NO WARNING IF EXECUTE FORM 00185000
MNOTE 4,'DMSLN005W NON-RE-ENTRANT CODE WILL BE GENERATED' 00186000
.RENT ANOP 00187000
AIF (NOT &GENR).NOST 00188000
&B SETA &$NMA*(1-&$NMAR) 00189000
DMSLNP &B,MVC,&LHD.(2,1),&NUMA 00190000
&B SETA &$NMR 00191000
DMSLNP &B,STCM,&NUM(1),B'0011',&LHD.(1) 00192000
&B SETA &$NMAR 00193000
DMSLNP &B,MVC,&LHD.(2,1),0(&NUMA(1)) 00194000
&B SETA &$LTA*(1-&$LTAR) 00195000
DMSLNP &B,MVC,&LHD+2(1,1),&LETA 00196000
&B SETA &$LTR 00197000
DMSLNP &B,STC,&LET(1),&LHD+2(1) 00198000
&B SETA &$LTAR 00199000
DMSLNP &B,MVC,&LHD+2(1,1),0(&LETA(1)) 00200000
&B SETA &$TXAR 00201000
DMSLNP &B,STCM,&TEXTA(1),B'0111',<X.(1) 00202000
&B SETA &$BFAR 00203000
DMSLNP &B,STCM,&BUFFA(1),B'0111',&LBF.(1) 00204000
.NOST ANOP 00205000
.* 00206000
.* GENERATE CODE FOR ONE SUBSTITUTION 00207000
AIF (NOT &$SB1).NOSB1 00208000
DMSC&S DMSLNU &SUB(1),&SUB(2),1 00209000
.NOSB1 ANOP 00210000
AIF (NOT &$SBN).SBE 00211000
&I SETA 0-1 00212000
&DMSLNGA SETA &LSB LOCATION OF FIRST SUB 00213000
.SBL ANOP 00214000
&I SETA &I+2 POINT TO NEXT SUB PAIR 00215000
AIF (&I GT N'&SUB).SBE 00216000
&TB SETB (&I+1 GE N'&SUB) SET IF THIS IS THE LAST SUB 00217000
DMSLNU &SUB(&I),&SUB(&I+1),&TB 00218000
AGO .SBL 00219000
.SBE ANOP 00220000
.* 00221000
.* GENERATE THE CALL TO DMSERR 00222000
DMSLNP &$TP2,SVC,202 00223000
DMSLNP &$TP2,DC,AL4(*+4) 00224000
DMSLNP &$TPS,SVC,203 00225000
DMSLNP &$TPS,DC,H'-6' 00226000
&B SETA &$TPB 00227000
DMSLNP &B,L,15,=V(DMSERR) 00228000
&B SETA &$TPB 00229000
DMSLNP &B,BALR,14,15 00230000
MEXIT 00231000
.* 00232000
.* GENERATE LIST FORM EXPANSION 00233000
.MFL ANOP 00234000
&I SETA 8+14+5*&NSUBS MAX LENGTH OF PLIST 00235000
&NM DS &I.X 00236000
MEND 00237000