MACRO 00001000 DMSERT &CSECT 00002000 PUSH PRINT 00002200 AIF ('&SYSPARM' NE 'SUP').ACC01 00002400 PRINT OFF,NOGEN 00002600 .ACC01 ANOP 00002800 AIF (NOT('&CSECT' EQ 'CSECT' OR '&CSECT' EQ 'TEST')).D 00003000 ENTRY DMSERT 00004000 DMSERT DS 0D 00005000 AIF ('&CSECT' EQ 'CSECT').C 00006000 ERDSECT EQU * 00007000 AGO .C 00008000 .D ANOP 00009000 ERDSECT DSECT 00010000 .C ANOP 00011000 SPACE 00012000 * WORK AREA FOR DMSERR ERROR HANDLING ROUTINE. 00013000 SPACE 00014000 ERT1 DS D DOUBLE-WORD WORKSPACE 00015000 ERT2 DS 2D TWO DOUBLE-WORDS WORKSPACE 00016000 SPACE 00017000 * SAVE AREA 00018000 ERSAVE DS 16F 00019000 ERPAS13 DS 18F PASS THIS SAVE AREA IN REG 13 *00020000 TO BALR'ED-TO ROUTINES 00021000 SPACE 00022000 * RECONSTRUCTED PLIST AREA 00023000 ERPF1 DS B FIRST FLAG BYTE 00024000 ERF1TX EQU X'80' TEXT ADDRESS IN PLIST 00025000 ERF1HD EQU X'40' HEADER IN PLIST 00026000 ERF1BF EQU X'20' BUFFER ADDRESS IN PLIST 00027000 ERF1SB1 EQU X'10' ONE SUBSTITUTION 00028000 ERF1SBN EQU X'08' MULTIPLE SUBSTITUTIONS (> 1) 00029000 SPACE 00030000 ERPF2 DS B SECOND FLAG BYTE 00031000 ERF2CM EQU X'80' BLANK COMPRESSION WANTED 00032000 ERF2DT EQU X'40' DOT AT END OF LINE WANTED 00033000 ERF2DI EQU X'20' 'DIE = YES' WANTED 00034000 * LAST THREE BITS INDICATE 'DISP' FIELD 00035000 ERF2ER EQU 0 ERRMSG 00036000 ERF2TY EQU 1 TYPE 00037000 ERF2SI EQU 2 SIO 00038000 ERF2NO EQU 3 NONE 00039000 ERF2PR EQU 4 PRINT 00040000 ERF2CP EQU 5 CPCOMM 00041000 SPACE 00042000 ERPTXA DS A TEXT ADDRESS 00043000 ERPHDR DS 0CL6 ERROR MESSAGE HEADER 00044000 ERPNUM DS H MESSAGE NUMBER 00045000 ERPLET DS C MESSAGE LETTER 00046000 ERPCS DS CL3 CSECT NAME 00047000 ERPBFA DS A BUFFER ADDRESS (FOR 'BUFFA') 00048000 SPACE 2 00049000 * FIELDS FOR SUBSTITUTIONS 00050000 ERPSBA DS A POINTER TO FIRST (NEXT) GROUP OF*00051000 SUB PARAMS IN ORIGINAL PLIST 00052000 ERSBD DS A DATA ADDR/VALUE OR CURRENT SUB 00053000 SPACE 00054000 ERSBF DS B SUB FLAG BYTE FOR CURRENT SUB 00055000 ERSFLST EQU X'80' THE LAST SUBSTITUTION PARAM 00056000 ERSFA EQU X'40' 'A'-TYPE OPTION 00057000 ERSFL EQU X'20' LENGTH SPECIFIED 00058000 * LAST THREE BITS GIVE OPTION TYPE 00059000 ERSFH EQU 0 HEX OR HEXA 00060000 ERSFD EQU 1 DEC OR DECA 00061000 ERSFC EQU 2 CHARA 00062000 ERSFH4 EQU 3 HEX4A 00063000 ERSFC8 EQU 4 CHAR8A 00064000 ERSBL DS X SUB LENGTH BYTE FOR CURRENT SUB 00065000 SPACE 00066000 ERSSZ DS A SIZE OF SUB FIELD (# DOTS - 1) 00067000 SPACE 2 00068000 * MESSAGE CONSTRUCTION AREA 00069000 DS D NEED DOUBLE WORD BEFORE TEXT 00070000 ERMESS DC C'DMS' FIRST LETTERS OF HEADER 00071000 ERSECT DC C'MMM' DSECT NAME 00072000 ERNUM DC C'NNN' MESSAGE NUMBER 00073000 ERLET DC C'L' MESSAGE LEVEL LETTER 00074000 ERBL DC C' ' BLANK 00075000 ERTSIZE EQU 130 MAX TEXT SIZE 00076000 ERTEXT DS (ERTSIZE+1)C MESSAGE TEXT AREA 00077000 SPACE 2 00078000 * 'TYPLIN'/'PRINTR' PLIST CONSTRUCTION AREA 00079000 DS 0F 00080000 ERTPL DC CL8'TYPLIN' 00081000 ERTPLA DS AL1(1),AL3 (ERMESS) MESSAGE TEXT ADDR 00082000 ERTPLL DS C'R',AL3 MESSAGE LENGTH 00083000 EJECT 00084000 POP PRINT 00084100 MEND 00085000