Macro .*- .* TSOPUTLN - assembler macro - TSO putline not needing setup. .* .* The macro is self-contained in that it does not need an external .* subroutine, the subroutine is generated internally at the first .* macro expansion. .* .* The macro works even if used in a mdule started with the BAKR .* instruction, because the generated subroutine uses EXTRACT and .* LOCASCB to get the necessary runtime info, it does not rely on .* tracing back through save areas. .* .* It may cause a slight performance degradation as the module must .* format the message string, so GETMAINs and FREEMAINs a work area. .* On the other hand, this makes the subroutine fully reentrant and .* reusable. .* .* The generated CSECT will by default use amode 31 and rmode ANY. .* This can be changed in the main program like so: .* gblc &#modrmod,&#modamod .* &#modamod setc '24' amode .* &#modrmod setc '24' rmode .* .* Syntax .* .* TSOPUTLN address,length (,DSECT=YES/NO) .* address Address of text. Required. .* May be label, (reg) or F|H|B.label for .* L label, LH label or LB label. .* length Length of text. Number or (reg). Default .* is length of 'address'. .* DSECT=YES Generate various neccessary IBM dsects. .* DSECT=NO Do not generate IBM dsects. This is used .* when those dsects are generated elsewhere. .* .* Samples .* .* la r5,120 .* TsoPutln msg,(r5) .* .* la r4,msg .* TsoPutln (r4),(r5) .* .* TsoPutln text .* .* TsoPutln text,25 .* .* TsoPutln 'Just another fine day' .* .* TsoPutln f.textaddr,h.textlen .* .* msg ds cl256 .* textaddr dc a(test) .* textlen dc y(l'test) .* text dc c'Kilroy was here' .* text2 dc c' and it is such a nice day today' .* .* Note .* .* TSOPUTLN does not work when used in a REXX function, i.e. n=PGM() .* .* by: Willy Jensen .* mail: willy@harders-jensen.com .* web : http://harders-jensen.com/wjtech/index.html .*- &mlbl TSoPutLn &print=nogen,&dsects=YES lcla &n,&pn lclc &q,&l,§,&src,&len,&p,&r gblb @@tsoputln gblc $xlalen &q setc Upper('&syslist(1)') aif ('&q' eq 'XLA').xla &l setc 'tp&sysndx' § setc '&sysect' &src setc '&syslist(1)' &len setc '&syslist(2)' aif (k'&mlbl eq 0).mlbln &mlbl ds 0h .mlbln anop .* text address - label, (reg) or 'literal' TSOPUTLN xla,r1,&src .* text length - label, (reg) or null. if null then set l'text TSOPUTLN xla,r0,&len,&$xlalen l r15,=v(TSOPUTLN) basr r14,r15 aif (&@@tsoputln).x .*- .* module .*- &@@tsoputln setb 1 push using push print print &print *- * TSOPUTLN module *- .* set amode/rmode, expects both defaultet in macro prototype gblc &#modrmod,&#modamod .* amode aif ('&#modamod' ne '').#modam2 TSOPUTLN Amode 31 ago .#modamn .#modam2 anop TSOPUTLN Amode &#modamod .#modamn anop .* rmode aif ('&#modrmod' ne '').#modrm2 TSOPUTLN Rmode ANY ago .#modrmn .#modrm2 anop TSOPUTLN Rmode &#modrmod .#modrmn anop TSOPUTLN Csect save (14,12) lr r12,r15 Using TSOPUTLN,r12 Using @tputblk,r10 lr r2,r1 copy text/buffer address lr r3,r0 copy text length *- get storage la r9,@tputblkl+4(r3) blk+text length Getmain R,lv=(r9),loc=31 lr r10,r1 lr r0,r10 la r1,@tputblkl .* la r14,=al1(0) la r14,tsoputln_al10 la r15,1 mvcl r0,r14 st r10,8(,r13) chain st r13,4(,r10) save lr r13,r10 areas *- copy data la r1,4(,r3) set length sll r1,16 to upper halfword st r1,@tputlen store as prefix la r14,@tputtext target address lr r15,r3 copy length mvcl r14,r2 copy text *- obtain address of the upt through the extract facility la r0,@tputiopl EXTRACT (0),'S',FIELDS=(PSB,ASID),MF=(E,@tputextr) l r1,@tputiopl mvc @tputupta,pscbupt-pscb(r1) *- obtain address of the ect from the lwa control block l r1,@tputiopl+4 asid LOCASCB ASID=(1) l r1,ascbasxb-ascb(,r1) -> asxb l r1,asxblwa-asxb(,r1) -> lwa mvc @tputecta,lwapect-lwa(r1) get ect address *- do putline xc @tputecb,@tputecb xc @tputiopl(16),@tputiopl l r14,@tputupta l r15,@tputecta PUTLINE PARM=@tputmfl,UPT=(r14),ECT=(r15),ECB=@tputecb, c OUTPUT=(@tputlen,TERM,SINGLE,DATA),MF=(E,@tputiopl) lr r5,r15 *- release storage l r13,4(,r13) <- callers save area Freemain R,lv=(r9),a=(r10) *- back lr r15,r5 set return code lm r2,r12,28(r13) reload gregs l r14,12(,r13) return address br r14 and return tsoputln_al10 dc al1(0) drop r10,r12 *- * TSOPUTLN local dsects *- @tputblk dsect @tputsa1 ds 18a @tputextr EXTRACT MF=L * org @tputextr @tputecb ds a @tputecta ds a @tputupta ds a * org @tputiopl ds 4a @tputmfl PUTLINE MF=L @tputmsgl ds a @tputmsg ds cl255 @tputlen ds a @tputtext ds 0c @tputblkl equ *-@tputblk aif ('&dsects' ne 'YES').dsctn *- * TSOPUTLN IBM dsect expansions (if requested) *- IKJPSCB IHAASCB IHAASXB IKJEFLWA .dsctn anop pop print .* rejoin csect § Csect resume main pop using .x Mexit .*- .* XLA - subroutine, generate Lx instruction .* Syntax: macname XLA,reg,ahat .* what: label, (reg), 'literal', f/h/b.label .*- .XLA anop lclc &xlar,&xlap,&xla lcla &xlapn,&xlan &$xlalen setc '' &xlar setc '&syslist(2)' &xlapn seta 2 .xlanext anop &xlapn seta &xlapn+1 aif (&xlapn gt n'&syslist).xlan &xlap setc '&syslist(&xlapn)' aif (k'&xlap eq 0).xlanext aif ('&xlap '(1,1) eq '(').xlareg aif ('&xlap '(1,1) eq '''').xlalit aif ('&xlap '(2,1) eq '.').xlafld &xla setc t'&xlap aif ('&xla' eq 'N').xlanum la &xlar,&xlap &$xlalen setc 'l''&xlap' mexit .xlanum anop lgfi &xlar,&xlap mexit .xlafld anop &xlan seta k'&xlap-2 &xla setc '&xlap'(1,1) &xla setc Upper('&xla') aif ('&xla' ne 'F').xlafld2 &xla setc '' .xlafld2 anop &xlap setc '&xlap'(3,&xlan) l&xla &xlar,&xlap mexit .xlareg anop &xlan seta k'&xlap-2 &xlap setc '&xlap'(2,&xlan) lr &xlar,&xlap mexit .xlalit anop la &xlar,=c&xlap &xlan seta k'&xlap-2 &$xlalen setc '&xlan' .xlan mexit MEND