paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-21 12:19:27 +01: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

62
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
@ -119,9 +120,8 @@ implementation
{ 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:
@ -134,21 +134,49 @@ implementation
ltn,lten,gtn,gten, ltn,lten,gtn,gten,
equaln,unequaln: equaln,unequaln:
begin begin
pushusedregisters(pushedregs,$ff);
secondpass(p^.left); secondpass(p^.left);
del_reference(p^.left^.location.reference); pushed:=maybe_push(p^.right^.registers32,p);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
secondpass(p^.right); 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); del_reference(p^.right^.location.reference);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference); LOC_REGISTER,LOC_CREGISTER:
emitcall('FPC_ANSISTRCMP',true); ungetregister32(p^.right^.location.register);
maybe_loadesi; 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); popusedregisters(pushedregs);
maybe_loadesi;
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
end; end;
end; end;
end end;
else st_shortstring:
{$endif UseAnsiString} begin
case p^.treetype of case p^.treetype of
addn: addn:
begin begin
@ -180,7 +208,8 @@ implementation
{ on the right we do not need the register anymore too } { on the right we do not need the register anymore too }
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
{ if p^.right^.resulttype^.deftype=orddef then {
if p^.right^.resulttype^.deftype=orddef then
begin begin
pushusedregisters(pushedregs,$ff); pushusedregisters(pushedregs,$ff);
exprasmlist^.concat(new(pai386,op_ref_reg( exprasmlist^.concat(new(pai386,op_ref_reg(
@ -271,6 +300,8 @@ implementation
end; end;
else CGMessage(type_e_mismatch); 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

24
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
@ -218,9 +219,8 @@ implementation
{ 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 :
@ -245,10 +245,9 @@ implementation
popusedregisters(pushedregs); popusedregisters(pushedregs);
end; end;
end; end;
end end;
else st_shortstring:
{$endif UseAnsiString} begin
case p^.treetype of case p^.treetype of
addn : begin addn : begin
cmpop:=false; cmpop:=false;
@ -343,9 +342,11 @@ implementation
ungetiftemp(p^.left^.location.reference); ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference); ungetiftemp(p^.right^.location.reference);
end; { end this case } end; { end this case }
else CGMessage(type_e_mismatch);
end; { end 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

71
compiler/tcadd.pas
View File

@ -377,7 +377,9 @@ 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,
orn:
begin
calcregisters(p,0,0,0); calcregisters(p,0,0,0);
make_bool_equal_size(p); make_bool_equal_size(p);
p^.location.loc:=LOC_JUMP; p^.location.loc:=LOC_JUMP;
@ -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
}
if not((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then
begin
if ld^.deftype=stringdef then
p^.right:=gentypeconvnode(p^.right,cstringdef)
else 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^.left:=gentypeconvnode(p^.left,cstringdef);
firstpass(p^.left); p^.resulttype:=cstringdef;
firstpass(p^.right); { this is only for add, the comparisaion is handled later }
p^.location.loc:=LOC_MEM;
end; 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 } { 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