paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 17:05:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ binary operators for ansi strings

Browse Source
This commit is contained in:
florian 1998-10-20 15:09:21 +00:00
parent 0a51bba5f7
commit e4290ba94a
3 changed files with 371 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

336
compiler/cg386add.pas
View File

@ -45,6 +45,7 @@ implementation
flags : tresflags; flags : tresflags;
begin begin
{ remove temporary location if not a set or string } { 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 if (p^.left^.resulttype^.deftype<>stringdef) and
((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and ((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
@ -118,158 +119,188 @@ implementation
begin begin
{ string operations are not commutative } { string operations are not commutative }
if p^.swaped then if p^.swaped then
swaptree(p); swaptree(p);
case pstringdef(p^.left^.resulttype)^.string_typ of
{$ifdef UseAnsiString} st_ansistring:
if is_ansistring(p^.left^.resulttype) then begin
begin case p^.treetype of
case p^.treetype of addn:
addn : begin
begin { we do not need destination anymore }
{ we do not need destination anymore } del_reference(p^.left^.location.reference);
del_reference(p^.left^.location.reference); del_reference(p^.right^.location.reference);
del_reference(p^.right^.location.reference); { concatansistring(p); }
{ concatansistring(p); } end;
end; ltn,lten,gtn,gten,
ltn,lten,gtn,gten, equaln,unequaln:
equaln,unequaln : begin
begin secondpass(p^.left);
pushusedregisters(pushedregs,$ff); pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.left); secondpass(p^.right);
del_reference(p^.left^.location.reference); if pushed then restore(p);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); { release used registers }
secondpass(p^.right); case p^.right^.location.loc of
del_reference(p^.right^.location.reference); LOC_REFERENCE,LOC_MEM:
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); del_reference(p^.right^.location.reference);
emitcall('FPC_ANSISTRCMP',true); LOC_REGISTER,LOC_CREGISTER:
maybe_loadesi; ungetregister32(p^.right^.location.register);
popusedregisters(pushedregs); end;
end; case p^.left^.location.loc of
end; LOC_REFERENCE,LOC_MEM:
end del_reference(p^.left^.location.reference);
else LOC_REGISTER,LOC_CREGISTER:
{$endif UseAnsiString} ungetregister32(p^.left^.location.register);
case p^.treetype of end;
addn : { push the still used registers }
begin pushusedregisters(pushedregs,$ff);
cmpop:=false; { push data }
secondpass(p^.left); case p^.right^.location.loc of
{ if str_concat is set in expr LOC_REFERENCE,LOC_MEM:
s:=s+ ... no need to create a temp string (PM) } emit_push_mem(p^.right^.location.reference);
LOC_REGISTER,LOC_CREGISTER:
if (p^.left^.treetype<>addn) and not (p^.use_strconcat) then exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.right^.location.register)));
begin end;
case p^.left^.location.loc of
{ can only reference be } LOC_REFERENCE,LOC_MEM:
{ string in register would be funny } emit_push_mem(p^.left^.location.reference);
{ therefore produce a temporary string } LOC_REGISTER,LOC_CREGISTER:
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
{ release the registers } end;
del_reference(p^.left^.location.reference); emitcall('FPC_ANSICOMPARE',true);
gettempofsizereference(256,href); emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
copystring(href,p^.left^.location.reference,255); popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference); maybe_loadesi;
ungetiftemp(p^.left^.location.reference);
{ does not hurt: } ungetiftemp(p^.right^.location.reference);
clear_location(p^.left^.location); end;
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; 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); if (p^.left^.treetype<>addn) and not (p^.use_strconcat) then
ungetiftemp(p^.right^.location.reference); begin
end;
ltn,lten,gtn,gten, { can only reference be }
equaln,unequaln : { string in register would be funny }
begin { therefore produce a temporary string }
cmpop:=true;
{ generate better code for s='' and s<>'' } { release the registers }
if (p^.treetype in [equaln,unequaln]) and del_reference(p^.left^.location.reference);
(((p^.left^.treetype=stringconstn) and (str_length(p^.left)=0)) or gettempofsizereference(256,href);
((p^.right^.treetype=stringconstn) and (str_length(p^.right)=0))) then copystring(href,p^.left^.location.reference,255);
begin ungetiftemp(p^.left^.location.reference);
secondpass(p^.left);
{ are too few registers free? } { does not hurt: }
pushed:=maybe_push(p^.right^.registers32,p); clear_location(p^.left^.location);
secondpass(p^.right); p^.left^.location.loc:=LOC_MEM;
if pushed then restore(p); p^.left^.location.reference:=href;
del_reference(p^.right^.location.reference); end;
del_reference(p^.left^.location.reference);
{ only one node can be stringconstn } secondpass(p^.right);
{ else pass 1 would have evaluted }
{ this node } { on the right we do not need the register anymore too }
if p^.left^.treetype=stringconstn then del_reference(p^.right^.location.reference);
exprasmlist^.concat(new(pai386,op_const_ref( {
A_CMP,S_B,0,newreference(p^.right^.location.reference)))) if p^.right^.resulttype^.deftype=orddef then
else begin
exprasmlist^.concat(new(pai386,op_const_ref( pushusedregisters(pushedregs,$ff);
A_CMP,S_B,0,newreference(p^.left^.location.reference)))); exprasmlist^.concat(new(pai386,op_ref_reg(
end A_LEA,S_L,newreference(p^.left^.location.reference),R_EDI)));
else exprasmlist^.concat(new(pai386,op_reg_reg(
begin A_XOR,S_L,R_EBX,R_EBX)));
pushusedregisters(pushedregs,$ff); reset_reference(href);
secondpass(p^.left); href.base:=R_EDI;
del_reference(p^.left^.location.reference); exprasmlist^.concat(new(pai386,op_ref_reg(
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference); A_MOV,S_B,newreference(href),R_BL)));
secondpass(p^.right); exprasmlist^.concat(new(pai386,op_reg(
del_reference(p^.right^.location.reference); A_INC,S_L,R_EBX)));
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); exprasmlist^.concat(new(pai386,op_reg_ref(
emitcall('FPC_STRCMP',true); A_MOV,S_B,R_BL,newreference(href))));
maybe_loadesi; href.index:=R_EBX;
popusedregisters(pushedregs); if p^.right^.treetype=ordconstn then
end; exprasmlist^.concat(new(pai386,op_const_ref(
ungetiftemp(p^.left^.location.reference); A_MOV,S_L,p^.right^.value,newreference(href))))
ungetiftemp(p^.right^.location.reference); else
end; begin
else CGMessage(type_e_mismatch); 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; end;
SetResultLocation(cmpop,true,p); SetResultLocation(cmpop,true,p);
end; end;
@ -1293,7 +1324,10 @@ implementation
end. end.
{ {
$Log$ $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 * several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location; => never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default + finally I added now by default

254
compiler/cg68kadd.pas
View File

@ -144,6 +144,7 @@ implementation
flags : tresflags; flags : tresflags;
begin begin
{ remove temporary location if not a set or string } { remove temporary location if not a set or string }
{ that's a hack (FK) }
if (p^.left^.resulttype^.deftype<>stringdef) and if (p^.left^.resulttype^.deftype<>stringdef) and
((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and ((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
@ -217,135 +218,135 @@ implementation
begin begin
{ string operations are not commutative } { string operations are not commutative }
if p^.swaped then if p^.swaped then
swaptree(p); swaptree(p);
case pstringdef(p^.left^.resulttype)^.string_typ of
{$ifdef UseAnsiString} st_ansistring:
if is_ansistring(p^.left^.resulttype) then begin
begin case p^.treetype of
case p^.treetype of addn :
addn : begin
begin { we do not need destination anymore }
{ we do not need destination anymore } del_reference(p^.left^.location.reference);
del_reference(p^.left^.location.reference); del_reference(p^.right^.location.reference);
del_reference(p^.right^.location.reference); { concatansistring(p); }
{ 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;
end; end;
end ltn,lten,gtn,gten,
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,
equaln,unequaln : equaln,unequaln :
begin begin
secondpass(p^.left); pushusedregisters(pushedregs,$ff);
{ are too few registers free? } secondpass(p^.left);
pushed:=maybe_push(p^.right^.registers32,p); del_reference(p^.left^.location.reference);
secondpass(p^.right); emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
if pushed then restore(p); secondpass(p^.right);
cmpop:=true; del_reference(p^.right^.location.reference);
del_reference(p^.right^.location.reference); emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
del_reference(p^.left^.location.reference); emitcall('FPC_ANSISTRCMP',true);
{ generates better code } maybe_loada5;
{ s='' and s<>'' } popusedregisters(pushedregs);
if (p^.treetype in [equaln,unequaln]) and end;
( end;
((p^.left^.treetype=stringconstn) and end;
(str_length(p^.left)=0)) or st_shortstring:
((p^.right^.treetype=stringconstn) and begin
(str_length(p^.right)=0)) case p^.treetype of
) then addn : begin
begin cmpop:=false;
{ only one node can be stringconstn } secondpass(p^.left);
{ else pass 1 would have evaluted } if (p^.left^.treetype<>addn) then
{ this node } begin
if p^.left^.treetype=stringconstn then { can only reference be }
exprasmlist^.concat(new(pai68k,op_ref( { string in register would be funny }
A_TST,S_B,newreference(p^.right^.location.reference)))) { therefore produce a temporary string }
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 } { release the registers }
{ this has several advantages, no loss of the flags } del_reference(p^.left^.location.reference);
{ on exit ,and MUCH faster on m68k machines } gettempofsizereference(256,href);
{ speed difference (68000) } copystring(href,p^.left^.location.reference,255);
{ normal routine: entry, exit code + push = 124 } ungetiftemp(p^.left^.location.reference);
{ (best case) }
{ assembler routine: param setup (worst case) = 48 }
exprasmlist^.concat(new(pai68k,op_ref_reg( { does not hurt: }
A_LEA,S_L,newreference(p^.left^.location.reference),R_A0))); clear_location(p^.left^.location);
exprasmlist^.concat(new(pai68k,op_ref_reg( p^.left^.location.loc:=LOC_MEM;
A_LEA,S_L,newreference(p^.right^.location.reference),R_A1))); p^.left^.location.reference:=href;
{ end;
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 }
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); SetResultLocation(cmpop,true,p);
end; end;
@ -1279,7 +1280,10 @@ implementation
end. end.
{ {
$Log$ $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 * several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location; => never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default + finally I added now by default

87
compiler/tcadd.pas
View File

@ -377,11 +377,13 @@ implementation
if is_boolean(ld) and is_boolean(rd) then if is_boolean(ld) and is_boolean(rd) then
begin begin
case p^.treetype of case p^.treetype of
andn,orn : begin andn,
calcregisters(p,0,0,0); orn:
make_bool_equal_size(p); begin
p^.location.loc:=LOC_JUMP; calcregisters(p,0,0,0);
end; make_bool_equal_size(p);
p^.location.loc:=LOC_JUMP;
end;
unequaln, unequaln,
equaln,xorn : begin equaln,xorn : begin
{ this forces a better code generation (TEST } { this forces a better code generation (TEST }
@ -437,33 +439,61 @@ implementation
end end
else else
{ is one of the sides a shortstring ? } { is one of the operands a string ? }
if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) then if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) then
begin begin
{
if is_widestring(rd) or is_widestring(ld) then if is_widestring(rd) or is_widestring(ld) then
begin 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 end
else if is_ansistring(rd) or is_ansistring(ld) then else if is_ansistring(rd) or is_ansistring(ld) then
begin 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 end
else if is_longstring(rd) or is_longstring(ld) then else if is_longstring(rd) or is_longstring(ld) then
begin 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 end
} else
if not((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then begin
begin if not(is_shortstring(rd)) then
if ld^.deftype=stringdef then p^.right:=gentypeconvnode(p^.right,cstringdef);
p^.right:=gentypeconvnode(p^.right,cstringdef) if not(is_shortstring(ld)) then
else p^.left:=gentypeconvnode(p^.left,cstringdef);
p^.left:=gentypeconvnode(p^.left,cstringdef); p^.resulttype:=cstringdef;
firstpass(p^.left); { this is only for add, the comparisaion is handled later }
firstpass(p^.right); p^.location.loc:=LOC_MEM;
end; end;
{ here we call STRCONCAT or STRCMP or STRCOPY } { 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; procinfo.flags:=procinfo.flags or pi_do_call;
calcregisters(p,0,0,0); if p^.location.loc=LOC_MEM then
p^.location.loc:=LOC_MEM; calcregisters(p,0,0,0)
else
calcregisters(p,1,0,0);
convdone:=true; convdone:=true;
end end
else else
@ -875,7 +905,8 @@ implementation
case p^.treetype of case p^.treetype of
ltn,lten,gtn,gten,equaln,unequaln: ltn,lten,gtn,gten,equaln,unequaln:
begin begin
if not assigned(p^.resulttype) then if (not assigned(p^.resulttype)) or
(p^.resulttype^.deftype=stringdef) then
p^.resulttype:=booldef; p^.resulttype:=booldef;
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
end; end;
@ -891,16 +922,9 @@ implementation
if (p^.left^.resulttype^.deftype=stringdef) or if (p^.left^.resulttype^.deftype=stringdef) or
(p^.right^.resulttype^.deftype=stringdef) then (p^.right^.resulttype^.deftype=stringdef) then
begin begin
{$ifndef UseAnsiString}
if not assigned(p^.resulttype) then if not assigned(p^.resulttype) then
p^.resulttype:=cstringdef p^.resulttype:=cstringdef
{$else UseAnsiString} { the rest is done before }
if is_ansistring(p^.left^.resulttype) or
is_ansistring(p^.right^.resulttype) then
p^.resulttype:=cansistringdef
else
p^.resulttype:=cstringdef;
{$endif UseAnsiString}
end end
else else
if not assigned(p^.resulttype) then if not assigned(p^.resulttype) then
@ -915,7 +939,10 @@ implementation
end. end.
{ {
$Log$ $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 * several memory corruptions due to double freemem solved
=> never use p^.loc.location:=p^.left^.loc.location; => never use p^.loc.location:=p^.left^.loc.location;
+ finally I added now by default + finally I added now by default