COBOL - Example: ALLOCATE and FREE storage for UNBOUNDED tables



Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com

COBOL - Example: ALLOCATE and FREE storage for UNBOUNDED tables
Enterprise COBOL for z/OS, V4.2, Language Reference

Este exemplo ilustra uma maneira de gerenciar uma tabela UNBOUNDED que precisa ser aumentada dinamicamente em tamanho usando as instruções ALLOCATE e FREE.


 IDENTIFICATION DIVISION.
 PROGRAM-ID. ALLOC.

 ENVIRONMENT DIVISION.

 DATA DIVISION.

 WORKING-STORAGE SECTION.
 77  X              PIC 9(002) PACKED-DECIMAL.
 77  NUM-ELEMENTS   PIC 9(004) BINARY.
 77  SIZE-NEEDED    PIC 9(004) BINARY.
 77  VPTR                      POINTER.

 LINKAGE SECTION.

 01  VARGRP.
     02 OBJ PIC 9(004) COMP.
     02 TABGRP.
        03 VARTAB OCCURS 1 TO UNBOUNDED DEPENDING ON OBJ.
           04 T1 PIC 9(004).
           04 T2 PIC X(008).
           04 T3 PIC 9(004) COMP.
 01 BUFFER PIC X(1000).

 PROCEDURE DIVISION.

     DISPLAY ’Starting testcase ALLOC’
     SET VPTR To NULL

*************************************************************
* Aloque uma tabela com 20 elementos
*************************************************************

     COMPUTE NUM-ELEMENTS = 20
     PERFORM ALLOC-VARGRP

*************************************************************
* Defina alguns valores de 'teste' para validar a tabela re-alocada
*************************************************************

     COMPUTE T1(12) = 9999
     MOVE ’HI MOM’ TO T2 (17)
     DISPLAY ’ ’
     DISPLAY ’VARTAB(12) = ’ VARTAB(12)
     DISPLAY ’VARTAB(17) = ’ VARTAB(17)
     DISPLAY ’ ’

*************************************************************
* Precisa de uma tabela maior! Aloque um maior e copie dados 
*************************************************************

     COMPUTE NUM-ELEMENTS = 30
     PERFORM ALLOC-VARGRP

************************************************************** 
* Verifique se a nova tabela possui dados corretos do original
*************************************************************

     DISPLAY ’VARTAB(12) = ’ VARTAB(12)
     DISPLAY ’VARTAB(17) = ’ VARTAB(17)

 GOBACK.

*************************************************************
* Na primeira vez, aloque a tabela original. Se a mesa
* já foi alocado, assuma que estamos alocando
* um maior e deseja copiar os dados para ele
*************************************************************

  ALLOC-VARGRP.
     If VPTR = NULL Then *> Se for a primeira vez, aloque a tabela
       COMPUTE SIZE-NEEDED = LENGTH OF OBJ +
                           LENGTH OF VARTAB * NUM-ELEMENTS
       ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR
       SET ADDRESS OF VARGRP TO VPTR
       MOVE NUM-ELEMENTS TO OBJ

     Else                *> Se já tiver uma tabela, redimensionar

*********************************************************************
* Re-size!
* Primeiro, mapeie o BUFFER na tabela atual   
*********************************************************************
                                     
       SET ADDRESS OF BUFFER TO VPTR   

*********************************************************************
* Calcular novo tamanho a partir de NUM-ELEMENTS
*********************************************************************

     COMPUTE SIZE-NEEDED = LENGTH OF OBJ +
                           LENGTH OF VARTAB * NUM-ELEMENTS

     ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR

*************************************************************
* Mover dados da tabela antiga para a nova tabela maior
*************************************************************

     SET ADDRESS OF VARGRP TO VPTR
     MOVE NUM-ELEMENTS TO OBJ
     MOVE BUFFER(1:SIZE-NEEDED) TO VARGRP

*************************************************************
* Liberte a tabela original
*************************************************************

     SET VPTR TO ADDRESS OF BUFFER
     FREE VPTR
     .


© Copyright IBM Corp.