***********************************************************
      *  FRANCO STRINGARI PUDLER                                *
      *  PROGRAMA - Justifica uma string para esquerda          *
      *  Este programa foi desenvolvido com o objetivo unico    *
      *  para estudo. Sem garantia alguma.                      *
      ***********************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID.    JUSTIFICA.
       AUTHOR.        Franco Stringari Pudler.
       ENVIRONMENT    DIVISION.
       CONFIGURATION  SECTION.
       SPECIAL-NAMES.
       INPUT-OUTPUT   SECTION.
       FILE-CONTROL.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       77  W-POS              PIC 9(05) COMP-5.
       77  W-TMN              PIC 9(05) COMP-5.
       77  W-CRT              PIC X(01).
       77  W-FLG              PIC X(04) COMP-5.
       77  W-HAN              USAGE POINTER.
       77  W-STA              PIC S9(09) COMP-5.

       01  W-STR              PIC X(128) VALUE "
      -    " TESTE 123456789".


       LOCAL-STORAGE SECTION.

       LINKAGE SECTION.
       01  LK-TMN             PIC 9(05) COMP-5.

       01  LK-FLT             PIC X(01).

       01  LK-CRT             PIC X(01).

       01  LK-STR             PIC X(01).

       01  LK-SIZ             PIC X(04) COMP-5.
       01  LK-STA             PIC S9(09) COMP-5.
       01  LK-HAN             USAGE POINTER.

       PROCEDURE DIVISION.
       INICIO.
           MOVE  " "          TO W-CRT.
           MOVE  LENGTH OF W-STR TO W-TMN.
           CALL "JustLeft" USING W-TMN W-STR W-CRT W-STA.

           EXHIBIT W-STR.

           MOVE  X"00"        TO W-CRT.
           MOVE  "                   123" TO W-STR.

           CALL "JustLeft" USING W-TMN W-STR W-CRT W-STA.

           EXHIBIT W-STR.

           STOP RUN.

      *> Justifica a esquerda.
      *> Informe tamanho do campo a justificar, e o campo.
      *> Retorna o tamanho do campo valido e o campo justificado a esquerda.

       ENTRY "JustLeft" USING LK-TMN LK-STR LK-CRT LK-STA.
       INICIO.
           MOVE  LK-TMN      TO W-TMN.
           CALL "AlocaMemoria" USING W-HAN  *> Aloca memoria para esta tabela
                            BY VALUE LK-TMN  *> Tamanho da area a ser reservada
                            BY REFERENCE LK-STA.  *> Status de retorno
                            
           IF LK-STA NOT = ZEROS
              EXIT PROGRAM.                 

           SET   ADDRESS OF LK-FLT TO W-HAN.

          *> Inicializa variavel temporária.

           PERFORM VARYING W-POS FROM 1 BY 1
                     UNTIL W-POS > LK-TMN
              MOVE  LK-CRT       TO LK-FLT (W-POS:1).

          *> Localiza inicio da string a ser tratada

           PERFORM VARYING W-POS FROM 1 BY 1
                   UNTIL (LK-STR (W-POS:1) NOT = LOW-VALUES
                                       AND NOT = SPACES)
                      OR W-TMN < 1
              SUBTRACT 1 FROM W-TMN.

          *> Se encontrou algo justifica

           IF W-TMN > ZEROS
              MOVE  LK-STR (W-POS:W-TMN) TO LK-FLT (1:W-TMN)
              MOVE  LK-FLT (1:W-TMN) TO LK-STR (1:W-TMN)
           END-IF.

           CALL "LiberaMemoria" USING W-HAN       *> Endereco do LK-TABL
                                      LK-STA.            *> Status de retorno

           MOVE  W-TMN           TO LK-TMN.
           EXIT PROGRAM.

       ALOCAMEMORIA SECTION.
       ENTRY "AlocaMemoria" USING LK-HAN  *> Aloca memoria para esta tabela
                         BY VALUE LK-TMN  *> Tamanho da area a ser reservada
                         BY REFERENCE LK-STA.  *> Status de retorno

      *>$IF OSTYPE = "L"

           CALL "CBL_ALLOC_MEM" USING LK-HAN              *> Aloca memoria para este processo
                                BY VALUE LK-TMN
                                BY VALUE W-FLG.

           MOVE  ZEROS        TO LK-STA.
           IF Return-Code NOT = 0
              MOVE  RETURN-CODE TO LK-STA.

           EXIT PROGRAM.

       ALOCAMEMORIA SECTION.
       ENTRY "LiberaMemoria" USING LK-HAN  *> Aloca memoria para esta tabela
                                   LK-STA.  *> Status de retorno

           CALL "CBL_FREE_MEM" USING BY VALUE LK-HAN   *> Libera memoria usada pelas chaves
                         RETURNING LK-STA.

           EXIT PROGRAM.