/* File: HASHTABLE.QRPGLESRC RPG Hashtable ala Java                     */
     /* Copyright (C) 2005  Dieter Bender  <db@bender-dv.de>                 */
     /*                                                                      */
     /* This program is free software; you can redistribute it and/or modify */
     /* it under the terms of the GNU General Public License as published by */
     /* the Free Software Foundation.                                        */
     /*                                                                      */
     /* This program is distributed in the hope that it will be useful,      */
     /* but WITHOUT ANY WARRANTY; without even the implied warranty of       */
     /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        */
     /* GNU General Public License for more details.                         */
     /*                                                                      */
     /* You should have received a copy of the GNU General Public License    */
     /* along with this program; if not, write to the Free Software          */
     /* Foundation, Inc., 59 Temple Place,                                   */
     /* Suite 330, Boston, MA  02111-1307   USA                              */
     /* You might find a version at http://www.gnu.org                       */
     /************************************************************************/
     h nomain
     D*B   CRTRPGMOD HASHTABLE
     D*B+       DBGVIEW(*SOURCE)
     D*B   CRTSRVPGM HASHTABLE
     D*B+       EXPORT(*ALL)
     D*B+       ACTGRP(*CALLER)
     D*B+       BNDDIR(QC2LE)
     /*---   Prototypes Export    ----------------------------------*/
      /DEFINE POINTER
      /COPY QRPGLEH,HASHTABLE
      /UNDEFINE POINTER
     /*---   Prototypes Import    ----------------------------------*/
      /COPY QRPGLEH,MEMCPY
      /COPY QRPGLEH,CEE4RAGE
     /*---   local Prototypes     ----------------------------------*/
     D alocBloc        PR
     D find            PR              n
     D                               36    value
     d exit            pr
     d actMark                       10u 0 options(*nopass)
     d reason                        10u 0 options(*nopass)
     d result                        10u 0 options(*nopass)
     d user                          10u 0 options(*nopass)
     d init            pr
     /*---   Constants            ----------------------------------*/
     d TRUE            c                   *ON
     d FALSE           c                   *OFF
     /*---   Types                ----------------------------------*/
     /*---   statefull Variables  ----------------------------------*/
     D Key             S             36    DIM(32767)
     D                                     BASED(KeyP)
     D ObjectP         S               *   DIM(32767)
     D                                     BASED(ObjectPP)
     D allocated       s               N   INZ(FALSE)
     D size            s             10i 0
     D used            S             10i 0
     D current         S             10i 0
     d initFlag        s               n   inz(FALSE)
     /*-------------------------------------------------------------*/
     /*---   SQL Work Variables   ----------------------------------*/
     p put             b                   export
     d put             pi              n
     D pKey                          36    VALUE
     D DSPointer                       *   value
     D plength                       10i 0 VALUE
     d result          s               n
      /free
                   if not initFlag;
                      init();
                   endif;
                if used = size  ;
                   alocBloc() ;
                endif ;
                select ;
                   when find(pKey) ;
                      ObjectP(current) = %realloc( ObjectP(current)
                                                 : pLength) ;
                   when find(' ') ;
                      ObjectP(current) = %alloc(pLength) ;
                      Key(current) = pKey ;
                   other ;
                      used = used + 1 ;
                      current = used ;
                      Key(current) = pKey ;
                      ObjectP(current) = %alloc(pLength) ;
                endsl ;
                memcpy(
                        ObjectP(current)
                      : DSPointer
                      : pLength
                      ) ;
                return TRUE     ;
      /end-free
     p put             e
     /*-------------------------------------------------------------*/
     p get             b                   export
     d get             pi              n
     D pKey                          36    VALUE
     D DSPointer                       *   value
     D pLength                       10i 0 VALUE
      /free
                if not find(pKey) ;
                   return FALSE ;
                else ;
                memcpy(
                        DSPointer
                      : ObjectP(current)
                      : pLength
                      ) ;
                return TRUE     ;
                endif ;
      /end-free
     p get             e
     /*-------------------------------------------------------------*/
     p remove          b                   export
     d remove          pi              n
     D pKey                          36    VALUE
     d result          s               n
      /free
                if find(pKey) ;
                   Key(current) = ' ' ;
                   dealloc(n) ObjectP(current) ;
                endif ;
                return TRUE ;
      /end-free
     p remove          e
     /*-------------------------------------------------------------*/
     p clearAll        b                   export
     d clearAll        pi              n
     D i               S             10i 0
      /free
                for i = 1 to used ;
                   dealloc(n) ObjectP(i) ;
                endfor ;
                dealloc(n) ObjectPP ;
                dealloc(n) KeyP ;
                size = 0;
                used = 0 ;
                current = 0 ;
                allocated = false ;
                return TRUE ;
      /end-free
     p clearAll        e
     /*-------------------------------------------------------------*/
     P alocBloc        B
     D alocBloc        PI
      /free
                size = size + 100 ;
                if allocated ;
                   KeyP = %realloc(KeyP : size * %size(Key)) ;
                   ObjectPP = %realloc( ObjectPP
                                   : size * %size(ObjectP)) ;
                else ;
                   KeyP = %alloc(size * %size(Key)) ;
                   ObjectPP = %alloc(size * %size(ObjectP)) ;
                   allocated = TRUE ;
                endif ;
      /end-free
     P alocBloc        E
     /*-------------------------------------------------------------------*/
     P find            B
     D find            PI              n
     D pKey                          36    value
      /free
                current = %lookup(
                                   pKey
                                 : Key
                                 : 1
                                 : used
                                 ) ;
                if current = 0 ;
                   return FALSE ;
                else ;
                   return TRUE ;
                endif ;
      /end-free
     P find            E
     /*-------------------------------------------------------------------*/
     P init            b
     d init            pi
      * called once at begin
     /*-------------------------------------------------------------*/
      /free
                   CEE4RAGE(%paddr(exit) : *OMIT);
                   // TODO your init code
                   initFlag = TRUE;
      /end-free
     P init            e
     /*-------------------------------------------------------------*/
     P exit            b
     d exit            pi
      * called at very end  by runtime
     d actMark                       10u 0 options(*nopass)
     d reason                        10u 0 options(*nopass)
     d result                        10u 0 options(*nopass)
     d user                          10u 0 options(*nopass)
     /*-------------------------------------------------------------*/
      /free
                   // TODO your exit code
                   return;
      /end-free
     P exit            e