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?
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