Macro .*- .* Generate new string from string using conversion mask. v2 .* .* Parm field: .* [what,]STRING=s,MASK=m,OUT=o,MCHR=c,PL=p .* what is an optional directive as follows: .* CALL generate call only, do not generate module. This can be .* used if the module is included by lked. .* MODULE generate module only, do not generate call. This can be .* used to create a module for later inclusion by lked. .* You must supply register equates before and END statement. .* PL generate the parameter list area. Label is required. .* s, m and o are either an address or an (address,length) pair, .* when pair then both operands may be (register). Default length .* is the length of the field. .* c is the address of a 7-byte optional area, it contains alternate .* mask characters. Default is %*>?+'\ .* p is the address of a 8-word area, it may be (register). It is .* recommended that you use STRBYMSK PL to generate the area. .* .* Returns .* r15 = 0 => all ok .* 1 => end of string before end of mask .* 2 => mask error i.e. missing quote .* 3 => output overflow .* 4 => text not found in string .* 5 => mask text overflow (no space in string) .* r0 = length of generated output .* .* Mask characters operation .* % String character is copied to the output. .* +c Insert character. .* +'text' Insert text. Maximum text length is 254. .* - Delete character. .* -'text' Delete up to, but not including, 'text'. Maximum text .* length is 254. .* * Copy remainder to output (position cursor). .* *'text' Copy string characters from the current position to text, .* 'text' itself is not copied. Maximum text length is 254. .* ?text?if-found?not-found? .* If text matches string at cursor then use if-found mask, .* else use not-found mask. Either mask may be null. .* ?>text?if-found?not-found? .* If text matches string anywhere at or after cursor then .* use if-found mask, else use not-found mask. Either mask .* may be null. Maximum text length is 254. .* \ The char following in the mask is copied to output, this .* allows you to copy a mask character - i.e. \% .* other Mask character is copied. .* .* Sample call .* la r2,l'str1 .* la r3,l'msk1 .* StrByMsk string=(str1,(r2)),mask=(msk1,(r3)), .* out=out,pl=sbmpl .* lr r5,r0 copy out length .* . . . .* str1 dc c'SYS1.ASM.MACLIB' .* msk1 dc c'SYS2.-''MAC''*' -> SYS2.MACLIB .* out dc cl100' ' .* sbmpl StrByMsk pl .* .* Some samples .* Text Mask Result .* ASM.MACLIB +'B.'* B.ASM.MACLIB .* ASM.MACLIB *'.M'.TEST ASM.TEST .* SYS1.ASM.MACLIB SYS2.-'MAC'* SYS2.MACLIB 0 .* ASM.MACLIB +'SYS2'-'.'* SYS2.MACLIB 0 .* SYS1.ASM.MACLIB SYS2.-'MAC'---ASMLIB SYS2.ASMLIB 0 .* SYS1.ASM.MACLIB *'.'--'.'.* SYS1.MACLIB 0 .* SYS2.T.ASM.MACLIB *'.'--'.'--'.'.* SYS2.MACLIB 0 .* ABC.T.ASM.MACLIB SYS3-'.'--'.'.* SYS3.MACLIB 0 .* SYS1.ASM.MACLIB SYS2.*'MAC'TESTLIB SYS2.ASM.TESTLIB N .* Kilroy_was_here *'was'was+'_never'* Kilroy_was_never_here .* .* History .* 2021-08-01 Initial .* 2021-09-18 Add PRINT parameter .* .* Author .* Willy Jensen .* mail: willy@harders-jensen.com .* web : http://harders-jensen.com/wjtech .*- &mlbl StrByMsk &string=,&mask=,&out=,&pl=,&mchr=0,&print=GEN lcla &n lclc &s,&l,&sl1 gblb &#STRBYMSK gblc &$setreglc &sl1 setc Upper('&syslist(1)') aif ('&sl1' eq 'PL').pl aif ('&sl1' eq 'MODULE').module aif ('&sl1' eq 'CALL').t01 aif ('&sl1' eq 'SETMOD').setmod aif (&#STRBYMSK eq 0).module .t01 aif (n'&string gt 0).t02 mnote 8,'*** missing string' mexit .t02 aif (n'&mask gt 0).t03 mnote 8,'*** missing mask' mexit .t03 aif (n'&out gt 0).t04 mnote 8,'*** missing out' mexit .t04 aif (n'&pl eq 1).t05 mnote 8,'*** missing pl' mexit .t05 anop SETREG r1,&pl xc 0(8*4,r1),0(r1) SETREG r14,&string(1) SETREG r15,&string(2),&$setreglc SETREG r0,&mask(1) stm r14,r0,0(r1) SETREG r14,&mask(2),&$setreglc SETREG r15,&out(1) SETREG r0,&out(2),&$setreglc stm r14,r0,12(r1) SETREG r14,&mchr st r14,24(r1) Call zStrByMs ltr r15,r15 mexit .err1 anop mexit .*- .* Module .* .* General register usage .* r4 -> text .* r5 -> end of text .* r6 -> mask .* r7 -> end of mask .* r8 -> output .* r9 -> end of output .* r10 mask chars 1-4, defaults %*+- .* r11 some conditions in byte 1 .* mask chars 5-7, defaults '?\ in bytes 2-4 .* r12 base .*- .module anop push print print &print gblc &#module_rmode,&#module_amode &#STRBYMSK setb 1 &sloc setc '&sysloc' push using &l setc 'zsbm' aif (k'&#module_rmode eq 0).rmodend Zstrbyms rmode &#module_rmode Zstrbyms amode &#module_amode .rmodend anop .* lclc &pcm,axm,psm,msm,qmm,qtm,&cndsup,&cnds1,&cnds2 * in r10 &pcm setc 'b''1000''' PerCentage sign mask &axm setc 'b''0100''' AsteriX mask &psm setc 'b''0010''' Plus Sign mask &msm setc 'b''0001''' Minus sign (-) mask &pcr setc 'R10' PerCentage sign register &axr setc 'R10' AsteriX register &psr setc 'R10' Plus Sign register &msr setc 'R10' Minus sign (-) register * in r11 &qtm setc 'b''0100''' QuoTe mask &qmm setc 'b''0010''' Question Mark mask &ecm setc 'b''0001''' EsCape mask &qtr setc 'R11' QuoTe register &qmr setc 'R11' Question Mark register &ecr setc 'R11' EsCape register * flags in storage &cndsup setc 'x''80''' cond-suppress on &cnds1 setc 'x''40''' cond-sect 1 in progress &cnds2 setc 'x''20''' cond-sect 2 in progress &cndr setc 'R11' * Begin csect Zstrbyms Csect save (14,12) basr r12,0 ahi r12,-6 using zstrbyms,r12 xc 8(4,r13),8(r13) clear flag field lm r4,r10,0(r1) ar r5,r4 make length bctr r5,0 to end-of-text pointer ar r7,r6 make length bctr r7,0 to end-of-mask pointer ar r9,r8 make length bctr r9,0 to end-of-mask pointer sr r11,r11 ltr r10,r10 alternate char list? jne &l.lmc nope la r10,&l.mcl -> default char list &l.lmc icm r11,b'0111',4(r10) '?\ icm r10,b'1111',0(r10) %*+- &l.t01 ds 0h cr r8,r9 test for end of output jh &l.x03 cr r6,r7 test for end of mask jh &l.x00 .* cr r4,r5 test for end of string .* jh &l.x01 .* handle suppression on .* tm 8(r13),&cndsup suppression on? .* jz &l.t02 nope ltr r11,r11 suppression on? jnm &l.t02 nope clm &qmr,&qmm,0(r6) question mark ? je &l.q01 then go handle la r6,1(r6) else bump mask pos j &l.t01 and try next .* escape char, copy the following unmodified to output .* normal mask test &l.t02 ds 0h clm &pcr,&pcm,0(r6) % -> copy string char je &l.c01 clm &psr,&psm,0(r6) + -> insert text je &l.i01 .* clm &qtr,&qtm,0(r6) ' -> insert text (old style) .* je &l.i21 clm &msr,&msm,0(r6) - -> drop string char je &l.d01 clm &axr,&axm,0(r6) * -> copy string block je &l.b01 clm &ecr,&ecm,0(r6) \ -> escape char (special ops) je &l.e01 clm &qmr,&qmm,0(r6) ? -> question if continue je &l.q01 j &l.o01 &l.e01 ds 0h copy following cr r6,r7 is there a following? je &l.x02 no, error mvc 0(1,r8),1(r6) la r4,1(,r4) bump string pos la r6,2(,r6) bump mask pos la r8,1(,r8) bump output pos j &l.t01 .* copy mask char to output &l.o01 ds 0h overlay with mask char mvc 0(1,r8),0(r6) la r4,1(,r4) bump string pos la r6,1(,r6) bump mask pos la r8,1(,r8) bump output pos j &l.t01 .* copy string char to output &l.c01 ds 0h copy string char cr r4,r5 test for end of string jh &l.x01 mvc 0(1,r8),0(r4) la r4,1(,r4) bump string pos la r6,1(,r6) bump mask pos la r8,1(,r8) bump output pos j &l.t01 .* insert mask text &l.i01 ds 0h la r6,1(,r6) -> after + clm &qtr,&qtm,0(r6) ' -> insert text je &l.i21 mvc 0(1,r8),0(r6) insert char la r6,1(,r6) bump char la r8,1(,r8) bump output ptr j &l.t01 &l.i21 ds 0h llc r0,0(,r6) load quote la r1,1(,r6) -> after ' bal r14,&l.msd get text length in r15 ar r15,r8 test cr r15,r9 sufficient jh &l.x03 space sr r15,r8 restore r15 bctr r15,0 ex r15,&l.ix1 la r6,3(r15,r6) -> past 'text' la r8,1(r15,r8) bump output ptr j &l.t01 &l.ix1 mvc 0(*-*,r8),1(r6) copy mask text to output .* drop string char &l.d01 ds 0h drop string char clm &qtr,&qtm,1(r6) insert text? je &l.d02 la r6,1(r6) bump mask pos la r4,1(r4) bump string pos j &l.t01 &l.d02 ds 0h drop till text llc r0,1(,r6) load quote la r1,2(,r6) -> after >' bal r14,&l.msd get text length in r15 la r1,2(,r6) -> text (after >') la r6,3(15,r6) -> after >'text' bal r14,&l.lst locate text jne &l.x04 not found lr r4,r1 set string ptr j &l.t01 .* copy block from string, char = *'text' &l.b01 ds 0h copy block clm &qtr,&qtm,1(r6) quote? (*') je &l.b06 cr r4,r5 anything in string left? jh &l.x00 nope 2021-07-24 sr r5,r4 remaining string ar r5,r8 test cr r5,r9 sufficient space? jh &l.x03 else quit sr r5,r8 restore r5 cfi r5,250 jh &l.b02 large remaining ex r5,&l.bx1 copy rest of string la r8,1(r5,r8) bump output ptr la r6,1(,r6) bump mask ptr j &l.t01 &l.b02 ds 0h copy large block la r5,1(,r5) make real length lr r2,r8 -> output lr r3,r5 copy length lr r14,r4 -> input lr r15,r5 copy length mvcl r2,r14 do copy ar r4,r5 bump string ptr la r6,1(,r6) bump mask ptr ar r8,r5 adjust outupt cursor j &l.t01 &l.b06 ds 0h copy block llc r0,1(,r6) load quote la r1,2(,r6) -> after *' bal r14,&l.msd get text length in r15 bal r14,&l.lst locate text jne &l.x04 not found sr r1,r4 length of block before text ar r1,r8 test cr r1,r9 sufficient jh &l.x03 space sr r1,r8 restore r1 bctr r1,0 ex r1,&l.bx1 la r6,3(15,r6) bump mask ptr after *'text' la r4,1(r1,r4) bump string ptr la r8,1(r1,r8) bump output ptr j &l.t01 &l.bx1 mvc 0(*-*,r8),0(r4) copy string block .* questionmark, conditional blocks &l.q01 ds 0h question if continue tm 8(r13),&cnds1 in section 1? jo &l.q10 go handle tm 8(r13),&cnds2 in section 2? jo &l.q20 go handle .* first question mark .* ni 8(r13),255-&cndsup set suppression off sll r11,1 set suppression srl r11,1 off oi 8(r13),&cnds1 set section 1 llc r0,0(,r6) load question mark clm &msr,&msm,1(r6) is it ?>text? jne *+8 nope la r6,1(,r6) yes, bump cursor -> > la r1,1(,r6) -> text bal r14,&l.msd get text length clm &msr,&msm,0(r6) is it >text? je &l.q04 yes, go locate .* test text at cursor la r14,1(r15,r4) space in cr r14,r5 in string jh &l.x05 for text? bctr r15,0 ex r15,&l.qc1 la r6,3(r15,r6) bump mask ptr je &l.t01 match o r11,&l.zuo set suppression on for sect1 j &l.t01 not matched &l.q04 ds 0h not found .* la r1,1(,r6) -> text? bal r14,&l.lst locate text in string la r6,2(r15,r6) bump mask ptr je &l.t01 found .* oi 8(r13),&cndsup set suppression on for sect1 o r11,&l.zuo set suppression on for sect1 j &l.t01 &l.qc1 clc 1(*-*,r6),0(r4) compare text to string &l.q10 ds 0h conditional section 1 end la r6,1(,r6) bump mask ptr ni 8(r13),255-&cnds1 switch to oi 8(r13),&cnds2 section 2 .* tm 8(r13),&cndsup is suppression on? .* jo &l.q11 yes ltr r11,r11 is suppression on? jm &l.q11 yes .* oi 8(r13),&cndsup else set on o r11,&l.zuo else set suppression on j &l.t01 &l.q11 sll r11,1 set suppression srl r11,1 off j &l.t01 &l.q20 ds 0h conditional sections end la r6,1(,r6) bump mask ptr ni 8(r13),255-&cnds2 clear section id .* ni 8(r13),255-&cndsup clear suppresssion flag sll r11,1 set suppression srl r11,1 off j &l.t01 .* Describe mask text address and length .* at entry: r1->text, r0 contains char in low-order byte .* at exit : r1->text, r15=text length &l.msd ds 0h mask string describe lr r15,r1 .* msd1 clm &qtr,&qtm,0(r15) &l.msd1 clm r0,1,0(r15) je &l.msd2 la r15,1(,r15) cr r15,r7 test for end of mask jnh &l.msd1 continue test j &l.x02 not good &l.msd2 sr r15,r1 compute text length br r14 .* Locate mask text in string .* at entry: r1 -> mask text, r15 = text length, r4 -> string .* returns: cc=eq / ne, r1 -> text in string .* note - uses r2 as work reg (r3 too, but that is saved in r0) &l.lst ds 0h lr r0,r3 .* la r3,1(,r5) -> string end la r3,2(,r5) -> string end sr r3,r4 remaining string sr r3,r15 minus text length bctr r15,0 machine length lr r2,r1 -> text lr r1,r4 -> string &l.lst1 ex r15,&l.lstx je &l.lst2 la r1,1(,r1) bump string ptr bct r3,&l.lst1 cli &l.zuo,255 set 'ne' &l.lst2 lr r3,r0 restore r3 la r15,1(,r15) reinstate text length br r14 &l.lstx clc 0(*-*,r1),0(r2) compare text to string &l.mcl dc cl8'%*+-''?\' &l.zuo dc a(x'80000000') set upper to one .* end &l.rtn br r14 &l.x00 sr r15,r15 end of mask j &l.xx &l.x01 la r15,1 end of string j &l.xx &l.x02 la r15,2 mask error, i.e. missing quote j &l.xx &l.x03 la r15,3 output overflow j &l.xx &l.x04 la r15,4 text not found in string j &l.xx &l.x05 la r15,5 mask text overrun j &l.xx &l.xx ds 0h end of string xc 8(4,r13),8(r13) reset flag field .* lr r0,r8 -> past end of output l r1,24(,r13) reload r1 s r0,16(,r1) output length l r14,12(,r13) return (2,12) drop r12 pop using pop print aif ('&sl1' eq 'MODULE').x &sloc Loctr resume main ago .t01 continue macro .* parmlist .pl anop &mlbl ds 8a mexit .setmod anop &#STRBYMSK setb 1 mexit .x Mend