perl5
perl5 copied to clipboard
Perl
mg.c: Perl_magic_get() dont call libc's getter func _errno() over and over
Ever since threads and SMP motherboards were invented, C's grammer token errno has been a function call returning an int * and not a extern "C" global data variable. Whether C grammer token is an inline asm intrinsic macro, or a traditional linker symbol in the C lang's symbol table, doesn't matter. On Windows errno is a macro to int * _errno(void) from ucrtbase.dll The UCRT dll from its day 1 upto atleast the UCRT dllfrom Win 10 ~2019, has a severe multi-eval bug in its C++/CPP getter method for its core TLS fetcher function. The multi-eval problem involves GetProcAddress(), and dynamic dispatching between TlsGetValue() and FlsGetValue(), and the rule that non-inlined function calls may never be de-duped for any reason. C++ operator overloading and CPP #define will never turn 10 method calls in a .i file or C++ template, into 1 method call and 1 POD size_t/void * variable. VC6, all msvcrt.dlls thru VC 2013, correctly only execute TlsGetValue() once and cache the result. UCRT does not.
A pathologic reading of the POSIX spec, guarentees sv_setnv() UBed the value inside errno, through some ISO C lexer token inside the sv.i file made from sv.c that defines the body of sv_setnv(). If libc.so is chmod to --x by root user, how can a user prove the machine code inside libc's memcpy() does not call libc's sqrt() function? All behavior is unspecified and valid until it is defined. A realistic, not pedantic, location where errno was UBed could be these 2 lines:
SV_CHECK_THINKFIRST_COW_DROP(sv); sv_upgrade(sv, SVt_PVNV);
This patch was written for Win32 perf reasons, and not POSIX/C compliance. The later are an afterthought. To fix all of the above, cache the retval of errno. The ticket for this patch has a before/after.
/////////// BEFORE
#endif /* End of platforms with special handling for $^E; others just fall
through to $! */
}
/* FALLTHROUGH */
case '!':
{
dSAVE_ERRNO;
000007FE93BE5B6F FF 15 1B 5B 04 00 call qword ptr [__imp__errno (07FE93C2B690h)]
000007FE93BE5B75 8B 30 mov esi,dword ptr [rax]
000007FE93BE5B77 FF 15 B3 57 04 00 call qword ptr [__imp_GetLastError (07FE93C2B330h)]
000007FE93BE5B7D 8B E8 mov ebp,eax
#ifdef VMS
sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
#else
sv_setnv(sv, (NV)errno);
000007FE93BE5B7F FF 15 0B 5B 04 00 call qword ptr [__imp__errno (07FE93C2B690h)]
000007FE93BE5B85 48 8B D7 mov rdx,rdi
000007FE93BE5B88 48 8B CB mov rcx,rbx
000007FE93BE5B8B 66 0F 6E 10 movd xmm2,dword ptr [rax]
000007FE93BE5B8F F3 0F E6 D2 cvtdq2pd xmm2,xmm2
000007FE93BE5B93 E8 34 84 F6 FF call Perl_sv_setnv (07FE93B4DFCCh)
#endif
#ifdef OS2
if (errno == errno_isOS2 || errno == errno_isOS2_set)
sv_setpv(sv, os2error(Perl_rc));
else
#endif
if (! errno) {
000007FE93BE5B98 FF 15 F2 5A 04 00 call qword ptr [__imp__errno (07FE93C2B690h)]
000007FE93BE5B9E 44 39 38 cmp dword ptr [rax],r15d
000007FE93BE5BA1 75 13 jne $add_groups+536h (07FE93BE5BB6h)
SvPVCLEAR(sv);
000007FE93BE5BA3 45 33 C9 xor r9d,r9d
000007FE93BE5BA6 45 33 C0 xor r8d,r8d
000007FE93BE5BA9 48 8B D7 mov rdx,rdi
000007FE93BE5BAC 48 8B CB mov rcx,rbx
000007FE93BE5BAF E8 D8 CE F6 FF call Perl_sv_setpv_bufsize (07FE93B52A8Ch)
}
000007FE93BE5BB4 EB 23 jmp $add_groups+559h (07FE93BE5BD9h)
else {
sv_string_from_errnum(errno, sv);
000007FE93BE5BB6 FF 15 D4 5A 04 00 call qword ptr [__imp__errno (07FE93C2B690h)]
000007FE93BE5BBC 4C 8B C7 mov r8,rdi
000007FE93BE5BBF 48 8B CB mov rcx,rbx
000007FE93BE5BC2 8B 10 mov edx,dword ptr [rax]
000007FE93BE5BC4 E8 17 F6 FF FF call Perl_sv_string_from_errnum (07FE93BE51E0h)
/* If no useful string is available, don't
* claim to have a string part. The SvNOK_on()
* below will cause just the number part to be valid */
if (!SvCUR(sv))
000007FE93BE5BC9 48 8B 07 mov rax,qword ptr [rdi]
000007FE93BE5BCC 4C 39 78 10 cmp qword ptr [rax+10h],r15
000007FE93BE5BD0 75 07 jne $add_groups+559h (07FE93BE5BD9h)
SvPOK_off(sv);
000007FE93BE5BD2 81 67 0C FF BB FF FF and dword ptr [rdi+0Ch],0FFFFBBFFh
}
RESTORE_ERRNO;
000007FE93BE5BD9 FF 15 B1 5A 04 00 call qword ptr [__imp__errno (07FE93C2B690h)]
000007FE93BE5BDF 8B CD mov ecx,ebp
000007FE93BE5BE1 89 30 mov dword ptr [rax],esi
000007FE93BE5BE3 FF 15 57 57 04 00 call qword ptr [__imp_SetLastError (07FE93C2B340h)]
}
SvRTRIM(sv);
000007FE93BE5BE9 BD 00 04 00 00 mov ebp,400h
000007FE93BE5BEE 85 6F 0C test dword ptr [rdi+0Ch],ebp
000007FE93BE5BF1 0F 84 40 FA FF FF je Perl_magic_get+30Bh (07FE93BE5637h)
000007FE93BE5BF7 4C 8B 17 mov r10,qword ptr [rdi]
000007FE93BE5BFA 4C 8B 4F 10 mov r9,qword ptr [rdi+10h]
000007FE93BE5BFE 49 8B 4A 10 mov rcx,qword ptr [r10+10h]
000007FE93BE5C02 48 85 C9 test rcx,rcx
000007FE93BE5C05 0F 84 24 FA FF FF je Perl_magic_get+303h (07FE93BE562Fh)
000007FE93BE5C0B 49 8D 51 FF lea rdx,[r9-1]
000007FE93BE5C0F BE 01 00 00 00 mov esi,1
000007FE93BE5C14 48 03 D1 add rdx,rcx
000007FE93BE5C17 4C 8D 35 E2 A3 EE FF lea r14,[`gai_strerrorW'::`2'::buff (07FE93AD0000h)]
000007FE93BE5C1E 41 B8 00 44 00 00 mov r8d,4400h
000007FE93BE5C24 0F B6 02 movzx eax,byte ptr [rdx]
000007FE93BE5C27 41 8B 84 86 B0 E3 2D 00 mov eax,dword ptr [r14+rax*4+2DE3B0h]
000007FE93BE5C2F 41 23 C0 and eax,r8d
000007FE93BE5C32 41 3B C0 cmp eax,r8d
000007FE93BE5C35 0F 85 F4 F9 FF FF jne Perl_magic_get+303h (07FE93BE562Fh)
000007FE93BE5C3B 48 2B D6 sub rdx,rsi
000007FE93BE5C3E 48 2B CE sub rcx,rsi
000007FE93BE5C41 75 E1 jne $add_groups+5A4h (07FE93BE5C24h)
SvNOK_on(sv); /* what a wonderful hack! */
break;
000007FE93BE5C43 E9 E7 F9 FF FF jmp Perl_magic_get+303h (07FE93BE562Fh)
case '\027': /* ^W & $^WARNING_BITS */
if (nextchar == '\0')
000007FE93BE5C48 84 D2 test dl,dl
000007FE93BE5C4A 75 11 jne $add_groups+5DDh (07FE93BE5C5Dh)
sv_setiv(sv, (IV)cBOOL(PL_dowarn & G_WARN_ON));
000007FE93BE5C4C 44 0F B6 83 B4 00 00 00 movzx r8d,byte ptr [rbx+0B4h]
000007FE93BE5C54 49 83 E0 01 and r8,1
000007FE93BE5C58 E9 23 FA FF FF jmp $add_groups (07FE93BE5680h)
else if (strEQ(remaining, "ARNING_BITS")) {
000007FE93BE5C5D 48 8D 15 9C 2E 1F 00 lea rdx,[string "ARNING_BITS" (07FE93DD8B00h)]
000007FE93BE5C64 48 8B CE mov rcx,rsi
000007FE93BE5C67 FF 15 4B 5C 04 00 call qword ptr [__imp_strcmp (07FE93C2B8B8h)]
////////// AFTER
#endif /* End of platforms with special handling for $^E; others just fall
through to $! */
}
/* FALLTHROUGH */
case '!':
{
dSAVE_ERRNO;
000007FE93F65B6F FF 15 1B 5B 04 00 call qword ptr [__imp__errno (07FE93FAB690h)]
000007FE93F65B75 8B 30 mov esi,dword ptr [rax]
000007FE93F65B77 FF 15 B3 57 04 00 call qword ptr [__imp_GetLastError (07FE93FAB330h)]
000007FE93F65B7D 66 0F 6E D6 movd xmm2,esi
#ifdef VMS
sv_setnv(sv, (NV)((saved_errno == EVMSERR) ? vaxc$errno : saved_errno));
#else
sv_setnv(sv, (NV)saved_errno);
000007FE93F65B81 48 8B D7 mov rdx,rdi
000007FE93F65B84 F3 0F E6 D2 cvtdq2pd xmm2,xmm2
000007FE93F65B88 48 8B CB mov rcx,rbx
000007FE93F65B8B 8B E8 mov ebp,eax
000007FE93F65B8D E8 3A 84 F6 FF call Perl_sv_setnv (07FE93ECDFCCh)
#endif
#ifdef OS2
if (saved_errno == errno_isOS2 || saved_errno == errno_isOS2_set)
sv_setpv(sv, os2error(Perl_rc));
else
#endif
if (! saved_errno) {
000007FE93F65B92 48 8B CB mov rcx,rbx
000007FE93F65B95 85 F6 test esi,esi
000007FE93F65B97 75 10 jne $add_groups+529h (07FE93F65BA9h)
SvPVCLEAR(sv);
000007FE93F65B99 45 33 C9 xor r9d,r9d
000007FE93F65B9C 45 33 C0 xor r8d,r8d
000007FE93F65B9F 48 8B D7 mov rdx,rdi
000007FE93F65BA2 E8 E5 CE F6 FF call Perl_sv_setpv_bufsize (07FE93ED2A8Ch)
}
000007FE93F65BA7 EB 1A jmp $add_groups+543h (07FE93F65BC3h)
else {
sv_string_from_errnum(saved_errno, sv);
000007FE93F65BA9 4C 8B C7 mov r8,rdi
000007FE93F65BAC 8B D6 mov edx,esi
000007FE93F65BAE E8 2D F6 FF FF call Perl_sv_string_from_errnum (07FE93F651E0h)
/* If no useful string is available, don't
* claim to have a string part. The SvNOK_on()
* below will cause just the number part to be valid */
if (!SvCUR(sv))
000007FE93F65BB3 48 8B 07 mov rax,qword ptr [rdi]
000007FE93F65BB6 4C 39 78 10 cmp qword ptr [rax+10h],r15
000007FE93F65BBA 75 07 jne $add_groups+543h (07FE93F65BC3h)
SvPOK_off(sv);
000007FE93F65BBC 81 67 0C FF BB FF FF and dword ptr [rdi+0Ch],0FFFFBBFFh
}
RESTORE_ERRNO;
000007FE93F65BC3 FF 15 C7 5A 04 00 call qword ptr [__imp__errno (07FE93FAB690h)]
000007FE93F65BC9 8B CD mov ecx,ebp
000007FE93F65BCB 89 30 mov dword ptr [rax],esi
000007FE93F65BCD FF 15 6D 57 04 00 call qword ptr [__imp_SetLastError (07FE93FAB340h)]
}
SvRTRIM(sv);
000007FE93F65BD3 BD 00 04 00 00 mov ebp,400h
000007FE93F65BD8 85 6F 0C test dword ptr [rdi+0Ch],ebp
000007FE93F65BDB 0F 84 56 FA FF FF je Perl_magic_get+30Bh (07FE93F65637h)
000007FE93F65BE1 4C 8B 17 mov r10,qword ptr [rdi]
000007FE93F65BE4 4C 8B 4F 10 mov r9,qword ptr [rdi+10h]
000007FE93F65BE8 49 8B 4A 10 mov rcx,qword ptr [r10+10h]
000007FE93F65BEC 48 85 C9 test rcx,rcx
000007FE93F65BEF 0F 84 3A FA FF FF je Perl_magic_get+303h (07FE93F6562Fh)
000007FE93F65BF5 49 8D 51 FF lea rdx,[r9-1]
000007FE93F65BF9 BE 01 00 00 00 mov esi,1
000007FE93F65BFE 48 03 D1 add rdx,rcx
000007FE93F65C01 4C 8D 35 F8 A3 EE FF lea r14,[`gai_strerrorW'::`2'::buff (07FE93E50000h)]
000007FE93F65C08 41 B8 00 44 00 00 mov r8d,4400h
000007FE93F65C0E 0F B6 02 movzx eax,byte ptr [rdx]
000007FE93F65C11 41 8B 84 86 B0 E3 2D 00 mov eax,dword ptr [r14+rax*4+2DE3B0h]
000007FE93F65C19 41 23 C0 and eax,r8d
000007FE93F65C1C 41 3B C0 cmp eax,r8d
000007FE93F65C1F 0F 85 0A FA FF FF jne Perl_magic_get+303h (07FE93F6562Fh)
000007FE93F65C25 48 2B D6 sub rdx,rsi
000007FE93F65C28 48 2B CE sub rcx,rsi
000007FE93F65C2B 75 E1 jne $add_groups+58Eh (07FE93F65C0Eh)
SvNOK_on(sv); /* what a wonderful hack! */
break;
000007FE93F65C2D E9 FD F9 FF FF jmp Perl_magic_get+303h (07FE93F6562Fh)
case '\027': /* ^W & $^WARNING_BITS */
if (nextchar == '\0')
000007FE93F65C32 84 D2 test dl,dl
000007FE93F65C34 75 11 jne $add_groups+5C7h (07FE93F65C47h)
- This set of changes does not require a perldelta entry.
