1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210 |
- {
- $Id$
- Copyright (c) 1993-98 by Florian Klaempfl
- Generate i386 assembler for in add node
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit cg386add;
- interface
- uses
- tree;
- procedure secondadd(var p : ptree);
- implementation
- uses
- cobjects,verbose,globals,
- symtable,aasm,i386,types,
- cgi386,cgai386,temp_gen,tgeni386,hcodegen;
- {*****************************************************************************
- SecondAdd
- *****************************************************************************}
- procedure setaddresult(cmpop,unsigned : boolean;var p :ptree);
- var
- flags : tresflags;
- begin
- if (p^.left^.resulttype^.deftype<>stringdef) and
- ((p^.left^.resulttype^.deftype<>setdef) or
- (psetdef(p^.left^.resulttype)^.settype=smallset)) then
- if (p^.left^.location.loc=LOC_REFERENCE) or
- (p^.left^.location.loc=LOC_MEM) then
- ungetiftemp(p^.left^.location.reference);
- if (p^.right^.resulttype^.deftype<>stringdef) and
- ((p^.right^.resulttype^.deftype<>setdef) or
- (psetdef(p^.right^.resulttype)^.settype=smallset)) then
- { this can be useful if for instance length(string) is called }
- if (p^.right^.location.loc=LOC_REFERENCE) or
- (p^.right^.location.loc=LOC_MEM) then
- ungetiftemp(p^.right^.location.reference);
- { in case of comparison operation the put result in the flags }
- if cmpop then
- begin
- if not(unsigned) then
- begin
- if p^.swaped then
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_G;
- lten : flags:=F_GE;
- gtn : flags:=F_L;
- gten : flags:=F_LE;
- end
- else
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_L;
- lten : flags:=F_LE;
- gtn : flags:=F_G;
- gten : flags:=F_GE;
- end;
- end
- else
- begin
- if p^.swaped then
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_A;
- lten : flags:=F_AE;
- gtn : flags:=F_B;
- gten : flags:=F_BE;
- end
- else
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_B;
- lten : flags:=F_BE;
- gtn : flags:=F_A;
- gten : flags:=F_AE;
- end;
- end;
- p^.location.loc:=LOC_FLAGS;
- p^.location.resflags:=flags;
- end;
- end;
- procedure addstring(var p : ptree);
- var
- swapp : ptree;
- pushedregs : tpushed;
- href : treference;
- pushed,cmpop : boolean;
- begin
- { string operations are not commutative }
- if p^.swaped then
- begin
- swapp:=p^.left;
- p^.left:=p^.right;
- p^.right:=swapp;
- { because of jump being produced at comparison below: }
- p^.swaped:=not(p^.swaped);
- end;
- {$ifdef UseAnsiString}
- if is_ansistring(p^.left^.resulttype) then
- begin
- case p^.treetype of
- addn :
- begin
- { we do not need destination anymore }
- del_reference(p^.left^.location.reference);
- del_reference(p^.right^.location.reference);
- { concatansistring(p); }
- end;
- ltn,lten,gtn,gten,
- equaln,unequaln :
- begin
- pushusedregisters(pushedregs,$ff);
- secondpass(p^.left);
- del_reference(p^.left^.location.reference);
- emitpushreferenceaddr(p^.left^.location.reference);
- secondpass(p^.right);
- del_reference(p^.right^.location.reference);
- emitpushreferenceaddr(p^.right^.location.reference);
- emitcall('ANSISTRCMP',true);
- maybe_loadesi;
- popusedregisters(pushedregs);
- end;
- end;
- end
- else
- {$endif UseAnsiString}
- case p^.treetype of
- addn :
- begin
- cmpop:=false;
- secondpass(p^.left);
- { if str_concat is set in expr
- s:=s+ ... no need to create a temp string (PM) }
- if (p^.left^.treetype<>addn) and not (p^.use_strconcat) then
- begin
- { can only reference be }
- { string in register would be funny }
- { therefore produce a temporary string }
- { release the registers }
- del_reference(p^.left^.location.reference);
- gettempofsizereference(256,href);
- copystring(href,p^.left^.location.reference,255);
- ungetiftemp(p^.left^.location.reference);
- { does not hurt: }
- p^.left^.location.loc:=LOC_MEM;
- p^.left^.location.reference:=href;
- end;
- secondpass(p^.right);
- { on the right we do not need the register anymore too }
- del_reference(p^.right^.location.reference);
- { if p^.right^.resulttype^.deftype=orddef then
- begin
- pushusedregisters(pushedregs,$ff);
- exprasmlist^.concat(new(pai386,op_ref_reg(
- A_LEA,S_L,newreference(p^.left^.location.reference),R_EDI)));
- exprasmlist^.concat(new(pai386,op_reg_reg(
- A_XOR,S_L,R_EBX,R_EBX)));
- reset_reference(href);
- href.base:=R_EDI;
- exprasmlist^.concat(new(pai386,op_ref_reg(
- A_MOV,S_B,newreference(href),R_BL)));
- exprasmlist^.concat(new(pai386,op_reg(
- A_INC,S_L,R_EBX)));
- exprasmlist^.concat(new(pai386,op_reg_ref(
- A_MOV,S_B,R_BL,newreference(href))));
- href.index:=R_EBX;
- if p^.right^.treetype=ordconstn then
- exprasmlist^.concat(new(pai386,op_const_ref(
- A_MOV,S_L,p^.right^.value,newreference(href))))
- else
- begin
- if p^.right^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
- exprasmlist^.concat(new(pai386,op_reg_ref(
- A_MOV,S_B,p^.right^.location.register,newreference(href))))
- else
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(
- A_MOV,S_L,newreference(p^.right^.location.reference),R_EAX)));
- exprasmlist^.concat(new(pai386,op_reg_ref(
- A_MOV,S_B,R_AL,newreference(href))));
- end;
- end;
- popusedregisters(pushedregs);
- end
- else }
- begin
- if p^.use_strconcat then
- pushusedregisters(pushedregs,pstringdef(p^.left^.resulttype)^.len)
- else
- pushusedregisters(pushedregs,$ff);
- emitpushreferenceaddr(p^.left^.location.reference);
- emitpushreferenceaddr(p^.right^.location.reference);
- emitcall('STRCONCAT',true);
- maybe_loadesi;
- popusedregisters(pushedregs);
- end;
- set_location(p^.location,p^.left^.location);
- ungetiftemp(p^.right^.location.reference);
- end;
- ltn,lten,gtn,gten,
- equaln,unequaln :
- begin
- cmpop:=true;
- { generate better code for s='' and s<>'' }
- if (p^.treetype in [equaln,unequaln]) and
- (((p^.left^.treetype=stringconstn) and (p^.left^.values^='')) or
- ((p^.right^.treetype=stringconstn) and (p^.right^.values^=''))) then
- begin
- secondpass(p^.left);
- { are too few registers free? }
- pushed:=maybe_push(p^.right^.registers32,p);
- secondpass(p^.right);
- if pushed then restore(p);
- del_reference(p^.right^.location.reference);
- del_reference(p^.left^.location.reference);
- { only one node can be stringconstn }
- { else pass 1 would have evaluted }
- { this node }
- if p^.left^.treetype=stringconstn then
- exprasmlist^.concat(new(pai386,op_const_ref(
- A_CMP,S_B,0,newreference(p^.right^.location.reference))))
- else
- exprasmlist^.concat(new(pai386,op_const_ref(
- A_CMP,S_B,0,newreference(p^.left^.location.reference))));
- end
- else
- begin
- pushusedregisters(pushedregs,$ff);
- secondpass(p^.left);
- del_reference(p^.left^.location.reference);
- emitpushreferenceaddr(p^.left^.location.reference);
- secondpass(p^.right);
- del_reference(p^.right^.location.reference);
- emitpushreferenceaddr(p^.right^.location.reference);
- emitcall('STRCMP',true);
- maybe_loadesi;
- popusedregisters(pushedregs);
- end;
- ungetiftemp(p^.left^.location.reference);
- ungetiftemp(p^.right^.location.reference);
- end;
- else Message(sym_e_type_mismatch);
- end;
- setaddresult(cmpop,true,p);
- end;
- procedure secondadd(var p : ptree);
- { is also being used for xor, and "mul", "sub, or and comparative }
- { operators }
- label do_normal;
- var
- swapp : ptree;
- hregister : tregister;
- pushed,mboverflow,cmpop : boolean;
- op : tasmop;
- pushedregs : tpushed;
- flags : tresflags;
- otl,ofl : plabel;
- power : longint;
- href : treference;
- opsize : topsize;
- hl4: plabel;
- { true, if unsigned types are compared }
- unsigned : boolean;
- { is_in_dest if the result is put directly into }
- { the resulting refernce or varregister }
- { true, if a small set is handled with the longint code }
- is_set : boolean;
- is_in_dest : boolean;
- { true, if for sets subtractions the extra not should generated }
- extra_not : boolean;
- {$ifdef SUPPORT_MMX}
- mmxbase : tmmxtype;
- {$endif SUPPORT_MMX}
- begin
- if (p^.left^.resulttype^.deftype=stringdef) then
- begin
- addstring(p);
- exit;
- end;
- unsigned:=false;
- is_in_dest:=false;
- extra_not:=false;
- opsize:=S_L;
- { calculate the operator which is more difficult }
- firstcomplex(p);
- { handling boolean expressions extra: }
- if ((p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) or
- ((p^.right^.resulttype^.deftype=orddef) and
- (porddef(p^.right^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
- begin
- if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
- (porddef(p^.right^.resulttype)^.typ=bool8bit) then
- opsize:=S_B
- else
- if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
- (porddef(p^.right^.resulttype)^.typ=bool16bit) then
- opsize:=S_W
- else
- opsize:=S_L;
- case p^.treetype of
- andn,
- orn : begin
- p^.location.loc:=LOC_JUMP;
- cmpop:=false;
- case p^.treetype of
- andn : begin
- otl:=truelabel;
- getlabel(truelabel);
- secondpass(p^.left);
- maketojumpbool(p^.left);
- emitl(A_LABEL,truelabel);
- truelabel:=otl;
- end;
- orn : begin
- ofl:=falselabel;
- getlabel(falselabel);
- secondpass(p^.left);
- maketojumpbool(p^.left);
- emitl(A_LABEL,falselabel);
- falselabel:=ofl;
- end;
- else
- Message(sym_e_type_mismatch);
- end;
- secondpass(p^.right);
- maketojumpbool(p^.right);
- end;
- unequaln,
- equaln,xorn : begin
- if p^.left^.treetype=ordconstn then
- begin
- swapp:=p^.right;
- p^.right:=p^.left;
- p^.left:=swapp;
- p^.swaped:=not(p^.swaped);
- end;
- secondpass(p^.left);
- p^.location:=p^.left^.location;
- { are enough registers free ? }
- pushed:=maybe_push(p^.right^.registers32,p);
- secondpass(p^.right);
- if pushed then restore(p);
- goto do_normal;
- end
- else
- Message(sym_e_type_mismatch);
- end
- end
- else if (p^.left^.resulttype^.deftype=setdef) and
- not(psetdef(p^.left^.resulttype)^.settype=smallset) then
- begin
- mboverflow:=false;
- secondpass(p^.left);
- set_location(p^.location,p^.left^.location);
- { are too few registers free? }
- pushed:=maybe_push(p^.right^.registers32,p);
- secondpass(p^.right);
- if pushed then restore(p);
- { not commutative }
- if p^.swaped then
- begin
- swapp:=p^.left;
- p^.left:=p^.right;
- p^.right:=swapp;
- { because of jump being produced by comparison }
- p^.swaped:=not(p^.swaped);
- end;
- case p^.treetype of
- equaln,unequaln:
- begin
- cmpop:=true;
- del_reference(p^.left^.location.reference);
- del_reference(p^.right^.location.reference);
- pushusedregisters(pushedregs,$ff);
- emitpushreferenceaddr(p^.right^.location.reference);
- emitpushreferenceaddr(p^.left^.location.reference);
- emitcall('SET_COMP_SETS',true);
- maybe_loadesi;
- popusedregisters(pushedregs);
- ungetiftemp(p^.left^.location.reference);
- ungetiftemp(p^.right^.location.reference);
- end;
- addn,symdifn,subn,muln:
- begin
- cmpop:=false;
- del_reference(p^.left^.location.reference);
- del_reference(p^.right^.location.reference);
- href.symbol:=nil;
- pushusedregisters(pushedregs,$ff);
- gettempofsizereference(32,href);
- emitpushreferenceaddr(href);
- { wrong place !! was hard to find out
- pushusedregisters(pushedregs,$ff);}
- emitpushreferenceaddr(p^.right^.location.reference);
- emitpushreferenceaddr(p^.left^.location.reference);
- case p^.treetype of
- subn:
- emitcall('SET_SUB_SETS',true);
- addn:
- emitcall('SET_ADD_SETS',true);
- symdifn:
- emitcall('SET_SYMDIF_SETS',true);
- muln:
- emitcall('SET_MUL_SETS',true);
- end;
- maybe_loadesi;
- popusedregisters(pushedregs);
- ungetiftemp(p^.left^.location.reference);
- ungetiftemp(p^.right^.location.reference);
- p^.location.loc:=LOC_MEM;
- stringdispose(p^.location.reference.symbol);
- p^.location.reference:=href;
- end;
- else Message(sym_e_type_mismatch);
- end;
- end
- else
- begin
- { in case of constant put it to the left }
- if p^.left^.treetype=ordconstn then
- begin
- swapp:=p^.right;
- p^.right:=p^.left;
- p^.left:=swapp;
- p^.swaped:=not(p^.swaped);
- end;
- secondpass(p^.left);
- { this will be complicated as
- a lot of code below assumes that
- p^.location and p^.left^.location are the same }
- {$ifdef test_dest_loc}
- if dest_loc_known and (dest_loc_tree=p) and
- ((dest_loc.loc=LOC_REGISTER) or (dest_loc.loc=LOC_CREGISTER)) then
- begin
- set_location(p^.location,dest_loc);
- in_dest_loc:=true;
- is_in_dest:=true;
- end
- else
- {$endif test_dest_loc}
- set_location(p^.location,p^.left^.location);
- { are too few registers free? }
- pushed:=maybe_push(p^.right^.registers32,p);
- secondpass(p^.right);
- if pushed then restore(p);
- if (p^.left^.resulttype^.deftype=pointerdef) or
- (p^.right^.resulttype^.deftype=pointerdef) or
- ((p^.right^.resulttype^.deftype=objectdef) and
- pobjectdef(p^.right^.resulttype)^.isclass and
- (p^.left^.resulttype^.deftype=objectdef) and
- pobjectdef(p^.left^.resulttype)^.isclass
- ) or
- (p^.left^.resulttype^.deftype=classrefdef) or
- (p^.left^.resulttype^.deftype=procvardef) or
- (p^.left^.resulttype^.deftype=enumdef) or
- ((p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ=s32bit)) or
- ((p^.right^.resulttype^.deftype=orddef) and
- (porddef(p^.right^.resulttype)^.typ=s32bit)) or
- ((p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ=u32bit)) or
- ((p^.right^.resulttype^.deftype=orddef) and
- (porddef(p^.right^.resulttype)^.typ=u32bit)) or
- { as well as small sets }
- ((p^.left^.resulttype^.deftype=setdef) and
- (psetdef(p^.left^.resulttype)^.settype=smallset)
- ) then
- begin
- do_normal:
- mboverflow:=false;
- cmpop:=false;
- if (p^.left^.resulttype^.deftype=pointerdef) or
- (p^.right^.resulttype^.deftype=pointerdef) or
- ((p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ=u32bit)) or
- ((p^.right^.resulttype^.deftype=orddef) and
- (porddef(p^.right^.resulttype)^.typ=u32bit)) then
- unsigned:=true;
- is_set:=p^.resulttype^.deftype=setdef;
- case p^.treetype of
- addn : begin
- if is_set then
- begin
- op:=A_OR;
- mboverflow:=false;
- unsigned:=false;
- end
- else
- begin
- op:=A_ADD;
- mboverflow:=true;
- end;
- end;
- symdifn : begin
- { the symetric diff is only for sets }
- if is_set then
- begin
- op:=A_XOR;
- mboverflow:=false;
- unsigned:=false;
- end
- else
- begin
- Message(sym_e_type_mismatch);
- end;
- end;
- muln : begin
- if is_set then
- begin
- op:=A_AND;
- mboverflow:=false;
- unsigned:=false;
- end
- else
- begin
- if unsigned then
- op:=A_MUL
- else
- op:=A_IMUL;
- mboverflow:=true;
- end;
- end;
- subn : begin
- if is_set then
- begin
- op:=A_AND;
- mboverflow:=false;
- unsigned:=false;
- extra_not:=true;
- end
- else
- begin
- op:=A_SUB;
- mboverflow:=true;
- end;
- end;
- ltn,lten,gtn,gten,
- equaln,unequaln :
- begin
- op:=A_CMP;
- cmpop:=true;
- end;
- xorn : op:=A_XOR;
- orn : op:=A_OR;
- andn : op:=A_AND;
- else Message(sym_e_type_mismatch);
- end;
- { left and right no register? }
- { then one must be demanded }
- if (p^.left^.location.loc<>LOC_REGISTER) and
- (p^.right^.location.loc<>LOC_REGISTER) then
- begin
- { register variable ? }
- if (p^.left^.location.loc=LOC_CREGISTER) then
- begin
- { it is OK if this is the destination }
- if is_in_dest then
- begin
- hregister:=p^.location.register;
- emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
- hregister);
- end
- else
- if cmpop then
- begin
- { do not disturb the register }
- hregister:=p^.location.register;
- end
- else
- begin
- case opsize of
- S_L : hregister:=getregister32;
- S_B : hregister:=reg32toreg8(getregister32);
- end;
- emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
- hregister);
- end
- end
- else
- begin
- del_reference(p^.left^.location.reference);
- if is_in_dest then
- begin
- hregister:=p^.location.register;
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
- newreference(p^.left^.location.reference),hregister)));
- end
- else
- begin
- { first give free, then demand new register }
- case opsize of
- S_L : hregister:=getregister32;
- S_W : hregister:=reg32toreg16(getregister32);
- S_B : hregister:=reg32toreg8(getregister32);
- end;
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
- newreference(p^.left^.location.reference),hregister)));
- end;
- end;
- p^.location.loc:=LOC_REGISTER;
- p^.location.register:=hregister;
- end
- else
- { if on the right the register then swap }
- if (p^.right^.location.loc=LOC_REGISTER) then
- begin
- swap_location(p^.location,p^.right^.location);
- { newly swapped also set swapped flag }
- p^.swaped:=not(p^.swaped);
- end;
- { at this point, p^.location.loc should be LOC_REGISTER }
- { and p^.location.register should be a valid register }
- { containing the left result }
- if p^.right^.location.loc<>LOC_REGISTER then
- begin
- if (p^.treetype=subn) and p^.swaped then
- begin
- if p^.right^.location.loc=LOC_CREGISTER then
- begin
- if extra_not then
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
- emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
- emit_reg_reg(op,opsize,p^.location.register,R_EDI);
- emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
- end
- else
- begin
- if extra_not then
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
- newreference(p^.right^.location.reference),R_EDI)));
- exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,p^.location.register,R_EDI)));
- exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,p^.location.register)));
- del_reference(p^.right^.location.reference);
- end;
- end
- else
- begin
- if (p^.right^.treetype=ordconstn) and
- (op=A_CMP) and
- (p^.right^.value=0) then
- begin
- exprasmlist^.concat(new(pai386,op_reg_reg(A_TEST,opsize,p^.location.register,
- p^.location.register)));
- end
- else if (p^.right^.treetype=ordconstn) and
- (op=A_ADD) and
- (p^.right^.value=1) then
- begin
- exprasmlist^.concat(new(pai386,op_reg(A_INC,opsize,
- p^.location.register)));
- end
- else if (p^.right^.treetype=ordconstn) and
- (op=A_SUB) and
- (p^.right^.value=1) then
- begin
- exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
- p^.location.register)));
- end
- else if (p^.right^.treetype=ordconstn) and
- (op=A_IMUL) and
- (ispowerof2(p^.right^.value,power)) then
- begin
- exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,opsize,power,
- p^.location.register)));
- end
- else
- begin
- if (p^.right^.location.loc=LOC_CREGISTER) then
- begin
- if extra_not then
- begin
- emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
- emit_reg_reg(A_AND,S_L,R_EDI,
- p^.location.register);
- end
- else
- begin
- emit_reg_reg(op,opsize,p^.right^.location.register,
- p^.location.register);
- end;
- end
- else
- begin
- if extra_not then
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
- p^.right^.location.reference),R_EDI)));
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
- emit_reg_reg(A_AND,S_L,R_EDI,
- p^.location.register);
- end
- else
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,newreference(
- p^.right^.location.reference),p^.location.register)));
- end;
- del_reference(p^.right^.location.reference);
- end;
- end;
- end;
- end
- else
- begin
- { when swapped another result register }
- if (p^.treetype=subn) and p^.swaped then
- begin
- if extra_not then
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
- exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
- p^.location.register,p^.right^.location.register)));
- swap_location(p^.location,p^.right^.location);
- { newly swapped also set swapped flag }
- { just to maintain ordering }
- p^.swaped:=not(p^.swaped);
- end
- else
- begin
- if extra_not then
- exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.right^.location.register)));
- exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
- p^.right^.location.register,
- p^.location.register)));
- end;
- case opsize of
- S_L : ungetregister32(p^.right^.location.register);
- S_B : ungetregister32(reg8toreg32(p^.right^.location.register));
- end;
- end;
- if cmpop then
- case opsize of
- S_L : ungetregister32(p^.location.register);
- S_B : ungetregister32(reg8toreg32(p^.location.register));
- end;
- { only in case of overflow operations }
- { produce overflow code }
- if mboverflow then
- { we must put it here directly, because sign of operation }
- { is in unsigned VAR!! }
- begin
- if cs_check_overflow in aktswitches then
- begin
- getlabel(hl4);
- if unsigned then
- emitl(A_JNB,hl4)
- else
- emitl(A_JNO,hl4);
- emitcall('RE_OVERFLOW',true);
- emitl(A_LABEL,hl4);
- end;
- end;
- end
- else if ((p^.left^.resulttype^.deftype=orddef) and
- (porddef(p^.left^.resulttype)^.typ=uchar)) then
- begin
- case p^.treetype of
- ltn,lten,gtn,gten,
- equaln,unequaln :
- cmpop:=true;
- else Message(sym_e_type_mismatch);
- end;
- unsigned:=true;
- { left and right no register? }
- { the one must be demanded }
- if (p^.location.loc<>LOC_REGISTER) and
- (p^.right^.location.loc<>LOC_REGISTER) then
- begin
- if p^.location.loc=LOC_CREGISTER then
- begin
- if cmpop then
- { do not disturb register }
- hregister:=p^.location.register
- else
- begin
- hregister:=reg32toreg8(getregister32);
- emit_reg_reg(A_MOV,S_B,p^.location.register,
- hregister);
- end;
- end
- else
- begin
- del_reference(p^.location.reference);
- { first give free then demand new register }
- hregister:=reg32toreg8(getregister32);
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(p^.location.reference),
- hregister)));
- end;
- p^.location.loc:=LOC_REGISTER;
- p^.location.register:=hregister;
- end;
- { now p always a register }
- if (p^.right^.location.loc=LOC_REGISTER) and
- (p^.location.loc<>LOC_REGISTER) then
- begin
- swap_location(p^.location,p^.right^.location);
- { newly swapped also set swapped flag }
- p^.swaped:=not(p^.swaped);
- end;
- if p^.right^.location.loc<>LOC_REGISTER then
- begin
- if p^.right^.location.loc=LOC_CREGISTER then
- begin
- emit_reg_reg(A_CMP,S_B,
- p^.right^.location.register,p^.location.register);
- end
- else
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,S_B,newreference(
- p^.right^.location.reference),p^.location.register)));
- del_reference(p^.right^.location.reference);
- end;
- end
- else
- begin
- emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
- p^.location.register);
- ungetregister32(reg8toreg32(p^.right^.location.register));
- end;
- ungetregister32(reg8toreg32(p^.location.register));
- end
- else if (p^.left^.resulttype^.deftype=floatdef) and
- (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
- begin
- { real constants to the left }
- if p^.left^.treetype=realconstn then
- begin
- swapp:=p^.right;
- p^.right:=p^.left;
- p^.left:=swapp;
- p^.swaped:=not(p^.swaped);
- end;
- cmpop:=false;
- case p^.treetype of
- addn : op:=A_FADDP;
- muln : op:=A_FMULP;
- subn : op:=A_FSUBP;
- slashn : op:=A_FDIVP;
- ltn,lten,gtn,gten,
- equaln,unequaln : begin
- op:=A_FCOMPP;
- cmpop:=true;
- end;
- else Message(sym_e_type_mismatch);
- end;
- if (p^.right^.location.loc<>LOC_FPU) then
- begin
- floatload(pfloatdef(p^.right^.resulttype)^.typ,p^.right^.location.reference);
- if (p^.left^.location.loc<>LOC_FPU) then
- floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
- { left was on the stack => swap }
- else
- p^.swaped:=not(p^.swaped);
- { releases the right reference }
- del_reference(p^.right^.location.reference);
- end
- { the nominator in st0 }
- else if (p^.left^.location.loc<>LOC_FPU) then
- floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
- { fpu operands are always in the wrong order on the stack }
- else
- p^.swaped:=not(p^.swaped);
- { releases the left reference }
- if (p^.left^.location.loc<>LOC_FPU) then
- del_reference(p^.left^.location.reference);
- { if we swaped the tree nodes, then use the reverse operator }
- if p^.swaped then
- begin
- if (p^.treetype=slashn) then
- op:=A_FDIVRP
- else if (p^.treetype=subn) then
- op:=A_FSUBRP;
- end;
- { to avoid the pentium bug
- if (op=FDIVP) and (opt_processors=pentium) then
- exprasmlist^.concat(new(pai386,op_CALL,S_NO,'EMUL_FDIVP')
- else
- }
- { the Intel assemblers want operands }
- if op<>A_FCOMPP then
- exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,R_ST,R_ST1)))
- else
- exprasmlist^.concat(new(pai386,op_none(op,S_NO)));
- { on comparison load flags }
- if cmpop then
- begin
- if not(R_EAX in unused) then
- emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
- exprasmlist^.concat(new(pai386,op_reg(A_FNSTSW,S_NO,R_AX)));
- exprasmlist^.concat(new(pai386,op_none(A_SAHF,S_NO)));
- if not(R_EAX in unused) then
- emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
- if p^.swaped then
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_A;
- lten : flags:=F_AE;
- gtn : flags:=F_B;
- gten : flags:=F_BE;
- end
- else
- case p^.treetype of
- equaln : flags:=F_E;
- unequaln : flags:=F_NE;
- ltn : flags:=F_B;
- lten : flags:=F_BE;
- gtn : flags:=F_A;
- gten : flags:=F_AE;
- end;
- p^.location.loc:=LOC_FLAGS;
- p^.location.resflags:=flags;
- cmpop:=false;
- end
- else
- p^.location.loc:=LOC_FPU;
- end
- {$ifdef SUPPORT_MMX}
- else if is_mmx_able_array(p^.left^.resulttype) then
- begin
- cmpop:=false;
- mmxbase:=mmx_type(p^.left^.resulttype);
- case p^.treetype of
- addn : begin
- if (cs_mmx_saturation in aktswitches) then
- begin
- case mmxbase of
- mmxs8bit:
- op:=A_PADDSB;
- mmxu8bit:
- op:=A_PADDUSB;
- mmxs16bit,mmxfixed16:
- op:=A_PADDSB;
- mmxu16bit:
- op:=A_PADDUSW;
- end;
- end
- else
- begin
- case mmxbase of
- mmxs8bit,mmxu8bit:
- op:=A_PADDB;
- mmxs16bit,mmxu16bit,mmxfixed16:
- op:=A_PADDW;
- mmxs32bit,mmxu32bit:
- op:=A_PADDD;
- end;
- end;
- end;
- muln : begin
- case mmxbase of
- mmxs16bit,mmxu16bit:
- op:=A_PMULLW;
- mmxfixed16:
- op:=A_PMULHW;
- end;
- end;
- subn : begin
- if (cs_mmx_saturation in aktswitches) then
- begin
- case mmxbase of
- mmxs8bit:
- op:=A_PSUBSB;
- mmxu8bit:
- op:=A_PSUBUSB;
- mmxs16bit,mmxfixed16:
- op:=A_PSUBSB;
- mmxu16bit:
- op:=A_PSUBUSW;
- end;
- end
- else
- begin
- case mmxbase of
- mmxs8bit,mmxu8bit:
- op:=A_PSUBB;
- mmxs16bit,mmxu16bit,mmxfixed16:
- op:=A_PSUBW;
- mmxs32bit,mmxu32bit:
- op:=A_PSUBD;
- end;
- end;
- end;
- {
- ltn,lten,gtn,gten,
- equaln,unequaln :
- begin
- op:=A_CMP;
- cmpop:=true;
- end;
- }
- xorn:
- op:=A_PXOR;
- orn:
- op:=A_POR;
- andn:
- op:=A_PAND;
- else Message(sym_e_type_mismatch);
- end;
- { left and right no register? }
- { then one must be demanded }
- if (p^.left^.location.loc<>LOC_MMXREGISTER) and
- (p^.right^.location.loc<>LOC_MMXREGISTER) then
- begin
- { register variable ? }
- if (p^.left^.location.loc=LOC_CMMXREGISTER) then
- begin
- { it is OK if this is the destination }
- if is_in_dest then
- begin
- hregister:=p^.location.register;
- emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
- hregister);
- end
- else
- begin
- hregister:=getregistermmx;
- emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
- hregister);
- end
- end
- else
- begin
- del_reference(p^.left^.location.reference);
- if is_in_dest then
- begin
- hregister:=p^.location.register;
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
- newreference(p^.left^.location.reference),hregister)));
- end
- else
- begin
- hregister:=getregistermmx;
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
- newreference(p^.left^.location.reference),hregister)));
- end;
- end;
- p^.location.loc:=LOC_MMXREGISTER;
- p^.location.register:=hregister;
- end
- else
- { if on the right the register then swap }
- if (p^.right^.location.loc=LOC_MMXREGISTER) then
- begin
- swap_location(p^.location,p^.right^.location);
- { newly swapped also set swapped flag }
- p^.swaped:=not(p^.swaped);
- end;
- { at this point, p^.location.loc should be LOC_MMXREGISTER }
- { and p^.location.register should be a valid register }
- { containing the left result }
- if p^.right^.location.loc<>LOC_MMXREGISTER then
- begin
- if (p^.treetype=subn) and p^.swaped then
- begin
- if p^.right^.location.loc=LOC_CMMXREGISTER then
- begin
- emit_reg_reg(A_MOVQ,S_NO,p^.right^.location.register,R_MM7);
- emit_reg_reg(op,S_NO,p^.location.register,R_EDI);
- emit_reg_reg(A_MOVQ,S_NO,R_MM7,p^.location.register);
- end
- else
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
- newreference(p^.right^.location.reference),R_MM7)));
- exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,p^.location.register,
- R_MM7)));
- exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO,
- R_MM7,p^.location.register)));
- del_reference(p^.right^.location.reference);
- end;
- end
- else
- begin
- if (p^.right^.location.loc=LOC_CREGISTER) then
- begin
- emit_reg_reg(op,S_NO,p^.right^.location.register,
- p^.location.register);
- end
- else
- begin
- exprasmlist^.concat(new(pai386,op_ref_reg(op,S_NO,newreference(
- p^.right^.location.reference),p^.location.register)));
- del_reference(p^.right^.location.reference);
- end;
- end;
- end
- else
- begin
- { when swapped another result register }
- if (p^.treetype=subn) and p^.swaped then
- begin
- exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,
- p^.location.register,p^.right^.location.register)));
- swap_location(p^.location,p^.right^.location);
- { newly swapped also set swapped flag }
- { just to maintain ordering }
- p^.swaped:=not(p^.swaped);
- end
- else
- begin
- exprasmlist^.concat(new(pai386,op_reg_reg(op,S_NO,
- p^.right^.location.register,
- p^.location.register)));
- end;
- ungetregistermmx(p^.right^.location.register);
- end;
- end
- {$endif SUPPORT_MMX}
- else Message(sym_e_type_mismatch);
- end;
- setaddresult(cmpop,unsigned,p);
- end;
- end.
- {
- $Log$
- Revision 1.2 1998-06-08 13:13:28 pierre
- + temporary variables now in temp_gen.pas unit
- because it is processor independent
- * mppc68k.bat modified to undefine i386 and support_mmx
- (which are defaults for i386)
- Revision 1.1 1998/06/05 17:44:10 peter
- * splitted cgi386
- }
|