Macro .*- .* .* Write a block of data in DUMP format: .* address hex-offset dec-offset hex-display-of-text text .* .* Each line dumps up to 32 bytes of data. .* .* The HEXDUMP module is generated internally 1st time around .* .* Syntax .* HEXDUMP DATA=(addr,length),DCB=dcb,PL=parmlist, .* HDR=hdr,WORK=wrka .* addr Address of data. .* length Length of data. .* dcb Address of DCB. .* Recfm may be fixed or variable. .* Record length must be 130 or greater for .* fixed, 134 or greater for variable. .* hdr Y/n for generate header. .* parmlist Address of 4-word parameter list. .* wrka Address of optional 512 byte workarea. If .* supplied it eliminates the programs need .* for a dynamically acquired area. .* .* address may be a label, (reg) or f.fullword. .* length may be a value, (reg) or f.fullword. .* f.fullword is the label of a fullword containing the value. .* .* The generated module is fully reentrant. .* .* Sample .* HexDump data=(databfr+32,512),dcb=logdcb,work=wrk1k, c .* hdr=n,pl=parmlist .* .* Author .* Willy Jensen .* mail: willy@harders-jensen.com .* web : http://harders-jensen.com/wjtech .*- &ml HexDump &dcb=,&data=,&hdr=Y,&work=,&pl=,&print=NOGEN, c &from=,&to= gblb &$hexdump lclc &s lcla &n,&olen,&ilen &s setc Upper('&syslist(1)') aif ('&s' eq 'XLA').xla aif ('&s' eq 'C2D').c2d aif ('&s' eq 'C2X').c2x &ml HexDump xla,r1,&pl parmlist HexDump xla,r14,&data(1) -> rec 1 HexDump xla,r15,&data(2),l'&data(1) size HexDump xla,r0,&dcb -> DCB stm r14,r0,0(r1) aif (k'&work gt 0).work oi 8(r1),x'80' set VL flag ago .flg .work anop HexDump xla,r14,&work st r14,12(r1) .flg anop &s setc Upper('&hdr') aif ('&s' eq 'Y').flgn oi 8(r1),x'01' set 'no hdr' flag .flgn anop call ZHexDump aif (&$hexdump).x &$hexdump setb 1 &s setc '&sysect' Push Using Push Print Print &print *- * hexdump module *- HexDumpStg Dsect HexDumpFlg ds a HexDumpSa ds 18a HexDumpRdw ds a HexDumpRec ds cl140 org HexDumpRec HexDumpRaddr ds cl8 ds c HexDumpRoffx ds cl4 ds c HexDumpRoffd ds cl6 ds 2c HexDumpRhex ds cl(8*9) ds 2c HexDumpRhexf ds c HexDumpRtext ds cl32 HexDumpRhexb ds c org HexDumpRlen equ *-HexDumpRec ds 0d HexDumpWrk ds xl64 HexDumpStgl equ *-HexDumpStg x11C = 284 bytes *- *- Using ZHexDump,r11 Using HexDumpStg,r10 ZHexDump Amode 31 ZHexDump Rmode any ZHexDump Csect Save (14,12) lr r11,r15 lr r7,r1 tm 8(r7),x'80' VL flag set => no storage jo HexDumpGm l r10,12(,r7) use passed storage mvi HexDumpflg,1 j HexDumpGmn HexDumpGm equ * Getmain R,lv=HexDumpStgl,loc=24 lr r10,r1 mvi HexDumpflg,2 HexDumpGmn equ * la r14,HexDumpSa st r14,8(,r13) st r13,4(,r14) lr r13,r14 * * r7 -> first byte of area * r8 -> size of area * r9 -> flags + dcb * r10 -> work (optional) * * DCB Map * 000024 DCBRECFM DS BL1 RECORD FORMAT * 00040 DCBRECV EQU DCBBIT1 VARIABLE RECORD LENGTH lr r2,r7 lm r7,r9,0(r7) sll r9,8 clear flags srl r9,8 just in case tm 8(r2),x'01' test hdr flag jo HexDumpHdn one => no hdr clear HexDumpRec mvc HexDumpRec(12),HexDumpHdr1 HexDump C2x,from=(0(,r2),4),to=HexDumpRec+13 mvc HexDumpRec+22(4),HexDumpHdr2 HexDump C2d,from=(6(r2),2),to=HexDumpRec+27 * write header fixed or variable la r3,HexDumpRec tm x'24'(r9),x'40' Variable format?? jz HexDumpHdw nope la r1,33+4 sll r1,16 st r1,HexDumpRdw la r3,HexDumpRdw HexDumpHdw put (9),(3) HexDumpHdn equ * sr r6,r6 block offset HexDumpA equ * ltr r8,r8 any remaining? jnp HexDumpX nope, get out clfi r8,32 test remaining size jl HexDumpS le 32 (short value) la r5,32 use full width j HexDumpF go format HexDumpS equ * lr r5,r8 use remaining HexDumpF equ * clear HexDumpRec mvc HexDumpWrk(64),HexDumpRec HexDump C2x,from=(0(,r7),(r5)),to=HexDumpWrk mvi HexDumpRhexf,c'*' mvi HexDumpRhexb,c'*' bctr r5,0 mch length ex r5,HexDumpCopy get data tr HexDumpRtext,HexDumpTab mvc HexDumpRhex(8),HexDumpWrk mvc HexDumpRhex+9(8),HexDumpWrk+8 mvc HexDumpRhex+18(8),HexDumpWrk+16 mvc HexDumpRhex+27(8),HexDumpWrk+24 mvc HexDumpRhex+37(8),HexDumpWrk+32 mvc HexDumpRhex+46(8),HexDumpWrk+40 mvc HexDumpRhex+55(8),HexDumpWrk+48 mvc HexDumpRhex+64(8),HexDumpWrk+56 st r7,HexDumpWrk HexDump C2x,from=(HexDumpWrk,4),to=HexDumpRaddr st r6,HexDumpWrk HexDump C2x,from=(HexDumpWrk+2,2),to=HexDumpRoffx HexDump C2d,from=(HexDumpWrk+2,2),to=HexDumpRoffd wrk+16 * write data fixed or variable la r3,HexDumpRec tm x'24'(r9),x'40' Variable format?? jz HexDumpRwr nope la r1,130+4 sll r1,16 st r1,HexDumpRdw la r3,HexDumpRdw HexDumpRwr put (9),(3) la r5,1(,r5) reinstate real length ar r6,r5 incr offset ar r7,r5 next block sr r8,r5 compute remaining clfi r8,0 test remaining size jh HexDumpA ok HexDumpX equ * l r13,4(,r13) -> old sa cli HexDumpFlg,2 passed storage jne HexDumpFmn yup Freemain R,lv=HexDumpStgl,a=(10) HexDumpFmn equ * l r14,12(,r13) -> return sr r15,r15 Return (2,12) * char-to-hex conversion sub * r14 -> source * r15 = source length * r1 -> target * r2 -> return HexDumpC2x ds 0a sr r0,r0 * upper nibble HexDumpC2xa ic r0,0(r14) insert into workreg one byte srl r0,4 shift last four bit away ahi r0,240 cfi r0,x'fa' nibble gt 9? jl *+8 ahi r0,-57 then use C'A'-C'F' stc r0,0(r1) * lower nibble ic r0,0(r14) insert into workreg one byte sll r0,28 leave srl r0,28 lower nibble ahi r0,240 cfi r0,x'fa' nibble gt 9? jl *+8 ahi r0,-57 then use C'A'-C'F' stc r0,1(r1) * next la r1,2(,r1) la r14,1(,r14) bct r15,HexDumpC2xa br r2 * HexDumpCopy mvc HexDumpRtext(*-*),0(r7) copy * HexDumpTab HexTab HexDumpHdr1 dc c'Hexdump addr' HexDumpHdr2 dc c'size' drop r10,r11 Pop Print Pop Using &s Loctr Mexit .*- .* XLA - subroutine, generate Lx instruction .* Syntax: macname XLA,reg,what .* what: label or (reg) or 'literal' or 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 &ml la &xlar,&xlap aif ('&xlap '(1,2) eq 'l''').mend &$xlalen setc 'l''&xlap' Mexit .xlanum anop &ml lgfi &xlar,&xlap ago .x .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 .*- .C2X ANOP la r14,&from(1) aif ('&from(2)'(1,1) eq '(').lr la r15,&from(2) ago .ln .lr anop &n seta k'&from(2) &s setc '&from(2)'(2,&n-2) lr r15,&s .ln anop la r1,&to to-addr to r1 st r2,28(,r13) bal r2,HexDumpc2x l r2,28(,r13) Mexit *- .C2D ANOP * load source to r15 sr r15,r15 &ilen seta &from(2) aif (&ilen eq 1).ld1 aif (&ilen eq 2).ld2 aif (&ilen eq 3).ld3 .ld4 icm r15,15,&from(1) &ilen seta 4 force length ago .ldn .ld3 icm r15,7,&from(1) ago .ldn .ld2 icm r15,3,&from(1) ago .ldn .ld1 icm r15,1,&from(1) .ldn anop cvd r15,60(,r13) * make decimal &olen seta &ilen*3 la r14,&to unpk &to.(&olen),60(8,r13) oi &to+&olen-1,x'f0' Mexit .*- .X Mend