************************************************************** 
      ************************************************************** 
      *            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.                                            
      **************************************************************