--- 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) (28001767h)
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 integers 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 take well to NV
471: addition, and an SV which is NOK, NV=6.0 ought to be coerced to
472: integer in case the second argument is IV=9223372036854775806
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 integer 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 type is a subrange
484: of the corresponding unsigned integer type, and the representation 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 reduced modulo
488: the number that is one greater than the largest value that 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 "exception condition"
496:
497: If an exceptional condition occurs during the evaluation of an
498: expression (that is, if the result is not mathematically 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 arithmetic would
505: wrap, hence coded pp_add and pp_subtract on the assumption that
506: everything perl builds on would be happy. After much wailing and
507: gnashing of teeth it would seem that irix64 knows its ANSI spec well,
508: knows that it doesn't need to, and doesn't. Bah. Anyway, the all-
509: unsigned code below is actually shorter than the old code. :-)
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) (28001A8Ch)
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 going to have to
514: use NV maths. Hence only attempt to coerce the right argument 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 identity,
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) (28001A8Ch)
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) (28002644h)
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) (28002563h)
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@41f0000000000000 (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) (28002581h)
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) (28001816h)
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) (28001A87h)
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 identity. */
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) (28001A87h)
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) (28002581h)
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) (28001816h)
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
####
OP *
Perl_pp_add(PerlInterpreter * my_perl)
{
extern int Perl___notused(void);
SV **sp = (my_perl->Istack_sp);
SV *targ =
((my_perl->Iop)->op_flags & 64 ? sp[-1] : Perl_pad_sv(my_perl, (my_perl->Iop)->op_targ));
char useleft;
SV *svl,
*svr;
do {
if (((((*(sp - 1)))->sv_flags | ((*sp))->sv_flags) & (0x00000800 | 0x00200000))
&& Perl_try_amagic_bin(my_perl, add_amg, 4 | 0x10))
return (my_perl->Iop)->op_next;
} while (0);
svr = (*sp);
svl = (*(sp - 1));
useleft =
(((((svtype) ((svl)->sv_flags & 0xff)) ==
SVt_BIND) ? ((((svl)->sv_u.svu_rv))->
sv_flags & (0x00000100 | 0x00000200 | 0x00000400 | 0x00000800 | 0x00001000 |
0x00002000 | 0x00004000 | 0x00008000)) : ((svl)->
sv_flags & (0x00000100 |
0x00000200 |
0x00000400 |
0x00000800 |
0x00001000 |
0x00002000 |
0x00004000 |
0x00008000)))
|| !((my_perl->Iop)->op_flags & 64));
if ((!((svr)->sv_flags & 0x00001000)
&& (((svr)->sv_flags & 0x00000200)
|| ((svr)->
sv_flags & 0x00000400)) ? ((((svr)->sv_flags & 0x00000100) ? ((XPVIV *) (svr)->sv_any)->
xiv_u.xivu_iv : Perl_sv_2iv_flags(my_perl, svr, 0)),
((svr)->sv_flags & 0x00000100)) : ((svr)->
sv_flags & 0x00000100))) {
UV auv = 0;
char auvok = (0);
char a_valid = 0;
if (!useleft) {
auv = 0;
a_valid = auvok = 1;
} else {
if ((!((svl)->sv_flags & 0x00001000)
&& (((svl)->sv_flags & 0x00000200)
|| ((svl)->
sv_flags & 0x00000400)) ? ((((svl)->sv_flags & 0x00000100) ? ((XPVIV *) (svl)->
sv_any)->xiv_u.
xivu_iv : Perl_sv_2iv_flags(my_perl, svl, 0)),
((svl)->sv_flags & 0x00000100)) : ((svl)->
sv_flags &
0x00000100))) {
if ((auvok = (((svl)->sv_flags & (0x00000100 | 0x80000000)) == (0x00000100 | 0x80000000))))
auv = ((XPVUV *) (svl)->sv_any)->xuv_u.xivu_uv;
else {
const IV aiv = ((XPVIV *) (svl)->sv_any)->xiv_u.xivu_iv;
if (aiv >= 0) {
auv = aiv;
auvok = 1;
} else {
auv = (UV) - aiv;
}
}
a_valid = 1;
}
}
if (a_valid) {
char result_good = 0;
UV result;
UV buv;
char buvok =
(((svr)->sv_flags & (0x00000100 | 0x80000000)) == (0x00000100 | 0x80000000));
if (buvok)
buv = ((XPVUV *) (svr)->sv_any)->xuv_u.xivu_uv;
else {
const IV biv = ((XPVIV *) (svr)->sv_any)->xiv_u.xivu_iv;
if (biv >= 0) {
buv = biv;
buvok = 1;
} else
buv = (UV) - biv;
}
if (auvok ^ buvok) {
if (auv >= buv) {
result = auv - buv;
if (result <= auv)
result_good = 1;
} else {
result = buv - auv;
if (result <= buv) {
auvok = !auvok;
result_good = 1;
}
}
} else {
result = auv + buv;
if (result >= auv)
result_good = 1;
}
if (result_good) {
sp--;
if (auvok)
do {
Perl_sv_setuv(my_perl, targ, (UV) (result));
do {
do {
if (((targ)->sv_flags & 0x00400000))
Perl_mg_set(my_perl, targ);
} while (0);
(*sp = targ);
} while (0);
} while (0);
else {
if (result <= (UV) ((long) (-2147483647L - 1)))
do {
Perl_sv_setiv(my_perl, targ, (IV) (-(IV) result));
do {
do {
if (((targ)->sv_flags & 0x00400000))
Perl_mg_set(my_perl, targ);
} while (0);
(*sp = targ);
} while (0);
} while (0);
else {
do {
Perl_sv_setnv(my_perl, targ, (NV) (-(NV) result));
do {
do {
if (((targ)->sv_flags & 0x00400000))
Perl_mg_set(my_perl, targ);
} while (0);
(*sp = targ);
} while (0);
} while (0);
}
}
return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
}
}
}
#line 609 "..\\pp_hot.c"
{
NV value =
(((svr)->sv_flags & 0x00000200) ? ((XPVNV *) (svr)->sv_any)->xnv_u.
xnv_nv : Perl_sv_2nv_flags(my_perl, svr, 0));
(void) (*sp--);
if (!useleft) {
do {
Perl_sv_setnv(my_perl, targ, (NV) (value));
do {
do {
if (((targ)->sv_flags & 0x00400000))
Perl_mg_set(my_perl, targ);
} while (0);
(*sp = targ);
} while (0);
} while (0);
return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
}
do {
Perl_sv_setnv(my_perl, targ,
(NV) (value +
(((svl)->sv_flags & 0x00000200) ? ((XPVNV *) (svl)->sv_any)->xnv_u.
xnv_nv : Perl_sv_2nv_flags(my_perl, svl, 0))));
do {
do {
if (((targ)->sv_flags & 0x00400000))
Perl_mg_set(my_perl, targ);
} while (0);
(*sp = targ);
} while (0);
} while (0);
return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
}
}
####
--- c:\p517\perl\pp_hot.c ------------------------------------------------------
456:
457: OP *
458: Perl_pp_add(PerlInterpreter * my_perl)
459: {
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
460: extern int Perl___notused(void);
461: SV **sp = (my_perl->Istack_sp);
2807D4BA 8B 7D 08 mov edi,dword ptr [my_perl]
462: SV *targ =
463: ((my_perl->Iop)->op_flags & 64 ? sp[-1] : Perl_pad_sv(my_perl, (my_perl->Iop)->op_targ));
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) (28001767h)
2807D4D6 59 pop ecx
2807D4D7 59 pop ecx
464: char useleft;
465: SV *svl,
466: *svr;
467: do {
468: if (((((*(sp - 1)))->sv_flags | ((*sp))->sv_flags) & (0x00000800 | 0x00200000))
469: && Perl_try_amagic_bin(my_perl, add_amg, 4 | 0x10))
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
470: return (my_perl->Iop)->op_next;
2807D501 0F 85 12 02 00 00 jne Perl_pp_add+268h (2807D719h)
471: } while (0);
472: svr = (*sp);
473: svl = (*(sp - 1));
2807D507 8B 13 mov edx,dword ptr [ebx]
474:
475: useleft =
476: (((((svtype) ((svl)->sv_flags & 0xff)) ==
477: SVt_BIND) ? ((((svl)->sv_u.svu_rv))->
478: sv_flags & (0x00000100 | 0x00000200 | 0x00000400 | 0x00000800 | 0x00001000 |
479: 0x00002000 | 0x00004000 | 0x00008000)) : ((svl)->
480: sv_flags & (0x00000100 |
481: 0x00000200 |
482: 0x00000400 |
483: 0x00000800 |
484: 0x00001000 |
485: 0x00002000 |
486: 0x00004000 |
487: 0x00008000)))
488: || !((my_perl->Iop)->op_flags & 64));
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
489:
490: if ((!((svr)->sv_flags & 0x00001000)
491: && (((svr)->sv_flags & 0x00000200)
492: || ((svr)->
493: sv_flags & 0x00000400)) ? ((((svr)->sv_flags & 0x00000100) ? ((XPVIV *) (svr)->sv_any)->
494: xiv_u.xivu_iv : Perl_sv_2iv_flags(my_perl, svr, 0)),
495: ((svr)->sv_flags & 0x00000100)) : ((svr)->
496: sv_flags & 0x00000100))) {
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) (28001A8Ch)
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)
497:
498: UV auv = 0;
499: char auvok = (0);
500: char a_valid = 0;
501:
502: 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)
503: auv = 0;
2807D583 33 F6 xor esi,esi
504: a_valid = auvok = 1;
2807D585 B2 01 mov dl,1
505:
506: } else {
2807D587 EB 53 jmp Perl_pp_add+12Bh (2807D5DCh)
507:
508: if ((!((svl)->sv_flags & 0x00001000)
509: && (((svl)->sv_flags & 0x00000200)
510: || ((svl)->
511: sv_flags & 0x00000400)) ? ((((svl)->sv_flags & 0x00000100) ? ((XPVIV *) (svl)->
512: sv_any)->xiv_u.
513: xivu_iv : Perl_sv_2iv_flags(my_perl, svl, 0)),
514: ((svl)->sv_flags & 0x00000100)) : ((svl)->
515: sv_flags &
516: 0x00000100))) {
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) (28001A8Ch)
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)
517: if ((auvok = (((svl)->sv_flags & (0x00000100 | 0x80000000)) == (0x00000100 | 0x80000000))))
2807D5B8 23 C7 and eax,edi
2807D5BA 3B C7 cmp eax,edi
518: auv = ((XPVUV *) (svl)->sv_any)->xuv_u.xivu_uv;
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]
519: else {
2807D5CB EB 0F jmp Perl_pp_add+12Bh (2807D5DCh)
520: const IV aiv = ((XPVIV *) (svl)->sv_any)->xiv_u.xivu_iv;
2807D5CD 8B 40 10 mov eax,dword ptr [eax+10h]
521: if (aiv >= 0) {
2807D5D0 85 C0 test eax,eax
2807D5D2 7C 04 jl Perl_pp_add+127h (2807D5D8h)
522: auv = aiv;
523: auvok = 1;
2807D5D4 B2 01 mov dl,1
524: } else {
2807D5D6 EB 02 jmp Perl_pp_add+129h (2807D5DAh)
525: auv = (UV) - aiv;
2807D5D8 F7 D8 neg eax
2807D5DA 8B F0 mov esi,eax
526: }
527: }
528: a_valid = 1;
529: }
530: }
531: if (a_valid) {
532: char result_good = 0;
533: UV result;
534: UV buv;
535: char buvok =
536: (((svr)->sv_flags & (0x00000100 | 0x80000000)) == (0x00000100 | 0x80000000));
2807D5DC 8B 4D EC mov ecx,dword ptr [svr]
2807D5DF 8B 41 08 mov eax,dword ptr [ecx+8]
537:
538: if (buvok)
539: buv = ((XPVUV *) (svr)->sv_any)->xuv_u.xivu_uv;
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
540: else {
2807D5F0 75 0A jne Perl_pp_add+14Bh (2807D5FCh)
541: const IV biv = ((XPVIV *) (svr)->sv_any)->xiv_u.xivu_iv;
542: if (biv >= 0) {
2807D5F2 85 C9 test ecx,ecx
2807D5F4 7C 04 jl Perl_pp_add+149h (2807D5FAh)
543: buv = biv;
544: buvok = 1;
2807D5F6 FE C0 inc al
545: } else
2807D5F8 EB 02 jmp Perl_pp_add+14Bh (2807D5FCh)
546: buv = (UV) - biv;
2807D5FA F7 D9 neg ecx
547: }
548:
549: if (auvok ^ buvok) {
2807D5FC 32 C2 xor al,dl
2807D5FE 74 3C je Perl_pp_add+18Bh (2807D63Ch)
550:
551: if (auv >= buv) {
2807D600 3B F1 cmp esi,ecx
2807D602 72 29 jb Perl_pp_add+17Ch (2807D62Dh)
552: result = auv - buv;
2807D604 8B C6 mov eax,esi
2807D606 2B C1 sub eax,ecx
553:
554: if (result <= auv)
2807D608 3B C6 cmp eax,esi
2807D60A 76 37 jbe Perl_pp_add+192h (2807D643h)
606: } while (0);
607: } while (0);
608: }
609: }
610: return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
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]
611: }
612: }
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)
555: result_good = 1;
556: } else {
557: result = buv - auv;
2807D62D 8B C1 mov eax,ecx
2807D62F 2B C6 sub eax,esi
558: if (result <= buv) {
2807D631 3B C1 cmp eax,ecx
2807D633 77 D7 ja Perl_pp_add+15Bh (2807D60Ch)
559:
560: auvok = !auvok;
2807D635 84 D2 test dl,dl
2807D637 0F 94 C2 sete dl
561: result_good = 1;
562: }
563: }
564: } else {
2807D63A EB 07 jmp Perl_pp_add+192h (2807D643h)
565:
566: result = auv + buv;
2807D63C 8D 04 31 lea eax,[ecx+esi]
567: if (result >= auv)
2807D63F 3B C6 cmp eax,esi
2807D641 72 C9 jb Perl_pp_add+15Bh (2807D60Ch)
568: result_good = 1;
569: }
570: if (result_good) {
571: sp--;
572: if (auvok)
2807D643 84 D2 test dl,dl
2807D645 74 0F je Perl_pp_add+1A5h (2807D656h)
573: do {
574: Perl_sv_setuv(my_perl, targ, (UV) (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) (28002644h)
575: do {
576: do {
577: if (((targ)->sv_flags & 0x00400000))
578: Perl_mg_set(my_perl, targ);
579: } while (0);
580: (*sp = targ);
581: } while (0);
582: } while (0);
583: else {
2807D654 EB 16 jmp Perl_pp_add+1BBh (2807D66Ch)
584:
585: if (result <= (UV) ((long) (-2147483647L - 1)))
2807D656 3D 00 00 00 80 cmp eax,80000000h
2807D65B 77 14 ja Perl_pp_add+1C0h (2807D671h)
586: do {
587: Perl_sv_setiv(my_perl, targ, (IV) (-(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) (28002563h)
2807D66C 83 C4 0C add esp,0Ch
588: do {
589: do {
590: if (((targ)->sv_flags & 0x00400000))
591: Perl_mg_set(my_perl, targ);
592: } while (0);
593: (*sp = targ);
594: } while (0);
595: } while (0);
596: else {
2807D66F EB 26 jmp Perl_pp_add+1E6h (2807D697h)
597:
598: do {
599: Perl_sv_setnv(my_perl, targ, (NV) (-(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@41f0000000000000 (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) (28002581h)
2807D694 83 C4 10 add esp,10h
600: do {
601: do {
602: if (((targ)->sv_flags & 0x00400000))
2807D697 F6 46 0A 40 test byte ptr [esi+0Ah],40h
2807D69B 74 0B je Perl_pp_add+1F7h (2807D6A8h)
603: Perl_mg_set(my_perl, targ);
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) (28001816h)
2807D6A6 59 pop ecx
2807D6A7 59 pop ecx
604: } while (0);
605: (*sp = targ);
2807D6A8 8B 45 F0 mov eax,dword ptr [ebp-10h]
2807D6AB 89 30 mov dword ptr [eax],esi
606: } while (0);
607: } while (0);
608: }
609: }
610: return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
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)
611: }
612: }
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) (28001A87h)
2807D6C2 8B 55 F8 mov edx,dword ptr [svl]
2807D6C5 83 C4 0C add esp,0Ch
613: }
614: #line 609 "..\\pp_hot.c"
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)
615: {
616: NV value =
617: (((svr)->sv_flags & 0x00000200) ? ((XPVNV *) (svr)->sv_any)->xnv_u.
2807D6D1 DD 45 E8 fld qword ptr [value]
618: xnv_nv : Perl_sv_2nv_flags(my_perl, svr, 0));
619: (void) (*sp--);
620: if (!useleft) {
621:
622: do {
623: Perl_sv_setnv(my_perl, targ, (NV) (value));
624: do {
625: do {
626: if (((targ)->sv_flags & 0x00400000))
2807D6D4 EB 1B jmp Perl_pp_add+240h (2807D6F1h)
627: Perl_mg_set(my_perl, targ);
628: } while (0);
629: (*sp = targ);
630: } while (0);
631: } while (0);
632: return ((my_perl->Istack_sp) = sp, (my_perl->Iop)->op_next);
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) (28001A87h)
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) (28002581h)
2807D700 83 C4 10 add esp,10h
633: }
634: do {
635: Perl_sv_setnv(my_perl, targ,
2807D703 F6 46 0A 40 test byte ptr [esi+0Ah],40h
2807D707 74 09 je Perl_pp_add+261h (2807D712h)
636: (NV) (value +
2807D709 56 push esi
2807D70A 57 push edi
2807D70B E8 06 41 F8 FF call @ILT+2065(_Perl_mg_set) (28001816h)
2807D710 59 pop ecx
2807D711 59 pop ecx
637: (((svl)->sv_flags & 0x00000200) ? ((XPVNV *) (svl)->sv_any)->xnv_u.
638: xnv_nv : Perl_sv_2nv_flags(my_perl, svl, 0))));
2807D712 8B 45 F0 mov eax,dword ptr [ebp-10h]
2807D715 89 30 mov dword ptr [eax],esi
639: do {
640: do {
641: if (((targ)->sv_flags & 0x00400000))
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
642: Perl_mg_set(my_perl, targ);
643: } while (0);
2807D721 C9 leave
2807D722 C3 ret
####
#psuedo code probably
sub NewUser{
$Users{$_[0]}{'Locations'} = $magicHash{'NewRecord'}->AddClientLocations($magicHash{'NewRecord'}->AddLocation($magicHash{'NewRecord'}));
}