Intrinsic functions HEX-OF & HEX-TO-CHAR

[Sergio Samayoa]

Hi guys,

I need intrinsic functions HEX-OF & HEX-TO-CHAR and find out that they didn't exists yet in GNU COBOL.

I don't want to invent the wheel so, does someone has implemented in COBOL who can share with me?

I'm very rusty in COBOL :S

TIA.

[Emmad]

COBOL requires exact input and output description. HEX-OF (what)? Also, HEX-TO-CHAR(what)? are the arguments single character or are the arguments strings?

[Sergio Samayoa]

https://www.ibm.com/docs/en/cobol-zos/6.2?topic=functions-hex

But never mind, I'm writing them from scratch, I will share them when are ready - Newer USAGE made them easier to write than with ancient COBOL 74 I used to work with in the 80s.

Regards!

[Emmad]

Strange that GNU COBOL does not support them. Did you try to do a test using flag "-std=ibm-strict"? This should be compatible with IBM Enterprise Compiler.

Thank you for sharing the code in advance.

If nothing else works for you, here is a sample I coded quickly, it is not well tested and variable sizes need to be adjusted for your case:

IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
DATA DIVISION.
*>-------------------------------------------------
*> PROGRAM TO CONVERT A STRING TO HEX. 
*> SEE: https://www.rapidtables.com/convert/number/hex-to-decimal.html
*> Code is not optimized - Make sure you check the variable sizes
*> hardly tested using GNU COOBOL 
*>-------------------------------------------------
WORKING-STORAGE SECTION.
*>-------------------------------------------------
01 L       PIC S9(4) COMP.
01 I       PIC S9(4) COMP.
01 J       PIC S9(4) COMP.
01 HEX     PIC S9(9).
01 MSG     PIC X(10).
01 MSG-WRK PIC X(10).
01 CHAR    PIC X.
01 SGN     PIC S9.
01 LM1     PIC S9(4) COMP.
01 F.
   02 HEX-0-F PIC X(16) VALUE "0123456789ABCDEF".
   02 F REDEFINES HEX-0-F.
      03 B OCCURS 16 TIMES INDEXED BY IX PIC X.
*>-------------------------------------------------
PROCEDURE DIVISION.
*>-------------------------------------------------
DISPLAY "--------------------- Hello"

MOVE ZERO    TO MSG. PERFORM P1       *> 0
MOVE 9       TO MSG. PERFORM P1       *> 9
MOVE 12      TO MSG. PERFORM P1       *> 18
MOVE "F1"    TO MSG. PERFORM P1       *> 241
MOVE "-FF"   TO MSG. PERFORM P1       *> -255
MOVE "-C3F1" TO MSG. PERFORM P1       *> -50161
MOVE "+2EEE" TO MSG. PERFORM P1       *> 12014
MOVE "-e"    TO MSG. PERFORM P1       *> 12014
STOP RUN.
*>-------------------------------------------------
P1.
*>-------------------------------------------------

IF MSG = SPACES OR LOW-VALUES DISPLAY "STRING IS EMPTY-1" STOP RUN END-IF

COMPUTE L = FUNCTION LENGTH( FUNCTION TRIM(MSG) )  *> THIS BETTER BE EVEN
COMPUTE LM1 = L - 1
MOVE SPACE TO MSG-WRK
MOVE FUNCTION UPPER-CASE(MSG) TO MSG

IF MSG(1:1) = "-" THEN
              MOVE MSG(2: LM1) TO MSG-WRK
              MOVE -1 TO SGN
              MOVE LM1 TO L
ELSE              
    IF MSG(1:1) = "+" THEN
              MOVE MSG(2: LM1) TO MSG-WRK
              MOVE 1 TO SGN
              MOVE LM1 TO L
    ELSE
              MOVE 1 TO SGN
              MOVE MSG TO MSG-WRK
    END-IF
END-IF

IF L = 0 THEN DISPLAY "STRING IS TOO SHORT-2" STOP RUN END-IF

MOVE ZERO TO HEX
COMPUTE J = L 
PERFORM VARYING I FROM 1 BY 1 UNTIL I > L 
        MOVE MSG-WRK(I:1) TO CHAR
        SET IX TO 1
        SEARCH B AT END DISPLAY "BAD INPUT VALUE:" CHAR 
        WHEN CHAR=B(IX)
             COMPUTE IX = IX - 1
             COMPUTE J  = J  - 1
             COMPUTE HEX=HEX + IX * (16 ** J) 

             *>DISPLAY IX SPACE J SPACE HEX
        END-SEARCH
END-PERFORM
COMPUTE HEX=HEX * SGN
DISPLAY MSG SPACE HEX 
DISPLAY "---------------------".
*>------------------------------------------------- END OF CODE

[Sergio Samayoa]

Here are mine -
Regards!

      ******************************************************************
       IDENTIFICATION DIVISION. 
       FUNCTION-ID. BYTE-TO-HEX.

       DATA DIVISION. 

       WORKING-STORAGE SECTION.

       77  HEX-CHAR PIC X.
       77  HEX-CHAR-NUM REDEFINES HEX-CHAR PIC 9.              
       77  HEX-CHAR-VALUE USAGE BINARY-CHAR UNSIGNED.
       77  IGNORE-VALUE USAGE BINARY-LONG. 

       LINKAGE SECTION.

       01  BYTE-VALUE USAGE BINARY-CHAR UNSIGNED.
       01  HEX-STRING PIC XX.

       PROCEDURE DIVISION USING BYTE-VALUE
           RETURNING HEX-STRING. 
       MAIN.
           MOVE ZEROS TO HEX-STRING.
           DIVIDE BYTE-VALUE BY 16 
              GIVING HEX-CHAR-VALUE 
              REMAINDER IGNORE-VALUE.
           PERFORM GET-HEX-CHAR.
           MOVE HEX-CHAR TO HEX-STRING (1:1).
           COMPUTE HEX-CHAR-VALUE = BYTE-VALUE - 
              HEX-CHAR-VALUE * 16.
           PERFORM GET-HEX-CHAR.
           MOVE HEX-CHAR TO HEX-STRING (2:1).    
           GOBACK.

       GET-HEX-CHAR.
           MOVE "0" TO HEX-CHAR.
           IF HEX-CHAR-VALUE >= 0 AND <= 9 THEN
              MOVE HEX-CHAR-VALUE TO HEX-CHAR-NUM
           ELSE IF HEX-CHAR-VALUE = 10 THEN
              MOVE 'A' TO HEX-CHAR
           ELSE IF HEX-CHAR-VALUE = 11 THEN
              MOVE 'B' TO HEX-CHAR
           ELSE IF HEX-CHAR-VALUE = 12 THEN
              MOVE 'C' TO HEX-CHAR
           ELSE IF HEX-CHAR-VALUE = 13 THEN
              MOVE 'D' TO HEX-CHAR
           ELSE IF HEX-CHAR-VALUE = 14 THEN
              MOVE 'E' TO HEX-CHAR
           ELSE IF HEX-CHAR-VALUE = 15 THEN
              MOVE 'F' TO HEX-CHAR.

       END FUNCTION BYTE-TO-HEX.

      ******************************************************************
       IDENTIFICATION DIVISION. 
       FUNCTION-ID. HEX-TO-BYTE.

       DATA DIVISION. 

       WORKING-STORAGE SECTION.

       77  HEX-CHAR PIC X.
           88  HEX-CHAR-IS-A VALUES 'A', 'a'.
           88  HEX-CHAR-IS-B VALUES 'B', 'b'.
           88  HEX-CHAR-IS-C VALUES 'C', 'c'.
           88  HEX-CHAR-IS-D VALUES 'D', 'd'.
           88  HEX-CHAR-IS-E VALUES 'E', 'e'.
           88  HEX-CHAR-IS-F VALUES 'F', 'f'.
       77  HEX-CHAR-NUM REDEFINES HEX-CHAR PIC 9.              
       77  HEX-CHAR-VALUE USAGE BINARY-CHAR UNSIGNED.

       LINKAGE SECTION.

       01  HEX-STRING PIC XX.
       01  BYTE-VALUE USAGE BINARY-CHAR UNSIGNED.

       PROCEDURE DIVISION USING HEX-STRING 
           RETURNING BYTE-VALUE. 
       MAIN.
           MOVE ZERO TO BYTE-VALUE.
           MOVE HEX-STRING (1:1) TO HEX-CHAR.
           PERFORM GET-HEX-CHAR-VALUE.
           COMPUTE BYTE-VALUE = HEX-CHAR-VALUE * 16.
           MOVE HEX-STRING (2:1) TO HEX-CHAR.
           PERFORM GET-HEX-CHAR-VALUE.
           ADD HEX-CHAR-VALUE TO BYTE-VALUE.
           GOBACK.

       GET-HEX-CHAR-VALUE.
           MOVE ZERO TO HEX-CHAR-VALUE.
           IF HEX-CHAR >= '0' AND HEX-CHAR <= '9' THEN
              MOVE HEX-CHAR-NUM TO HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-A THEN
              MOVE 10 to HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-B THEN
              MOVE 11 to HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-C THEN
              MOVE 12 to HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-D THEN
              MOVE 13 to HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-E THEN
              MOVE 14 to HEX-CHAR-VALUE
           ELSE IF HEX-CHAR-IS-F THEN
              MOVE 15 to HEX-CHAR-VALUE.

       END FUNCTION HEX-TO-BYTE.

      ******************************************************************
       IDENTIFICATION DIVISION. 
       FUNCTION-ID. BUFFER-TO-HEX.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY. 
           FUNCTION BYTE-TO-HEX.

       DATA DIVISION.

       WORKING-STORAGE SECTION. 

       77  W-INDEX USAGE BINARY-SHORT.

       LINKAGE SECTION. 

       01  INPUT-BYTE-BUFFER.
           05  BYTE-VALUE USAGE BINARY-CHAR UNSIGNED 
               OCCURS 1000 TIMES.
       01  OUTPUT-HEX-BUFFER.
           05  HEX-STRING PIC XX OCCURS 1000 TIMES.

       PROCEDURE DIVISION 
           USING INPUT-BYTE-BUFFER
           RETURNING OUTPUT-HEX-BUFFER.
       MAIN.
           MOVE ZEROS TO OUTPUT-HEX-BUFFER.
           PERFORM VARYING W-INDEX FROM 1 BY 1 UNTIL W-INDEX > 1000 
              MOVE BYTE-TO-HEX(BYTE-VALUE (W-INDEX)) TO
                 HEX-STRING (W-INDEX)
           END-PERFORM.
           GOBACK.

       END FUNCTION BUFFER-TO-HEX.

      ******************************************************************
       IDENTIFICATION DIVISION. 
       FUNCTION-ID. HEX-TO-BUFFER.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY. 
           FUNCTION HEX-TO-BYTE.

       DATA DIVISION.

       WORKING-STORAGE SECTION. 

       77  W-INDEX USAGE BINARY-SHORT.

       LINKAGE SECTION. 

       01  INPUT-HEX-BUFFER.
           05  HEX-STRING PIC XX OCCURS 1000 TIMES.
       01  OUTPUT-BYTE-BUFFER.
           05  BYTE-VALUE USAGE BINARY-CHAR UNSIGNED 
               OCCURS 1000 TIMES.

       PROCEDURE DIVISION 
           USING INPUT-HEX-BUFFER
           RETURNING OUTPUT-BYTE-BUFFER.

       MAIN.
           MOVE LOW-VALUES TO OUTPUT-BYTE-BUFFER.
           PERFORM VARYING W-INDEX FROM 1 BY 1 UNTIL W-INDEX > 1000 
              MOVE HEX-TO-BYTE (HEX-STRING (W-INDEX)) TO
                 BYTE-VALUE (W-INDEX)
           END-PERFORM.
           GOBACK.

       END FUNCTION HEX-TO-BUFFER.

[Brian Tiffin]

We strive to include as many extensions as volunteer time and attention permit. Will take a peek at HEX-. At the moment, this laptop doesn't want to show those IBM doc pages...likely on my end with noscript or ublock.

By the by. The 202x Standard now includes FUNCTION BASECONVERT. That new feature will be going in as soon as feasible.

Basically,

DISPLAY FUNCTION BASECONVERT(arg1 inbase outbase)
DISPLAY BASECONVERT("ABCD", 16, 10)
DISPLAY BASECONVERT(43981, 10, 16)

The current draft Standard limits inbase and outbase to 2-16. arg1 can be an unsigned integer, if inbase is 2-10, otherwise expects a usage DISPLAY item, with "0-F" allowed. Exception codes set for invalid character for base, and what not. Returns character data "0-F".

I'm probably going to pester Simon about a strict mode for the 2-16 check, and open up the base range for default GnuCOBOL. We can support up to base36 "for free", and other base ranges after arguing over a few things. I'm a fan of base64 support for instance, but it'll require explicit docs about what character matches what number, etc. And I might argue, we at first only support base32, and purge ambiguous pairs, 1, one, l, little-ell, 0, zero, O, capital O, q, g, and something I'm forgetting. Far more human friendly than base36. But that's dreaming, Standard will be base-2 to hexadecimal range.

Won't be in GnuCOBOL in time to suit any immediate needs though, Sergio, but I don't think it'll be too long.

I've done this with built in libgmp functions and CALL, with C source code helper and as a user defined function.

https://sourceforge.net/p/gnucobol/discussion/contrib/thread/031203b3/

Basically

::cobolfree
    MOVE "12345" TO source-value
    MOVE 16 TO outbase
    CALL "CBL_OC_BASE_CONVERSION" USING
        BY REFERENCE input-number-as-string
        BY VALUE input-base
        BY REFERENCE output-buffer
        BY VALUE output-base
        RETURNING converted-length
    END-CALL

or

::cobolfree
01 hex-value pic x(7).

MOVE convert-base("3737844653", 10, 16) TO hex-value

Code is attached to the above link. It's old code, before the days of doing more low level things in straight up COBOL, ergo the C support code. Arbitrary precision in terms of the size of the numbers allowed.

Due to my limited understanding of UDF back then, convert-base is limited to an output of 256 "digits" in the returned output buffer. I picked a fixed length return buffer for the UDF, but the CALL version can handle arbitrarily long strings of digits, both for input and output.

Cheers,
Blue

[Simon Sobisch]

@btiffin Could you please try to integrate the 202x function into GC soon? It sounds that most of the actual work is already done, isn't it?

And a note: I've already added the two IBM functions (were requested by some people working on an IBM codebase conversion shortly before my vacation), this addition should be included very soon (I've already started to write the test cases, so possibly this week, still a lot mails to sort out before doing "actual" work). So don't mind those two intrinsic functions for now; I'll post a reference for the implementation here, too, so people can apply the patch to a local version of whatever GnuCOBOL (2.x+), too.

[Simon Sobisch]

@ssamayoagt
HEX-OF and HEX-TO-CHAR (along with BIT-OF and BIT-TO-CHAR) are now implemented with [r4323] and will be available with 3.2 RC-1 this month.

@btiffin: Is there any option that you can have a look at adding the missing pieces for COBOL 202x based on that?

[Emmad]

COOL :)

[Vincent (Bryan) Coen]

Now included in the PG manual.

On 02/09/2021 13:22, Simon Sobisch wrote:

@ssamayoagt https://sourceforge.net/u/ssamayoagt/
|HEX-OF| and |HEX-TO-CHAR| (along with |BIT-OF| and |BIT-TO-CHAR|) are
now implemented with [r4323]
https://sourceforge.net/p/gnucobol/code/4323/ and will be available
with 3.2 RC-1 this month.

@btiffin https://sourceforge.net/u/btiffin/: Is there any option
that you can have a look at adding the missing pieces for COBOL 202x
based on that?