CATALS J.BIT2CHAR      /*  000058 CARD(S)  */
* $$ JOB JNM=BIT2CHAR,CLASS=4
* $$ LST CLASS=C
// JOB BIT2CHAR
/*       D=10/13/2000,T=03:57:20,L=PROG,N=J.BIT2CHAR,U=FRAN         */
/*       D=11/26/96,T=07:20:55,L=PROG,N=J.BIT2CHAR,U=FRAN           */
// OPTION LOG
// EXEC PROC=DSKPUNCH
// EXEC PROC=HLASM
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* SUBROUTINE: BIT2CHAR                                              *
*                                                                   *
* (C) 1993 LEO LANGEVIN                                             *
*                                                                   *
* PURPOSE: TO CONVERT ONE HEX BYTE INTO A STRING OF ONES AND ZEROES.*
*                                                                   *
* INPUT: R1 POINTS TO ADDRESS OF FIELD CONTAINING THE 8 1-BYTE      *
*   CHARACTERS, FOLLOWED BY THE SINGLE BYTE INPUT FIELD.            *
*                                                                   *
* OUTPUT: THE EIGHT BYTE OUTPUT FIELD IS MODIFIED.                  *
*                                                                   *
* NON-IBM MACROS: SUBRT                                             *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
BIT2CHAR AMODE 31
BIT2CHAR RMODE ANY
BIT2CHAR SUBRT ,                       START OF SUBROUTINE
         L     R4,0(R1)                POINT TO PASSED FIELD
         MVI   0(R4),C'0'              DEFAULT VALUE
         MVC   1(7,R4),0(R4)           IS ALL ZEROES
BC0000   TM    8(R4),B'10000000'       IS IT A 1 ?
         BZ    BC0010                  NO...PROCEED
         MVI   0(R4),C'1'              SET A BYTE ON
BC0010   TM    8(R4),B'01000000'       IS IT A 1 ?
         BZ    BC0020                  NO...PROCEED
         MVI   1(R4),C'1'              SET A BYTE ON
BC0020   TM    8(R4),B'00100000'       IS IT A 1 ?
         BZ    BC0030                  NO...PROCEED
         MVI   2(R4),C'1'              SET A BYTE ON
BC0030   TM    8(R4),B'00010000'       IS IT A 1 ?
         BZ    BC0040                  NO...PROCEED
         MVI   3(R4),C'1'              SET A BYTE ON
BC0040   TM    8(R4),B'00001000'       IS IT A 1 ?
         BZ    BC0050                  NO...PROCEED
         MVI   4(R4),C'1'              SET A BYTE ON
BC0050   TM    8(R4),B'00000100'       IS IT A 1 ?
         BZ    BC0060                  NO...PROCEED
         MVI   5(R4),C'1'              SET A BYTE ON
BC0060   TM    8(R4),B'00000010'       IS IT A 1 ?
         BZ    BC0070                  NO...PROCEED
         MVI   6(R4),C'1'              SET A BYTE ON
BC0070   TM    8(R4),B'00000001'       IS IT A 1 ?
         BZ    BC0080                  NO...PROCEED
         MVI   7(R4),C'1'              SET A BYTE ON
BC0080   SUBRT ,                       RETURN TO CALLER
         END
/*
// EXEC PROC=DSKLIBR
/&
* $$ EOJ
 
 
 
 
 
       CATALS J.CHAR2BIT      /*  000050 CARD(S)  */
* $$ JOB JNM=CHAR2BIT,CLASS=F
* $$ LST CLASS=C
// JOB CHAR2BIT
/*       D=10/13/2000,T=03:57:26,L=PROG,N=J.CHAR2BIT,U=FRAN         */
/*       D=11/26/96,T=07:21:09,L=PROG,N=J.CHAR2BIT,U=FRAN           */
// EXEC PROC=DSKPUNCH
// EXEC PROC=HLASM
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* SUBROUTINE: CHAR2BIT                                              *
*                                                                   *
* (C) 1993 LEO LANGEVIN                                             *
*                                                                   *
* PURPOSE: TO CONVERT A STRING OF 8 ONES AND ZEROES TO ONE HEX BYTE.*
*                                                                   *
* INPUT: R1 POINTS TO ADDRESS OF FIELD CONTAINING THE 8 1-BYTE      *
*   CHARACTERS, FOLLOWED BY THE SINGLE BYTE OUTPUT FIELD. THE INPUT *
*   FIELD MUST ONLY CONTAIN "1" AND "0" CHARACTERS.                 *
*                                                                   *
* OUTPUT: THE SINGLE BYTE OUTPUT FIELD IS MODIFIED. AN INVALID      *
*    INPUT FIELD WILL RESULT IN IT BEING CHANGED TO THE WORD        *
*    "INVALID!".                                                    *
*                                                                   *
* NON-IBM MACROS: SUBRT                                             *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CHAR2BIT AMODE 31
CHAR2BIT RMODE ANY
CHAR2BIT SUBRT ,                       START OF SUBROUTINE
         L     R4,0(R1)                POINT TO PASSED FIELD
         LR    R6,R4                   SAVE A COPY
         LA    R5,8(R4)                POINT TO OUTPUT FIELD
         MVI   0(R5),X'00'             DEFAULT VALUE
         LA    R2,B'10000000'          GET THE INITIAL CHECK
         LA    R3,8                    CHECK FOR 8 BITS
CB0010   CLI   0(R4),C'1'              IS IT A 1 ?
         BZ    CB0020                  YES...DO IT
         CLI   0(R4),C'0'              IS IT VALID ?
         BZ    CB0030                  YES...PROCEED
         MVC   0(8,R6),=C'INVALID!'    INSERT ERROR CODE
         B     CB0040                  AND EXIT
CB0020   STC   R2,CB0025+1             MODIFY THE OI
CB0025   OI    0(R5),X'00'             THIS IS THE INSTRUCTION
CB0030   LA    R4,1(,R4)               SKIP A BYTE
         SRL   R2,1                    SHIFT A BIT
         BCT   R3,CB0010               AND CHECK AGAIN
CB0040   SUBRT ,                       RETURN TO CALLER
         END
/*
// EXEC PROC=DSKLIBR
/&
* $$ EOJ