in reply to Perl 5 Optimizing Compiler, Part 4: LLVM Backend?
--- c:\p517\perl\pp_hot.c -------------------------------------------- +---------- 456: 457: PP(pp_add) 458: { 2807D4B1 55 push ebp 2807D4B2 8B EC mov ebp,esp 2807D4B4 83 EC 18 sub esp,18h 2807D4B7 53 push ebx 2807D4B8 56 push esi 2807D4B9 57 push edi 459: dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr; 2807D4BA 8B 7D 08 mov edi,dword ptr [my_perl] 2807D4BD 8B 47 04 mov eax,dword ptr [edi+4] 2807D4C0 F6 40 12 40 test byte ptr [eax+12h],40h 2807D4C4 8B 37 mov esi,dword ptr [edi] 2807D4C6 74 05 je Perl_pp_add+1Ch (2807D4CDh) 2807D4C8 8B 46 FC mov eax,dword ptr [esi-4] 2807D4CB EB 0B jmp Perl_pp_add+27h (2807D4D8h) 2807D4CD FF 70 0C push dword ptr [eax+0Ch] 2807D4D0 57 push edi 2807D4D1 E8 91 42 F8 FF call @ILT+1890(_Perl_pad_sv) (2800176 +7h) 2807D4D6 59 pop ecx 2807D4D7 59 pop ecx 460: tryAMAGICbin_MG(add_amg, AMGf_assign|AMGf_numeric); 2807D4D8 8B 0E mov ecx,dword ptr [esi] 2807D4DA 89 45 F4 mov dword ptr [targ],eax 2807D4DD 8D 5E FC lea ebx,[esi-4] 2807D4E0 8B 03 mov eax,dword ptr [ebx] 2807D4E2 8B 40 08 mov eax,dword ptr [eax+8] 2807D4E5 0B 41 08 or eax,dword ptr [ecx+8] 2807D4E8 89 5D F0 mov dword ptr [ebp-10h],ebx 2807D4EB A9 00 08 20 00 test eax,200800h 2807D4F0 74 15 je Perl_pp_add+56h (2807D507h) 2807D4F2 6A 14 push 14h 2807D4F4 6A 1E push 1Eh 2807D4F6 57 push edi 2807D4F7 E8 0E 4F F8 FF call @ILT+5125(_Perl_try_amagic_bin) +(2800240Ah) 2807D4FC 83 C4 0C add esp,0Ch 2807D4FF 84 C0 test al,al 2807D501 0F 85 12 02 00 00 jne Perl_pp_add+268h (2807D719h) 461: svr = TOPs; 462: svl = TOPm1s; 2807D507 8B 13 mov edx,dword ptr [ebx] 463: 464: useleft = USE_LEFT(svl); 2807D509 8B 42 08 mov eax,dword ptr [edx+8] 2807D50C 3C 01 cmp al,1 2807D50E 8B 0E mov ecx,dword ptr [esi] 2807D510 89 4D EC mov dword ptr [svr],ecx 2807D513 89 55 F8 mov dword ptr [svl],edx 2807D516 75 06 jne Perl_pp_add+6Dh (2807D51Eh) 2807D518 8B 42 0C mov eax,dword ptr [edx+0Ch] 2807D51B 8B 40 08 mov eax,dword ptr [eax+8] 2807D51E 25 00 FF 00 00 and eax,0FF00h 2807D523 85 C0 test eax,eax 2807D525 75 0D jne Perl_pp_add+83h (2807D534h) 2807D527 8B 47 04 mov eax,dword ptr [edi+4] 2807D52A F6 40 12 40 test byte ptr [eax+12h],40h 2807D52E C6 45 FF 00 mov byte ptr [useleft],0 2807D532 75 04 jne Perl_pp_add+87h (2807D538h) 2807D534 C6 45 FF 01 mov byte ptr [useleft],1 465: #ifdef PERL_PRESERVE_IVUV 466: /* We must see if we can perform the addition with integer +s if possible, 467: as the integer code detects overflow while the NV code +doesn't. 468: If either argument hasn't had a numeric conversion yet +attempt to get 469: the IV. It's important to do this now, rather than just + assuming that 470: it's not IOK as a PV of "9223372036854775806" may not t +ake well to NV 471: addition, and an SV which is NOK, NV=6.0 ought to be co +erced to 472: integer in case the second argument is IV=9223372036854 +775806 473: We can (now) rely on sv_2iv to do the right thing, only + setting the 474: public IOK flag if the value in the NV (or PV) slot is +truly integer. 475: 476: A side effect is that this also aggressively prefers in +teger maths over 477: fp maths for integer values. 478: 479: How to detect overflow? 480: 481: C 99 section 6.2.6.1 says 482: 483: The range of nonnegative values of a signed integer typ +e is a subrange 484: of the corresponding unsigned integer type, and the rep +resentation of 485: the same value in each type is the same. A computation +involving 486: unsigned operands can never overflow, because a result +that cannot be 487: represented by the resulting unsigned integer type is r +educed modulo 488: the number that is one greater than the largest value t +hat can be 489: represented by the resulting type. 490: 491: (the 9th paragraph) 492: 493: which I read as "unsigned ints wrap." 494: 495: signed integer overflow seems to be classed as "excepti +on condition" 496: 497: If an exceptional condition occurs during the evaluatio +n of an 498: expression (that is, if the result is not mathematicall +y defined or not 499: in the range of representable values for its type), the + behavior is 500: undefined. 501: 502: (6.5, the 5th paragraph) 503: 504: I had assumed that on 2s complement machines signed ari +thmetic would 505: wrap, hence coded pp_add and pp_subtract on the assumpt +ion that 506: everything perl builds on would be happy. After much w +ailing and 507: gnashing of teeth it would seem that irix64 knows its A +NSI spec well, 508: knows that it doesn't need to, and doesn't. Bah. Anyw +ay, the all- 509: unsigned code below is actually shorter than the old co +de. :-) 510: */ 511: 512: if (SvIV_please_nomg(svr)) { 2807D538 8B 41 08 mov eax,dword ptr [ecx+8] 2807D53B BB 00 10 00 00 mov ebx,1000h 2807D540 85 C3 test ebx,eax 2807D542 75 25 jne Perl_pp_add+0B8h (2807D569h) 2807D544 F6 C4 06 test ah,6 2807D547 74 20 je Perl_pp_add+0B8h (2807D569h) 2807D549 BE 00 01 00 00 mov esi,100h 2807D54E 85 C6 test esi,eax 2807D550 75 12 jne Perl_pp_add+0B3h (2807D564h) 2807D552 6A 00 push 0 2807D554 51 push ecx 2807D555 57 push edi 2807D556 E8 31 45 F8 FF call @ILT+2695(_Perl_sv_2iv_flags) (2 +8001A8Ch) 2807D55B 8B 55 F8 mov edx,dword ptr [svl] 2807D55E 8B 4D EC mov ecx,dword ptr [svr] 2807D561 83 C4 0C add esp,0Ch 2807D564 8B 41 08 mov eax,dword ptr [ecx+8] 2807D567 EB 05 jmp Perl_pp_add+0BDh (2807D56Eh) 2807D569 BE 00 01 00 00 mov esi,100h 2807D56E 23 C6 and eax,esi 2807D570 85 C0 test eax,eax 2807D572 0F 84 9D 00 00 00 je Perl_pp_add+164h (2807D615h) 513: /* Unless the left argument is integer in range we are goi +ng to have to 514: use NV maths. Hence only attempt to coerce the right ar +gument if 515: we know the left is integer. */ 516: UV auv = 0; 517: bool auvok = FALSE; 518: bool a_valid = 0; 519: 520: if (!useleft) { 2807D578 80 7D FF 00 cmp byte ptr [useleft],0 2807D57C BF 00 01 00 80 mov edi,80000100h 2807D581 75 06 jne Perl_pp_add+0D8h (2807D589h) 521: auv = 0; 2807D583 33 F6 xor esi,esi 522: a_valid = auvok = 1; 2807D585 B2 01 mov dl,1 523: /* left operand is undef, treat as zero. + 0 is identi +ty, 524: Could SETi or SETu right now, but space optimise by + not adding 525: lots of code to speed up what is probably a rarish +case. */ 526: } else { 2807D587 EB 53 jmp Perl_pp_add+12Bh (2807D5DCh) 527: /* Left operand is defined, so is it IV? */ 528: if (SvIV_please_nomg(svl)) { 2807D589 8B 4D F8 mov ecx,dword ptr [svl] 2807D58C 8B 41 08 mov eax,dword ptr [ecx+8] 2807D58F 85 C3 test ebx,eax 2807D591 75 1D jne Perl_pp_add+0FFh (2807D5B0h) 2807D593 F6 C4 06 test ah,6 2807D596 74 18 je Perl_pp_add+0FFh (2807D5B0h) 2807D598 85 C6 test esi,eax 2807D59A 75 11 jne Perl_pp_add+0FCh (2807D5ADh) 2807D59C 6A 00 push 0 2807D59E 51 push ecx 2807D59F FF 75 08 push dword ptr [my_perl] 2807D5A2 E8 E5 44 F8 FF call @ILT+2695(_Perl_sv_2iv_flags) (2 +8001A8Ch) 2807D5A7 8B 4D F8 mov ecx,dword ptr [svl] 2807D5AA 83 C4 0C add esp,0Ch 2807D5AD 8B 41 08 mov eax,dword ptr [ecx+8] 2807D5B0 8B C8 mov ecx,eax 2807D5B2 23 CE and ecx,esi 2807D5B4 85 C9 test ecx,ecx 2807D5B6 74 54 je Perl_pp_add+15Bh (2807D60Ch) 529: if ((auvok = SvUOK(svl))) 2807D5B8 23 C7 and eax,edi 2807D5BA 3B C7 cmp eax,edi 530: auv = SvUVX(svl); 2807D5BC 8B 45 F8 mov eax,dword ptr [svl] 2807D5BF 8B 00 mov eax,dword ptr [eax] 2807D5C1 0F 94 C2 sete dl 2807D5C4 84 D2 test dl,dl 2807D5C6 74 05 je Perl_pp_add+11Ch (2807D5CDh) 2807D5C8 8B 70 10 mov esi,dword ptr [eax+10h] 531: else { 2807D5CB EB 0F jmp Perl_pp_add+12Bh (2807D5DCh) 532: const IV aiv = SvIVX(svl); 2807D5CD 8B 40 10 mov eax,dword ptr [eax+10h] 533: if (aiv >= 0) { 2807D5D0 85 C0 test eax,eax 2807D5D2 7C 04 jl Perl_pp_add+127h (2807D5D8h) 534: auv = aiv; 535: auvok = 1; /* Now acting as a sign flag. */ 2807D5D4 B2 01 mov dl,1 536: } else { /* 2s complement assumption for IV_MIN +*/ 2807D5D6 EB 02 jmp Perl_pp_add+129h (2807D5DAh) 537: auv = (UV)-aiv; 2807D5D8 F7 D8 neg eax 2807D5DA 8B F0 mov esi,eax 538: } 539: } 540: a_valid = 1; 541: } 542: } 543: if (a_valid) { 544: bool result_good = 0; 545: UV result; 546: UV buv; 547: bool buvok = SvUOK(svr); 2807D5DC 8B 4D EC mov ecx,dword ptr [svr] 2807D5DF 8B 41 08 mov eax,dword ptr [ecx+8] 548: 549: if (buvok) 550: buv = SvUVX(svr); 2807D5E2 8B 09 mov ecx,dword ptr [ecx] 2807D5E4 8B 49 10 mov ecx,dword ptr [ecx+10h] 2807D5E7 23 C7 and eax,edi 2807D5E9 3B C7 cmp eax,edi 2807D5EB 0F 94 C0 sete al 2807D5EE 84 C0 test al,al 551: else { 2807D5F0 75 0A jne Perl_pp_add+14Bh (2807D5FCh) 552: const IV biv = SvIVX(svr); 553: if (biv >= 0) { 2807D5F2 85 C9 test ecx,ecx 2807D5F4 7C 04 jl Perl_pp_add+149h (2807D5FAh) 554: buv = biv; 555: buvok = 1; 2807D5F6 FE C0 inc al 556: } else 2807D5F8 EB 02 jmp Perl_pp_add+14Bh (2807D5FCh) 557: buv = (UV)-biv; 2807D5FA F7 D9 neg ecx 558: } 559: /* ?uvok if value is >= 0. basically, flagged as UV if + it's +ve, 560: else "IV" now, independent of how it came in. 561: if a, b represents positive, A, B negative, a maps +to -A etc 562: a + b => (a + b) 563: A + b => -(a - b) 564: a + B => (a - b) 565: A + B => -(a + b) 566: all UV maths. negate result if A negative. 567: add if signs same, subtract if signs differ. */ 568: 569: if (auvok ^ buvok) { 2807D5FC 32 C2 xor al,dl 2807D5FE 74 3C je Perl_pp_add+18Bh (2807D63Ch) 570: /* Signs differ. */ 571: if (auv >= buv) { 2807D600 3B F1 cmp esi,ecx 2807D602 72 29 jb Perl_pp_add+17Ch (2807D62Dh) 572: result = auv - buv; 2807D604 8B C6 mov eax,esi 2807D606 2B C1 sub eax,ecx 573: /* Must get smaller */ 574: if (result <= auv) 2807D608 3B C6 cmp eax,esi 2807D60A 76 37 jbe Perl_pp_add+192h (2807D643h) 602: } 603: } 604: RETURN; 2807D60C 8B 7D 08 mov edi,dword ptr [my_perl] 2807D60F 8B 55 F8 mov edx,dword ptr [svl] 2807D612 8B 4D EC mov ecx,dword ptr [svr] 605: } /* Overflow, drop through to NVs. */ 606: } 607: } 608: #endif 609: { 610: NV value = SvNV_nomg(svr); 2807D615 BE 00 02 00 00 mov esi,200h 2807D61A 85 71 08 test dword ptr [ecx+8],esi 2807D61D 0F 84 96 00 00 00 je Perl_pp_add+208h (2807D6B9h) 2807D623 8B 01 mov eax,dword ptr [ecx] 2807D625 DD 40 18 fld qword ptr [eax+18h] 2807D628 E9 9B 00 00 00 jmp Perl_pp_add+217h (2807D6C8h) 575: result_good = 1; 576: } else { 577: result = buv - auv; 2807D62D 8B C1 mov eax,ecx 2807D62F 2B C6 sub eax,esi 578: if (result <= buv) { 2807D631 3B C1 cmp eax,ecx 2807D633 77 D7 ja Perl_pp_add+15Bh (2807D60Ch) 579: /* result really should be -(auv-buv). as its +negation 580: of true value, need to swap our result flag + */ 581: auvok = !auvok; 2807D635 84 D2 test dl,dl 2807D637 0F 94 C2 sete dl 582: result_good = 1; 583: } 584: } 585: } else { 2807D63A EB 07 jmp Perl_pp_add+192h (2807D643h) 586: /* Signs same */ 587: result = auv + buv; 2807D63C 8D 04 31 lea eax,[ecx+esi] 588: if (result >= auv) 2807D63F 3B C6 cmp eax,esi 2807D641 72 C9 jb Perl_pp_add+15Bh (2807D60Ch) 589: result_good = 1; 590: } 591: if (result_good) { 592: SP--; 593: if (auvok) 2807D643 84 D2 test dl,dl 2807D645 74 0F je Perl_pp_add+1A5h (2807D656h) 594: SETu( result ); 2807D647 8B 75 F4 mov esi,dword ptr [targ] 2807D64A 50 push eax 2807D64B 56 push esi 2807D64C FF 75 08 push dword ptr [my_perl] 2807D64F E8 F0 4F F8 FF call @ILT+5695(_Perl_sv_setuv) (28002 +644h) 595: else { 2807D654 EB 16 jmp Perl_pp_add+1BBh (2807D66Ch) 596: /* Negate result */ 597: if (result <= (UV)IV_MIN) 2807D656 3D 00 00 00 80 cmp eax,80000000h 2807D65B 77 14 ja Perl_pp_add+1C0h (2807D671h) 598: SETi( -(IV)result ); 2807D65D 8B 75 F4 mov esi,dword ptr [targ] 2807D660 F7 D8 neg eax 2807D662 50 push eax 2807D663 56 push esi 2807D664 FF 75 08 push dword ptr [my_perl] 2807D667 E8 F7 4E F8 FF call @ILT+5470(_Perl_sv_setiv) (28002 +563h) 2807D66C 83 C4 0C add esp,0Ch 599: else { 2807D66F EB 26 jmp Perl_pp_add+1E6h (2807D697h) 600: /* result valid, but out of range for IV. */ 601: SETn( -(NV)result ); 2807D671 85 C0 test eax,eax 2807D673 89 45 EC mov dword ptr [svr],eax 2807D676 DB 45 EC fild dword ptr [svr] 2807D679 7D 06 jge Perl_pp_add+1D0h (2807D681h) 2807D67B DC 05 D0 50 13 28 fadd qword ptr [__real@41f0000000000 +000 (281350D0h)] 2807D681 8B 75 F4 mov esi,dword ptr [targ] 2807D684 D9 E0 fchs 2807D686 51 push ecx 2807D687 51 push ecx 2807D688 DD 1C 24 fstp qword ptr [esp] 2807D68B 56 push esi 2807D68C FF 75 08 push dword ptr [my_perl] 2807D68F E8 ED 4E F8 FF call @ILT+5500(_Perl_sv_setnv) (28002 +581h) 2807D694 83 C4 10 add esp,10h 2807D697 F6 46 0A 40 test byte ptr [esi+0Ah],40h 2807D69B 74 0B je Perl_pp_add+1F7h (2807D6A8h) 2807D69D 56 push esi 2807D69E FF 75 08 push dword ptr [my_perl] 2807D6A1 E8 70 41 F8 FF call @ILT+2065(_Perl_mg_set) (2800181 +6h) 2807D6A6 59 pop ecx 2807D6A7 59 pop ecx 2807D6A8 8B 45 F0 mov eax,dword ptr [ebp-10h] 2807D6AB 89 30 mov dword ptr [eax],esi 602: } 603: } 604: RETURN; 2807D6AD 8B C8 mov ecx,eax 2807D6AF 8B 45 08 mov eax,dword ptr [my_perl] 2807D6B2 89 08 mov dword ptr [eax],ecx 2807D6B4 8B 40 04 mov eax,dword ptr [eax+4] 2807D6B7 EB 63 jmp Perl_pp_add+26Bh (2807D71Ch) 605: } /* Overflow, drop through to NVs. */ 606: } 607: } 608: #endif 609: { 610: NV value = SvNV_nomg(svr); 2807D6B9 6A 00 push 0 2807D6BB 51 push ecx 2807D6BC 57 push edi 2807D6BD E8 C5 43 F8 FF call @ILT+2690(_Perl_sv_2nv_flags) (2 +8001A87h) 2807D6C2 8B 55 F8 mov edx,dword ptr [svl] 2807D6C5 83 C4 0C add esp,0Ch 611: (void)POPs; 612: if (!useleft) { 2807D6C8 80 7D FF 00 cmp byte ptr [useleft],0 2807D6CC DD 5D E8 fstp qword ptr [value] 2807D6CF 75 05 jne Perl_pp_add+225h (2807D6D6h) 613: /* left operand is undef, treat as zero. + 0.0 is iden +tity. */ 614: SETn(value); 2807D6D1 DD 45 E8 fld qword ptr [value] 615: RETURN; 2807D6D4 EB 1B jmp Perl_pp_add+240h (2807D6F1h) 616: } 617: SETn( value + SvNV_nomg(svl) ); 2807D6D6 85 72 08 test dword ptr [edx+8],esi 2807D6D9 74 07 je Perl_pp_add+231h (2807D6E2h) 2807D6DB 8B 02 mov eax,dword ptr [edx] 2807D6DD DD 40 18 fld qword ptr [eax+18h] 2807D6E0 EB 0C jmp Perl_pp_add+23Dh (2807D6EEh) 2807D6E2 6A 00 push 0 2807D6E4 52 push edx 2807D6E5 57 push edi 2807D6E6 E8 9C 43 F8 FF call @ILT+2690(_Perl_sv_2nv_flags) (2 +8001A87h) 2807D6EB 83 C4 0C add esp,0Ch 2807D6EE DC 45 E8 fadd qword ptr [value] 2807D6F1 8B 75 F4 mov esi,dword ptr [targ] 2807D6F4 51 push ecx 2807D6F5 51 push ecx 2807D6F6 DD 1C 24 fstp qword ptr [esp] 2807D6F9 56 push esi 2807D6FA 57 push edi 2807D6FB E8 81 4E F8 FF call @ILT+5500(_Perl_sv_setnv) (28002 +581h) 2807D700 83 C4 10 add esp,10h 2807D703 F6 46 0A 40 test byte ptr [esi+0Ah],40h 2807D707 74 09 je Perl_pp_add+261h (2807D712h) 2807D709 56 push esi 2807D70A 57 push edi 2807D70B E8 06 41 F8 FF call @ILT+2065(_Perl_mg_set) (2800181 +6h) 2807D710 59 pop ecx 2807D711 59 pop ecx 2807D712 8B 45 F0 mov eax,dword ptr [ebp-10h] 2807D715 89 30 mov dword ptr [eax],esi 618: RETURN; 2807D717 89 07 mov dword ptr [edi],eax 2807D719 8B 47 04 mov eax,dword ptr [edi+4] 2807D71C 8B 00 mov eax,dword ptr [eax] 2807D71E 5F pop edi 2807D71F 5E pop esi 2807D720 5B pop ebx 619: } 620: } 2807D721 C9 leave 2807D722 C3 ret
Can you eliminate dereferencing %magicHash thrice?#psuedo code probably sub NewUser{ $Users{$_[0]}{'Locations'} = $magicHash{'NewRecord'}->AddClientLocatio +ns($magicHash{'NewRecord'}->AddLocation($magicHash{'NewRecord'})); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Perl 5 Optimizing Compiler, Part 4: LLVM Backend?
by Will_the_Chill (Pilgrim) on Aug 27, 2012 at 23:21 UTC |