//MARKJOBA JOB (0),'MARK',CLASS=A,MSGCLASS=T //STEPA EXEC PGM=IEBUPDTE,PARM=NEW //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=MARK.PROD.LIB.MACROS.ASM //SYSUT2 DD DISP=SHR,DSN=MARK.PROD.LIB.MACROS.ASM //SYSIN DD DATA,DLM=ZZ ./ ADD NAME=TODEC3 MACRO &LABEL TODEC3 ®=,&BUF=,&MF=L .* ******************************************************************* .* .* TODEC3 REG=REGISTER,BUF=STRING,MF=L(DEFAULT) or MF=R .* .* ® - register with binary value .* &S1 - 8 byte (minimum) output string field .* MF=L ... a data area name is passed for the output string field .* MF=R ... a register containing the address of the data area is .* passed for the output string field .* REGISTER 1 IS TRASHED .* .* Purpose: Convert a binary number (less than 1000) to a three .* digit displayable field in the output location. .* .* ******************************************************************* AIF ('®' EQ '').TD3ER01 AIF ('®(1)' EQ '1').TD3ER03 AIF ('&BUF' EQ '').TD3ER02 AIF ('&MF' NE 'L' AND '&MF' NE 'R').TD3ER04 .* &LABEL. B T3B&SYSNDX SKIP DATA AREA DS 0D T3A&SYSNDX DC D'0' PACKED DECIMAL WORK T3B&SYSNDX CVD ®,T3A&SYSNDX UNPK T3A&SYSNDX.(3),T3A&SYSNDX+6(2) OI T3A&SYSNDX+2,C'0' ZERO ZONE BIT .* Now move the three digits to the buffer AIF ('&MF' NE 'L').TD3SKP1 LA 1,&BUF LIST FORMAT, DATA NAME AGO .TD3SKP2 .TD3SKP1 LR 1,&BUF REGISTER FORMAT, REG HAS ADDR .TD3SKP2 MVC 0(3,1),T3A&SYSNDX MOVE 3 BYTES TO BUF MEXIT .* .* POSSIBLE ERROR MNOTES ARE BELOW .TD3ER01 MNOTE 12,'REG MUST BE A VALID REGISTER' MEXIT .TD3ER02 MNOTE 12,'BUF MUST BE A 3 BYTE CHAR FIELD' MEXIT .TD3ER03 MNOTE 12,'YOU CANNOT USE REGISTER 1 HERE' MEXIT .TD3ER04 MNOTE 12,'MF MUST BE MF=L OR MF=R' MEND ./ ADD NAME=TODEC8 MACRO &LABEL TODEC8 ®=,&BUF=,&MF=L .* ******************************************************************* .* .* TODEC8 REG=REGISTER,BUF=STRING,MF=L(DEFAULT) or MF=R .* .* ® - register with binary value .* &S1 - 8 byte (minimum) output string field .* MF=L ... a data area name is passed for the output string field .* MF=R ... a register containing the address of the data area is .* passed for the output string field .* REGISTER 1 IS TRASHED .* .* Purpose: Convert a binary number (less than 1000) to a three .* digit displayable field in the output location. .* .* ******************************************************************* AIF ('®' EQ '').TD8ER01 AIF ('®(1)' EQ '1').TD8ER03 AIF ('&BUF' EQ '').TD8ER02 AIF ('&MF' NE 'L' AND '&MF' NE 'R').TD8ER04 .* &LABEL. B T8B&SYSNDX SKIP DATA AREA DS 0D T8A&SYSNDX DS PL8 PACKED DECIMAL WORK T8B&SYSNDX CVD ®,T8A&SYSNDX AIF ('&MF' NE 'L').TD8SKP1 LA 1,&BUF LIST FORMAT, DATA NAME AGO .TD8SKP2 .TD8SKP1 LR 1,&BUF REGISTER FORMAT, REG HAS ADDR .TD8SKP2 UNPK 0(8,1),T8A&SYSNDX UNPACK FOR LENGTH 8 OI 7(1),X'F0' ZERO ZONE BIT MEXIT .* .* POSSIBLE ERROR MNOTES ARE BELOW .TD8ER01 MNOTE 12,'REG MUST BE A VALID REGISTER' MEXIT .TD8ER02 MNOTE 12,'BUF MUST BE A 8 BYTE CHAR FIELD' MEXIT .TD8ER03 MNOTE 12,'YOU CANNOT USE REGISTER 1 HERE' MEXIT .TD8ER04 MNOTE 12,'MF MUST BE MF=L OR MF=R' MEND ./ ADD NAME=STRTOBIN MACRO &LABEL STRTOBIN &STR=,&LEN=,&STRTYPE=L,&LENTYPE=L .* ******************************************************************* .* .* Proto: STRTOBIN &STR=,&LEN=,&STRTYPE=L,&LENTYPE=L .* Purpose: convert a character number to a binary number .* .* STR=xxx, STRTYPE=L STR must be a data area .* STR=Rn, STRTYPE=R STR address is passed in a register .* .* LEN=nn, LENTYPE=L LEN is hard coded, ie: LEN=5 .* LEN=Rn, LENTYPE=R LENgth value is in the register .* .* Returns: binary number in R1 .* .* ******************************************************************* AIF ('&STR' EQ '' OR '&LEN' EQ '').STRER01 AIF ('&STRTYPE' NE 'L' AND '&STRTYPE' NE 'R').STRER02 AIF ('&LENTYPE' NE 'L' AND '&LENTYPE' NE 'R').STRER02 &LABEL. B STA&SYSNDX SKIP DATA AREA SDA&SYSNDX DS 2F REGISTER SAVE AREA DS 0D SDB&SYSNDX PACK SDC&SYSNDX,0(*-*,3) ** EXECUTE ONLY ** SDC&SYSNDX DC D'0' STA&SYSNDX STM 3,4,SDA&SYSNDX AIF ('&STRTYPE' EQ 'L').STSKIP1 LR 3,&STR AGO .STSKIP2 .STSKIP1 ANOP STA&SYSNDX LA 3,&STR .STSKIP2 AIF ('&LENTYPE' EQ 'L').STSKIP3 LR 4,&LEN AGO .STSKIP4 .STSKIP3 LA 4,&LEN .STSKIP4 ANOP S 4,=F'1' len-1 (ie: if len is one we need 0) EX 4,SDB&SYSNDX convert R4 parmlist to decimal, len in R3 CVB 1,SDC&SYSNDX then to binary into R1 LM 3,4,SDA&SYSNDX MEXIT .STRER01 MNOTE 12,'BOTH STR AND LEN FIELDS ARE REQUIRED' MEXIT .STRER02 MNOTE 12,'STRTYPE AND LENTYPE CAN ONLY BE L OR R' MEND ./ ADD NAME=BIN2HEX MACRO &NAME BIN2HEX ®=,&BUF=,&TINYPRG=NO .* ******************************************************************** .* BIN2HEX - Debugging aid .* .* Converts the value in the register to a displayable 8 byte HEX .* string. .* .* Parameters .* REG= The register containing the binary value needing .* to be displayed .* BUF= The 8 byte field the returned HEX displayable .* sting is to be returned in .* TINYPRG= normally OK to leave as NO, see note below .* .* Important note: as I normally use this in small 'function test' .* programs those programs are often smaller than .* 255 bytes in size so the *-X'F0' before the TRT .* table will cause addressing outside the programs .* space and cause assembly to fail with a .* 'base and displacement cannot be resolved' error. .* So in small programs use the option TINYPRG=YES .* which creates a 255 byte buffer area allowing the .* the TRT table to be used. Obviously not required .* in large complex programs. .* .* ******************************************************************** AIF ('®' EQ '' OR '&BUF' EQ '').B2HERR1 B B2H&SYSNDX AIF ('&TINYPRG' EQ 'NO').B2HA DS CL255 OR *-X'F0' FAILS IF WE ARE A TINY PROGRAM .B2HA DS 0F Must align TRT&SYSNDX EQU *-X'F0' 16 Byte Translate Table. SPACE , * 0 1 2 3 4 5 6 7 8 9 A B C D E F SPACE , DC XL16'F0F1F2F3F4F5F6F7F8F9C1C2C3C4C5C6' F0 - FF BIN&SYSNDX DS XL4 4 Byte Binary Field. DS X 1 Byte Pad for UNPK. DIS&SYSNDX DS CL8 8 Byte Displayable Hex Field. DS C 1 Byte Pad for UNPK. B2H&SYSNDX ST ®,BIN&SYSNDX UNPK DIS&SYSNDX.(9),BIN&SYSNDX.(5) TR DIS&SYSNDX,TRT&SYSNDX DIS&SYSNDX is displayable value MVC &BUF.(8),DIS&SYSNDX Move to callers buffer area MEXIT .B2HERR1 MNOTE 12,'REG= AND BUF= MUST BOTH BE PROVIDED' MEND ./ ENDUP ZZ //