Code:
- PRCMEM_P copybook
-
-
- /IF DEFINED(PRCMEM_P)
- /EOF
- /ENDIF
- /DEFINE PRCMEM_P
- *
- *‚minit() - Initialize allocated memory.
- *
- D minit PR 10I 0 Extproc('minit')
- D memptr * Value
- D memlen 10I 0 Value
- D InzVal 1024A Value Varying Options(*Nopass)
- *
- *‚mset() - Set a section of memory to a value.
- *
- D mset PR 10I 0 Extproc('mset')
- D memptr * Value
- D memlen 10I 0 Value
- D P_Data 65535A Value Varying
- D P_StartPos 10I 0 Value Options(*Nopass)
- D P_Length 10I 0 Value Options(*Nopass)
- *
- *‚mdup() - Duplicate allocated memory to new memory
- *
- D mdup PR * Extproc('mdup')
- D memptr * Value
- D memlen 10I 0 Value
- *
- *‚mcopy() - Copy a section of memory to a variable.
- *
- D mcopy PR 10I 0 Extproc('mcopy')
- D memptr * Value
- D memlen 10I 0 Value
- D VarAddr * Value
- D VarSize 10I 0 Value Options(*Nopass)
- D FromPos 10I 0 Value Options(*Nopass)
- *
- *‚mscan() - Scan memory.
- *
- D mscan PR 10I 0 Extproc('mscan')
- D Scan 65535A Value Varying
- D memptr * Value
- D memlen 10I 0 Value
- D P_StartPos 10I 0 Value Options(*Nopass)
- D P_ScanType 10I 0 Value Options(*Nopass)
- *
- *‚mreplace() - Replace memory
- *
- D mreplace PR 10I 0 Extproc('mreplace')
- D ReplaceWith 65535A Value Varying
- D memptr * Value
- D memlen 10I 0 Value
- D FromPos 10I 0 Value
- D FromLen 10I 0 Value Options(*Nopass)
- D DataLen 10I 0 Value Options(*Nopass)
- *
- *‚mappend() - Append data to data in allocated memory
- *
- D mappend PR 10I 0 Extproc('mappend')
- D memptr * Value
- D memlen 10I 0 Value
- D Data 65535A Value Varying
- D DataLen 10I 0 Value Options(*Nopass)
- *
- *‚mlen() - Retrieve length of non-blank data in allocated memory
- *
- D mlen PR 10I 0 Extproc('mlen')
- D Mem@ * Value
- D MemLen 10I 0 Value
- *
-
-
- MEM_P copybook
-
-
- /IF DEFINED(MEM_P)
- /EOF
- /ENDIF
- /DEFINE MEM_P
- *
- D memcpy PR * Extproc('__memcpy')
- D target * Value
- D source * Value
- D len 10U 0 Value
- *
- D memcpy2 PR * Extproc('__memcpy')
- D target 1A Options(*Varsize)
- D source 1A Options(*Varsize)
- D len 10U 0 Value
- *
- D memset PR * Extproc('__memset')
- D target * Value
- D val 10I 0 Value
- D len 10U 0 Value
- *
- D memmove pr * Extproc('_MEMMOVE')
- D rcvr * Value
- D src * Value
- D len 10U 0 Value
- *
- D memcmp PR 10I 0 extproc('memcmp')
- D buf1 * value
- D buf2 * value
- D cmpsize 10I 0 value
- *
- D memchr PR * extproc('memchr')
- D buf * value
- D scanchar 10I 0 value
- D bufsize 10I 0 value
- *
- D memicmp PR 10I 0 extproc('__memicmp')
- D buf1 * value
- D buf2 * value
- D cmpsize 10U 0 value
- *
- D cpybytes PR * Extproc('_CPYBYTES')
- D target * Value
- D source * Value
- D len 10U 0 Value
- *
- D cpybytes2 PR * Extproc('_CPYBYTES')
- D target 1A Options(*Varsize)
- D source 1A Options(*Varsize)
- D len 10U 0 Value
- *
-
-
- PRCMEM module
-
-
- H NOMAIN DEBUG(*YES)
- *=====================================================================
- /COPY QRPGLECPY,MEM_P ‚memcpy(), memset(), memmove() etc.
- /COPY QRPGLECPY,PRCMEM_P ‚Memory processing
- *=====================================================================
- *‚minit() - Initialize allocated memory.
- *=====================================================================
- P minit B Export
- D PI 10I 0
- D MemPtr * Value
- D MemLen 10I 0 Value
- D P_InzVal 1024A Value Varying Options(*Nopass)
- *---------------------------------------------------------------------
- D rc S 10I 0 Inz
- D InzChar DS
- D InzInt 3I 0 Inz(64)
- *---------------------------------------------------------------------
- /free
-
- if %parms > 2;
- if %len( P_InzVal ) = 1;
- InzChar = P_InzVal;
- callp(e) memset( MemPtr : InzInt : MemLen );
- else;
- rc = mset( memptr : memlen : P_InzVal : 1 : memlen );
- endif;
- else;
- callp(e) memset( MemPtr : InzInt : MemLen );
- endif;
-
- if %error or rc <> 0;
- exsr *pssr;
- endif;
-
- return 0;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mset() - Set a section of memory to a value.
- *=====================================================================
- P mset B Export
- D PI 10I 0
- D MemPtr * Value
- D MemLen 10I 0 Value
- D Data 65535A Value Varying
- D P_Start 10I 0 Value Options(*Nopass)
- D P_SetLen 10I 0 Value Options(*Nopass)
- *---------------------------------------------------------------------
- D DataPtr S * Inz
- D ToPtr S * Inz
- D DataLen S 10I 0 Inz
- D WrkLen S 10I 0 Inz
- D SetLen S 10I 0 Inz
- D Start S 10I 0 Inz(0)
- *---------------------------------------------------------------------
- /free
-
- DataPtr = %addr( Data ) + 2;
- DataLen = %len( Data );
-
- if %parms > 3 and P_Start > 1;
- Start = P_Start - 1;
- endif;
-
- if %parms > 4;
- SetLen = P_SetLen;
- else;
- SetLen = DataLen;
- endif;
-
- //‚Copy the data into the allocated memory as many times as it
- //‚will fit (up to Len bytes).
- ToPtr = MemPtr + Start;
- WrkLen = DataLen;
- dow SetLen >= WrkLen;
- callp(e) memmove( ToPtr : DataPtr : DataLen );
- if %error;
- exsr *pssr;
- endif;
- ToPtr = ToPtr + DataLen;
- WrkLen = WrkLen + DataLen;
- enddo;
-
- //‚Add in any partial bit at the end
- if WrkLen > SetLen;
- callp(e) memmove( ToPtr : DataPtr : DataLen - (WrkLen - SetLen) );
- else;
- if WrkLen < ( SetLen + DataLen ); //‚Trailing blanks
- callp(e) memset( ToPtr : 64 : SetLen - WrkLen + DataLen );
- endif;
- endif;
-
- return 0;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mdup() - Duplicate allocated memory to new memory
- *=====================================================================
- P mdup B Export
- D PI *
- D FromPtr * Value
- D FromLen 10I 0 Value
- *---------------------------------------------------------------------
- D ToPtr S * Inz
- *---------------------------------------------------------------------
- /free
-
- //‚Allocate new memory
-
- ToPtr = %alloc( FromLen );
-
- if ToPtr = *null;
- exsr *pssr;
- endif;
-
- //‚Copy existing memory to new memory
-
- return memcpy( ToPtr : FromPtr : FromLen );
-
- begsr *pssr;
- return *null;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mcopy() - Copy a section of memory to a variable.
- *=====================================================================
- P mcopy B Export
- D PI 10I 0
- D FromPtr * Value
- D FromLen 10I 0 Value
- D ToPtr * Value
- D ToSize 10I 0 Value Options(*Nopass)
- D FromPos 10I 0 Value Options(*Nopass)
- *---------------------------------------------------------------------
- /free
-
- //‚Quit immediately if invalid data passed
-
- if FromPtr = *null or ToPtr = *null or FromLen = 0;
- exsr *pssr;
- endif;
-
- //‚Determine the start position to copy from
-
- if %parms > 4 and FromPos > 0;
- if FromPos >= FromLen;
- exsr *pssr;
- endif;
- FromLen = FromLen - FromPos + 1;
- FromPtr = FromPtr + FromPos - 1;
- endif;
-
- //‚If the variable is larger than the memory, initialize it to
- //‚blanks. Also, don't copy more data than the variable can take.
-
- if %parms > 3;
- if ToSize > FromLen;
- callp(e) memset( ToPtr : 64 : ToSize );
- if %error;
- exsr *pssr;
- endif;
- endif;
- if FromLen > ToSize;
- FromLen = ToSize;
- endif;
- endif;
-
- //‚Copy the from-data to the to-variable
-
- callp(e) memmove( ToPtr : FromPtr : FromLen );
- if %error;
- exsr *pssr;
- endif;
-
- return 0;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mscan() - Scan memory.
- *=====================================================================
- P mscan B Export
- D PI 10I 0
- D Scan 65535A Value Varying
- D Mem@ * Value
- D MemLen 10I 0 Value
- D P_StartPos 10I 0 Value Options(*Nopass)
- D P_ScanType 10I 0 Value Options(*Nopass)
- *---------------------------------------------------------------------
- D ScanLen S 10I 0
- D Scan@ S *
- D Num S 3U 0 Based(Scan@)
- D StartPos S 10I 0 Inz(0)
- D ScanType S 10I 0 Inz(0)
- D Found@ S *
- D Search@ S *
- D Mem S 65535A Based(Mem@)
- *---------------------------------------------------------------------
- /free
-
- ScanLen = %len( Scan );
-
- if ScanLen = 0 or MemLen = 0 or MemLen < ScanLen;
- return 0; //‚Invalid parameter values
- endif;
-
- if %parms > 3 and P_StartPos > 1; //‚Check for passed start position
- StartPos = P_StartPos - 1;
- endif;
-
- if %parms > 4; //‚Check for passed scan type
- ScanType = P_ScanType;
- endif;
-
- if MemLen <= %size( Mem ); //‚Use RPG built-in %SCAN if possible
- return %scan( Scan : %subst( Mem : 1 : MemLen ) : StartPos + 1 );
- endif;
-
- //‚If the first character in SCAN is not likely to appear many
- //‚times in the memory being scanned, use memchr() to search for
- //‚the first character in SCAN and then use memcmp() to check for
- //‚the remainder of SCAN.
-
- //‚If the first character in SCAN is likely to appear many times
- //‚in the memory being scanned, simply move through the memory
- //‚one position at a time, using memcmp() to check for the entire
- //‚SCAN string.
-
- Search@ = Mem@ + StartPos;
- Scan@ = %addr( Scan ) + 2;
-
- if ScanType = 0;
- dou memcmp( Found@ : Scan@ : ScanLen ) = 0;
- Found@ = memchr( Search@ : Num : MemLen - ( Search@ - Mem@ ) );
- if Found@ = *null;
- return 0; //‚String was not found
- endif;
- Search@ = Found@ + 1;
- enddo;
- return ( Found@ - Mem@ ) + 1; //‚Return found position
- else;
- dou Search@ = Mem@ + MemLen;
- if memcmp( Search@ : Scan@ : ScanLen ) = 0;
- return ( Search@ - Mem@ + 1 ); //‚Return found position
- endif;
- Search@ = Search@ + 1;
- enddo;
- return 0; //‚String was not found
- endif;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mreplace() - Replace memory
- *=====================================================================
- P mreplace B Export
- D PI 10I 0
- D With 65535A Value Varying
- D Mem@ * Value
- D MemLen 10I 0 Value
- D P_FromPos 10I 0 Value
- D P_FromLen 10I 0 Value Options(*Nopass)
- D P_DataLen 10I 0 Value Options(*Nopass)
- *---------------------------------------------------------------------
- D WithLen S 10I 0 Inz(0)
- D With@ S *
- D FromPos S 10I 0 Inz(0)
- D FromLen S 10I 0 Inz(0)
- D DataLen S 10I 0 Inz(0)
- D WrkLen S 10I 0 Inz(0)
- D To@ S *
- D From@ S *
- *---------------------------------------------------------------------
- /free
-
- With@ = %addr( With ) + 2;
- WithLen = %len( %trimr( With ) );
- FromPos = P_FromPos;
-
- //‚Determine the length of memory to replace
- if %parms > 4;
- FromLen = P_FromLen;
- else;
- FromLen = WithLen;
- endif;
-
- //‚Replacement data won't fit in available space or data is invalid
- if MemLen <= 0 or FromPos < 0 or FromLen < 0 or
- FromPos - 1 + WithLen > MemLen;
- exsr *pssr;
- endif;
-
- //‚Determine non-blank length of allocated memory
- if %parms > 5 and P_DataLen > 0 and P_DataLen <= MemLen;
- DataLen = P_DataLen;
- else;
- DataLen = mlen( Mem@ : MemLen );
- endif;
- if DataLen < 0;
- exsr *pssr;
- endif;
-
- if FromPos > 0;
- //‚If FromPos is specified, then we need to move existing data,
- //‚so determine the amount of trailing characters to copy and
- //‚then copy them after the From string (truncate if necessary).
- //‚If the With string is shorter than the From string, then we
- //‚must also overwrite the final data with blanks.
- if FromLen <> WithLen;
- To@ = Mem@ + FromPos + WithLen - 1;
- From@ = Mem@ + FromPos + FromLen - 1;
- WrkLen = DataLen - ( From@ - Mem@ );
- if ( To@ - Mem@ ) + WrkLen > MemLen;
- WrkLen = MemLen - ( To@ - Mem@ );
- endif;
- callp(e) memmove( To@ : From@ : WrkLen );
- if %error;
- exsr *pssr;
- endif;
- if WithLen < FromLen;
- To@ = Mem@ + DataLen + WithLen - FromLen;
- callp(e) memset( To@ : 64 : FromLen - WithLen );
- if %error;
- exsr *pssr;
- endif;
- endif;
- endif;
- else;
- //‚If FromPos is not specified, simply append the data to the end
- //‚of the current string and set FromLen to zero, so return value
- //‚is calculated correctly.
- if DataLen + WithLen > MemLen;
- exsr *pssr;
- else;
- FromPos = DataLen + 1;
- FromLen = 0;
- endif;
-
- endif;
-
- //‚Copy the With string into memory at the appropriate spot
- To@ = Mem@ + FromPos - 1;
- callp(e) memmove( To@ : With@ : WithLen );
- if %error;
- exsr *pssr;
- endif;
-
- //‚Calculate the new non-blank data length.
- Datalen = DataLen + WithLen - FromLen;
- if DataLen > Memlen;
- DataLen = MemLen;
- endif;
-
- //‚Return the non-blank data length
- return DataLen;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mappend() - Append data to memory
- *=====================================================================
- P mappend B Export
- D PI 10I 0
- D Mem@ * Value
- D MemLen 10I 0 Value
- D Data 65535A Value Varying
- D P_DataLen 10I 0 Value Options(*Nopass)
- *---------------------------------------------------------------------
- D DataLen S 10I 0 Inz
- D Prv@ S * Inz Static
- D PrvLen S 10I 0 Inz Static
- *---------------------------------------------------------------------
- /free
-
- if %parms > 3 and P_DataLen > 0;
- DataLen = P_DataLen;
- else;
- DataLen = %len( Data );
- endif;
-
- //‚If MemLen is passed as zero, reset PrvLen and return
-
- if MemLen = 0;
- PrvLen = DataLen;
- return 0;
- endif;
-
- //‚Retrieve and save the pointer and non-blank length of the memory
-
- if Prv@ = *null or Prv@ <> Mem@;
- Prv@ = Mem@;
- PrvLen = mlen( Mem@ : MemLen );
- if PrvLen = -1;
- exsr *pssr;
- endif;
- endif;
-
- //‚Determine if the data will fit in the allocated length
-
- if PrvLen + DataLen > MemLen;
- exsr *pssr;
- endif;
-
- //‚Append the data to the existing non-blank data in memory
-
- callp(e) memmove( Prv@ + PrvLen : %addr( Data ) : DataLen );
- if %error;
- exsr *pssr;
- endif;
- PrvLen = PrvLen + DataLen;
-
- return 0;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
- *=====================================================================
- *‚mlen() - Retrieve the non-blank length of allocated memory
- *
- *‚Check the allocated memory in 65535-byte blocks (starting from the
- *‚end) and stop when the first non-blank block is found.
- *=====================================================================
- P mlen B Export
- D PI 10I 0
- D Mem@ * Value
- D MemLen 10I 0 Value
- *---------------------------------------------------------------------
- D Block@ S *
- D Block S 65535A Based(Block@)
- D BlockLen C 65535
- D DataLen S 10I 0 Inz(0)
- *---------------------------------------------------------------------
- /free
-
- if Mem@ = *Null or MemLen = 0;
- exsr *pssr;
- endif;
-
- //‚Determine non-blank data length
-
- if MemLen <= BlockLen;
- Block@ = Mem@;
- return %len( %trimr( %subst( Block : 1 : MemLen ) ) );
- else;
- Block@ = Mem@ + MemLen - BlockLen;
- DataLen = MemLen;
- dou DataLen <= 0;
- DataLen = DataLen - BlockLen;
- if Block <> *blanks;
- return DataLen + %len( %trimr( Block ) );
- endif;
- if DataLen <= BlockLen;
- Block@ = Mem@;
- return %len( %trimr( %subst( Block : 1 : DataLen ) ) );
- endif;
- Block@ = Block@ - BlockLen;
- enddo;
- endif;
-
- begsr *pssr;
- return -1;
- endsr;
-
- /end-free
- P E
-
|
|