ibm:vm370-lib:macro:dmsln.macro_src
Table of Contents
DMSLN Source
References
- Fixes Applied : 0
- This Source Date : Saturday, December 9, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMSLN.MACRO.txt
- 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
ibm/vm370-lib/macro/dmsln.macro_src.txt · Last modified: 2023/08/06 13:38 by Site Administrator