Friday, April 8, 2022

COBOL code to test BIT setting in a BINARY field

The below COBOL code tests whether 31st bit in "0100 0000 0000 0000 0000 0000 0000 0000" is ON.
 
        WORKING-STORAGE SECTION.                                         
       ***************************************************************** 
       * DETERMINE THE VALUE IN A SPECIFIC BIT IN A FULLWORD.          * 
       *                                                               * 
       * - 'BIT-POINTER'. MOVE A VALUE TO THIS FIELD TO INDICATE       * 
       *       WHICH BIT YOU WANT TO TEST. BIT '0' IS THE LOW-ORDER    * 
       *       BIT AND '31' IS THE HIGH-ORDER.                         * 
       * - 'RESULT-FIELD'. CONTAINS A VALUE OF '0' OR '1', INDICATING  * 
       *       THE VALUE OF THE BIT TO WHICH BIT-POINTER IS POINTING.  * 
       *                                                               * 
       ***************************************************************** 
        01  FEEDBACK-CODE.                                               
            05 FC-SEVERITY                 PIC S9(4) BINARY VALUE +0.    
            05 FC-MESSAGE                  PIC S9(4) BINARY VALUE +0.    
            05 FILLER                      PIC X(08).                    
        01  WS-WORK-FIELDS.                                              
           05 INPUT-BINARY-FIELD             PIC S9(9) COMP-5.           
           05 BIT-POINTER                    PIC S9(9) BINARY VALUE +0.  
           05 RESULT-FIELD                   PIC S9(9) BINARY VALUE +0.  
        PROCEDURE DIVISION.                                              
            MOVE 1073741824 TO INPUT-BINARY-FIELD                        
            MOVE +30 TO BIT-POINTER.                                     
            MOVE +0  TO RESULT-FIELD.                                    
            CALL 'CEESITST' USING INPUT-BINARY-FIELD,                    
                                  BIT-POINTER,                           
                                 FEEDBACK-CODE,                         
                                 RESULT-FIELD.                          
           IF FC-SEVERITY = +0                                          
              DISPLAY 'VALUE OF BIT ' BIT-POINTER ' IS ' RESULT-FIELD   
           ELSE                                                         
             DISPLAY 'BAD RETURN FROM CEESITST '                        
             DISPLAY 'FEEDBACK SEVERITY = ' FC-SEVERITY                 
             DISPLAY 'FEEDBACK MESSAGE  = ' FC-MESSAGE                  
           END-IF.                                                      
           GOBACK.                                                      


No comments:

Post a Comment

Note: Only a member of this blog may post a comment.