Example: ALLOCATE and FREE storage for UNBOUNDED tables

This example illustrates one way to manage an UNBOUNDED table that needs to be dynamically increased in size by using the ALLOCATE and FREE statements.

Start of change
*-----------------------------------------------------------------
* ALLOC: An example using the ALLOCATE and FREE statements to
*        allocate and resize an unbounded table.
*A-1-B--+----2----+----3----+----4----+----5----+----6----+----7-|
 identification division.
 program-id. ALLOC.
*
 environment division.
 data division.

 working-storage section.

 77  k                 pic 9(4) binary.
 77  move-size         pic 9(4) binary.
 77  num-elements      pic 9(4) binary.
*
 77  vargrp-ptr        pointer.
 77  vargrp-size       pic 9(4) binary.
 77  vargrp-old-ptr    pointer.
 77  vargrp-old-size   pic 9(4) binary.

 linkage section.

 01  vargrp.
   02  vartab-bound    pic 9(4) comp.
   02  vartab-group.
     03  vartab        occurs 1 to unbounded
                       depending on vartab-bound.
       04  t1          pic 9(4).
       04  t2          pic x(8).
       04  t3          pic 9(4) comp.

 01  vargrp-old        pic x(999999999).

/*****************************************************************
* main
******************************************************************
 procedure division.

     display "Start testcase ALLOC"

     *> allocate a table with 20 elements
     compute num-elements = 20
     perform vargrp-alloc

     *> Set some test values to validate re-allocated table
     compute t1(12) = 9999
     move "HI MOM" to t2(17)
     move "END-VGRP" to t2(20)
     perform vargrp-display

     *> allocate a bigger table and show content
     compute num-elements = 30
     perform vargrp-realloc
     perform vargrp-display

     *> allocate a smaller table and show content
     compute num-elements = 17
     perform vargrp-realloc
     perform vargrp-display

     display " "
     display "End testcase ALLOC"

     goback.

/*****************************************************************
* vargrp-alloc(num-elements)
******************************************************************
 vargrp-alloc.

     compute vargrp-size = length of vartab-bound
         + length of vartab * num-elements
     allocate vargrp-size characters
         initialized
         returning vargrp-ptr
     set address of vargrp to vargrp-ptr
     move num-elements to vartab-bound

     exit.

******************************************************************
* vargrp-realloc(num-elements)
******************************************************************
 vargrp-realloc.

     *> save the address/length of the current table
     set vargrp-old-ptr to vargrp-ptr
     compute vargrp-old-size = vargrp-size

     *> allocate the new copy
     perform vargrp-alloc

     *> copy the old data to the new area
     compute move-size =
         function min(vargrp-old-size, vargrp-size)
     set address of vargrp-old to vargrp-old-ptr
     move vargrp-old(1:move-size)
         to   vargrp(1:move-size)
     set address of vargrp-old to null
     move num-elements to vartab-bound

     *> free the old area
     free vargrp-old-ptr

     exit.

******************************************************************
* vargrp-display
******************************************************************
 vargrp-display.

     display "VARGRP is at 0x"
         function hex-of(vargrp-ptr)
         " with " vartab-bound " elements,"
         " size " vargrp-size " bytes."
     perform varying k from 1 by 1 until k > vartab-bound
         display "vartab(" k ") =" vartab(k)
     end-perform
     display " "

     exit.

 end program alloc.
End of change

Related references  
ALLOCATE statement  
FREE statement  
MOVE statement  
Working with unbounded tables and groups (Enterprise COBOL Programming Guide)