Character Definition Even before the advent of hex literals, many instances of hex values typed as unprintable characters in old programs co...
Character Definition
Even before the advent of hex literals, many instances of hex values typed as unprintable characters in old programs could have been avoided by the use of COBOL’s symbolic characters facility which assigns program-defined names to one-byte bit patterns. The bit pattern is designated by the ordinal number of the desired character in either EBCDIC or another character set, if specified. A character’s ordinal number equals its numeric bit value plus one. Therefore, the ordinal character numbers of an 8-bit character set run from 1 to 256.
In the example below, the words: CHARACTERS and IS are optional.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
SYMBOLIC CHARACTERS LOW-VAL IS 1
HEX-15 IS 22
HI-VAL IS 256.
PROCEDURE DIVISION.
MOVE HEX-15 TO WS-LINE-BREAK.
Class Tests
COBOL allows the use of user-defined class conditions, in addition to the predefined class conditions such as NUMERIC and ALPHABETIC.
In the example below, a user-defined class name is used to test for the exclusive presence of upper-case aplha, numbers, low-value, or blank.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
CLASS NAMECHAR IS
'A' THRU 'Z', X'40', '-', '_'.
PROCEDURE DIVISION.
EVALUATE TRUE
WHEN WS-TEST-LINE IS NAMECHAR
SET NAME-LINE TO TRUE
WHEN WS-TEST-LINE IS NUMERIC
SET NUMBER-LINE TO TRUE
WHEN OTHER
SET ERROR-LINE TO TRUE
END-EVALUATE.
Masking External Storage
Use reference modification to mask a length of external storage that is longer than the length of the Linkage Section field defined to access it.
WORKING-STORAGE SECTION.
01 WS-BYTES-100 PIC X(100).
LINKAGE SECTION.
01 LINK-HOLD-AREA PIC X(1).
PROCEDURE DIVISION USING LINK-HOLD-AREA.
MOVE WS-BYTES-100
TO LINK-HOLD-AREA(1:LENGTH OF WS-BYTES-100).
Address Manipulation
The following demonstrates methods of address manipulation. Note that the ADDRESS OFspecial register is a USAGE POINTER item and therefore cannot be used in a MOVEstatement.
WORKING-STORAGE SECTION.
01 FILLER.
05 WS-PTR USAGE IS POINTER.
05 WS-ADDR-X REDEFINES WS-PTR.
10 WS-ADDR PIC S9(8) COMP.
05 WS-SAVE-POINTER USAGE IS POINTER.
05 WS-SAVE-FULLWORD PIC S9(8) COMP.
05 WS-SAVE-CHAR-4 PIC X(4).
01 WS-DATA-AREA-1 PIC X(100).
01 WS-DATA-AREA-2 PIC X(200).
LINKAGE SECTION.
01 LINK-CALL-AREA.
05 LINK-DATA-ADDR PIC S9(8) COMP.
01 LINK-DATA-AREA PIC X(100).
PROCEDURE DIVISION USING LINK-CALL-AREA
LINK-DATA-AREA.
MOVE LINK-DATA-ADDR TO WS-ADDR.
SET ADDRESS OF LINK-DATA-AREA TO WS-PTR.
SET WS-PTR TO ADDRESS OF WS-DATA-AREA-1.
SET ADDRESS OF LINK-DATA-AREA TO WS-PTR.
SET WS-SAVE-POINTER TO WS-PTR.
MOVE WS-ADDR TO WS-SAVE-FULLWORD.
MOVE WS-ADDR-X TO WS-SAVE-CHAR-4.
SET ADDRESS OF LINK-DATA-AREA
TO ADDRESS OF WS-DATA-AREA-2.
*********** THIS WILL NOT COMPILE
*** MOVE ADDRESS OF WS-DATA-AREA-2 WS-ADDR.
***********
SET ADDRESS OF LINK-DATA-AREA TO WS-PTR.
Passing an Address
The following demonstrates how to access a variable-length record whose address was passed by the caller. This method, in which the data is moved to a layout in Working Storage, will map the fixed-length area which follows the variable-length area to the correct displacement. Coding the record layout in the Linkage Section will not. Note that an equals sign rather than the keyword, IS, is used to test a pointer for NULL.
WORKING-STORAGE SECTION.
01 FILLER.
05 LEN PIC S9(4) COMP.
01 VARLEN-RECORD.
05 VLR-FIXED-AREA-1.
10 FILLER PIC X(98).
10 VLR-ITEM-CNT PIC S9(4) COMP.
05 VLR-VAR-AREA.
10 VLR-VAR-ITEM OCCURS 1 TO 10 TIMES
DEPENDING ON VLR-ITEM-CNT.
15 VLR-VAR-FLD-1 PIC X(5).
15 VLR-VAR-FLD-2 PIC X(10).
05 VLR-FIXED-AREA-2 PIC X(25).
LINKAGE SECTION.
01 LINK-CALL-AREA.
05 LINK-VAR-SUB PIC S9(4) COMP.
05 LINK-RECORD-PTR USAGE IS POINTER.
01 LINK-RECORD-AREA PIC X(1).
PROCEDURE DIVISION USING LINK-CALL-AREA
LINK-RECORD-AREA.
COMPUTE LEN = (LENGTH OF VLR-FIXED-AREA-1)
+ (LENGTH OF VLR-FIXED-AREA-2)
+ LINK-VAR-SUB
* (LENGTH OF VLR-VAR-ITEM (1)).
MOVE LINK-VAR-SUB TO VLR-ITEM-CNT.
IF LINK-RECORD-PTR NOT = NULL
SET ADDRESS OF LINK-RECORD-AREA TO LINK-RECORD-PTR
MOVE LINK-RECORD-AREA(1:LEN) TO VARLEN-RECORD
END-IF.
Compact Key Break Logic
The following demonstrates very brief logic for a nested key breaking routine that performs each break level paragraph only once for a key sorted by Region, Section, Department, and Group.
WORKING-STORAGE SECTION.
01 FILE-KEY.
05 FK-THRU-DEPT.
10 FK-THRU-SECTION.
15 FK-REGION PIC X(3).
15 FK-SECTION PIC X(5).
10 FK-DEPT PIC X(6).
05 FK-GROUP PIC X(2).
01 SAVE-KEY.
05 SV-THRU-DEPT.
10 SV-THRU-SECTION.
15 SV-REGION PIC X(3).
15 SV-SECTION PIC X(5).
10 SV-DEPT PIC X(6).
05 SV-GROUP PIC X(2).
PROCEDURE DIVISION.
IF FILE-KEY NOT = SAVE-KEY
PERFORM GROUP-BREAK
IF FK-THRU-DEPT NOT = SV-THRU-DEPT
PERFORM DEPT-BREAK
IF FK-THRU-SECTION NOT = SV-THRU-SECTION
PERFORM SECTION-BREAK
IF FK-REGION NOT = SV-REGION
PERFORM REGION-BREAK.
No comments
Post a Comment