home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-09-24 | 56.5 KB | 1,287 lines |
- {
- $Id: cgi386ad.inc,v 1.2.2.1 1998/04/08 11:38:43 peter Exp $
- Copyright (c) 1993-98 by Florian Klaempfl
-
- This include file generates i386+ assembler from the parse tree
-
- 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.
-
- ****************************************************************************
- }
-
- procedure secondas(var p : ptree);
-
- var
- pushed : tpushed;
-
- begin
- secondpass(p^.left);
- { save all used registers }
- pushusedregisters(pushed,$ff);
-
- { push instance to check: }
- case p^.left^.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
- S_L,p^.left^.location.register)));
- LOC_MEM,LOC_REFERENCE:
- exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
- S_L,newreference(p^.left^.location.reference))));
- else internalerror(100);
- end;
-
- { we doesn't modifiy the left side, we check only the type }
- set_location(p^.location,p^.left^.location);
-
- { generate type checking }
- secondpass(p^.right);
- case p^.right^.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
- S_L,p^.right^.location.register)));
- ungetregister32(p^.right^.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
- S_L,newreference(p^.right^.location.reference))));
- del_reference(p^.right^.location.reference);
- end;
- else internalerror(100);
- end;
- emitcall('DO_AS',true);
- { restore register, this restores automatically the }
- { result }
- popusedregisters(pushed);
- end;
-
- procedure secondloadvmt(var p : ptree);
-
- begin
- p^.location.register:=getregister32;
- exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
- S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
- p^.location.register)));
- end;
-
- procedure secondis(var p : ptree);
-
- var
- pushed : tpushed;
-
- begin
- { save all used registers }
- pushusedregisters(pushed,$ff);
- secondpass(p^.left);
- p^.location.loc:=LOC_FLAGS;
- p^.location.resflags:=F_NE;
-
- { push instance to check: }
- case p^.left^.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
- S_L,p^.left^.location.register)));
- ungetregister32(p^.left^.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
- S_L,newreference(p^.left^.location.reference))));
- del_reference(p^.left^.location.reference);
- end;
- else internalerror(100);
- end;
-
- { generate type checking }
- secondpass(p^.right);
- case p^.right^.location.loc of
- LOC_REGISTER,LOC_CREGISTER:
- begin
- exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
- S_L,p^.right^.location.register)));
- ungetregister32(p^.right^.location.register);
- end;
- LOC_MEM,LOC_REFERENCE:
- begin
- exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
- S_L,newreference(p^.right^.location.reference))));
- del_reference(p^.right^.location.reference);
- end;
- else internalerror(100);
- end;
- emitcall('DO_IS',true);
- exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
- popusedregisters(pushed);
- end;
-
- procedure setaddresult(cmpop,unsigned : boolean;var p :ptree);
- var
- flags : tresflags;
- begin
- if (p^.left^.resulttype^.deftype<>stringdef) and
- not ((p^.left^.resulttype^.deftype=setdef) and
- (psetdef(p^.left^.resulttype)^.settype<>smallset)) then
- begin
- { this can be useful if for instance length(string) is called }
- if (p^.left^.location.loc=LOC_REFERENCE) or
- (p^.left^.location.loc=LOC_MEM) then
- ungetiftemp(p^.left^.location.reference);
- if (p^.right^.location.loc=LOC_REFERENCE) or
- (p^.right^.location.loc=LOC_MEM) then
- ungetiftemp(p^.right^.location.reference);
- end;
- { 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 secondaddstring(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;
- case p^.treetype of
- addn :
- begin
- cmpop:=false;
- secondpass(p^.left);
- if (p^.left^.treetype<>addn) 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
- 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;
-
- mmxbase : tmmxtype;
-
- begin
- if (p^.left^.resulttype^.deftype=stringdef) then
- begin
- secondaddstring(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=bool8bit)) or
- ((p^.right^.resulttype^.deftype=orddef) and
- (porddef(p^.right^.resulttype)^.typ=bool8bit)) then
- begin
- if (p^.treetype=andn) or (p^.treetype=orn) then
- 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
- else if p^.treetype in [unequaln,equaln,xorn] then
- begin
- opsize:=S_B;
- 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
- 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_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;
-
- {
- $Log: cgi386ad.inc,v $
- Revision 1.2.2.1 1998/04/08 11:38:43 peter
- * nasm patches, pierres symtable patch
-
- Revision 1.2 1998/03/28 23:09:55 florian
- * secondin bugfix (m68k and i386)
- * overflow checking bugfix (m68k and i386) -- pretty useless in
- secondadd, since everything is done using 32-bit
- * loading pointer to routines hopefully fixed (m68k)
- * flags problem with calls to RTL internal routines fixed (still strcmp
- to fix) (m68k)
- * #ELSE was still incorrect (didn't take care of the previous level)
- * problem with filenames in the command line solved
- * problem with mangledname solved
- * linking name problem solved (was case insensitive)
- * double id problem and potential crash solved
- * stop after first error
- * and=>test problem removed
- * correct read for all float types
- * 2 sigsegv fixes and a cosmetic fix for Internal Error
- * push/pop is now correct optimized (=> mov (%esp),reg)
-
- Revision 1.1.1.1 1998/03/25 11:18:12 root
- * Restored version
-
- Revision 1.15 1998/03/10 23:48:36 florian
- * a couple of bug fixes to get the compiler with -OGaxz compiler, sadly
- enough, it doesn't run
-
- Revision 1.14 1998/03/10 01:17:18 peter
- * all files have the same header
- * messages are fully implemented, EXTDEBUG uses Comment()
- + AG... files for the Assembler generation
-
- Revision 1.13 1998/03/09 10:44:38 peter
- + string='', string<>'', string:='', string:=char optimizes (the first 2
- were already in cg68k2)
-
- Revision 1.12 1998/03/06 00:52:16 peter
- * replaced all old messages from errore.msg, only ExtDebug and some
- Comment() calls are left
- * fixed options.pas
-
- Revision 1.11 1998/03/02 01:48:30 peter
- * renamed target_DOS to target_GO32V1
- + new verbose system, merged old errors and verbose units into one new
- verbose.pas, so errors.pas is obsolete
-
- Revision 1.10 1998/02/15 21:27:50 florian
- *** empty log message ***
- }
-