MACRO 00001000
&LABEL WRTERM &UMSG,&ULEN,&EDIT=YES,&COLOR=B 00002000
LCLA &PNT,&CNT,&END 00003000
LCLC &FLG,&CLR,&LEN,&MSG 00004000
LCLB &MR,&LR,&MSD 00005000
.**** 00006000
.** LCLA'S USED TO COMPUTE LENGTH OF SELF-DEFINING MESSAGE 00007000
.** LCLC'S USED TO ASSEMBLE PLIST VALUES 00008000
.** LCLB'S CONTAIN CODE-GENERATION FLAGS 00009000
.**** 00010000
.** MAKE SURE A MESSAGE OF SOME TYPE WAS GIVEN, AND NOTE 00011000
.** IF IT'S SELF-DEFINING OR GIVEN AS A REGISTER 00012000
.**** 00013000
AIF (T'&UMSG NE 'O').UMSGOK 00014000
MNOTE 8,'LINE ADDRESS NOT SPECIFIED' 00015000
MEXIT 00016000
.* 00017000
.UMSGOK AIF ('&UMSG'(1,1) NE '''').UMSGR 00018000
&MSD SETB 1 NOTE SELF-DEFINING MSG 00019000
&MSG SETC 'DMS&SYSNDX.D' ASSEMBLE MSG-ADDRESS 00020000
AGO .UMSGZ 00021000
.* 00022000
.UMSGR AIF ('&UMSG'(1,1) NE '(').UMSGA 00023000
&MR SETB 1 NOTE MSG REGISTER-ADDRESSED 00024000
&MSG SETC '&UMSG(1)' DUMMY ASSEMBLE-VALUE 00025000
AGO .UMSGZ 00026000
.* 00027000
.UMSGA ANOP 00028000
&MSG SETC '&UMSG' MESSAGE SYMBOLIC NAME 00029000
.UMSGZ ANOP 00030000
.**** 00031000
.** GET THE VALUE OF THE MESSAGE LENGTH. COMPUTE IT, IF IT 00032000
.** WASN'T GIVEN OR IF THE MESSAGE IS SELF-DEFINING. 00033000
.**** 00034000
AIF (T'&ULEN EQ 'O').ULENO 00035000
AIF ('&ULEN'(1,1) EQ '(').ULENR 00036000
&LEN SETC '&ULEN' SELF-DEFINING LENGTH 00037000
AGO .ULENZ 00038000
.* 00039000
.ULENR ANOP 00040000
&LR SETB 1 NOTE LENGTH IN REGISTER 00041000
&LEN SETC '01' INSURE &LEN HAS VALUE 00041500
AGO .COMPL 00042000
.* 00043000
.ULENO AIF (&MSD).COMPL 00044000
MNOTE 8,'LENGTH PARAMETER NOT SPECIFIED' 00045000
MEXIT 00046000
.* 00047000
.COMPL ANOP PREPARE TO COMPUTE MSG-LENGTH 00048000
AIF (NOT &MSD).ULENZ BRANCH IF NOT SELF-DEFINING 00048500
&PNT SETA 2 FIRST-CHARACTER INDEX 00049000
&END SETA K'&UMSG-2 LAST CHARACTER INDEX 00050000
AIF (&END GT 0).COMPGO 00051000
MNOTE 8,'INVALID LINE SPECIFICATION' 00052000
MEXIT 00053000
.* 00054000
.COMPGO AIF (&PNT GT &END).COMPZ 00055000
AIF ('&UMSG'(&PNT,2) EQ '''''').QUOTE 00056000
&PNT SETA &PNT+1 00057000
AGO .COMPGO 00058000
.QUOTE ANOP 00059000
&CNT SETA &CNT+1 00060000
&PNT SETA &PNT+2 00061000
AGO .COMPGO 00062000
.COMPZ ANOP 00063000
&CNT SETA K'&UMSG-&CNT-2 00064000
&LEN SETC '&CNT' ASSEMBLE LENGTH-VALUE 00065000
.* 00066000
.ULENZ ANOP 00067000
.**** 00068000
.** EXAMINE THE EDIT PARAMETER, TRANSLATE IT TO 00069000
.** FLAG BITS FOR 'DMSCWR' TO USE. 00070000
.**** 00071000
&FLG SETC '00' 00072000
AIF ('&EDIT' EQ 'YES').UEDITZ 00073000
&FLG SETC '80' 00074000
AIF ('&EDIT' EQ 'NO').UEDITZ 00075000
&FLG SETC '90' 00076000
AIF ('&EDIT' EQ 'LONG').UEDITZ 00077000
MNOTE 4,'INVALID EDIT SPECIFICATION - YES ASSUMED' 00078000
&FLG SETC '00' 00079000
.UEDITZ ANOP 00080000
.**** 00081000
.** EXAMINE THE COLOR PARAMETER FOR 'B' OR 'R' 00082000
.**** 00083000
&CLR SETC 'B' 00084000
AIF ('&COLOR' EQ 'B').UCLRZ 00085000
AIF ('&FLG' EQ '90').UCLRERR 00086000
AIF ('&COLOR' NE 'R').UCLRERR 00087000
&CLR SETC 'R' 00088000
AGO .UCLRZ 00089000
.UCLRERR MNOTE 4,'INVALID COLOR SPECIFICATION - B ASSUMED' 00090000
.UCLRZ ANOP 00091000
.**** 00092000
.** ALIGN TO A WORD, GENERATE LABEL 00093000
.**** 00094000
CNOP 0,4 00095000
&LABEL DS 0H 00096000
.**** 00097000
.** GENERATE ADDRESS-STORE, IF NEEDED. 00098000
.**** 00099000
AIF (NOT &MR).CONT5 00100000
ST &MSG,DMS&SYSNDX.B STORE MESSAGE-ADDRESS 00101000
MVI DMS&SYSNDX.B,X'01' RESTORE FLAG 00102000
.CONT5 ANOP 00103000
.**** 00104000
.** GENERATE LENGTH-STORE, IF NEEDED 00105000
.**** 00106000
AIF (NOT &LR).CONT6 00107000
STH &ULEN(1),DMS&SYSNDX.C+2 STORE LENGTH IN PLIST 00108000
.CONT6 ANOP 00109000
.**** 00110000
.** GENERATE PLIST, BAL ON R1 AROUND IT 00111000
.**** 00112000
BAL 1,DMS&SYSNDX.E POINT R1 TO PLIST 00113000
DMS&SYSNDX.A DC CL8'TYPLIN' 00114000
DMS&SYSNDX.B DC X'01',AL3(&MSG) 00115000
DMS&SYSNDX.C DC C'&CLR',X'&FLG',AL2(&LEN) 00116000
.**** 00117000
.** GENERATE MESSAGE TEXT, IF SELF-DEFINING 00118000
.**** 00119000
AIF (NOT &MSD).CONTZ 00120000
DMS&SYSNDX.D DC CL&LEN&UMSG 00121000
.CONTZ ANOP 00122000
.**** 00123000
.** GENERATE SVC, ALIGNED ON HALFWORD 00124000
.**** 00125000
DMS&SYSNDX.E DS 0H 00126000
SVC 202 CALL CMS TO TYPE 00127000
DC AL4(*+4) 00128000
MEXIT 00129000
MEND 00130000