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