/* REXX PLIMSGO adds error messages in-line with the compiler listing. Written by Frank Clarke 20010307 rexxhead@yahoo.com Modification History 20010717 fxc don't sort if only 1 token; 20030723 fxc split for two compilers 20240503 fxc change $ to @ everywhere; 20250512 fxc FIXOPTS; SPACEOUT; */ address ISREDIT "MACRO (opts)" "RESET" address ISPEXEC "CONTROL ERRORS RETURN" call A_INIT /* -*/ @z = Trace( tv ) /* activate TRACE, maybe */ call B_COLLECT_REFS /* -*/ if sw.0BuildLog then, call ZB_SAVELOG /* -*/ exit /*@ PLIMSGO */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ address ISREDIT monitor = "0" parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn tk_globalvars = "exec_name sw. monitor " call AS_SETUP_LOG /* -*/ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with, msgid. msgid sev stmt# msgtxt stmts. msg. , . parse value "0 0 0 0 0 0 0 0 0 0 0 0 0 0" with, sw. , . upper opts opts = Strip( opts,"T",'5d'x ) /* clip trailing paren */ parse var opts "TRACE" tv . parse value tv "N" with tv . /* guarantee a value */ sw.0DropLink = Wordpos( "NOLINK",opts ) > 0 sw.0BuildLog = Wordpos( "LOG",opts ) > 0 monitor = Wordpos( "MONITOR",opts ) > 0 IgnoreList = " IEL0239I IEL0533I IEL0541I IEL0916I ", " IEL0671I IEL0885I IEL0892I IEL0919I" return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AS_SETUP_LOG: /*@ */ address TSO parse value "0" with, log# log. parse value Date( "S" ) Time( "S" ) Time( "N" ) with, yyyymmdd sssss hhmmss . parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos( yrdigit,"13579" ) > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr( "ABCDEFGHIJKLMNOPQRSTUVWX",mm,1 ) /* logtag=X */ subid = logtag""dd""Right( sssss,5,0 ) /* X1423722 ? */ vb4k.0 = "NEW CATALOG UNIT( SYSDA ) SPACE( 1 5 ) TRACKS", "RECFM( V B ) LRECL( 128 ) BLKSIZE( 0 )" vb4k.1 = "SHR" /* if it already exists... */ logdsn = "@@LOG."exec_name"."subid".LIST" call ZL_LOGMSG( "Log started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( "Arg:" argline ) return /*@ AS_SETUP_LOG */ /* . ----------------------------------------------------------------- */ B_COLLECT_REFS: /*@ */ address ISREDIT call BA_DELIMIT_SECTIONS /* -*/ call BB_FIND_MESSAGES /* -*/ call BP_POST_MESSAGES /* -*/ return /*@ B_COLLECT_REFS */ /* Find the Start-of-Source and label it (.SS), End-of-Source (.ES), Start-of-Messages (.SM) and End-of-Messages (.EM) . ----------------------------------------------------------------- */ BA_DELIMIT_SECTIONS: /*@ */ address ISREDIT "CAPS OFF" "SEGMENT LABELS" address ISPEXEC "VGET LBLLIST SHARED" parse var lbllist . ".SRC" ss# lbllist "LABEL" ss# "= .SS " /* end of source statements */ call ZL_LOGMSG( "Source starts at" ss# ) parse var lbllist . ".ATTR" es# lbllist "LABEL" es# "= .ES " /* end of source statements */ call ZL_LOGMSG( "Source ends at" es# ) parse var lbllist . ".DIAG" msg_bgn lbllist "(text) = LINE" msg_bgn if Pos( "NO MESSAGES PRODUCED",text ) > 0 then exit "LABEL" msg_bgn "= .SM" /* start of messages */ sm# = msg_bgn /* save the line # */ call ZL_LOGMSG( "Messages start at" sm# ) if lbllist = "" then do "LABEL .zl = .EM " /* end of messages */ "(em#) = LINENUM .EM " /* save the line # */ end else do parse var lbllist . ".LINK" msg_end . "LABEL" msg_end "= .EM " /* end of messages */ em# = msg_end /* save the line # */ if rc = 0 & sw.0DropLink then do "X ALL .EM .ZL" "DELETE ALL X .em .zl" end end call ZL_LOGMSG( "Messages end at" em# ) return /*@ BA_DELIMIT_SECTIONS */ /* Locate the messages between .SM and .EM The position of "L" in "ERROR ID L" is the location of the severity indicator which must be S, E, W, or I The position of "MESS" in "MESSAGE DESCR" is the location of the message text which may continue onto following lines Parse out , , , and (possibly continued) Ignore any s in Ignore any s affecting only stmt# 1 Save unique MSGIDs in Save unique affected statements in Save msgid, severity, and text as . . ----------------------------------------------------------------- */ BB_FIND_MESSAGES: /*@ */ address ISREDIT "LOCATE .sm" "F 'ERROR ID L '" "(text) = LINE .zcsr" sev_pos = Pos( "L",text ) - 1 txt_pos = Pos( "MESSAG",text ) - 1 stm_pos = Pos( "STMT",text ) - 1 msg = "" /* init */ do bbx = em# to sm# by -1 /* diagnostic messages */ "(text) = LINE" bbx parse var text cc 2 text /* snip off cc */ if text = "" then iterate if cc = "1" then iterate if Left( text,11 ) = "ERROR ID L " then iterate if Left( text,21 ) = "" then do /* continued line */ text = Strip( text ) msg = text || " " || msg /* prepend */ iterate end /* continued line */ if Datatype( Substr( text,stm_pos,1 ),"N" ) then do /* new stmt */ parse var text msgid sev text if Wordpos( msgid,IgnoreList ) > 0 then do msg = "" /* collected text */ iterate end if Wordpos( msgid,msgid.0 ) = 0 then, msgid.0 = msgid.0 msgid text = Strip( text ) text = text msg /* splice ahead */ templist = "" /* init */ do while text <> "" parse var text stmt# text if Right( stmt#,1 ) = "," then do stmt# = Strip( stmt#,"T","," ) if Wordpos( stmt#,templist ) = 0 then, templist = templist stmt# /* attach */ end else do /* no trailing comma */ if Wordpos( stmt#,templist ) = 0 then, templist = templist stmt# /* attach */ msgtext = text; text = "" /* shut down loop */ end /* no trailing comma */ end /* while text not empty */ /* now contains the actual message */ if "1" = Strip( STMTS.msgid ) then do parse value "" with STMTS.msgid msg text msgtext delpos = Wordpos( msgid,MSGID.0 ) if delpos <> 0 then, MSGID.0 = Delword( MSGID.0,delpos,1 ) else say "DELPOS was zero for" msgid iterate end call BBZ_STORE_MSGTEXT /* -*/ end /* new stmt */ end /* bbx bottom up */ return /*@ BB_FIND_MESSAGES */ /* . ----------------------------------------------------------------- */ BBZ_STORE_MSGTEXT: /*@ */ address TSO do bbz = 1 to Words( templist ) stmt# = Word( templist,bbz ) key = Space( msgid"."stmt#,0 ) MSG.key = Strip( msgid ) Strip( sev ) Strip( msgtext ) MSG.key = Left( MSG.key,69 )"..." call ZL_LOGMSG( "MSG."key "=" msg.key ) end /* bbz */ STMTS.msgid = STMTS.msgid templist /* save statement numbers */ return /*@ BBZ_STORE_MSGTEXT */ /* For each msgid in MSGID.0, acquire STMTS.msgid For each stmt# in STMTS.msgid, - find the statement between .SS and .ES - load MSG.msgid.stmt# as LINE_BEFORE . ----------------------------------------------------------------- */ BP_POST_MESSAGES: /*@ */ address ISREDIT do bpa = 1 to Words( MSGID.0 ) /* each MSGID */ msgid = Word( MSGID.0,bpa ) /* isolate msgid */ if Words( STMTS.msgid ) > 1 then, STMTS.msgid = STRSORT(STMTS.msgid) /* sort the stmt#'s */ seq = "FIRST" do bpb = 1 to Words( STMTS.msgid ) /* each affected statement */ stmt# = Word( STMTS.msgid,bpb ) /* isolate statement number */ "F WORD '"stmt#"' .SS .ES 1 20" seq /* locate the statement */ key = Space( msgid"."stmt#,0 ) msgtext = " "MSG.key "LINE_BEFORE .zcsr = NOTELINE (msgtext)" seq = "NEXT" end /* bpb */ end /* bpa */ "L FIRST SPECIAL" zcmd = "&L NEXT SPECIAL" return /*@ BP_POST_MESSAGES */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO say helpmsg exit /*@ HELP */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ address TSO if Symbol( "LOG#" ) = "LIT" then return /* not yet set */ "ALLOC FI( @LOG ) DA( "logdsn" ) REU" vb4k.0 "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI( @LOG )" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# rc = Trace( "O" ) address TSO parse arg msgtext parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */