**************************************************************
**************************************************************
* MAIN PROGRAM STACKY
**************************************************************
**************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. STACKY.
**************************************************************
* *
* THE PROGRAM READS A FILE OF RECORDS, PUSHES THE RECORDS *
* ONTO A STACK, THEN POPS THEM OFF AND PRINTS THE RECORDS *
* IN REVERSE ORDER. RECORDS ARE NOT PHYSICALLY PUSHED. *
* *
* - USES ALLOCATE AND FREE AVAILABLE IN VERSION 6.2 *
* - IF RUNNING IN VERSION 5.2, USE CEEGTST AND CEEFRST *
* *
**************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO MYIFILE.
DATA DIVISION.
FILE SECTION.
FD INPUT-FILE
RECORDING MODE IS F.
01 INPUT-REC.
10 PIC X(80).
WORKING-STORAGE SECTION.
01 CUST-REC.
10 CUST-FNAME PIC X(25).
10 CUST-LNAME PIC X(25).
10 CUST-PHONE-NUMBER PIC X(14).
10 PIC X(16).
01 MY-STACK.
05 ITEM-PTR USAGE IS POINTER OCCURS 1000 TIMES.
01 MY-STACK-NUM-VER REDEFINES MY-STACK.
05 ITEM-PTR-NUM PIC S9(9) BINARY OCCURS 1000 TIMES.
01 STACK-CNT PIC S9(9) BINARY VALUE 0.
01 J PIC S9(9) BINARY.
01 EOF-FLAG PIC X(3).
LINKAGE SECTION.
PROCEDURE DIVISION.
010-MAIN.
PERFORM PROCESS-ITEMS
GOBACK
.
PROCESS-ITEMS.
OPEN INPUT INPUT-FILE
*
* PUSH EACH INPUT RECORD ONTO THE STACK
*
READ INPUT-FILE INTO CUST-REC
AT END
MOVE "YES" TO EOF-FLAG
END-READ
PERFORM UNTIL EOF-FLAG = 'YES'
CALL 'PUSH' USING CUST-REC MY-STACK STACK-CNT
READ INPUT-FILE INTO CUST-REC
AT END
MOVE "YES" TO EOF-FLAG
END-READ
END-PERFORM
DISPLAY "FINISHED PUSHING RECORDS"
DISPLAY "STACK COUNT: " STACK-CNT
*
* PRINT THE PHYSICAL ADDRESS OF EACH ITEM ON THE STACK
*
PERFORM PRINT-STACK
*
* POP AND PRINT EACH RECORD ON THE STACK
*
PERFORM STACK-CNT TIMES
CALL 'POP' USING CUST-REC MY-STACK STACK-CNT
DISPLAY "POPPED RECORD: " CUST-REC
END-PERFORM
DISPLAY "FINISHED POPPING RECORDS"
DISPLAY "STACK COUNT: " STACK-CNT
CLOSE INPUT-FILE
.
PRINT-STACK.
PERFORM VARYING J FROM 1 BY 1 UNTIL J > STACK-CNT
DISPLAY "SUBSCRIPT: " J " POINTER: " ITEM-PTR-NUM(J)
END-PERFORM
.
**************************************************************
* SUBPROGRAM PUSH
**************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PUSH.
**************************************************************
* *
* THE PUSH PROGRAM ADDS AN ITEM ONTO THE STACK *
* *
**************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 APTR USAGE IS POINTER.
01 APTR-NUM REDEFINES APTR PIC S9(9) BINARY.
LINKAGE SECTION.
01 STACK-ITEM.
10 CUST-FNAME PIC X(25).
10 CUST-LNAME PIC X(25).
10 CUST-PHONE-NUMBER PIC X(14).
01 ITEM PIC X(64).
01 MY-STACK.
05 ITEM-PTR USAGE IS POINTER OCCURS 1000 TIMES.
01 STACK-CNT PIC S9(9) BINARY.
PROCEDURE DIVISION USING ITEM MY-STACK STACK-CNT.
START-PUSH.
ALLOCATE STACK-ITEM LOC 31 RETURNING APTR
IF APTR = NULL THEN
DISPLAY "ALLOCATION FAILED"
STOP RUN
END-IF
COMPUTE STACK-CNT = STACK-CNT + 1
SET ITEM-PTR(STACK-CNT) TO APTR
MOVE ITEM TO STACK-ITEM
DISPLAY "ADDED ITEM TO STACK = " STACK-ITEM
.
END PROGRAM PUSH.
**************************************************************
* SUBPROGRAM POP
**************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. POP.
**************************************************************
* *
* THE SUB PROGRAM ADDS AN ITEM ONTO THE STACK *
* *
**************************************************************
ENVIRONMENT DIVISION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 APTR USAGE IS POINTER.
01 APTR-NUM REDEFINES APTR PIC S9(9) BINARY.
LINKAGE SECTION.
01 MY-STACK.
05 ITEM-PTR USAGE IS POINTER OCCURS 1000 TIMES.
01 STACK-CNT PIC S9(9) BINARY.
01 WS-ITEM PIC X(64).
01 STACK-ITEM.
10 CUST-FNAME PIC X(25).
10 CUST-LNAME PIC X(25).
10 CUST-PHONE-NUMBER PIC X(14).
PROCEDURE DIVISION USING WS-ITEM MY-STACK STACK-CNT.
START-POP.
SET ADDRESS OF STACK-ITEM TO ITEM-PTR(STACK-CNT)
MOVE STACK-ITEM TO WS-ITEM
FREE ITEM-PTR(STACK-CNT)
SET ITEM-PTR(STACK-CNT) TO NULL
COMPUTE STACK-CNT = STACK-CNT - 1
.
END PROGRAM POP.
**************************************************************
END PROGRAM STACKY.
**************************************************************