Description
Description
win32_realloc() was passed 0x30, HeapSize() on the ptr says the block size is already 0x30.
inside S_change_engine_size
((RExC_state_t *)pRExC_state)->precomp is "(?x) \b strict .pmc? \z"
((RExC_state_t *)pRExC_state)->size is 1
((RExC_state_t *)pRExC_state)->parens_buf_size is 0
((RExC_state_t *)pRExC_state)->maxlen is 0
inside S_change_engine_size input stack argument const ptrdiff_t size is 1
inside STATIC regnode_offset S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const STRLEN extra_size) c stack input argument extra_size is 0
STATIC regnode_offset
S_regnode_guts_debug(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STRLEN extra_size) {
PERL_ARGS_ASSERT_REGNODE_GUTS_DEBUG;
assert(extra_size >= REGNODE_ARG_LEN(op) || REGNODE_TYPE(op) == ANYOF);
return S_regnode_guts(aTHX_ pRExC_state, extra_size);
}
why is extra_size >= REGNODE_ARG_LEN(op) >= operator and not >?
STATIC regnode_offset
S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const STRLEN extra_size)
{
/* Allocate a regnode that is (1 + extra_size) times as big as the
* smallest regnode worth of space, and also aligns and increments
* RExC_size appropriately.
*
* It returns the regnode's offset into the regex engine program */
const regnode_offset ret = RExC_emit;
PERL_ARGS_ASSERT_REGNODE_GUTS;
SIZE_ALIGN(RExC_size);
change_engine_size(pRExC_state, (ptrdiff_t) 1 + extra_size);
NODE_ALIGN_FILL(REGNODE_p(ret));
return(ret);
}
why does this have no logic to text if old and new sizes are equal? IDK enough to say if "are equal" is before or after whatever SIZE_ALIGN(RExC_size); does.
But now change_engine_size(pRExC_state, (ptrdiff_t) 1 + extra_size); is going to realloc() a ptr that was 0x30 before, with a new length of 0x30.
PL_curcop is pointing to line 13 at
Line 13 in 6fbe2c7
&& __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
The script executing is ..\miniperl.exe -I..\lib -f ..\write_buildcustomize.pl .. as the 1st process start ever of a fresh miniperl.exe binary.
callstack of the msize() assert() I added to catch this p = realloc(realloc(p,0x30),0x30); defect.
> miniperl.exe!win32_realloc(void * block, unsigned __int64 size) Line 5090 C
miniperl.exe!Perl_safesysrealloc(void * where, unsigned __int64 size) Line 308 C
miniperl.exe!S_change_engine_size(RExC_state_t * pRExC_state, const __int64 size) Line 12821 C
miniperl.exe!S_regnode_guts(RExC_state_t * pRExC_state, const unsigned __int64 extra_size) Line 12851 C
miniperl.exe!S_regnode_guts_debug(RExC_state_t * pRExC_state, const unsigned char op, const unsigned __int64 extra_size) Line 12862 C
miniperl.exe!S_reg_node(RExC_state_t * pRExC_state, unsigned char op) Line 12874 C
miniperl.exe!S_regatom(RExC_state_t * pRExC_state, long * flagp, unsigned long depth) Line 5911 C
miniperl.exe!S_regpiece(RExC_state_t * pRExC_state, long * flagp, unsigned long depth) Line 4811 C
miniperl.exe!S_regbranch(RExC_state_t * pRExC_state, long * flagp, long first, unsigned long depth) Line 4576 C
miniperl.exe!S_reg(RExC_state_t * pRExC_state, long paren, long * flagp, unsigned long depth) Line 4248 C
miniperl.exe!Perl_re_op_compile(sv * * const patternp, int pat_count, op * expr, const regexp_engine * eng, p5rx * old_re, bool * is_bare_re, const unsigned long orig_rx_flags, const unsigned long pm_flags) Line 1793 C
miniperl.exe!Perl_pmruntime(op * o, op * expr, op * repl, unsigned __int64 flags, long floor) Line 7765 C
miniperl.exe!Perl_bind_match(long type, op * left, op * right) Line 4338 C
miniperl.exe!Perl_yyparse(int gramtype) Line 1178 C
miniperl.exe!S_doeval_compile(unsigned char gimme, cv * outside, unsigned long seq, hv * hh) Line 4212 C
miniperl.exe!S_require_file(sv * sv) Line 5316 C
miniperl.exe!Perl_pp_require() Line 5346 C
miniperl.exe!Perl_runops_debug() Line 3003 C
miniperl.exe!Perl_call_sv(sv * sv, long arg_flags) Line 3342 C
miniperl.exe!Perl_call_list(long oldscope, av * paramList) Line 5456 C
miniperl.exe!S_process_special_blocks(long floor, const char * const fullname, gv * const gv, cv * const cv) Line 11666 C
miniperl.exe!Perl_newATTRSUB_x(long floor, op * o, op * proto, op * attrs, op * block, bool o_is_gv) Line 11500 C
miniperl.exe!Perl_utilize(int aver, long floor, op * version, op * idop, op * arg) Line 8267 C
miniperl.exe!Perl_yyparse(int gramtype) Line 461 C
miniperl.exe!S_parse_body(char * * env, void(*)() xsinit) Line 2779 C
miniperl.exe!perl_parse(interpreter * my_perl, void(*)() xsinit, int argc, char * * argv, char * * env) Line 2022 C
miniperl.exe!main(int argc, char * * argv, char * * env) Line 112 C
[Inline Frame] miniperl.exe!invoke_main() Line 78 C++
miniperl.exe!__scrt_common_main_seh() Line 288 C++
kernel32.dll!BaseThreadInitThunk�() Unknown
ntdll.dll!RtlUserThreadStart�() Unknown
Steps to Reproduce
Modify win32_realloc() inside the repo to be similar to this, on Linux this is probably called msize().
DllExport void *
win32_realloc(void *block, size_t size)
{
//return realloc(block,size);
if (size == 0) {
__debugbreak();
win32_free(block);
return NULL;
}
else if(!block) {
__debugbreak();
return win32_malloc(size);
}
SIZE_T oldlen = HeapSize(w32_crt_heap, HEAP_GENERATE_EXCEPTIONS, block);
if (size == oldlen)
__debugbreak();
return HeapReAlloc(w32_crt_heap, HEAP_GENERATE_EXCEPTIONS, block, size);
}
then run ..\miniperl.exe -I..\lib -f ..\write_buildcustomize.pl ..
Expected behavior
Don't do redundant realloc()s/Renew***()s/SvPV_shrink_to_cur(sv)s.
If the Perl VM doesn't the length of the memory blocks it obtained from libc, but now wants to shrink the memory blocks from an unknown larger size (hopefully shrinking from larger size during a shrinking operation), but not knowing the current valid length or what is the length of valid data/valid contents of the previously allocated (I hope so) block memory block, ...
That is called heap corruption.
Perl configuration
win64 x64 msvc 2022
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 41 /* epoch */
#define PERL_SUBVERSION 13 /* generation */
update
regcomp.c is spaghetti.
Line 476 in 6fbe2c7
#define NODE_ALIGN(node)
#define SIZE_ALIGN NODE_ALIGN
#undef OP
#undef OPERAND
#undef STRING
#undef NEXT_OFF
#undef NODE_ALIGN
#define NEXT_OFF(p) ((p)->head.data.next_off)
Search "SIZE_ALIGN" (2 hits in 2 files of 366 searched)
C:\sources\perl5\regcomp.c (1 hit)
Line 12849: SIZE_ALIGN(RExC_size);
C:\sources\perl5\regcomp.h (1 hit)
Line 476: #define SIZE_ALIGN NODE_ALIGN
Search "NODE_ALIGN" (7 hits in 2 files of 4806 searched)
C:\sources\perl5\regcomp.c (1 hit)
Line 12851: NODE_ALIGN_FILL(REGNODE_p(ret));
C:\sources\perl5\regcomp.h (6 hits)
Line 475: #define NODE_ALIGN(node)
Line 476: #define SIZE_ALIGN NODE_ALIGN
Line 482: #undef NODE_ALIGN
Line 499: #define NODE_ALIGN_FILL(node) (FLAGS(node) = 0)
Line 541: #undef NODE_ALIGN
Line 544: #define NODE_ALIGN(node)
Why do these macros even exist when they do nothing?
A quick sloppy git blame shows these macros became unused in recent new code
44eb4cd
Author: Yves Orton
Date: 3/21/2023 5:02:48 PM
Message: regcomp.h - use a common union for head and args across all regnodes.
a very old maybe related commit
830247a
Author: Ilya Zakharevich
Date: 11/17/2000 3:35:11 PM
Message: [PATCH 5.7.0] make regcomp reenterable