MACRO
&NAME $VWTO &MSG,&TO2,&MCSFLAG=,&MSGTYP=,&ROUTCDE=,&DESC=, X
&BUILDA=*,&MSGID=*,&ML=
.*******************************************************************
.* *
.* FEATURES INCLUDE: *
.* -SPECIFING VARIABLE FIELDS INTERMIXED WITH CONSTANTS. *
.* -SPECIFING A SEPARATE AREA TO BUILD MESSAGE, ALLOWING A *
.* PROGRAM TO MAINTAIN ITS RE-ENTRANCY. *
.* -PRECEDES MESSAGE WITH &SYSPARM DATA IF ANY EXISTS. THIS *
.* CAN BE SET DURING ASSEMBLY TO PROGRAM NAME (THIS IS STANDARD *
.* PROCEDURE IN THE AAS DEVELOPMENT SHOP). IF &SYSPARM *
.* DATA IS NOT TO BE INCLUDED IN THE MESSAGE REGARDLESS *
.* OF &SYSPARM SETTING, CODE IN PROGRAM - '&$VWTOSW SETB 1' *
.* IF &SYSPARM DATA IS BEING GENERATED AS A PART OF THE MESSAGES *
.* (THAT IS, '&$VWTOSW' IS 0 INTENTIONALLY OR BY DEFAULT) *
.* BUT IS NOT WANTED FOR ANY PARTICULAR MESSAGE, CODE *
.* 'SPARM=NO' IN THE MACRO CALL. *
.* *
.*******************************************************************
.* FORMAT: *
.* *
.* <NAME> $VWTO *
.* --------------------------------------------------------------- *
.* 'MSG' SIMPLE MESSAGE *
.* ('TEXT',VARIABLE) ANY COMBINATION OF CONSTANTS AND VARIABLES *
.* WHERE THE VARIABLE IS EITHER THE SYMBOLIC *
.* NAME OF A FIELD CONTAINING DATA FOR THE *
.* MESSAGE OR REGISTER SPECIFICATION. *
.* A LENGTH SPECIFICATION IS OPTIONAL FOR *
.* SYMBOLIC BUT REQUIRED FOR REGISTER SPEC. *
.* EX. ('TEXT',FLD1,'TEXT',(R5,20)) *
.* BUILDA= NAME OF FIELD TO BUILD MESSAGE. MAY USE *
.* REGISTER NOTATION. *
.* MSGID= MESSAGE ID TO BE PREFIXED TO THE MESSAGE. *
.* SPARM=NO DO NOT INCLUDE &SYSPARM DATA IN THIS *
.* MESSAGE REGARDLESS OF &SYSPARM SETTING. *
.* ML= LINE TYPE FOR MULTI-LINE WTO. *
.* SEE SYSTEM MACRO MANUAL FOR TYPES. *
.* ALL OTHER PARAMETERS ARE STANDARD WTO PARAMETERS. *
.* --------------------------------------------------------------- *
.* EX: LA 5,RECAREA *
.* $VWTO ('DSN = ',DSNAM,' FIRST 4 CHAR DDN = ',DDNAME(4), X *
.* 'RECORD = ',(5,20)) *
.* *
.* DSNAM DS CL44 *
.* DDNAME DS CL8 *
.* *
.*******************************************************************
GBLB &$VWINLN
GBLB &$VWTOR1
LCLA &CTR1,&CTR2,&CTR5
LCLA &DISP,&TLEN,&VR,&MC,&WKLN1,&WKLN2
LCLA &LEN1,&LEN2,&LEN3,&NLEN,&LEN5
LCLB &VWRGSW1,&MLSW
LCLC &LEN4,&SUBP,&SUBP1,&PLUS8
LCLC &MV(20),&CN(20)
&DISP SETA 4
&VR SETA 1
&MC SETA 1
&TLEN SETA 0
&CTR1 SETA 0
&CTR2 SETA 0
&CTR5 SETA 0
&ADDISP SETA 0
&MVDISP SETA 0
&MLSW SETB 0
&PLUS8 SETC ''
.**********************************************************************
.* *
.* SETUP MSGID, SYSPARM, VARIOUS SWITCHES ( MULTILINE WTO ETC. ). *
.* *
.**********************************************************************
AIF ('&ML' EQ '').GO0
&MLSW SETB 1
.GO0 ANOP
AIF ('&BUILDA' NE '*').NOINL BRANCH IF NOT INLINE
&$VWINLN SETB 1 SET INLINE GENERATE SW
&TO SETC 'VW$A&SYSNDX' BUILD LABEL, INLINE
AGO .GOGO
.NOINL ANOP BUILD LABEL, NOT INLINE
&TO SETC '&BUILDA'
.GOGO ANOP
AIF ('&TO'(1,1) NE '(').GOGO2 BRANCH IF NOT REG SPEC.
&VWRGSW1 SETB 1 SET REG SPEC SW
.GOGO2 ANOP
AGO .SETA
.PARM ANOP
&PGMNAME SETC '('.'&SYSPARM'.' '(1,8-K'&SYSPARM).') '
AIF ('&MSGID' EQ '*').PARM1
&SUBP SETC ''''.'&MSGID'.' - '.'&PGMNAME'.' '''
AGO .CONST
.PARM1 ANOP
&SUBP SETC ''''.'&PGMNAME'.' '''
AGO .CONST
.SETA ANOP
AIF ('&MSGID' EQ '*').SETONE
&SUBP SETC ''''.'&MSGID'.' - '.''''
AGO .CONST
.**********************************************************************
.* *
.* ISOLATE A SUBPARAMETER OF THE MESSAGE, DETERMINE TYPE. *
.* ( CONSTANT, VARIABLE WITH OR W/O LENGTH, REGISTER SPEC ) *
.* *
.**********************************************************************
.SETONE ANOP
&CTR2 SETA 1
.SETB ANOP
&SUBP SETC '&MSG(&CTR2)'
AIF ('&SUBP' EQ '').OUT,('&SUBP'(1,1) EQ '''').CONST
AIF ('&SUBP'(1,1) EQ '(').REG
&LEN2 SETA K'&SUBP
&LEN3 SETA 0
.LP1 ANOP
AIF (&LEN3 EQ &LEN2).STMV
&LEN3 SETA &LEN3+1
AIF ('&SUBP'(&LEN3,1) NE '(').LP1
.**********************************************************************
.* *
.* SUBPARAMETER IS A VARIABLE WITH LENGTH SPECIFIED. *
.* *
.**********************************************************************
&SUBP1 SETC '&SUBP'(1,&LEN3-1)
&LEN2 SETA &LEN3
&LEN3 SETA &LEN3+1
&NLEN SETA 0
.LOOPL ANOP
&LEN2 SETA &LEN2+1
AIF ('&SUBP'(&LEN2,1) EQ ')').MVLN
&NLEN SETA &NLEN+1
AGO .LOOPL
.MVLN ANOP
&LEN4 SETC '&SUBP'(&LEN3,&NLEN)
AIF (&VWRGSW1).MOV1A
&MV(&VR) SETC '&TO+&DISP.(&LEN4),&SUBP1'
AGO .MOV1B
.MOV1A ANOP
&MV(&VR) SETC '&DISP.(&LEN4,&TO),&SUBP1'
.MOV1B ANOP
&LEN5 SETA &LEN4
&CN(&MC) SETC 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'(2,&LEN5)
&CTR5 SETA &CTR5+1
&TLEN SETA &TLEN+&LEN5
&VR SETA &VR+1
&MC SETA &MC+1
&CTR2 SETA &CTR2+1
&DISP SETA &LEN5+&DISP+&ADDISP
&ADDISP SETA 0
AGO .SETB
.**********************************************************************
.* *
.* SUBPARAMETER IS A VARIABLE WITHOUT A LENGTH SPECIFICATION. *
.* *
.**********************************************************************
.STMV ANOP
&LEN1 SETA L'&SUBP
AIF (&VWRGSW1).MOV2A
&MV(&VR) SETC '&TO+&DISP.(&LEN1),&SUBP'
AGO .MOV2B
.MOV2A ANOP
&MV(&VR) SETC '&DISP.(&LEN1,&TO),&SUBP'
.MOV2B ANOP
&CN(&MC) SETC 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'(2,&LEN1)
&CTR5 SETA &CTR5+1
&TLEN SETA &TLEN+&LEN1
&VR SETA &VR+1
&MC SETA &MC+1
.**********************************************************************
&CTR2 SETA &CTR2+1
&DISP SETA &LEN1+&DISP+&ADDISP
&ADDISP SETA 0
AGO .SETB
.**********************************************************************
.* *
.* SUBPARAMETER IS A CONSTANT. *
.* *
.**********************************************************************
.CONST ANOP
&LEN1 SETA K'&SUBP-2
&CN(&MC) SETC '&SUBP'(2,&LEN1)
.*--------------------------------------------------------------------*
.* *
.* THIS SCAN ROUTINE WILL REPLACE ALL DOUBLE QUOTES WITH A *
.* SINGLE QUOTE ; REPEATED SINGLE QUOTE CHARACTER AS (''), NOT *
.* THE DOUBLE QUOTE CHARACTER ("). *
.* *
.*--------------------------------------------------------------------*
&WKLN1 SETA K'&CN(&MC)
&WKLN2 SETA 0
.SCAN ANOP
AIF (&WKLN2 EQ &WKLN1).SCANOUT
&WKLN2 SETA &WKLN2+1
AIF ('&CN(&MC)'(&WKLN2,1) NE '''').SCAN
AIF ('&CN(&MC)'(&WKLN2+1,1) NE '''').SCAN
&LEN1 SETA &LEN1-1
&WKLN2 SETA &WKLN2+1
AGO .SCAN
.SCANOUT ANOP
.*--------------------------------------------------------------------*
&TLEN SETA &TLEN+&LEN1
&MC SETA &MC+1
&CTR2 SETA &CTR2+1
&DISP SETA &LEN1+&DISP+&ADDISP
&ADDISP SETA 0
AGO .SETB
.**********************************************************************
.* *
.* SUBPARAMETER IS REGISTER NOTATION, LENGTH IS REQUIRED. *
.* *
.**********************************************************************
.REG ANOP
&CTR1 SETA 0
&LEN3 SETA 2
.CKC ANOP
AIF ('&SUBP'(&LEN3,1) EQ ',').SETRG
AIF ('&SUBP'(&LEN3,1) EQ ')').ERR1
&CTR1 SETA &CTR1+1
&LEN3 SETA &LEN3+1
AGO .CKC
.SETRG ANOP
® SETC '&SUBP'(2,&CTR1)
&CTR1 SETA 0
&LEN3 SETA &LEN3+1
&LEN5 SETA &LEN3
.CKP ANOP
AIF ('&SUBP'(&LEN3,1) EQ ')').SETLN2
&CTR1 SETA &CTR1+1
&LEN3 SETA &LEN3+1
AGO .CKP
.SETLN2 ANOP
&LEN4 SETC '&SUBP'(&LEN5,&CTR1)
&LEN5 SETA &LEN4
AIF (&VWRGSW1).MOV3A
&MV(&VR) SETC '&TO+&DISP.(&LEN4),0(®)'
AGO .MOV3B
.MOV3A ANOP
&MV(&VR) SETC '&DISP.(&LEN4,&TO),0(®)'
.MOV3B ANOP
&CN(&MC) SETC 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'(2,&LEN5)
&MC SETA &MC+1
&VR SETA &VR+1
&TLEN SETA &TLEN+&LEN5
&CTR5 SETA &CTR5+1
&CTR2 SETA &CTR2+1
&DISP SETA &LEN5+&DISP+&ADDISP
&ADDISP SETA 0
AGO .SETB
.**********************************************************************
.* *
.* GENERATE THE WTO/WTOR CODE BY CALLING THE SYSTEM MACRO. *
.* *
.**********************************************************************
.OUT ANOP
&CTR1 SETA 1
&LAB4 SETC 'VW$D&SYSNDX'
&LAB3 SETC '&TO2'
AIF (&$VWTOR1).CKS2
&LAB3 SETC '&TO'
.CKS2 ANOP
AIF (&$VWINLN).GENCON
&LAB3 SETC 'VW$C&SYSNDX'
.GENCON ANOP
&LAB2 SETC 'VW$B&SYSNDX'
AIF (&$VWTOR1).GENIT
SPACE 1
&NAME DS 0H
.GENIT ANOP
B &LAB2 BRANCH AROUND LIST
AIF (&$VWTOR1).TSTINLN
AGO .SETWTO
.TSTINLN AIF (&$VWINLN).GWTOR
.SETWTO ANOP
&WTOMSG SETC '&CN(1)&CN(2)&CN(3)&CN(4)&CN(5)&CN(6)&CN(7)&CN(8)&CN(9)X
&CN(10)&CN(11)&CN(12)&CN(13)&CN(14)&CN(15)&CN(16)&CN(17)X
&CN(18)&CN(19)&CN(20)'
AIF (&MLSW).MLWTO
&LAB3 WTO '&WTOMSG', X
MCSFLAG=&MCSFLAG, X
DESC=&DESC,MSGTYP=&MSGTYP,ROUTCDE=&ROUTCDE,MF=L
AGO .GEN4
.MLWTO ANOP
AIF ('&ML' EQ 'C').TYPEC
AIF ('&ML' EQ 'E').SETMLW
AIF (K'&WTOMSG GT 70).TYPERR
AGO .SETMLW
.TYPEC AIF (K'&WTOMSG GT 34).TYPERR
.SETMLW ANOP
&LAB3 WTO ('&WTOMSG',&ML), X
MCSFLAG=&MCSFLAG, X
DESC=&DESC,MSGTYP=&MSGTYP,ROUTCDE=&ROUTCDE,MF=L
AGO .GEN4
.GWTOR ANOP
&LAB3 WTOR '&CN(1)&CN(2)&CN(3)&CN(4)&CN(5)&CN(6)&CN(7)&CN(8)&CN(9)&X
CN(10)&CN(11)&CN(12)&CN(13)&CN(14)&CN(15)&CN(16)&CN(17)&X
CN(18)&CN(19)&CN(20)', X
MCSFLAG=&MCSFLAG,DESC=&DESC,MSGTYP=&MSGTYP, X
ROUTCDE=&ROUTCDE,MF=L
.GEN4 ANOP
&LAB4 EQU *
&LAB2 DS 0H
AIF (&$VWINLN).IF
AIF (&VWRGSW1).MOV4A
MVC &TO&PLUS8.(&LAB4-&LAB3),&LAB3
AGO .IF
.MOV4A ANOP
MVC &MVDISP.(&LAB4-&LAB3,&TO),&LAB3
.IF ANOP
AIF (&CTR5 EQ 0).FIN
.GEN ANOP
MVC &MV(&CTR1)
&CTR1 SETA &CTR1+1
&CTR5 SETA &CTR5-1
AGO .IF
.FIN ANOP
AIF (&$VWTOR1).SVC
AIF (&VWRGSW1 NE 1).LOAD1
&TO SETC '0&TO'
.LOAD1 LA 1,&TO
.SVC ANOP
SVC 35
&$VWTOR1 SETB 0
&$VWINLN SETB 0
MEXIT
.ERR1 ANOP
MNOTE 'LENGTH MISSING, PARAM / &SUBP'
AGO .GENTERM
.TYPERR ANOP
MNOTE 'EXCESSIVE TEXT LENGTH FOR TYPE = &ML'
.GEMTERM ANOP
MNOTE 12,'GENERATION TERMINATED'
MEND
EDIT ENRICO.TEST.SRC(WTO2) - 01.02 Columns 00001 00072
Command ===> Scroll ===> CSR
****** ***************************** Top of Data ******************************
- - - - - - - - - - - - - - - - - - 349 Line(s) not Displayed
000350 WTO2 CSECT
000351 YREGS , Register equates generation macro
000352 SAVE (14,12)
000353 LR 12,15
000354 USING WTO2,12
000355 *
000356 GETMAIN RU,LV=WORKL GETMAIN WORKAREA
000357 ST R13,4(,R1) ST A(CALLERS S/A) IN MY S/A
000358 ST R1,8(,R13) ST A(MY S/A) IN CALLERS S/A
000359 LR R13,R1 LOAD A(MY S/A)
000360 USING WORK,R13 ESTABLISH ADDRESSABILITY
000361 *
000362 WTO 'SOME TEXT'
000363 WTO MF=(E,BUF1)
000364 *
000365 $VWTO ('TEXT1',VAR1),BUILDA=PLIS
000366 *
000367 RETURN LR R1,R13 LOAD R1 W/A(AREA TO FREEMAIN)
000368 L R13,4(,R13) LOAD A(CALLERS S/A)
000369 FREEMAIN RU,LV=WORKL,A=(1) FREEMAIN WORKAREA
000370 RETURN (14,12),RC=0 RETURN TO CALLER
000371 EJECT
000372 DS 0D
000373 VAR1 DC C'VAR1'
000374 *
000375 BUF1 WTO 'SOME OTHER TEXT',MF=L
000376 DS 0D
000377 LTORG
000378 WORK DSECT
000379 SAVE DS 9D
000380 DS 9D
000381 PLIS DS CL256
000382 DS 0D
000383 WORKL EQU *-WORK
000384 END
- - - - - - - - - - - - - - - - - - - 4 Line(s) not Displayed
****** **************************** Bottom of Data ****************************