COBOL example of building a linked list
Following is an example of how to build a linked list in a COBOL
program using callable services.
CBL C,LIB,RENT,LIST,QUOTE
*Module/File Name: IGZTLLST
****************************************************************
** *
** CESCSTO - Drive CEEGTST - obtain storage from user heap *
** for a linked list. *
** and CEEFRST - free linked list storage *
** *
** This example illustrates the construction of a linked *
** list using the LE storage management services. *
** *
** *
** 1. Storage for each list element is allocated from the *
** user heap, *
** *
** 2. The list element is initialized and appended to the *
** list. *
** *
** 3. After three members are appended, the list traversed *
** and the data saved in each element is displayed. *
** *
** 4. The linklist storage is freed. *
** *
****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CESCSTO.
DATA DIVISION.
*******************************************************
** Storage management parameters, including pointers **
** for the returned storage addresses. **
*******************************************************
WORKING-STORAGE SECTION.
01 LCOUNT PIC 9 USAGE DISPLAY VALUE 0.
01 HEAPID PIC S9(9) BINARY VALUE 0.
01 NBYTES PIC S9(9) BINARY.
01 FC.
05 FILLER PIC X(8).
COPY CEEIGZCT.
05 FILLER PIC X(4).
01 ADDRSS USAGE IS POINTER VALUE NULL.
01 ANCHOR USAGE IS POINTER VALUE NULL.
*******************************************************
** Define variables in linkage section in order to **
** reference storage returned as addresses in **
** pointer variables by Language Environment. **
*******************************************************
LINKAGE SECTION.
01 LIST-ITEM.
05 CHARDATA PIC X(80) USAGE DISPLAY.
05 NEXT-ITEM USAGE IS POINTER.
PROCEDURE DIVISION.
0001-BEGIN-PROCESSING.
DISPLAY "***************************************".
DISPLAY "CESCSTO COBOL Example is now in motion.".
DISPLAY "***************************************".
*******************************************************
** Call CEEGTST to get storage from user heap **
*******************************************************
MOVE LENGTH OF LIST-ITEM TO NBYTES
PERFORM 3 TIMES
ADD 1 TO LCOUNT
CALL "CEEGTST" USING HEAPID , NBYTES,
ADDRSS , FC
*******************************************************
** If storage storage is gotten successfully, an **
** address is returned by LE in the ADDRSS **
** parameter. The address of variable LIST-ITEM **
** in the linkage section can now be SET to address **
** the acquired storage. LIST-ITEM is appended to **
** the end of the list. The list origin is pointed **
** to by the variable ANCHOR. **
*******************************************************
IF CEE000 THEN
IF ANCHOR = NULL THEN
SET ANCHOR TO ADDRSS
ELSE
SET NEXT-ITEM TO ADDRSS
END-IF
SET ADDRESS OF LIST-ITEM TO ADDRSS
SET NEXT-ITEM TO NULL
MOVE " " TO CHARDATA
STRING "This is list item number " LCOUNT
DELIMITED BY SIZE INTO CHARDATA
ELSE
DISPLAY "Error in obtaining storage from heap"
GOBACK
END-IF
END-PERFORM.
*********************************************************
** On completion of the above loop, we have the **
** following layout: **
** **
** ANCHOR --> LIST-ITEM1 --> LIST-ITEM2 --> LIST-ITEM3 **
** **
** Loop thru list items 1 thru 3 and print out the **
** identifying text written in the CHARDATA fields. **
** **
** Test a counter variable to verify that three items **
** were indeed in the linked list. **
*********************************************************
MOVE 0 TO LCOUNT.
PERFORM WITH TEST AFTER UNTIL (ANCHOR = NULL)
SET ADDRESS OF LIST-ITEM TO ANCHOR
DISPLAY CHARDATA
SET ADDRSS TO ANCHOR
SET ANCHOR TO NEXT-ITEM
PERFORM 100-FREESTOR
ADD 1 TO LCOUNT
END-PERFORM.
IF (LCOUNT = 3 )
THEN
DISPLAY "**************************************"
DISPLAY "CESCSTO COBOL Example is now ended. "
DISPLAY "**************************************"
ELSE
DISPLAY "Error in List contruction ."
END-IF.
GOBACK.
100-FREESTOR.
*********************************************************
* Call CEEFRST to free this storage from user heap **
*********************************************************
CALL "CEEFRST" USING ADDRSS , FC.
IF CEE000 THEN
NEXT SENTENCE
ELSE
DISPLAY "Error freeing storage from heap"
END-IF.