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