1 {
2     Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe
3 
4     Code generation for add nodes on the PowerPC
5 
6     This program is free software; you can redistribute it and/or modify
7     it under the terms of the GNU General Public License as published by
8     the Free Software Foundation; either version 2 of the License, or
9     (at your option) any later version.
10 
11     This program is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14     GNU General Public License for more details.
15 
16     You should have received a copy of the GNU General Public License
17     along with this program; if not, write to the Free Software
18     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 
20  ****************************************************************************
21 }
22 unit nppcadd;
23 
24 {$i fpcdefs.inc}
25 
26 interface
27 
28     uses
29        node,nadd,ncgadd,ngppcadd,cpubase;
30 
31     type
32        tppcaddnode = class(tgenppcaddnode)
33           procedure pass_generate_code;override;
34          protected
use_generic_mul32to64null35           function use_generic_mul32to64: boolean; override;
36          private
37           procedure emit_compare(unsigned : boolean); override;
38 {$ifdef SUPPORT_MMX}
39           procedure second_addmmx;override;
40 {$endif SUPPORT_MMX}
41           procedure second_add64bit;override;
42        end;
43 
44   implementation
45 
46     uses
47       globtype,systems,
48       cutils,verbose,globals,
49       symconst,symdef,paramgr,
50       aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
51       cgbase,cpuinfo,pass_1,pass_2,
52       cpupara,cgcpu,cgutils,procinfo,
53       ncon,nset,
54       ncgutil,tgobj,rgobj,rgcpu,cgobj,hlcgobj,cg64f32;
55 
56 
57 {*****************************************************************************
58                                   Pass 1
59 *****************************************************************************}
60 
tppcaddnode.use_generic_mul32to64null61    function tppcaddnode.use_generic_mul32to64: boolean;
62      begin
63        result := false;
64      end;
65 
66 {*****************************************************************************
67                                   Helpers
68 *****************************************************************************}
69 
70     procedure tppcaddnode.emit_compare(unsigned: boolean);
71       var
72         op : tasmop;
73         tmpreg : tregister;
74         useconst : boolean;
75       begin
76         tmpreg:=NR_NO;
77         // get the constant on the right if there is one
78         if (left.location.loc = LOC_CONSTANT) then
79           swapleftright;
80         // can we use an immediate, or do we have to load the
81         // constant in a register first?
82         if (right.location.loc = LOC_CONSTANT) then
83           begin
84 {$ifdef dummy}
85             if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.value64)<>0) and ((hi(right.location.value64)<>$ffffffff) or unsigned) then
86               internalerror(2002080301);
87 {$endif extdebug}
88             if (nodetype in [equaln,unequaln]) then
89               if (unsigned and
90                   (aword(right.location.value) > high(word))) or
91                  (not unsigned and
92                   (aint(right.location.value) < low(smallint)) or
93                    (aint(right.location.value) > high(smallint))) then
94                 { we can then maybe use a constant in the 'othersigned' case
95                  (the sign doesn't matter for // equal/unequal)}
96                 unsigned := not unsigned;
97 
98             if (unsigned and
99                 (aword(right.location.value) <= high(word))) or
100                (not(unsigned) and
101                 (aint(right.location.value) >= low(smallint)) and
102                 (aint(right.location.value) <= high(smallint))) then
103                useconst := true
104             else
105               begin
106                 useconst := false;
107                 tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
108                 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,
109                     right.location.value,tmpreg);
110                end
111           end
112         else
113           useconst := false;
114         location.loc := LOC_FLAGS;
115         location.resflags := getresflags;
116         if not unsigned then
117           if useconst then
118             op := A_CMPWI
119           else
120             op := A_CMPW
121         else
122           if useconst then
123             op := A_CMPLWI
124           else
125             op := A_CMPLW;
126 
127         if (right.location.loc = LOC_CONSTANT) then
128           begin
129             if useconst then
130               current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(op,left.location.register,longint(right.location.value)))
131             else
132               current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,left.location.register,tmpreg));
133           end
134         else
135           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,
136             left.location.register,right.location.register));
137       end;
138 
139 
140 {*****************************************************************************
141                                 Add64bit
142 *****************************************************************************}
143 
144     procedure tppcaddnode.second_add64bit;
145       var
146         truelabel,
147         falselabel : tasmlabel;
148         op         : TOpCG;
149         op1,op2    : TAsmOp;
150         cmpop,
151         unsigned   : boolean;
152 
153 
154       procedure emit_cmp64_hi;
155 
156         var
157           oldleft, oldright: tlocation;
158         begin
159           // put the high part of the location in the low part
160           location_copy(oldleft,left.location);
161           location_copy(oldright,right.location);
162           if left.location.loc = LOC_CONSTANT then
163             left.location.value64 := left.location.value64 shr 32
164           else
165             left.location.register64.reglo := left.location.register64.reghi;
166           if right.location.loc = LOC_CONSTANT then
167             right.location.value64 := right.location.value64 shr 32
168           else
169             right.location.register64.reglo := right.location.register64.reghi;
170 
171           // and call the normal emit_compare
172           emit_compare(unsigned);
173           location_copy(left.location,oldleft);
174           location_copy(right.location,oldright);
175         end;
176 
177 
178       procedure emit_cmp64_lo;
179 
180         begin
181           emit_compare(true);
182         end;
183 
184 
185       procedure firstjmp64bitcmp;
186 
187         var
188           oldnodetype: tnodetype;
189         begin
190 {$ifdef OLDREGVARS}
191            load_all_regvars(current_asmdata.CurrAsmList);
192 {$endif OLDREGVARS}
193            { the jump the sequence is a little bit hairy }
194            case nodetype of
195               ltn,gtn:
196                 begin
197                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,truelabel);
198                    { cheat a little bit for the negative test }
199                    toggleflag(nf_swapped);
200                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,falselabel);
201                    toggleflag(nf_swapped);
202                 end;
203               lten,gten:
204                 begin
205                    oldnodetype:=nodetype;
206                    if nodetype=lten then
207                      nodetype:=ltn
208                    else
209                      nodetype:=gtn;
210                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,truelabel);
211                    { cheat for the negative test }
212                    if nodetype=ltn then
213                      nodetype:=gtn
214                    else
215                      nodetype:=ltn;
216                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,falselabel);
217                    nodetype:=oldnodetype;
218                 end;
219               equaln:
220                 begin
221                   nodetype := unequaln;
222                   cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,falselabel);
223                   nodetype := equaln;
224                 end;
225               unequaln:
226                 begin
227                   cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,truelabel);
228                 end;
229            end;
230         end;
231 
232 
233       procedure secondjmp64bitcmp;
234 
235         begin
236            { the jump the sequence is a little bit hairy }
237            case nodetype of
238               ltn,gtn,lten,gten:
239                 begin
240                    { the comparison of the low dword always has }
241                    { to be always unsigned!                     }
242                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,truelabel);
243                    cg.a_jmp_always(current_asmdata.CurrAsmList,falselabel);
244                 end;
245               equaln:
246                 begin
247                    nodetype := unequaln;
248                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,falselabel);
249                    cg.a_jmp_always(current_asmdata.CurrAsmList,truelabel);
250                    nodetype := equaln;
251                 end;
252               unequaln:
253                 begin
254                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,truelabel);
255                    cg.a_jmp_always(current_asmdata.CurrAsmList,falselabel);
256                 end;
257            end;
258         end;
259 
260 
261     var
262       tempreg64: tregister64;
263 
264       begin
265         truelabel:=nil;
266         falselabel:=nil;
267         firstcomplex(self);
268 
269         pass_left_and_right;
270 
271         cmpop:=false;
272         unsigned:=((left.resultdef.typ=orddef) and
273                    (torddef(left.resultdef).ordtype=u64bit)) or
274                   ((right.resultdef.typ=orddef) and
275                    (torddef(right.resultdef).ordtype=u64bit));
276         case nodetype of
277           addn :
278             begin
279               op:=OP_ADD;
280             end;
281           subn :
282             begin
283               op:=OP_SUB;
284               if (nf_swapped in flags) then
285                 swapleftright;
286             end;
287           ltn,lten,
288           gtn,gten,
289           equaln,unequaln:
290             begin
291               op:=OP_NONE;
292               cmpop:=true;
293             end;
294           xorn:
295             op:=OP_XOR;
296           orn:
297             op:=OP_OR;
298           andn:
299             op:=OP_AND;
300           muln:
301             begin
302               { should be handled in pass_1 (JM) }
303               if not(torddef(left.resultdef).ordtype in [U32bit,s32bit]) or
304                  (torddef(left.resultdef).typ <> torddef(right.resultdef).typ) then
305                 internalerror(200109051);
306               { handled separately }
307               op := OP_NONE;
308             end;
309           else
310             internalerror(2002072705);
311         end;
312 
313         if not cmpop or
314            (nodetype in [equaln,unequaln]) then
315           location_reset(location,LOC_REGISTER,def_cgsize(resultdef))
316         else
317           begin
318             { we call emit_cmp, which will set location.loc to LOC_FLAGS ->
319               wait till the end with setting the location }
320             current_asmdata.getjumplabel(truelabel);
321             current_asmdata.getjumplabel(falselabel);
322           end;
323 
324         load_left_right(cmpop,((cs_check_overflow in current_settings.localswitches) and
325             (nodetype in [addn,subn])) or (nodetype = muln));
326 
327         if (nodetype <> muln) and
328            (not(cs_check_overflow in current_settings.localswitches) or
329             not(nodetype in [addn,subn])) then
330           begin
331             case nodetype of
332               ltn,lten,
333               gtn,gten:
334                 begin
335                   emit_cmp64_hi;
336                   firstjmp64bitcmp;
337                   emit_cmp64_lo;
338                   secondjmp64bitcmp;
339                 end;
340               equaln,unequaln:
341                 begin
342                   // instead of doing a complicated compare, do
343                   // (left.hi xor right.hi) or (left.lo xor right.lo)
344                   // (somewhate optimized so that no superfluous 'mr's are
345                   //  generated)
346                   if (left.location.loc = LOC_CONSTANT) then
347                     swapleftright;
348                   if (right.location.loc = LOC_CONSTANT) then
349                     begin
350                       if left.location.loc = LOC_REGISTER then
351                         begin
352                           tempreg64.reglo := left.location.register64.reglo;
353                           tempreg64.reghi := left.location.register64.reghi;
354                         end
355                       else
356                         begin
357                           if (aint(right.location.value64) <> 0) then
358                             tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32)
359                           else
360                             tempreg64.reglo := left.location.register64.reglo;
361                           if ((right.location.value64 shr 32) <> 0) then
362                             tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_32)
363                           else
364                             tempreg64.reghi := left.location.register64.reghi;
365                         end;
366 
367                       if (aint(right.location.value64) <> 0) then
368                         { negative values can be handled using SUB, }
369                         { positive values < 65535 using XOR.        }
370                         if (longint(right.location.value64) >= -32767) and
371                            (longint(right.location.value64) < 0) then
372                           cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
373                             aint(right.location.value64),
374                             left.location.register64.reglo,tempreg64.reglo)
375                         else
376                           cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
377                             aint(right.location.value64),
378                             left.location.register64.reglo,tempreg64.reglo);
379 
380                       if ((right.location.value64 shr 32) <> 0) then
381                         if (longint(right.location.value64 shr 32) >= -32767) and
382                            (longint(right.location.value64 shr 32) < 0) then
383                           cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
384                             aint(right.location.value64 shr 32),
385                             left.location.register64.reghi,tempreg64.reghi)
386                         else
387                           cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
388                             aint(right.location.value64 shr 32),
389                             left.location.register64.reghi,tempreg64.reghi);
390                     end
391                   else
392                     begin
393                        tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
394                        tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
395                        cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,location.size,
396                          left.location.register64,right.location.register64,
397                          tempreg64);
398                     end;
399 
400                   cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_R0);
401                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR_,NR_R0,
402                     tempreg64.reglo,tempreg64.reghi));
403                   cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_R0);
404 
405                   location_reset(location,LOC_FLAGS,OS_NO);
406                   location.resflags := getresflags;
407                 end;
408               xorn,orn,andn,addn:
409                 begin
410                   location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
411                   location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
412 
413                   if (left.location.loc = LOC_CONSTANT) then
414                     swapleftright;
415                   if (right.location.loc = LOC_CONSTANT) then
416                     cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.value64,
417                       left.location.register64,location.register64)
418                   else
419                     cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.register64,
420                       left.location.register64,location.register64);
421                 end;
422               subn:
423                 begin
424                   location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
425                   location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
426                   if left.location.loc <> LOC_CONSTANT then
427                     begin
428                       if right.location.loc <> LOC_CONSTANT then
429                         // reg64 - reg64
430                         cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size,
431                           right.location.register64,left.location.register64,
432                           location.register64)
433                       else
434                         // reg64 - const64
435                         cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size,
436                           right.location.value64,left.location.register64,
437                           location.register64)
438                     end
439                   else if ((left.location.value64 shr 32) = 0) then
440                     begin
441                       if (int64(left.location.value64) >= low(smallint)) and
442                          (int64(left.location.value64) <= high(smallint)) then
443                         begin
444                           // consts16 - reg64
445                           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,
446                             location.register64.reglo,right.location.register64.reglo,
447                             left.location.value));
448                         end
449                       else
450                         begin
451                           // const32 - reg64
452                           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
453                             left.resultdef,u32inttype,true);
454                           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBC,
455                             location.register64.reglo,left.location.register64.reglo,
456                             right.location.register64.reglo));
457                         end;
458                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SUBFZE,
459                         location.register64.reghi,right.location.register64.reghi));
460                     end
461                   else if (aint(left.location.value64) = 0) then
462                     begin
463                       // (const32 shl 32) - reg64
464                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,
465                         location.register64.reglo,right.location.register64.reglo,0));
466                       left.location.value64 := left.location.value64 shr 32;
467                       hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u32inttype,true);
468                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,
469                         location.register64.reghi,right.location.register64.reghi,
470                         left.location.register));
471                     end
472                   else
473                     begin
474                       // const64 - reg64
475                       hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
476                         left.resultdef,left.resultdef,false);
477                       cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size,
478                         right.location.register64,left.location.register64,
479                         location.register64);
480                      end;
481                 end;
482               else
483                 internalerror(2002072803);
484             end;
485           end
486         else
487           begin
488             if is_signed(left.resultdef) and
489                is_signed(right.resultdef) then
490               begin
491                 case nodetype of
492                   addn:
493                     begin
494                       op1 := A_ADDC;
495                       op2 := A_ADDEO;
496                     end;
497                   subn:
498                     begin
499                       op1 := A_SUBC;
500                       op2 := A_SUBFEO;
501                     end;
502                   muln:
503                     begin
504                       op1 := A_MULLW;
505                       op2 := A_MULHW
506                     end;
507                   else
508                     internalerror(2002072806);
509                 end
510               end
511             else
512               begin
513                 case nodetype of
514                   addn:
515                     begin
516                       op1 := A_ADDC;
517                       op2 := A_ADDE;
518                     end;
519                   subn:
520                     begin
521                       op1 := A_SUBC;
522                       op2 := A_SUBFE;
523                     end;
524                   muln:
525                     begin
526                       op1 := A_MULLW;
527                       op2 := A_MULHWU
528                     end;
529                   else
530                     internalerror(2014082040);
531                 end;
532               end;
533             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op1,location.register64.reglo,
534               left.location.register64.reglo,right.location.register64.reglo));
535 
536             if (nodetype <> muln) then
537               begin
538                 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi,
539                    right.location.register64.reghi,left.location.register64.reghi));
540                 if not(is_signed(resultdef)) then
541                   if nodetype = addn then
542                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,location.register64.reghi,left.location.register64.reghi))
543                   else
544                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register64.reghi,location.register64.reghi));
545                 cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
546               end
547             else
548               begin
549                { 32 * 32 -> 64 cannot overflow }
550                 current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi,
551                    left.location.register64.reglo,right.location.register64.reglo));
552               end
553           end;
554 
555         { set result location }
556         { (emit_compare sets it to LOC_FLAGS for compares, so set the }
557         {  real location only now) (JM)                               }
558         if cmpop and
559            not(nodetype in [equaln,unequaln]) then
560           location_reset_jump(location,truelabel,falselabel);
561       end;
562 
563 
564 {*****************************************************************************
565                                 pass_2
566 *****************************************************************************}
567 
568     procedure tppcaddnode.pass_generate_code;
569     { is also being used for xor, and "mul", "sub, or and comparative }
570     { operators                                                }
571       var
572          cgop       : topcg;
573          op         : tasmop;
574          tmpreg     : tregister;
575          hl         : tasmlabel;
576          cmpop      : boolean;
577          { true, if unsigned types are compared }
578          unsigned : boolean;
579          checkoverflow : boolean;
580 
581       begin
582          { to make it more readable, string and set (not smallset!) have their
583            own procedures }
584          case left.resultdef.typ of
585            orddef :
586              begin
587                { handling boolean expressions }
588                if is_boolean(left.resultdef) and
589                   is_boolean(right.resultdef) then
590                  begin
591                    second_addboolean;
592                    exit;
593                  end
594                { 64bit operations }
595                else if is_64bit(resultdef) or
596                        is_64bit(left.resultdef) then
597                  begin
598                    second_add64bit;
599                    exit;
600                  end;
601              end;
602            stringdef :
603              begin
604                internalerror(2002072402);
605                exit;
606              end;
607            setdef :
608              begin
609                { normalsets are already handled in pass1 }
610                if not is_smallset(left.resultdef) then
611                 internalerror(200109042);
612                second_addsmallset;
613                exit;
614              end;
615            arraydef :
616              begin
617 {$ifdef SUPPORT_MMX}
618                if is_mmx_able_array(left.resultdef) then
619                 begin
620                   second_addmmx;
621                   exit;
622                 end;
623 {$endif SUPPORT_MMX}
624              end;
625            floatdef :
626              begin
627                second_addfloat;
628                exit;
629              end;
630          end;
631 
632          { defaults }
633          cmpop:=nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
634          unsigned:=not(is_signed(left.resultdef)) or
635                    not(is_signed(right.resultdef));
636 
637          pass_left_and_right;
638 
639          { Convert flags to register first }
640          { can any of these things be in the flags actually?? (JM) }
641 
642          if (left.location.loc = LOC_FLAGS) or
643             (right.location.loc = LOC_FLAGS) then
644            internalerror(2002072602);
645 
646          { set result location }
647          if not cmpop then
648            location_reset(location,LOC_REGISTER,def_cgsize(resultdef))
649           else
650            location_reset(location,LOC_FLAGS,OS_NO);
651 
652          checkoverflow:=
653            (nodetype in [addn,subn,muln]) and
654            (cs_check_overflow in current_settings.localswitches) and
655            (left.resultdef.typ<>pointerdef) and
656            (right.resultdef.typ<>pointerdef);
657 
658          load_left_right(cmpop, checkoverflow);
659 
660          if not(cmpop) then
661            location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
662 
663          if not(checkoverflow) then
664            begin
665              case nodetype of
666                addn, muln, xorn, orn, andn:
667                  begin
668                    case nodetype of
669                      addn:
670                        cgop := OP_ADD;
671                      muln:
672                        if unsigned then
673                          cgop := OP_MUL
674                        else
675                          cgop := OP_IMUL;
676                      xorn:
677                        cgop := OP_XOR;
678                      orn:
679                        cgop := OP_OR;
680                      andn:
681                        cgop := OP_AND;
682                      else
683                        internalerror(2014082041);
684                    end;
685                    if (left.location.loc = LOC_CONSTANT) then
686                      swapleftright;
687                    if (right.location.loc <> LOC_CONSTANT) then
688                      cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT,
689                        left.location.register,right.location.register,
690                        location.register)
691                    else
692                      cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT,
693                        right.location.value,left.location.register,
694                      location.register);
695                  end;
696                subn:
697                  begin
698                    if (nf_swapped in flags) then
699                      swapleftright;
700                    if left.location.loc <> LOC_CONSTANT then
701                      if right.location.loc <> LOC_CONSTANT then
702                        cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
703                          right.location.register,left.location.register,
704                          location.register)
705                      else
706                        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
707                          right.location.value,left.location.register,
708                          location.register)
709                    else
710                      if (longint(left.location.value) >= low(smallint)) and
711                         (longint(left.location.value) <= high(smallint)) then
712                        begin
713                          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,
714                            location.register,right.location.register,
715                            longint(left.location.value)));
716                        end
717                      else
718                        begin
719                          tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
720                          cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,
721                            left.location.value,tmpreg);
722                          cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
723                            right.location.register,tmpreg,location.register);
724                        end;
725                  end;
726                ltn,lten,gtn,gten,equaln,unequaln :
727                  begin
728                    emit_compare(unsigned);
729                  end;
730              end;
731            end
732          else
733            // overflow checking is on and we have an addn, subn or muln
734            begin
735              if is_signed(resultdef) then
736                begin
737                  case nodetype of
738                    addn:
739                      op := A_ADDO;
740                    subn:
741                      begin
742                        op := A_SUBO;
743                        if (nf_swapped in flags) then
744                          swapleftright;
745                      end;
746                    muln:
747                      op := A_MULLWO;
748                    else
749                      internalerror(2002072601);
750                  end;
751                  current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,
752                    left.location.register,right.location.register));
753                  cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
754               end
755              else
756               begin
757                 case nodetype of
758                   addn:
759                     begin
760                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,location.register,
761                         left.location.register,right.location.register));
762                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,location.register,left.location.register));
763                       cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
764                     end;
765                   subn:
766                     begin
767                       if nf_swapped in flags then
768                         swapleftright;
769                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,location.register,
770                         left.location.register,right.location.register));
771                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register,location.register));
772                       cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
773                     end;
774                   muln:
775                     begin
776                       { calculate the upper 32 bits of the product, = 0 if no overflow }
777                       cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_R0);
778                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHWU_,NR_R0,
779                         left.location.register,right.location.register));
780                       cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_R0);
781                       { calculate the real result }
782                       current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULLW,location.register,
783                         left.location.register,right.location.register));
784                       { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
785                       current_asmdata.getjumplabel(hl);
786                       tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,hl);
787                       cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
788                       cg.a_label(current_asmdata.CurrAsmList,hl);
789                     end;
790                 end;
791               end;
792            end;
793       end;
794 
795 begin
796    caddnode:=tppcaddnode;
797 end.
798