mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 09:02:22 +01:00
+ binary operators for ansi strings
This commit is contained in:
florian
parent
0a51bba5f7
commit
e4290ba94a
@ -45,6 +45,7 @@ implementation
|
||||
flags : tresflags;
|
||||
begin
|
||||
{ remove temporary location if not a set or string }
|
||||
{ that's a bad hack (FK) who did this ? }
|
||||
if (p^.left^.resulttype^.deftype<>stringdef) and
|
||||
((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
|
||||
(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
|
||||
@ -118,158 +119,188 @@ implementation
|
||||
begin
|
||||
{ string operations are not commutative }
|
||||
if p^.swaped then
|
||||
swaptree(p);
|
||||
|
||||
{$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(exprasmlist,p^.left^.location.reference);
|
||||
secondpass(p^.right);
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_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: }
|
||||
clear_location(p^.left^.location);
|
||||
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(exprasmlist,p^.left^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_STRCONCAT',true);
|
||||
maybe_loadesi;
|
||||
popusedregisters(pushedregs);
|
||||
swaptree(p);
|
||||
case pstringdef(p^.left^.resulttype)^.string_typ of
|
||||
st_ansistring:
|
||||
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
|
||||
secondpass(p^.left);
|
||||
pushed:=maybe_push(p^.right^.registers32,p);
|
||||
secondpass(p^.right);
|
||||
if pushed then restore(p);
|
||||
{ release used registers }
|
||||
case p^.right^.location.loc of
|
||||
LOC_REFERENCE,LOC_MEM:
|
||||
del_reference(p^.right^.location.reference);
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
ungetregister32(p^.right^.location.register);
|
||||
end;
|
||||
case p^.left^.location.loc of
|
||||
LOC_REFERENCE,LOC_MEM:
|
||||
del_reference(p^.left^.location.reference);
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
ungetregister32(p^.left^.location.register);
|
||||
end;
|
||||
{ push the still used registers }
|
||||
pushusedregisters(pushedregs,$ff);
|
||||
{ push data }
|
||||
case p^.right^.location.loc of
|
||||
LOC_REFERENCE,LOC_MEM:
|
||||
emit_push_mem(p^.right^.location.reference);
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.right^.location.register)));
|
||||
end;
|
||||
case p^.left^.location.loc of
|
||||
LOC_REFERENCE,LOC_MEM:
|
||||
emit_push_mem(p^.left^.location.reference);
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
|
||||
end;
|
||||
emitcall('FPC_ANSICOMPARE',true);
|
||||
emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
|
||||
popusedregisters(pushedregs);
|
||||
maybe_loadesi;
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
st_shortstring:
|
||||
begin
|
||||
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) }
|
||||
|
||||
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 (str_length(p^.left)=0)) or
|
||||
((p^.right^.treetype=stringconstn) and (str_length(p^.right)=0))) 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(exprasmlist,p^.left^.location.reference);
|
||||
secondpass(p^.right);
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_STRCMP',true);
|
||||
maybe_loadesi;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end;
|
||||
else CGMessage(type_e_mismatch);
|
||||
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: }
|
||||
clear_location(p^.left^.location);
|
||||
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(exprasmlist,p^.left^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_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 (str_length(p^.left)=0)) or
|
||||
((p^.right^.treetype=stringconstn) and (str_length(p^.right)=0))) 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(exprasmlist,p^.left^.location.reference);
|
||||
secondpass(p^.right);
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_STRCMP',true);
|
||||
maybe_loadesi;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end;
|
||||
else CGMessage(type_e_mismatch);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetResultLocation(cmpop,true,p);
|
||||
end;
|
||||
@ -1293,7 +1324,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-10-20 08:06:38 pierre
|
||||
Revision 1.19 1998-10-20 15:09:21 florian
|
||||
+ binary operators for ansi strings
|
||||
|
||||
Revision 1.18 1998/10/20 08:06:38 pierre
|
||||
* several memory corruptions due to double freemem solved
|
||||
=> never use p^.loc.location:=p^.left^.loc.location;
|
||||
+ finally I added now by default
|
||||
|
||||
@ -144,6 +144,7 @@ implementation
|
||||
flags : tresflags;
|
||||
begin
|
||||
{ remove temporary location if not a set or string }
|
||||
{ that's a hack (FK) }
|
||||
if (p^.left^.resulttype^.deftype<>stringdef) and
|
||||
((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
|
||||
(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
|
||||
@ -217,135 +218,135 @@ implementation
|
||||
begin
|
||||
{ string operations are not commutative }
|
||||
if p^.swaped then
|
||||
swaptree(p);
|
||||
|
||||
{$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(exprasmlist,p^.left^.location.reference);
|
||||
secondpass(p^.right);
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_ANSISTRCMP',true);
|
||||
maybe_loada5;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
swaptree(p);
|
||||
case pstringdef(p^.left^.resulttype)^.string_typ of
|
||||
st_ansistring:
|
||||
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;
|
||||
end
|
||||
else
|
||||
{$endif UseAnsiString}
|
||||
|
||||
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: }
|
||||
clear_location(p^.left^.location);
|
||||
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);
|
||||
pushusedregisters(pushedregs,$ffff);
|
||||
{ WE INVERSE THE PARAMETERS!!! }
|
||||
{ Because parameters are inversed in the rtl }
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
|
||||
emitcall('FPC_STRCONCAT',true);
|
||||
maybe_loadA5;
|
||||
popusedregisters(pushedregs);
|
||||
set_location(p^.location,p^.left^.location);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end; { this case }
|
||||
ltn,lten,gtn,gten,
|
||||
ltn,lten,gtn,gten,
|
||||
equaln,unequaln :
|
||||
begin
|
||||
secondpass(p^.left);
|
||||
{ are too few registers free? }
|
||||
pushed:=maybe_push(p^.right^.registers32,p);
|
||||
secondpass(p^.right);
|
||||
if pushed then restore(p);
|
||||
cmpop:=true;
|
||||
del_reference(p^.right^.location.reference);
|
||||
del_reference(p^.left^.location.reference);
|
||||
{ generates better code }
|
||||
{ s='' and s<>'' }
|
||||
if (p^.treetype in [equaln,unequaln]) and
|
||||
(
|
||||
((p^.left^.treetype=stringconstn) and
|
||||
(str_length(p^.left)=0)) or
|
||||
((p^.right^.treetype=stringconstn) and
|
||||
(str_length(p^.right)=0))
|
||||
) then
|
||||
begin
|
||||
{ only one node can be stringconstn }
|
||||
{ else pass 1 would have evaluted }
|
||||
{ this node }
|
||||
if p^.left^.treetype=stringconstn then
|
||||
exprasmlist^.concat(new(pai68k,op_ref(
|
||||
A_TST,S_B,newreference(p^.right^.location.reference))))
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_ref(
|
||||
A_TST,S_B,newreference(p^.left^.location.reference))));
|
||||
end
|
||||
else
|
||||
begin
|
||||
pushusedregisters(pushedregs,$ffff);
|
||||
begin
|
||||
pushusedregisters(pushedregs,$ff);
|
||||
secondpass(p^.left);
|
||||
del_reference(p^.left^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
|
||||
secondpass(p^.right);
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitcall('FPC_ANSISTRCMP',true);
|
||||
maybe_loada5;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
st_shortstring:
|
||||
begin
|
||||
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 }
|
||||
|
||||
{ parameters are directly passed via registers }
|
||||
{ this has several advantages, no loss of the flags }
|
||||
{ on exit ,and MUCH faster on m68k machines }
|
||||
{ speed difference (68000) }
|
||||
{ normal routine: entry, exit code + push = 124 }
|
||||
{ (best case) }
|
||||
{ assembler routine: param setup (worst case) = 48 }
|
||||
{ release the registers }
|
||||
del_reference(p^.left^.location.reference);
|
||||
gettempofsizereference(256,href);
|
||||
copystring(href,p^.left^.location.reference,255);
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(
|
||||
A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(
|
||||
A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
|
||||
{
|
||||
emitpushreferenceaddr(p^.left^.location.reference);
|
||||
emitpushreferenceaddr(p^.right^.location.reference); }
|
||||
emitcall('FPC_STRCMP',true);
|
||||
maybe_loada5;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end; { end this case }
|
||||
else CGMessage(type_e_mismatch);
|
||||
end; { end case }
|
||||
{ does not hurt: }
|
||||
clear_location(p^.left^.location);
|
||||
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);
|
||||
pushusedregisters(pushedregs,$ffff);
|
||||
{ WE INVERSE THE PARAMETERS!!! }
|
||||
{ Because parameters are inversed in the rtl }
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
|
||||
emitcall('FPC_STRCONCAT',true);
|
||||
maybe_loadA5;
|
||||
popusedregisters(pushedregs);
|
||||
set_location(p^.location,p^.left^.location);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end; { this case }
|
||||
ltn,lten,gtn,gten,
|
||||
equaln,unequaln :
|
||||
begin
|
||||
secondpass(p^.left);
|
||||
{ are too few registers free? }
|
||||
pushed:=maybe_push(p^.right^.registers32,p);
|
||||
secondpass(p^.right);
|
||||
if pushed then restore(p);
|
||||
cmpop:=true;
|
||||
del_reference(p^.right^.location.reference);
|
||||
del_reference(p^.left^.location.reference);
|
||||
{ generates better code }
|
||||
{ s='' and s<>'' }
|
||||
if (p^.treetype in [equaln,unequaln]) and
|
||||
(
|
||||
((p^.left^.treetype=stringconstn) and
|
||||
(str_length(p^.left)=0)) or
|
||||
((p^.right^.treetype=stringconstn) and
|
||||
(str_length(p^.right)=0))
|
||||
) then
|
||||
begin
|
||||
{ only one node can be stringconstn }
|
||||
{ else pass 1 would have evaluted }
|
||||
{ this node }
|
||||
if p^.left^.treetype=stringconstn then
|
||||
exprasmlist^.concat(new(pai68k,op_ref(
|
||||
A_TST,S_B,newreference(p^.right^.location.reference))))
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_ref(
|
||||
A_TST,S_B,newreference(p^.left^.location.reference))));
|
||||
end
|
||||
else
|
||||
begin
|
||||
pushusedregisters(pushedregs,$ffff);
|
||||
|
||||
{ parameters are directly passed via registers }
|
||||
{ this has several advantages, no loss of the flags }
|
||||
{ on exit ,and MUCH faster on m68k machines }
|
||||
{ speed difference (68000) }
|
||||
{ normal routine: entry, exit code + push = 124 }
|
||||
{ (best case) }
|
||||
{ assembler routine: param setup (worst case) = 48 }
|
||||
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(
|
||||
A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(
|
||||
A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
|
||||
{
|
||||
emitpushreferenceaddr(p^.left^.location.reference);
|
||||
emitpushreferenceaddr(p^.right^.location.reference); }
|
||||
emitcall('FPC_STRCMP',true);
|
||||
maybe_loada5;
|
||||
popusedregisters(pushedregs);
|
||||
end;
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
end; { end this case }
|
||||
|
||||
else CGMessage(type_e_mismatch);
|
||||
end;
|
||||
end; { end case }
|
||||
end;
|
||||
SetResultLocation(cmpop,true,p);
|
||||
end;
|
||||
|
||||
@ -1279,7 +1280,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-10-20 08:06:43 pierre
|
||||
Revision 1.14 1998-10-20 15:09:23 florian
|
||||
+ binary operators for ansi strings
|
||||
|
||||
Revision 1.13 1998/10/20 08:06:43 pierre
|
||||
* several memory corruptions due to double freemem solved
|
||||
=> never use p^.loc.location:=p^.left^.loc.location;
|
||||
+ finally I added now by default
|
||||
|
||||
@ -377,11 +377,13 @@ implementation
|
||||
if is_boolean(ld) and is_boolean(rd) then
|
||||
begin
|
||||
case p^.treetype of
|
||||
andn,orn : begin
|
||||
calcregisters(p,0,0,0);
|
||||
make_bool_equal_size(p);
|
||||
p^.location.loc:=LOC_JUMP;
|
||||
end;
|
||||
andn,
|
||||
orn:
|
||||
begin
|
||||
calcregisters(p,0,0,0);
|
||||
make_bool_equal_size(p);
|
||||
p^.location.loc:=LOC_JUMP;
|
||||
end;
|
||||
unequaln,
|
||||
equaln,xorn : begin
|
||||
{ this forces a better code generation (TEST }
|
||||
@ -437,33 +439,61 @@ implementation
|
||||
end
|
||||
else
|
||||
|
||||
{ is one of the sides a shortstring ? }
|
||||
{ is one of the operands a string ? }
|
||||
if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) then
|
||||
begin
|
||||
{
|
||||
if is_widestring(rd) or is_widestring(ld) then
|
||||
begin
|
||||
if not(is_widestring(rd)) then
|
||||
p^.right:=gentypeconvnode(p^.right,cwidestringdef);
|
||||
if not(is_widestring(ld)) then
|
||||
p^.left:=gentypeconvnode(p^.left,cwidestringdef);
|
||||
p^.resulttype:=cwidestringdef;
|
||||
{ this is only for add, the comparisaion is handled later }
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
end
|
||||
else if is_ansistring(rd) or is_ansistring(ld) then
|
||||
begin
|
||||
if not(is_ansistring(rd)) then
|
||||
p^.right:=gentypeconvnode(p^.right,cansistringdef);
|
||||
if not(is_ansistring(ld)) then
|
||||
p^.left:=gentypeconvnode(p^.left,cansistringdef);
|
||||
p^.resulttype:=cansistringdef;
|
||||
{ this is only for add, the comparisaion is handled later }
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
end
|
||||
else if is_longstring(rd) or is_longstring(ld) then
|
||||
begin
|
||||
if not(is_longstring(rd)) then
|
||||
p^.right:=gentypeconvnode(p^.right,clongstringdef);
|
||||
if not(is_longstring(ld)) then
|
||||
p^.left:=gentypeconvnode(p^.left,clongstringdef);
|
||||
p^.resulttype:=clongstringdef;
|
||||
{ this is only for add, the comparisaion is handled later }
|
||||
p^.location.loc:=LOC_MEM;
|
||||
end
|
||||
}
|
||||
if not((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then
|
||||
begin
|
||||
if ld^.deftype=stringdef then
|
||||
p^.right:=gentypeconvnode(p^.right,cstringdef)
|
||||
else
|
||||
p^.left:=gentypeconvnode(p^.left,cstringdef);
|
||||
firstpass(p^.left);
|
||||
firstpass(p^.right);
|
||||
end;
|
||||
{ here we call STRCONCAT or STRCMP or STRCOPY }
|
||||
else
|
||||
begin
|
||||
if not(is_shortstring(rd)) then
|
||||
p^.right:=gentypeconvnode(p^.right,cstringdef);
|
||||
if not(is_shortstring(ld)) then
|
||||
p^.left:=gentypeconvnode(p^.left,cstringdef);
|
||||
p^.resulttype:=cstringdef;
|
||||
{ this is only for add, the comparisaion is handled later }
|
||||
p^.location.loc:=LOC_MEM;
|
||||
end;
|
||||
{ only if there is a type cast we need to do again }
|
||||
{ the first pass }
|
||||
if p^.left^.treetype=typeconvn then
|
||||
firstpass(p^.left);
|
||||
if p^.right^.treetype=typeconvn then
|
||||
firstpass(p^.right);
|
||||
{ here we call STRCONCAT or STRCMP or STRCOPY }
|
||||
procinfo.flags:=procinfo.flags or pi_do_call;
|
||||
calcregisters(p,0,0,0);
|
||||
p^.location.loc:=LOC_MEM;
|
||||
if p^.location.loc=LOC_MEM then
|
||||
calcregisters(p,0,0,0)
|
||||
else
|
||||
calcregisters(p,1,0,0);
|
||||
convdone:=true;
|
||||
end
|
||||
else
|
||||
@ -875,7 +905,8 @@ implementation
|
||||
case p^.treetype of
|
||||
ltn,lten,gtn,gten,equaln,unequaln:
|
||||
begin
|
||||
if not assigned(p^.resulttype) then
|
||||
if (not assigned(p^.resulttype)) or
|
||||
(p^.resulttype^.deftype=stringdef) then
|
||||
p^.resulttype:=booldef;
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
end;
|
||||
@ -891,16 +922,9 @@ implementation
|
||||
if (p^.left^.resulttype^.deftype=stringdef) or
|
||||
(p^.right^.resulttype^.deftype=stringdef) then
|
||||
begin
|
||||
{$ifndef UseAnsiString}
|
||||
if not assigned(p^.resulttype) then
|
||||
p^.resulttype:=cstringdef
|
||||
{$else UseAnsiString}
|
||||
if is_ansistring(p^.left^.resulttype) or
|
||||
is_ansistring(p^.right^.resulttype) then
|
||||
p^.resulttype:=cansistringdef
|
||||
else
|
||||
p^.resulttype:=cstringdef;
|
||||
{$endif UseAnsiString}
|
||||
{ the rest is done before }
|
||||
end
|
||||
else
|
||||
if not assigned(p^.resulttype) then
|
||||
@ -915,7 +939,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-10-20 08:07:05 pierre
|
||||
Revision 1.6 1998-10-20 15:09:24 florian
|
||||
+ binary operators for ansi strings
|
||||
|
||||
Revision 1.5 1998/10/20 08:07:05 pierre
|
||||
* several memory corruptions due to double freemem solved
|
||||
=> never use p^.loc.location:=p^.left^.loc.location;
|
||||
+ finally I added now by default
|
||||
|
||||
Loading…
Reference in New Issue
Block a user