midrange.com code scratchpad
Name:
Memory processing routines
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
12/01/2011 12:54:54 am
IP:
Logged
Description:
Some RPG memory-related routines for dealing with spaces > 64K. 2 copybooks (PRCMEM_P and MEM_P) and the source for the PRCMEM module (which should be compiled as a *MODULE and then probably put into its own *SRVPGM). No warranties or anything like that. Don't blame me for nuthin'.... Any copyright resides with me (Rory Hewitt), but you can pretty much do as you please with the source.
Code:
  1. PRCMEM_P copybook
  2.  
  3.  
  4.       /IF DEFINED(PRCMEM_P)
  5.       /EOF
  6.       /ENDIF
  7.       /DEFINE PRCMEM_P
  8.       *
  9.       *‚minit() - Initialize allocated memory.
  10.       *
  11.      D minit           PR            10I 0 Extproc('minit')
  12.      D   memptr                        *   Value
  13.      D   memlen                      10I 0 Value
  14.      D   InzVal                    1024A   Value Varying Options(*Nopass)
  15.       *
  16.       *‚mset() - Set a section of memory to a value.
  17.       *
  18.      D mset            PR            10I 0 Extproc('mset')
  19.      D   memptr                        *   Value
  20.      D   memlen                      10I 0 Value
  21.      D  P_Data                    65535A   Value Varying
  22.      D  P_StartPos                   10I 0 Value Options(*Nopass)
  23.      D  P_Length                     10I 0 Value Options(*Nopass)
  24.       *
  25.       *‚mdup() - Duplicate allocated memory to new memory
  26.       *
  27.      D mdup            PR              *   Extproc('mdup')
  28.      D   memptr                        *   Value
  29.      D   memlen                      10I 0 Value
  30.       *
  31.       *‚mcopy() - Copy a section of memory to a variable.
  32.       *
  33.      D mcopy           PR            10I 0 Extproc('mcopy')
  34.      D   memptr                        *   Value
  35.      D   memlen                      10I 0 Value
  36.      D  VarAddr                        *   Value
  37.      D  VarSize                      10I 0 Value Options(*Nopass)
  38.      D  FromPos                      10I 0 Value Options(*Nopass)
  39.       *
  40.       *‚mscan() - Scan memory.
  41.       *
  42.      D mscan           PR            10I 0 Extproc('mscan')
  43.      D  Scan                      65535A   Value Varying
  44.      D   memptr                        *   Value
  45.      D   memlen                      10I 0 Value
  46.      D  P_StartPos                   10I 0 Value Options(*Nopass)
  47.      D  P_ScanType                   10I 0 Value Options(*Nopass)
  48.       *
  49.       *‚mreplace() - Replace memory
  50.       *
  51.      D mreplace        PR            10I 0 Extproc('mreplace')
  52.      D  ReplaceWith               65535A   Value Varying
  53.      D   memptr                        *   Value
  54.      D   memlen                      10I 0 Value
  55.      D  FromPos                      10I 0 Value
  56.      D  FromLen                      10I 0 Value Options(*Nopass)
  57.      D  DataLen                      10I 0 Value Options(*Nopass)
  58.       *
  59.       *‚mappend() - Append data to data in allocated memory
  60.       *
  61.      D mappend         PR            10I 0 Extproc('mappend')
  62.      D   memptr                        *   Value
  63.      D   memlen                      10I 0 Value
  64.      D  Data                      65535A   Value Varying
  65.      D  DataLen                      10I 0 Value Options(*Nopass)
  66.       *
  67.       *‚mlen() - Retrieve length of non-blank data in allocated memory
  68.       *
  69.      D mlen            PR            10I 0 Extproc('mlen')
  70.      D  Mem@                           *   Value
  71.      D  MemLen                       10I 0 Value
  72.       *
  73.  
  74.  
  75. MEM_P copybook
  76.  
  77.  
  78.       /IF DEFINED(MEM_P)
  79.       /EOF
  80.       /ENDIF
  81.       /DEFINE MEM_P
  82.       *
  83.      D memcpy          PR              *   Extproc('__memcpy')
  84.      D   target                        *   Value
  85.      D   source                        *   Value
  86.      D   len                         10U 0 Value
  87.       *
  88.      D memcpy2         PR              *   Extproc('__memcpy')
  89.      D   target                       1A   Options(*Varsize)
  90.      D   source                       1A   Options(*Varsize)
  91.      D   len                         10U 0 Value
  92.       *
  93.      D memset          PR              *   Extproc('__memset')
  94.      D   target                        *   Value
  95.      D   val                         10I 0 Value
  96.      D   len                         10U 0 Value
  97.       *
  98.      D memmove         pr              *   Extproc('_MEMMOVE')
  99.      D   rcvr                          *   Value
  100.      D   src                           *   Value
  101.      D   len                         10U 0 Value
  102.       *
  103.      D memcmp          PR            10I 0 extproc('memcmp')
  104.      D   buf1                          *   value
  105.      D   buf2                          *   value
  106.      D   cmpsize                     10I 0 value
  107.       *
  108.      D memchr          PR              *   extproc('memchr')
  109.      D   buf                           *   value
  110.      D   scanchar                    10I 0 value
  111.      D   bufsize                     10I 0 value
  112.       *
  113.      D memicmp         PR            10I 0 extproc('__memicmp')
  114.      D   buf1                          *   value
  115.      D   buf2                          *   value
  116.      D   cmpsize                     10U 0 value
  117.       *
  118.      D cpybytes        PR              *   Extproc('_CPYBYTES')
  119.      D   target                        *   Value
  120.      D   source                        *   Value
  121.      D   len                         10U 0 Value
  122.       *
  123.      D cpybytes2       PR              *   Extproc('_CPYBYTES')
  124.      D   target                       1A   Options(*Varsize)
  125.      D   source                       1A   Options(*Varsize)
  126.      D   len                         10U 0 Value
  127.       *
  128.  
  129.  
  130. PRCMEM module
  131.  
  132.  
  133.      H NOMAIN DEBUG(*YES)
  134.       *=====================================================================
  135.       /COPY QRPGLECPY,MEM_P                      ‚memcpy(), memset(), memmove() etc.
  136.       /COPY QRPGLECPY,PRCMEM_P                   ‚Memory processing
  137.       *=====================================================================
  138.       *‚minit() - Initialize allocated memory.
  139.       *=====================================================================
  140.      P minit           B                   Export
  141.      D                 PI            10I 0
  142.      D   MemPtr                        *   Value
  143.      D   MemLen                      10I 0 Value
  144.      D   P_InzVal                  1024A   Value Varying Options(*Nopass)
  145.       *---------------------------------------------------------------------
  146.      D rc              S             10I 0 Inz
  147.      D InzChar         DS
  148.      D   InzInt                       3I 0 Inz(64)
  149.       *---------------------------------------------------------------------
  150.       /free
  151.  
  152.         if %parms > 2;
  153.           if %len( P_InzVal ) = 1;
  154.             InzChar = P_InzVal;
  155.             callp(e) memset( MemPtr : InzInt : MemLen );
  156.           else;
  157.             rc = mset( memptr : memlen : P_InzVal : 1 : memlen );
  158.           endif;
  159.         else;
  160.           callp(e) memset( MemPtr : InzInt : MemLen );
  161.         endif;
  162.  
  163.         if %error or rc <> 0;
  164.           exsr *pssr;
  165.         endif;
  166.  
  167.         return 0;
  168.  
  169.         begsr *pssr;
  170.           return -1;
  171.         endsr;
  172.  
  173.       /end-free
  174.      P                 E
  175.       *=====================================================================
  176.       *‚mset() - Set a section of memory to a value.
  177.       *=====================================================================
  178.      P mset            B                   Export
  179.      D                 PI            10I 0
  180.      D  MemPtr                         *   Value
  181.      D  MemLen                       10I 0 Value
  182.      D  Data                      65535A   Value Varying
  183.      D  P_Start                      10I 0 Value Options(*Nopass)
  184.      D  P_SetLen                     10I 0 Value Options(*Nopass)
  185.       *---------------------------------------------------------------------
  186.      D DataPtr         S               *   Inz
  187.      D ToPtr           S               *   Inz
  188.      D DataLen         S             10I 0 Inz
  189.      D WrkLen          S             10I 0 Inz
  190.      D SetLen          S             10I 0 Inz
  191.      D Start           S             10I 0 Inz(0)
  192.       *---------------------------------------------------------------------
  193.       /free
  194.  
  195.         DataPtr = %addr( Data ) + 2;
  196.         DataLen = %len( Data );
  197.  
  198.         if %parms > 3 and P_Start > 1;
  199.           Start = P_Start - 1;
  200.         endif;
  201.  
  202.         if %parms > 4;
  203.           SetLen = P_SetLen;
  204.         else;
  205.           SetLen = DataLen;
  206.         endif;
  207.  
  208.         //‚Copy the data into the allocated memory as many times as it
  209.         //‚will fit (up to Len bytes).
  210.         ToPtr = MemPtr + Start;
  211.         WrkLen = DataLen;
  212.         dow SetLen >= WrkLen;
  213.           callp(e) memmove( ToPtr : DataPtr : DataLen );
  214.           if %error;
  215.             exsr *pssr;
  216.           endif;
  217.           ToPtr = ToPtr + DataLen;
  218.           WrkLen = WrkLen + DataLen;
  219.         enddo;
  220.  
  221.         //‚Add in any partial bit at the end
  222.         if WrkLen > SetLen;
  223.           callp(e) memmove( ToPtr : DataPtr : DataLen - (WrkLen - SetLen) );
  224.         else;
  225.           if WrkLen < ( SetLen + DataLen ); //‚Trailing blanks
  226.             callp(e) memset( ToPtr : 64 : SetLen - WrkLen + DataLen );
  227.           endif;
  228.         endif;
  229.  
  230.         return 0;
  231.  
  232.         begsr *pssr;
  233.           return -1;
  234.         endsr;
  235.  
  236.       /end-free
  237.      P                 E
  238.       *=====================================================================
  239.       *‚mdup() - Duplicate allocated memory to new memory
  240.       *=====================================================================
  241.      P mdup            B                   Export
  242.      D                 PI              *
  243.      D  FromPtr                        *   Value
  244.      D  FromLen                      10I 0 Value
  245.       *---------------------------------------------------------------------
  246.      D ToPtr           S               *   Inz
  247.       *---------------------------------------------------------------------
  248.       /free
  249.  
  250.         //‚Allocate new memory
  251.  
  252.         ToPtr = %alloc( FromLen );
  253.  
  254.         if ToPtr = *null;
  255.           exsr *pssr;
  256.         endif;
  257.  
  258.         //‚Copy existing memory to new memory
  259.  
  260.         return memcpy( ToPtr : FromPtr : FromLen );
  261.  
  262.         begsr *pssr;
  263.           return *null;
  264.         endsr;
  265.  
  266.       /end-free
  267.      P                 E
  268.       *=====================================================================
  269.       *‚mcopy() - Copy a section of memory to a variable.
  270.       *=====================================================================
  271.      P mcopy           B                   Export
  272.      D                 PI            10I 0
  273.      D  FromPtr                        *   Value
  274.      D  FromLen                      10I 0 Value
  275.      D  ToPtr                          *   Value
  276.      D  ToSize                       10I 0 Value Options(*Nopass)
  277.      D  FromPos                      10I 0 Value Options(*Nopass)
  278.       *---------------------------------------------------------------------
  279.       /free
  280.  
  281.         //‚Quit immediately if invalid data passed
  282.  
  283.         if FromPtr = *null or ToPtr = *null or FromLen = 0;
  284.           exsr *pssr;
  285.         endif;
  286.  
  287.         //‚Determine the start position to copy from
  288.  
  289.         if %parms > 4 and FromPos > 0;
  290.           if FromPos >= FromLen;
  291.             exsr *pssr;
  292.           endif;
  293.           FromLen = FromLen - FromPos + 1;
  294.           FromPtr = FromPtr + FromPos - 1;
  295.         endif;
  296.  
  297.         //‚If the variable is larger than the memory, initialize it to
  298.         //‚blanks. Also, don't copy more data than the variable can take.
  299.  
  300.         if %parms > 3;
  301.           if ToSize > FromLen;
  302.             callp(e) memset( ToPtr : 64 : ToSize );
  303.             if %error;
  304.               exsr *pssr;
  305.             endif;
  306.           endif;
  307.           if FromLen > ToSize;
  308.             FromLen = ToSize;
  309.           endif;
  310.         endif;
  311.  
  312.         //‚Copy the from-data to the to-variable
  313.  
  314.         callp(e) memmove( ToPtr : FromPtr : FromLen );
  315.         if %error;
  316.           exsr *pssr;
  317.         endif;
  318.  
  319.         return 0;
  320.  
  321.         begsr *pssr;
  322.           return -1;
  323.         endsr;
  324.  
  325.       /end-free
  326.      P                 E
  327.       *=====================================================================
  328.       *‚mscan() - Scan memory.
  329.       *=====================================================================
  330.      P mscan           B                   Export
  331.      D                 PI            10I 0
  332.      D  Scan                      65535A   Value Varying
  333.      D  Mem@                           *   Value
  334.      D  MemLen                       10I 0 Value
  335.      D  P_StartPos                   10I 0 Value Options(*Nopass)
  336.      D  P_ScanType                   10I 0 Value Options(*Nopass)
  337.       *---------------------------------------------------------------------
  338.      D ScanLen         S             10I 0
  339.      D Scan@           S               *
  340.      D Num             S              3U 0 Based(Scan@)
  341.      D StartPos        S             10I 0 Inz(0)
  342.      D ScanType        S             10I 0 Inz(0)
  343.      D Found@          S               *
  344.      D Search@         S               *
  345.      D Mem             S          65535A   Based(Mem@)
  346.       *---------------------------------------------------------------------
  347.       /free
  348.  
  349.         ScanLen = %len( Scan );
  350.  
  351.         if ScanLen = 0 or MemLen = 0 or MemLen < ScanLen;
  352.           return 0;                       //‚Invalid parameter values
  353.         endif;
  354.  
  355.         if %parms > 3 and P_StartPos > 1; //‚Check for passed start position
  356.           StartPos = P_StartPos - 1;
  357.         endif;
  358.  
  359.         if %parms > 4;                    //‚Check for passed scan type
  360.           ScanType = P_ScanType;
  361.         endif;
  362.  
  363.         if MemLen <= %size( Mem ); //‚Use RPG built-in %SCAN if possible
  364.           return %scan( Scan : %subst( Mem : 1 : MemLen ) : StartPos + 1 );
  365.         endif;
  366.  
  367.         //‚If the first character in SCAN is not likely to appear many
  368.         //‚times in the memory being scanned, use memchr() to search for
  369.         //‚the first character in SCAN and then use memcmp() to check for
  370.         //‚the remainder of SCAN.
  371.  
  372.         //‚If the first character in SCAN is likely to appear many times
  373.         //‚in the memory being scanned, simply move through the memory
  374.         //‚one position at a time, using memcmp() to check for the entire
  375.         //‚SCAN string.
  376.  
  377.         Search@ = Mem@ + StartPos;
  378.         Scan@ = %addr( Scan ) + 2;
  379.  
  380.         if ScanType = 0;
  381.           dou memcmp( Found@ : Scan@ : ScanLen ) = 0;
  382.             Found@ = memchr( Search@ : Num : MemLen - ( Search@ - Mem@ ) );
  383.             if Found@ = *null;
  384.               return 0;                 //‚String was not found
  385.             endif;
  386.             Search@ = Found@ + 1;
  387.           enddo;
  388.           return ( Found@ - Mem@ ) + 1; //‚Return found position
  389.         else;
  390.           dou Search@ = Mem@ + MemLen;
  391.             if memcmp( Search@ : Scan@ : ScanLen ) = 0;
  392.               return ( Search@ - Mem@ + 1 ); //‚Return found position
  393.             endif;
  394.             Search@ = Search@ + 1;
  395.           enddo;
  396.           return 0;                          //‚String was not found
  397.         endif;
  398.  
  399.         begsr *pssr;
  400.           return -1;
  401.         endsr;
  402.  
  403.       /end-free
  404.      P                 E
  405.       *=====================================================================
  406.       *‚mreplace() - Replace memory
  407.       *=====================================================================
  408.      P mreplace        B                   Export
  409.      D                 PI            10I 0
  410.      D  With                      65535A   Value Varying
  411.      D  Mem@                           *   Value
  412.      D  MemLen                       10I 0 Value
  413.      D  P_FromPos                    10I 0 Value
  414.      D  P_FromLen                    10I 0 Value Options(*Nopass)
  415.      D  P_DataLen                    10I 0 Value Options(*Nopass)
  416.       *---------------------------------------------------------------------
  417.      D WithLen         S             10I 0 Inz(0)
  418.      D With@           S               *
  419.      D FromPos         S             10I 0 Inz(0)
  420.      D FromLen         S             10I 0 Inz(0)
  421.      D DataLen         S             10I 0 Inz(0)
  422.      D WrkLen          S             10I 0 Inz(0)
  423.      D To@             S               *
  424.      D From@           S               *
  425.       *---------------------------------------------------------------------
  426.       /free
  427.  
  428.         With@ = %addr( With ) + 2;
  429.         WithLen = %len( %trimr( With ) );
  430.         FromPos = P_FromPos;
  431.  
  432.         //‚Determine the length of memory to replace
  433.         if %parms > 4;
  434.           FromLen = P_FromLen;
  435.         else;
  436.           FromLen = WithLen;
  437.         endif;
  438.  
  439.         //‚Replacement data won't fit in available space or data is invalid
  440.         if MemLen <= 0 or FromPos < 0 or FromLen < 0 or
  441.            FromPos - 1 + WithLen > MemLen;
  442.           exsr *pssr;
  443.         endif;
  444.  
  445.         //‚Determine non-blank length of allocated memory
  446.         if %parms > 5 and P_DataLen > 0 and P_DataLen <= MemLen;
  447.           DataLen = P_DataLen;
  448.         else;
  449.           DataLen = mlen( Mem@ : MemLen );
  450.         endif;
  451.         if DataLen < 0;
  452.           exsr *pssr;
  453.         endif;
  454.  
  455.         if FromPos > 0;
  456.           //‚If FromPos is specified, then we need to move existing data,
  457.           //‚so determine the amount of trailing characters to copy and
  458.           //‚then copy them after the From string (truncate if necessary).
  459.           //‚If the With string is shorter than the From string, then we
  460.           //‚must also overwrite the final data with blanks.
  461.           if FromLen <> WithLen;
  462.             To@ = Mem@ + FromPos + WithLen - 1;
  463.             From@ = Mem@ + FromPos + FromLen - 1;
  464.             WrkLen = DataLen - ( From@ - Mem@ );
  465.             if ( To@ - Mem@ ) + WrkLen > MemLen;
  466.               WrkLen = MemLen - ( To@ - Mem@ );
  467.             endif;
  468.             callp(e) memmove( To@ : From@ : WrkLen );
  469.             if %error;
  470.               exsr *pssr;
  471.             endif;
  472.             if WithLen < FromLen;
  473.               To@ = Mem@ + DataLen + WithLen - FromLen;
  474.               callp(e) memset( To@ : 64 : FromLen - WithLen );
  475.               if %error;
  476.                 exsr *pssr;
  477.               endif;
  478.             endif;
  479.           endif;
  480.         else;
  481.           //‚If FromPos is not specified, simply append the data to the end
  482.           //‚of the current string and set FromLen to zero, so return value
  483.           //‚is calculated correctly.
  484.           if DataLen + WithLen > MemLen;
  485.             exsr *pssr;
  486.           else;
  487.             FromPos = DataLen + 1;
  488.             FromLen = 0;
  489.           endif;
  490.  
  491.         endif;
  492.  
  493.         //‚Copy the With string into memory at the appropriate spot
  494.         To@ = Mem@ + FromPos - 1;
  495.         callp(e) memmove( To@ : With@ : WithLen );
  496.         if %error;
  497.           exsr *pssr;
  498.         endif;
  499.  
  500.         //‚Calculate the new non-blank data length.
  501.         Datalen = DataLen + WithLen - FromLen;
  502.         if DataLen > Memlen;
  503.           DataLen = MemLen;
  504.         endif;
  505.  
  506.         //‚Return the non-blank data length
  507.         return DataLen;
  508.  
  509.         begsr *pssr;
  510.           return -1;
  511.         endsr;
  512.  
  513.       /end-free
  514.      P                 E
  515.       *=====================================================================
  516.       *‚mappend() - Append data to memory
  517.       *=====================================================================
  518.      P mappend         B                   Export
  519.      D                 PI            10I 0
  520.      D  Mem@                           *   Value
  521.      D  MemLen                       10I 0 Value
  522.      D  Data                      65535A   Value Varying
  523.      D  P_DataLen                    10I 0 Value Options(*Nopass)
  524.       *---------------------------------------------------------------------
  525.      D DataLen         S             10I 0 Inz
  526.      D Prv@            S               *   Inz Static
  527.      D PrvLen          S             10I 0 Inz Static
  528.       *---------------------------------------------------------------------
  529.       /free
  530.  
  531.         if %parms > 3 and P_DataLen > 0;
  532.           DataLen = P_DataLen;
  533.         else;
  534.           DataLen = %len( Data );
  535.         endif;
  536.  
  537.         //‚If MemLen is passed as zero, reset PrvLen and return
  538.  
  539.         if MemLen = 0;
  540.           PrvLen = DataLen;
  541.           return 0;
  542.         endif;
  543.  
  544.         //‚Retrieve and save the pointer and non-blank length of the memory
  545.  
  546.         if Prv@ = *null or Prv@ <> Mem@;
  547.           Prv@ = Mem@;
  548.           PrvLen = mlen( Mem@ : MemLen );
  549.           if PrvLen = -1;
  550.             exsr *pssr;
  551.           endif;
  552.         endif;
  553.  
  554.         //‚Determine if the data will fit in the allocated length
  555.  
  556.         if PrvLen + DataLen > MemLen;
  557.           exsr *pssr;
  558.         endif;
  559.  
  560.         //‚Append the data to the existing non-blank data in memory
  561.  
  562.         callp(e)  memmove( Prv@ + PrvLen : %addr( Data ) : DataLen );
  563.         if %error;
  564.           exsr *pssr;
  565.         endif;
  566.         PrvLen = PrvLen + DataLen;
  567.  
  568.         return 0;
  569.  
  570.         begsr *pssr;
  571.           return -1;
  572.         endsr;
  573.  
  574.       /end-free
  575.      P                 E
  576.       *=====================================================================
  577.       *‚mlen() - Retrieve the non-blank length of allocated memory
  578.       *
  579.       *‚Check the allocated memory in 65535-byte blocks (starting from the
  580.       *‚end) and stop when the first non-blank block is found.
  581.       *=====================================================================
  582.      P mlen            B                   Export
  583.      D                 PI            10I 0
  584.      D  Mem@                           *   Value
  585.      D  MemLen                       10I 0 Value
  586.       *---------------------------------------------------------------------
  587.      D Block@          S               *
  588.      D Block           S          65535A   Based(Block@)
  589.      D BlockLen        C                   65535
  590.      D DataLen         S             10I 0 Inz(0)
  591.       *---------------------------------------------------------------------
  592.       /free
  593.  
  594.         if Mem@ = *Null or MemLen = 0;
  595.           exsr *pssr;
  596.         endif;
  597.  
  598.         //‚Determine non-blank data length
  599.  
  600.         if MemLen <= BlockLen;
  601.           Block@ = Mem@;
  602.           return %len( %trimr( %subst( Block : 1 : MemLen ) ) );
  603.         else;
  604.           Block@ = Mem@ + MemLen - BlockLen;
  605.           DataLen = MemLen;
  606.           dou DataLen <= 0;
  607.             DataLen = DataLen - BlockLen;
  608.             if Block <> *blanks;
  609.               return DataLen + %len( %trimr( Block ) );
  610.             endif;
  611.             if DataLen <= BlockLen;
  612.               Block@ = Mem@;
  613.               return %len( %trimr( %subst( Block : 1 : DataLen ) ) );
  614.             endif;
  615.             Block@ = Block@ - BlockLen;
  616.           enddo;
  617.         endif;
  618.  
  619.         begsr *pssr;
  620.           return -1;
  621.         endsr;
  622.  
  623.       /end-free
  624.      P                 E
  625.  
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css