1 {
2     Copyright (c) 2000-2002 by Florian Klaempfl
3 
4     Code generation for add nodes on the i8086
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 n8086add;
23 
24 {$i fpcdefs.inc}
25 
26 interface
27 
28     uses
29        node,nadd,cpubase,nx86add;
30 
31     type
32 
33        { ti8086addnode }
34 
35        ti8086addnode = class(tx86addnode)
simplifynull36          function simplify(forinline: boolean) : tnode;override;
use_generic_mul32to64null37          function use_generic_mul32to64: boolean; override;
first_addpointernull38          function first_addpointer: tnode; override;
first_addhugepointernull39          function first_addhugepointer: tnode;
first_cmppointernull40          function first_cmppointer: tnode; override;
first_cmphugepointernull41          function first_cmphugepointer: tnode;
first_cmpfarpointernull42          function first_cmpfarpointer: tnode;
43          procedure second_addordinal; override;
44          procedure second_add64bit;override;
45          procedure second_addfarpointer;
46          procedure second_cmp64bit;override;
47          procedure second_cmp32bit;
48          procedure second_cmpfarpointer;
49          procedure second_cmpordinal;override;
50          procedure second_mul(unsigned: boolean);
51        end;
52 
53   implementation
54 
55     uses
56       globtype,systems,
57       cutils,verbose,globals,constexp,pass_1,
58       symconst,symdef,symtype,symcpu,paramgr,defutil,
59       aasmbase,aasmtai,aasmdata,aasmcpu,
60       cgbase,procinfo,
61       ncal,ncon,nset,cgutils,tgobj,
62       cga,ncgutil,cgobj,cg64f32,cgx86,
63       hlcgobj;
64 
65 {*****************************************************************************
66                                 simplify
67 *****************************************************************************}
68 
ti8086addnode.simplifynull69     function ti8086addnode.simplify(forinline: boolean): tnode;
70       var
71         t    : tnode;
72         lt,rt: tnodetype;
73         rd,ld: tdef;
74         rv,lv,v: tconstexprint;
75       begin
76         { load easier access variables }
77         rd:=right.resultdef;
78         ld:=left.resultdef;
79         rt:=right.nodetype;
80         lt:=left.nodetype;
81 
82         if (
83             (lt = pointerconstn) and is_farpointer(ld) and
84             is_constintnode(right) and
85             (nodetype in [addn,subn])
86            ) or
87            (
88             (rt = pointerconstn) and is_farpointer(rd) and
89             is_constintnode(left) and
90             (nodetype=addn)
91            ) or
92            (
93             (lt in [pointerconstn,niln]) and is_farpointer(ld) and
94             (rt in [pointerconstn,niln]) and is_farpointer(rd) and
95             (nodetype in [ltn,lten,gtn,gten,equaln,unequaln])
96            ) then
97           begin
98             t:=nil;
99 
100             { load values }
101             case lt of
102               ordconstn:
103                 lv:=tordconstnode(left).value;
104               pointerconstn:
105                 lv:=tpointerconstnode(left).value;
106               niln:
107                 lv:=0;
108               else
109                 internalerror(2002080202);
110             end;
111             case rt of
112               ordconstn:
113                 rv:=tordconstnode(right).value;
114               pointerconstn:
115                 rv:=tpointerconstnode(right).value;
116               niln:
117                 rv:=0;
118               else
119                 internalerror(2002080203);
120             end;
121 
122             case nodetype of
123               addn:
124                 begin
125                   v:=lv+rv;
126                   if lt=pointerconstn then
127                     t := cpointerconstnode.create((qword(lv) and $FFFF0000) or word(qword(v)),resultdef)
128                   else if rt=pointerconstn then
129                     t := cpointerconstnode.create((qword(rv) and $FFFF0000) or word(qword(v)),resultdef)
130                   else
131                     internalerror(2014040604);
132                 end;
133               subn:
134                 begin
135                   v:=lv-rv;
136                   if (lt=pointerconstn) then
137                     { pointer-pointer results in an integer }
138                     if (rt=pointerconstn) then
139                       begin
140                         if not(nf_has_pointerdiv in flags) then
141                           internalerror(2008030101);
142                         { todo: implement pointer-pointer as well }
143                         internalerror(2014040607);
144                         //t := cpointerconstnode.create(qword(v),resultdef);
145                       end
146                     else
147                       t := cpointerconstnode.create((qword(lv) and $FFFF0000) or word(qword(v)),resultdef)
148                   else
149                     internalerror(2014040606);
150                 end;
151               ltn:
152                 t:=cordconstnode.create(ord(word(qword(lv))<word(qword(rv))),pasbool1type,true);
153               lten:
154                 t:=cordconstnode.create(ord(word(qword(lv))<=word(qword(rv))),pasbool1type,true);
155               gtn:
156                 t:=cordconstnode.create(ord(word(qword(lv))>word(qword(rv))),pasbool1type,true);
157               gten:
158                 t:=cordconstnode.create(ord(word(qword(lv))>=word(qword(rv))),pasbool1type,true);
159               equaln:
160                 t:=cordconstnode.create(ord(lv=rv),pasbool1type,true);
161               unequaln:
162                 t:=cordconstnode.create(ord(lv<>rv),pasbool1type,true);
163               else
164                 internalerror(2014040605);
165             end;
166             result:=t;
167             exit;
168           end
169         else
170           Result:=inherited simplify(forinline);
171       end;
172 
173 {*****************************************************************************
174                                 use_generic_mul32to64
175 *****************************************************************************}
176 
ti8086addnode.use_generic_mul32to64null177     function ti8086addnode.use_generic_mul32to64: boolean;
178     begin
179       result := True;
180     end;
181 
182     { handles all multiplications }
183     procedure ti8086addnode.second_addordinal;
184     var
185       unsigned: boolean;
186     begin
187       unsigned:=not(is_signed(left.resultdef)) or
188                 not(is_signed(right.resultdef));
189       if nodetype=muln then
190         second_mul(unsigned)
191       else if is_farpointer(left.resultdef) xor is_farpointer(right.resultdef) then
192         second_addfarpointer
193       else
194         inherited second_addordinal;
195     end;
196 
197 {*****************************************************************************
198                                 Add64bit
199 *****************************************************************************}
200 
201     procedure ti8086addnode.second_add64bit;
202       var
203         op         : TOpCG;
204         op1,op2    : TAsmOp;
205         hregister,
206         hregister2 : tregister;
207         hl4        : tasmlabel;
208         mboverflow,
209         unsigned:boolean;
210         r:Tregister;
211       begin
212         pass_left_right;
213 
214         op1:=A_NONE;
215         op2:=A_NONE;
216         mboverflow:=false;
217         unsigned:=((left.resultdef.typ=orddef) and
218                    (torddef(left.resultdef).ordtype=u64bit)) or
219                   ((right.resultdef.typ=orddef) and
220                    (torddef(right.resultdef).ordtype=u64bit));
221         case nodetype of
222           addn :
223             begin
224               op:=OP_ADD;
225               mboverflow:=true;
226             end;
227           subn :
228             begin
229               op:=OP_SUB;
230               op1:=A_SUB;
231               op2:=A_SBB;
232               mboverflow:=true;
233             end;
234           xorn:
235             op:=OP_XOR;
236           orn:
237             op:=OP_OR;
238           andn:
239             op:=OP_AND;
240           else
241             begin
242               { everything should be handled in pass_1 (JM) }
243               internalerror(200109051);
244             end;
245         end;
246 
247         { left and right no register?  }
248         { then one must be demanded    }
249         if (left.location.loc<>LOC_REGISTER) then
250          begin
251            if (right.location.loc<>LOC_REGISTER) then
252             begin
253               hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
254               hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
255               cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2));
256               location_reset(left.location,LOC_REGISTER,left.location.size);
257               left.location.register64.reglo:=hregister;
258               left.location.register64.reghi:=hregister2;
259             end
260            else
261             begin
262               location_swap(left.location,right.location);
263               toggleflag(nf_swapped);
264             end;
265          end;
266 
267         { at this point, left.location.loc should be LOC_REGISTER }
268         if right.location.loc=LOC_REGISTER then
269          begin
270            { when swapped another result register }
271            if (nodetype=subn) and (nf_swapped in flags) then
272             begin
273               cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,op,location.size,
274                 left.location.register64,
275                 right.location.register64);
276               location_swap(left.location,right.location);
277               toggleflag(nf_swapped);
278             end
279            else
280             begin
281               cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,op,location.size,
282                 right.location.register64,
283                 left.location.register64);
284             end;
285          end
286         else
287          begin
288            { right.location<>LOC_REGISTER }
289            if (nodetype=subn) and (nf_swapped in flags) then
290             begin
291               r:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
292               cg64.a_load64low_loc_reg(current_asmdata.CurrAsmList,right.location,r);
293               emit_reg_reg(op1,S_W,left.location.register64.reglo,r);
294               emit_reg_reg(op2,S_W,cg.GetNextReg(left.location.register64.reglo),cg.GetNextReg(r));
295               emit_reg_reg(A_MOV,S_W,r,left.location.register64.reglo);
296               emit_reg_reg(A_MOV,S_W,cg.GetNextReg(r),cg.GetNextReg(left.location.register64.reglo));
297               cg64.a_load64high_loc_reg(current_asmdata.CurrAsmList,right.location,r);
298               { the carry flag is still ok }
299               emit_reg_reg(op2,S_W,left.location.register64.reghi,r);
300               emit_reg_reg(op2,S_W,cg.GetNextReg(left.location.register64.reghi),cg.GetNextReg(r));
301               emit_reg_reg(A_MOV,S_W,r,left.location.register64.reghi);
302               emit_reg_reg(A_MOV,S_W,cg.GetNextReg(r),cg.GetNextReg(left.location.register64.reghi));
303             end
304            else
305             begin
306               cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,op,location.size,right.location,
307                 left.location.register64);
308             end;
309           location_freetemp(current_asmdata.CurrAsmList,right.location);
310          end;
311 
312         { only in case of overflow operations }
313         { produce overflow code }
314         { we must put it here directly, because sign of operation }
315         { is in unsigned VAR!!                              }
316         if mboverflow then
317          begin
318            if cs_check_overflow in current_settings.localswitches  then
319             begin
320               current_asmdata.getjumplabel(hl4);
321               if unsigned then
322                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4)
323               else
324                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4);
325               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
326               cg.a_label(current_asmdata.CurrAsmList,hl4);
327             end;
328          end;
329 
330         location_copy(location,left.location);
331       end;
332 
333 
ti8086addnode.first_addpointernull334     function ti8086addnode.first_addpointer: tnode;
335       begin
336         if is_hugepointer(left.resultdef) or is_hugepointer(right.resultdef) then
337           result:=first_addhugepointer
338         else
339           result:=inherited;
340       end;
341 
342 
ti8086addnode.first_addhugepointernull343     function ti8086addnode.first_addhugepointer: tnode;
344       var
345         procname:string;
346       begin
347         result:=nil;
348 
349         if (nodetype=subn) and is_hugepointer(left.resultdef) and is_hugepointer(right.resultdef) then
350           procname:='fpc_hugeptr_sub_hugeptr'
351         else
352           begin
353             case nodetype of
354               addn:
355                 procname:='fpc_hugeptr_add_longint';
356               subn:
357                 procname:='fpc_hugeptr_sub_longint';
358               else
359                 internalerror(2014070301);
360             end;
361 
362             if cs_hugeptr_arithmetic_normalization in current_settings.localswitches then
363               procname:=procname+'_normalized';
364           end;
365 
366         if is_hugepointer(left.resultdef) then
367           result := ccallnode.createintern(procname,
368             ccallparanode.create(right,
369             ccallparanode.create(left,nil)))
370         else
371           result := ccallnode.createintern(procname,
372             ccallparanode.create(left,
373             ccallparanode.create(right,nil)));
374         left := nil;
375         right := nil;
376         firstpass(result);
377       end;
378 
379 
ti8086addnode.first_cmppointernull380     function ti8086addnode.first_cmppointer: tnode;
381       begin
382         if is_hugepointer(left.resultdef) or is_hugepointer(right.resultdef) then
383           result:=first_cmphugepointer
384         else if is_farpointer(left.resultdef) or is_farpointer(right.resultdef) then
385           result:=first_cmpfarpointer
386         else
387           result:=inherited;
388       end;
389 
390 
ti8086addnode.first_cmphugepointernull391     function ti8086addnode.first_cmphugepointer: tnode;
392       var
393         procname:string;
394       begin
395         result:=nil;
396 
397         if not (cs_hugeptr_comparison_normalization in current_settings.localswitches) then
398           begin
399             expectloc:=LOC_JUMP;
400             exit;
401           end;
402 
403         case nodetype of
404           equaln:
405             procname:='fpc_hugeptr_cmp_normalized_e';
406           unequaln:
407             procname:='fpc_hugeptr_cmp_normalized_ne';
408           ltn:
409             procname:='fpc_hugeptr_cmp_normalized_b';
410           lten:
411             procname:='fpc_hugeptr_cmp_normalized_be';
412           gtn:
413             procname:='fpc_hugeptr_cmp_normalized_a';
414           gten:
415             procname:='fpc_hugeptr_cmp_normalized_ae';
416           else
417             internalerror(2014070401);
418         end;
419 
420         result := ccallnode.createintern(procname,
421           ccallparanode.create(right,
422           ccallparanode.create(left,nil)));
423         left := nil;
424         right := nil;
425         firstpass(result);
426       end;
427 
428 
ti8086addnode.first_cmpfarpointernull429     function ti8086addnode.first_cmpfarpointer: tnode;
430       begin
431         { = and <> are handled as a 32-bit comparison }
432         if nodetype in [equaln,unequaln] then
433           begin
434             result:=nil;
435             expectloc:=LOC_JUMP;
436           end
437         else
438           begin
439             result:=nil;
440             expectloc:=LOC_FLAGS;
441           end;
442       end;
443 
444 
445     procedure ti8086addnode.second_addfarpointer;
446       var
447         tmpreg : tregister;
448         pointernode: tnode;
449       begin
450         pass_left_right;
451         force_reg_left_right(false,true);
452         set_result_location_reg;
453 
454         if (left.resultdef.typ=pointerdef) and (right.resultdef.typ<>pointerdef) then
455           pointernode:=left
456         else if (left.resultdef.typ<>pointerdef) and (right.resultdef.typ=pointerdef) then
457           pointernode:=right
458         else
459           internalerror(2014040601);
460 
461         if not (nodetype in [addn,subn]) then
462           internalerror(2014040602);
463 
464         if nodetype=addn then
465           begin
466             if (right.location.loc<>LOC_CONSTANT) then
467               begin
468                 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
469                    left.location.register,right.location.register,location.register);
470                 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
471                    cg.GetNextReg(pointernode.location.register),cg.GetNextReg(location.register));
472               end
473             else
474               begin
475                 if pointernode=left then
476                   begin
477                     { farptr_reg + int_const }
478                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
479                        right.location.value,left.location.register,location.register);
480                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
481                        cg.GetNextReg(left.location.register),cg.GetNextReg(location.register));
482                   end
483                 else
484                   begin
485                     { int_reg + farptr_const }
486                     tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
487                     hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,
488                       right.location.value,tmpreg);
489                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,
490                       left.location.register,tmpreg,location.register);
491                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
492                        cg.GetNextReg(tmpreg),cg.GetNextReg(location.register));
493                   end;
494               end;
495           end
496         else  { subtract is a special case since its not commutative }
497           begin
498             if (nf_swapped in flags) then
499               swapleftright;
500             { left can only be a pointer in this case, since (int-pointer) is not supported }
501             if pointernode<>left then
502               internalerror(2014040603);
503             if left.location.loc<>LOC_CONSTANT then
504               begin
505                 if right.location.loc<>LOC_CONSTANT then
506                   begin
507                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
508                         right.location.register,left.location.register,location.register);
509                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
510                        cg.GetNextReg(pointernode.location.register),cg.GetNextReg(location.register));
511                   end
512                 else
513                   begin
514                     { farptr_reg - int_const }
515                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
516                        right.location.value,left.location.register,location.register);
517                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
518                        cg.GetNextReg(left.location.register),cg.GetNextReg(location.register));
519                   end;
520               end
521             else
522               begin
523                 { farptr_const - int_reg }
524                 tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
525                 hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,
526                   left.location.value,tmpreg);
527                 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_16,
528                   right.location.register,tmpreg,location.register);
529                 cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,
530                    cg.GetNextReg(tmpreg),cg.GetNextReg(location.register));
531               end;
532           end;
533       end;
534 
535 
536     procedure ti8086addnode.second_cmp64bit;
537       var
538         truelabel,
539         falselabel : tasmlabel;
540         hregister,
541         hregister2 : tregister;
542         href       : treference;
543         unsigned   : boolean;
544 
545       procedure firstjmp64bitcmp;
546 
547         var
548            oldnodetype : tnodetype;
549 
550         begin
551 {$ifdef OLDREGVARS}
552            load_all_regvars(current_asmdata.CurrAsmList);
553 {$endif OLDREGVARS}
554            { the jump the sequence is a little bit hairy }
555            case nodetype of
556               ltn,gtn:
557                 begin
558                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.truelabel);
559                    { cheat a little bit for the negative test }
560                    toggleflag(nf_swapped);
561                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.falselabel);
562                    toggleflag(nf_swapped);
563                 end;
564               lten,gten:
565                 begin
566                    oldnodetype:=nodetype;
567                    if nodetype=lten then
568                      nodetype:=ltn
569                    else
570                      nodetype:=gtn;
571                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.truelabel);
572                    { cheat for the negative test }
573                    if nodetype=ltn then
574                      nodetype:=gtn
575                    else
576                      nodetype:=ltn;
577                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.falselabel);
578                    nodetype:=oldnodetype;
579                 end;
580               equaln:
581                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.falselabel);
582               unequaln:
583                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.truelabel);
584            end;
585         end;
586 
587       procedure middlejmp64bitcmp;
588 
589         var
590            oldnodetype : tnodetype;
591 
592         begin
593 {$ifdef OLDREGVARS}
594            load_all_regvars(current_asmdata.CurrAsmList);
595 {$endif OLDREGVARS}
596            { the jump the sequence is a little bit hairy }
597            case nodetype of
598               ltn,gtn:
599                 begin
600                    { the comparisaion of the low word have to be }
601                    {  always unsigned!                           }
602                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.truelabel);
603                    { cheat a little bit for the negative test }
604                    toggleflag(nf_swapped);
605                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.falselabel);
606                    toggleflag(nf_swapped);
607                 end;
608               lten,gten:
609                 begin
610                    oldnodetype:=nodetype;
611                    if nodetype=lten then
612                      nodetype:=ltn
613                    else
614                      nodetype:=gtn;
615                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.truelabel);
616                    { cheat for the negative test }
617                    if nodetype=ltn then
618                      nodetype:=gtn
619                    else
620                      nodetype:=ltn;
621                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.falselabel);
622                    nodetype:=oldnodetype;
623                 end;
624               equaln:
625                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.falselabel);
626               unequaln:
627                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.truelabel);
628            end;
629         end;
630 
631       procedure lastjmp64bitcmp;
632 
633         begin
634            { the jump the sequence is a little bit hairy }
635            case nodetype of
636               ltn,gtn,lten,gten:
637                 begin
638                    { the comparisaion of the low word have to be }
639                    {  always unsigned!                           }
640                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.truelabel);
641                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
642                 end;
643               equaln:
644                 begin
645                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.falselabel);
646                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.truelabel);
647                 end;
648               unequaln:
649                 begin
650                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.truelabel);
651                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
652                 end;
653            end;
654         end;
655 
656       begin
657         truelabel:=nil;
658         falselabel:=nil;
659         pass_left_right;
660 
661         unsigned:=((left.resultdef.typ=orddef) and
662                    (torddef(left.resultdef).ordtype=u64bit)) or
663                   ((right.resultdef.typ=orddef) and
664                    (torddef(right.resultdef).ordtype=u64bit));
665 
666         { we have LOC_JUMP as result }
667         current_asmdata.getjumplabel(truelabel);
668         current_asmdata.getjumplabel(falselabel);
669         location_reset_jump(location,truelabel,falselabel);
670 
671         { left and right no register?  }
672         { then one must be demanded    }
673         if (left.location.loc<>LOC_REGISTER) then
674          begin
675            if (right.location.loc<>LOC_REGISTER) then
676             begin
677               { we can reuse a CREGISTER for comparison }
678               if (left.location.loc<>LOC_CREGISTER) then
679                begin
680                  hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
681                  hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
682                  cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2));
683                  location_freetemp(current_asmdata.CurrAsmList,left.location);
684                  location_reset(left.location,LOC_REGISTER,left.location.size);
685                  left.location.register64.reglo:=hregister;
686                  left.location.register64.reghi:=hregister2;
687                end;
688             end
689            else
690             begin
691               location_swap(left.location,right.location);
692               toggleflag(nf_swapped);
693             end;
694          end;
695 
696         { at this point, left.location.loc should be LOC_REGISTER }
697         if right.location.loc=LOC_REGISTER then
698          begin
699            emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register64.reghi),cg.GetNextReg(left.location.register64.reghi));
700            firstjmp64bitcmp;
701            emit_reg_reg(A_CMP,S_W,right.location.register64.reghi,left.location.register64.reghi);
702            middlejmp64bitcmp;
703            emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register64.reglo),cg.GetNextReg(left.location.register64.reglo));
704            middlejmp64bitcmp;
705            emit_reg_reg(A_CMP,S_W,right.location.register64.reglo,left.location.register64.reglo);
706            lastjmp64bitcmp;
707          end
708         else
709          begin
710            case right.location.loc of
711              LOC_CREGISTER :
712                begin
713                  emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register64.reghi),cg.GetNextReg(left.location.register64.reghi));
714                  firstjmp64bitcmp;
715                  emit_reg_reg(A_CMP,S_W,right.location.register64.reghi,left.location.register64.reghi);
716                  middlejmp64bitcmp;
717                  emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register64.reglo),cg.GetNextReg(left.location.register64.reglo));
718                  middlejmp64bitcmp;
719                  emit_reg_reg(A_CMP,S_W,right.location.register64.reglo,left.location.register64.reglo);
720                  lastjmp64bitcmp;
721                end;
722              LOC_CREFERENCE,
723              LOC_REFERENCE :
724                begin
725                  tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference);
726                  href:=right.location.reference;
727                  inc(href.offset,6);
728                  emit_ref_reg(A_CMP,S_W,href,cg.GetNextReg(left.location.register64.reghi));
729                  firstjmp64bitcmp;
730                  dec(href.offset,2);
731                  emit_ref_reg(A_CMP,S_W,href,left.location.register64.reghi);
732                  middlejmp64bitcmp;
733                  dec(href.offset,2);
734                  emit_ref_reg(A_CMP,S_W,href,cg.GetNextReg(left.location.register64.reglo));
735                  middlejmp64bitcmp;
736                  emit_ref_reg(A_CMP,S_W,right.location.reference,left.location.register64.reglo);
737                  lastjmp64bitcmp;
738                  cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
739                  location_freetemp(current_asmdata.CurrAsmList,right.location);
740                end;
741              LOC_CONSTANT :
742                begin
743                  current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint((right.location.value64 shr 48) and $FFFF),cg.GetNextReg(left.location.register64.reghi)));
744                  firstjmp64bitcmp;
745                  current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint((right.location.value64 shr 32) and $FFFF),left.location.register64.reghi));
746                  middlejmp64bitcmp;
747                  current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint((right.location.value64 shr 16) and $FFFF),cg.GetNextReg(left.location.register64.reglo)));
748                  middlejmp64bitcmp;
749                  current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint(right.location.value64 and $FFFF),left.location.register64.reglo));
750                  lastjmp64bitcmp;
751                end;
752              else
753                internalerror(200203282);
754            end;
755          end;
756       end;
757 
758     procedure ti8086addnode.second_cmp32bit;
759       var
760         truelabel,
761         falselabel: tasmlabel;
762         hregister : tregister;
763         href      : treference;
764         unsigned  : boolean;
765 
766       procedure firstjmp32bitcmp;
767 
768         var
769            oldnodetype : tnodetype;
770 
771         begin
772 {$ifdef OLDREGVARS}
773            load_all_regvars(current_asmdata.CurrAsmList);
774 {$endif OLDREGVARS}
775            { the jump the sequence is a little bit hairy }
776            case nodetype of
777               ltn,gtn:
778                 begin
779                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.truelabel);
780                    { cheat a little bit for the negative test }
781                    toggleflag(nf_swapped);
782                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.falselabel);
783                    toggleflag(nf_swapped);
784                 end;
785               lten,gten:
786                 begin
787                    oldnodetype:=nodetype;
788                    if nodetype=lten then
789                      nodetype:=ltn
790                    else
791                      nodetype:=gtn;
792                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.truelabel);
793                    { cheat for the negative test }
794                    if nodetype=ltn then
795                      nodetype:=gtn
796                    else
797                      nodetype:=ltn;
798                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),location.falselabel);
799                    nodetype:=oldnodetype;
800                 end;
801               equaln:
802                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.falselabel);
803               unequaln:
804                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.truelabel);
805            end;
806         end;
807 
808       procedure secondjmp32bitcmp;
809 
810         begin
811            { the jump the sequence is a little bit hairy }
812            case nodetype of
813               ltn,gtn,lten,gten:
814                 begin
815                    { the comparisaion of the low dword have to be }
816                    {  always unsigned!                            }
817                    cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),location.truelabel);
818                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
819                 end;
820               equaln:
821                 begin
822                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.falselabel);
823                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.truelabel);
824                 end;
825               unequaln:
826                 begin
827                    cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,location.truelabel);
828                    cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
829                 end;
830            end;
831         end;
832 
833       begin
834         truelabel:=nil;
835         falselabel:=nil;
836         pass_left_right;
837 
838         unsigned:=((left.resultdef.typ=orddef) and
839                    (torddef(left.resultdef).ordtype=u32bit)) or
840                   ((right.resultdef.typ=orddef) and
841                    (torddef(right.resultdef).ordtype=u32bit)) or
842                   is_hugepointer(left.resultdef);
843 
844         { we have LOC_JUMP as result }
845         current_asmdata.getjumplabel(truelabel);
846         current_asmdata.getjumplabel(falselabel);
847         location_reset_jump(location,truelabel,falselabel);
848 
849         { left and right no register?  }
850         { then one must be demanded    }
851         if (left.location.loc<>LOC_REGISTER) then
852          begin
853            if (right.location.loc<>LOC_REGISTER) then
854             begin
855               { we can reuse a CREGISTER for comparison }
856               if (left.location.loc<>LOC_CREGISTER) then
857                begin
858                  hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
859                  cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_32,left.location,hregister);
860                  location_freetemp(current_asmdata.CurrAsmList,left.location);
861                  location_reset(left.location,LOC_REGISTER,left.location.size);
862                  left.location.register:=hregister;
863                end;
864             end
865            else
866             begin
867               location_swap(left.location,right.location);
868               toggleflag(nf_swapped);
869             end;
870          end;
871 
872         { at this point, left.location.loc should be LOC_REGISTER }
873         if right.location.loc=LOC_REGISTER then
874          begin
875            emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register),cg.GetNextReg(left.location.register));
876            firstjmp32bitcmp;
877            emit_reg_reg(A_CMP,S_W,right.location.register,left.location.register);
878            secondjmp32bitcmp;
879          end
880         else
881          begin
882            case right.location.loc of
883              LOC_CREGISTER :
884                begin
885                  emit_reg_reg(A_CMP,S_W,cg.GetNextReg(right.location.register),cg.GetNextReg(left.location.register));
886                  firstjmp32bitcmp;
887                  emit_reg_reg(A_CMP,S_W,right.location.register,left.location.register);
888                  secondjmp32bitcmp;
889                end;
890              LOC_CREFERENCE,
891              LOC_REFERENCE :
892                begin
893                  tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference);
894                  href:=right.location.reference;
895                  inc(href.offset,2);
896                  emit_ref_reg(A_CMP,S_W,href,cg.GetNextReg(left.location.register));
897                  firstjmp32bitcmp;
898                  dec(href.offset,2);
899                  emit_ref_reg(A_CMP,S_W,href,left.location.register);
900                  secondjmp32bitcmp;
901                  cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
902                  location_freetemp(current_asmdata.CurrAsmList,right.location);
903                end;
904              LOC_CONSTANT :
905                begin
906                  if (right.location.value=0) and (nodetype in [equaln,unequaln]) and (left.location.loc=LOC_REGISTER) then
907                    begin
908                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_OR,S_W,cg.GetNextReg(left.location.register),left.location.register));
909                      secondjmp32bitcmp;
910                    end
911                  else
912                    begin
913                      current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint((right.location.value shr 16) and $FFFF),cg.GetNextReg(left.location.register)));
914                      firstjmp32bitcmp;
915                      current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_W,aint(right.location.value and $FFFF),left.location.register));
916                      secondjmp32bitcmp;
917                    end;
918                end;
919              else
920                internalerror(200203282);
921            end;
922          end;
923       end;
924 
925 
926     procedure ti8086addnode.second_cmpfarpointer;
927       begin
928         { handle = and <> as a 32-bit comparison }
929         if nodetype in [equaln,unequaln] then
930           begin
931             second_cmp32bit;
932             exit;
933           end;
934 
935         pass_left_right;
936 
937         { <, >, <= and >= compare the 16-bit offset only }
938         if (right.location.loc=LOC_CONSTANT) and
939            (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE])
940         then
941           begin
942             emit_const_ref(A_CMP, S_W, word(right.location.value), left.location.reference);
943             location_freetemp(current_asmdata.CurrAsmList,left.location);
944           end
945         else
946           begin
947             { left location is not a register? }
948             if left.location.loc<>LOC_REGISTER then
949              begin
950                { if right is register then we can swap the locations }
951                if right.location.loc=LOC_REGISTER then
952                 begin
953                   location_swap(left.location,right.location);
954                   toggleflag(nf_swapped);
955                 end
956                else
957                 begin
958                   { maybe we can reuse a constant register when the
959                     operation is a comparison that doesn't change the
960                     value of the register }
961                   hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u16inttype,true);
962                 end;
963               end;
964 
965             emit_generic_code(A_CMP,OS_16,true,false,false);
966             location_freetemp(current_asmdata.CurrAsmList,right.location);
967             location_freetemp(current_asmdata.CurrAsmList,left.location);
968           end;
969         location_reset(location,LOC_FLAGS,OS_NO);
970         location.resflags:=getresflags(true);
971       end;
972 
973 
974     procedure ti8086addnode.second_cmpordinal;
975       begin
976         if is_farpointer(left.resultdef) then
977           second_cmpfarpointer
978         else if is_32bit(left.resultdef) or is_hugepointer(left.resultdef) or is_farprocvar(left.resultdef) then
979           second_cmp32bit
980         else
981           inherited second_cmpordinal;
982       end;
983 
984 
985 {*****************************************************************************
986                                 x86 MUL
987 *****************************************************************************}
988 
989     procedure ti8086addnode.second_mul(unsigned: boolean);
990 
991     var reg:Tregister;
992         ref:Treference;
993         use_ref:boolean;
994         hl4 : tasmlabel;
995 
996     const
997       asmops: array[boolean] of tasmop = (A_IMUL, A_MUL);
998 
999     begin
1000       reg:=NR_NO;
1001       reference_reset(ref,sizeof(pint),[]);
1002 
1003       pass_left_right;
1004 
1005       { MUL is faster than IMUL on the 8086 & 8088 (and equal in speed on 286+),
1006         but it's only safe to use in place of IMUL when overflow checking is off
1007         and we're doing a 16-bit>16-bit multiplication }
1008       if not (cs_check_overflow in current_settings.localswitches) and
1009         (not is_32bitint(resultdef)) then
1010         unsigned:=true;
1011 
1012       {The location.register will be filled in later (JM)}
1013       location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
1014       { Mul supports registers and references, so if not register/reference,
1015         load the location into a register. }
1016       use_ref:=false;
1017       if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
1018         reg:=left.location.register
1019       else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
1020         begin
1021           tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference);
1022           ref:=left.location.reference;
1023           use_ref:=true;
1024         end
1025       else
1026         begin
1027           {LOC_CONSTANT for example.}
1028           reg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
1029           hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,osuinttype,left.location,reg);
1030         end;
1031       {Allocate AX.}
1032       cg.getcpuregister(current_asmdata.CurrAsmList,NR_AX);
1033       {Load the right value.}
1034       hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,osuinttype,right.location,NR_AX);
1035       {Also allocate DX, since it is also modified by a mul (JM).}
1036       cg.getcpuregister(current_asmdata.CurrAsmList,NR_DX);
1037       if use_ref then
1038         emit_ref(asmops[unsigned],S_W,ref)
1039       else
1040         emit_reg(asmops[unsigned],S_W,reg);
1041       if (cs_check_overflow in current_settings.localswitches) and
1042         { 16->32 bit cannot overflow }
1043         (not is_32bitint(resultdef)) then
1044         begin
1045           current_asmdata.getjumplabel(hl4);
1046           cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4);
1047           cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
1048           cg.a_label(current_asmdata.CurrAsmList,hl4);
1049         end;
1050       {Free AX,DX}
1051       cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_DX);
1052       if is_32bitint(resultdef) then
1053       begin
1054         {Allocate an imaginary 32-bit register, which consists of a pair of
1055          16-bit registers and store DX:AX into it}
1056         location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
1057         cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_DX,cg.GetNextReg(location.register));
1058         cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX);
1059         cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_AX,location.register);
1060       end
1061       else
1062       begin
1063         {Allocate a new register and store the result in AX in it.}
1064         location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
1065         cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX);
1066         cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_AX,location.register);
1067       end;
1068       location_freetemp(current_asmdata.CurrAsmList,left.location);
1069       location_freetemp(current_asmdata.CurrAsmList,right.location);
1070     end;
1071 
1072 
1073 begin
1074    caddnode:=ti8086addnode;
1075 end.
1076