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