How to execute a variable length UNPK instruction (IBM mainframe ASM) in COBOL?

Question

I have a legacy code written in ASM that is required to convert to COBOL.

The ASM code is as follows,

         EX    R8,UNPK1
         OI    UNWK16+15,X'F0'

UNPK1    UNPK  UNWK16(16),0(0,R4)
UNWK16   DC    CL16' ' 

The register R4 stores the address of contents in Packed format, the length is defined in R8.

For example, if R4 stores the address of content '123C' (2 bytes), then R8 stores 1 (2 bytes minus 1).

The above code is equivalent to

     UNPK    UNWK16(16),0(2,R4)

The execution result of this command, is '0000000000000123'.

If R4 stores the address of content '12345C' (3 bytes), then R8 stores 2 (3 bytes minus 1).

The above code is equivalent to

     UNPK    UNWK16(16),0(3,R4)

The execution result of this command, is '0000000000012345'.

Now I need to convert the above code to COBOL.

In COBOL, the conversion from PACKED decimal to string is automatic.

01 TEST PIC 9(8) COMP-3 VALUE 123.
01 TEST-PATTERN PIC 9(16).
01 TEST-STRING PIC X(16).

MOVE TEST TO TEST-PATTERN. 
MOVE TEST-PATTERN TO TEST-STRING.

The above command will store '0000000000000123' into TEST-STRING.

However, I could not find a way to exactly define the actual data length underlying the packed decimal.

For example, one way could be,

 01 R4                PIC X(16) VALUE X'123C'.
 01 R4-1  REDEFINES R1 PIC 9(1) COMP-3.
 01 R4-2  REDEFINES R1 PIC 9(2) COMP-3.
 ...
 01 R4-16 REDEFINES R1 PIC 9(16) COMP-3.

This doesn't really work because I cannot make sure a 9(3) COMP-3 is exactly 2 byte, and 9(5) COMP-3 is exactly 3 bytes.

Is there a way to write this in COBOL with exactly the same input and output as ASM?

Answer 1

Q: Is there a way to write this in COBOL with exactly the same input and output as ASM?

The example given in the OP is for unsigned values (the OI instruction and the absence of S in the PIC clauses). Should the same UNPK instruction be used for signed values, an adaptation to the following is required.

I also show there is no difference with a straight MOVE.

Note that the LINKAGE SECTION holds the PICTURE clauses that will be used by the MOVE statement. Using LENGTH OF ... - 1 assures those picture clauses will match the original.

Code:

       PROGRAM-ID. EX-UNPK.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  TEST-DATA COMP-3.
           03 FLD-1 PIC 9(1) VALUE 1.
           03 FLD-3 PIC 9(3) VALUE 123.
           03 FLD-5 PIC 9(5) VALUE 12345.
           03 FLD-7 PIC 9(7) VALUE 1234567.
           03 FLD-9 PIC 9(9) VALUE 123456789.
      * RESULT FIELD
       01  UNWK16 PIC 9(16).
      * SIMULATE USING R4 AS THE ADDRESS OF THE SOURCE
       01  R4-PTR USAGE POINTER.
      * SIMULATE USING R8 AS THE LENGTH VALUE FOR 'EX UNPK'
       01  R8 COMP PIC S9(8).
       LINKAGE SECTION.
       01  UNPK-1 COMP-3 PIC 9(1).
       01  UNPK-3 COMP-3 PIC 9(3).
       01  UNPK-5 COMP-3 PIC 9(5).
       01  UNPK-7 COMP-3 PIC 9(7).
       01  UNPK-9 COMP-3 PIC 9(9).
       PROCEDURE DIVISION.
       BEGIN.
      * USING UNPK PROCEDURE FOR 'EX UNPK ...'
           SET R4-PTR TO ADDRESS OF FLD-1
           COMPUTE R8 = LENGTH OF FLD-1 - 1
           PERFORM UNPK
           DISPLAY UNWK16

           SET R4-PTR TO ADDRESS OF FLD-3
           COMPUTE R8 = LENGTH OF FLD-3 - 1
           PERFORM UNPK
           DISPLAY UNWK16

           SET R4-PTR TO ADDRESS OF FLD-5
           COMPUTE R8 = LENGTH OF FLD-5 - 1
           PERFORM UNPK
           DISPLAY UNWK16

           SET R4-PTR TO ADDRESS OF FLD-7
           COMPUTE R8 = LENGTH OF FLD-7 - 1
           PERFORM UNPK
           DISPLAY UNWK16

           SET R4-PTR TO ADDRESS OF FLD-9
           COMPUTE R8 = LENGTH OF FLD-9 - 1
           PERFORM UNPK
           DISPLAY UNWK16

           DISPLAY SPACE
      * STRAIGHT MOVE
           MOVE FLD-1 TO UNWK16
           DISPLAY UNWK16

           MOVE FLD-3 TO UNWK16
           DISPLAY UNWK16

           MOVE FLD-5 TO UNWK16
           DISPLAY UNWK16

           MOVE FLD-7 TO UNWK16
           DISPLAY UNWK16

           MOVE FLD-9 TO UNWK16
           DISPLAY UNWK16

           GOBACK
           .
       UNPK.
           EVALUATE R8
           WHEN 0
               SET ADDRESS OF UNPK-1 TO R4-PTR
               MOVE UNPK-1 TO UNWK16
           WHEN 1
               SET ADDRESS OF UNPK-3 TO R4-PTR
               MOVE UNPK-3 TO UNWK16
           WHEN 2
               SET ADDRESS OF UNPK-5 TO R4-PTR
               MOVE UNPK-5 TO UNWK16
           WHEN 3
               SET ADDRESS OF UNPK-7 TO R4-PTR
               MOVE UNPK-7 TO UNWK16
           WHEN 4
               SET ADDRESS OF UNPK-9 TO R4-PTR
               MOVE UNPK-9 TO UNWK16
           END-EVALUATE
           .

Output:

Using UNPK procedure:

0000000000000001
0000000000000123
0000000000012345
0000000001234567
0000000123456789

Using straight MOVE

0000000000000001
0000000000000123
0000000000012345
0000000001234567
0000000123456789