paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 01:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* type casts pchar<->ansistring fixed

Browse Source 
* ansistring[..] calls does now an unique call
This commit is contained in:
florian 1998-09-27 10:16:22 +00:00
parent d4ac5e456b
commit 9083713fe4
6 changed files with 142 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
compiler/cg386cnv.pas
View File

@ -637,7 +637,7 @@ implementation
begin
stringdispose(p^.location.reference.symbol);
gettempofsizereference(256,p^.location.reference);
{ call loadstring with correct left and right }
{ call loadstring with correct left and right }
p^.right:=p^.left;
p^.left:=p;
loadstring(p);
@ -1084,27 +1084,51 @@ implementation
pushed : tpushed;
begin
case pstringdef(p^.resulttype)^.string_typ of
st_shortstring : begin
pushusedregisters(pushed,$ff);
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
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_REFERENCE,LOC_MEM:
begin
emit_push_mem(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
end;
end;
emitpushreferenceaddr(exprasmlist,p^.location.reference);
emitcall('FPC_PCHAR_TO_STR',true);
maybe_loadesi;
popusedregisters(pushed);
end;
st_shortstring:
begin
pushusedregisters(pushed,$ff);
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
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_REFERENCE,LOC_MEM:
begin
emit_push_mem(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
end;
end;
emitpushreferenceaddr(exprasmlist,p^.location.reference);
emitcall('FPC_PCHAR_TO_STR',true);
maybe_loadesi;
popusedregisters(pushed);
end;
st_ansistring:
begin
stringdispose(p^.location.reference.symbol);
gettempofsizereference(p^.resulttype^.size,p^.location.reference);
case p^.left^.location.loc of
LOC_REGISTER,LOC_CREGISTER:
begin
ungetregister32(p^.left^.location.register);
pushusedregisters(pushed,$ff);
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
end;
LOC_REFERENCE,LOC_MEM:
begin
del_reference(p^.left^.location.reference);
pushusedregisters(pushed,$ff);
emit_push_mem(p^.left^.location.reference);
end;
end;
emitpushreferenceaddr(exprasmlist,p^.location.reference);
emitcall('FPC_PCHAR_TO_ANSISTRING',true);
maybe_loadesi;
popusedregisters(pushed);
end;
else
begin
p^.location.loc:=LOC_REGISTER;
@ -1282,7 +1306,11 @@ implementation
end.
{
$Log$
Revision 1.23 1998-09-23 12:03:51 peter
Revision 1.24 1998-09-27 10:16:22 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.23 1998/09/23 12:03:51 peter
* overloading fix for array of const
Revision 1.22 1998/09/22 15:34:09 peter

36
compiler/cg386mem.pas
View File

@ -324,7 +324,7 @@ implementation
procedure secondvecn(var p : ptree);
var
pushed : boolean;
is_pushed : boolean;
ind,hr : tregister;
_p : ptree;
@ -358,6 +358,7 @@ implementation
t : ptree;
hp : preference;
tai : Pai386;
pushed : tpushed;
begin
secondpass(p^.left);
@ -370,11 +371,34 @@ implementation
begin
reset_reference(p^.location.reference);
p^.location.loc:=LOC_REFERENCE;
if is_ansistring(p^.left^.resulttype) then
begin
if p^.callunique then
begin
pushusedregisters(pushed,$ff);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitcall('FPC_UNIQUE_ANSISTRING',true);
maybe_loadesi;
popusedregisters(pushed);
end;
end
else
begin
if p^.callunique then
begin
pushusedregisters(pushed,$ff);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
emitcall('FPC_UNIQUE_WIDESTRING',true);
maybe_loadesi;
popusedregisters(pushed);
end;
end;
del_reference(p^.left^.location.reference);
p^.location.reference.base:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),
p^.location.reference.base)));
if is_ansistring(p^.left^.resulttype) then
begin
{ in ansistrings S[1] is pchar(S)[0] !! }
@ -480,9 +504,9 @@ implementation
if (p^.location.loc<>LOC_REFERENCE) and
(p^.location.loc<>LOC_MEM) then
CGMessage(cg_e_illegal_expression);
pushed:=maybe_push(p^.right^.registers32,p);
is_pushed:=maybe_push(p^.right^.registers32,p);
secondpass(p^.right);
if pushed then restore(p);
if is_pushed then restore(p);
case p^.right^.location.loc of
LOC_REGISTER:
begin
@ -649,7 +673,11 @@ implementation
end.
{
$Log$
Revision 1.12 1998-09-23 15:46:36 florian
Revision 1.13 1998-09-27 10:16:23 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.12 1998/09/23 15:46:36 florian
* problem with with and classes fixed
Revision 1.11 1998/09/17 09:42:18 peter

11
compiler/tccal.pas
View File

@ -182,7 +182,10 @@ implementation
{ is this usefull here ? }
{ this was missing in formal parameter list }
if defcoll^.paratyp=vs_var then
make_not_regable(p^.left);
begin
set_unique(p^.left);
make_not_regable(p^.left);
end;
p^.resulttype:=defcoll^.data;
end;
@ -907,7 +910,11 @@ implementation
end.
{
$Log$
Revision 1.3 1998-09-24 14:27:40 peter
Revision 1.4 1998-09-27 10:16:24 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.3 1998/09/24 14:27:40 peter
* some better support for openarray
Revision 1.2 1998/09/24 09:02:16 peter

27
compiler/tccnv.pas
View File

@ -279,6 +279,7 @@ implementation
if p^.left^.treetype=ordconstn then
begin
hp:=genstringconstnode(chr(p^.left^.value));
hp^.stringtype:=pstringdef(p^.resulttype)^.string_typ;
firstpass(hp);
disposetree(p);
p:=hp;
@ -488,14 +489,11 @@ implementation
end;
procedure first_pchar_to_ansistring(var p : ptree);
procedure first_pchar_to_string(var p : ptree);
begin
p^.location.loc:=LOC_REGISTER;
if p^.registers32<1 then
p^.registers32:=1;
p^.location.loc:=LOC_MEM;
end;
procedure first_ansistring_to_pchar(var p : ptree);
begin
p^.location.loc:=LOC_REGISTER;
@ -550,12 +548,12 @@ implementation
first_cchar_charpointer,
first_load_smallset,
first_ansistring_to_pchar,
first_pchar_to_ansistring,
first_pchar_to_string,
first_arrayconstructor_to_set);
begin
aprocdef:=nil;
{ if explicite type conversation, then run firstpass }
{ if explicite type cast, then run firstpass }
if p^.explizit then
firstpass(p^.left);
@ -720,6 +718,13 @@ implementation
firstconvert[p^.convtyp](p);
exit;
end;
if is_pchar(p^.resulttype) and
is_ansistring(p^.left^.resulttype) then
begin
p^.convtyp:=tc_ansistring_2_pchar;
firstconvert[p^.convtyp](p);
exit;
end;
{ normal tc_equal-Konvertierung durchf<68>hren }
p^.convtyp:=tc_equal;
{ wenn Aufz„hltyp nach Ordinal konvertiert werden soll }
@ -738,7 +743,7 @@ implementation
else
begin
if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
ordconstn { nur Dummy},false ) then
ordconstn { only Dummy},false ) then
CGMessage(cg_e_illegal_type_conversion);
end;
@ -898,7 +903,11 @@ implementation
end.
{
$Log$
Revision 1.2 1998-09-24 23:49:22 peter
Revision 1.3 1998-09-27 10:16:26 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.2 1998/09/24 23:49:22 peter
+ aktmodeswitches
Revision 1.1 1998/09/23 20:42:24 peter

9
compiler/tcld.pas
View File

@ -174,6 +174,9 @@ implementation
store_valid:=must_be_valid;
must_be_valid:=false;
{ must be made unique }
set_unique(p^.left);
firstpass(p^.left);
if codegenerror then
exit;
@ -396,7 +399,11 @@ implementation
end.
{
$Log$
Revision 1.2 1998-09-24 15:13:48 peter
Revision 1.3 1998-09-27 10:16:27 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.2 1998/09/24 15:13:48 peter
* fixed type node which was always set to void :(
Revision 1.1 1998/09/23 20:42:24 peter

26
compiler/tree.pas
View File

@ -214,7 +214,7 @@ unit tree;
fixconstn : (value_fix: longint);
funcretn : (funcretprocinfo : pointer;retdef : pdef);
subscriptn : (vs : pvarsym);
vecn : (memindex,memseg:boolean);
vecn : (memindex,memseg:boolean;callunique : boolean);
{$ifdef UseAnsiString}
stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
{$else UseAnsiString}
@ -286,6 +286,10 @@ unit tree;
maxfirstpasscount : longint = 0;
{$endif extdebug}
{ sets the callunique flag, if the node is a vecn, }
{ takes care of type casts etc. }
procedure set_unique(p : ptree);
{ gibt den ordinalen Werten der Node zurueck oder falls sie }
{ keinen ordinalen Wert hat, wird ein Fehler erzeugt }
function get_ordinal_value(p : ptree) : longint;
@ -1493,6 +1497,20 @@ unit tree;
equal_trees:=false;
end;
procedure set_unique(p : ptree);
begin
if assigned(p) then
begin
case p^.treetype of
vecn:
p^.callunique:=true;
typeconvn:
set_unique(p^.left);
end;
end;
end;
{This is needed if you want to be able to delete the string with the nodes !!}
procedure set_location(var destloc,sourceloc : tlocation);
@ -1570,7 +1588,11 @@ unit tree;
end.
{
$Log$
Revision 1.42 1998-09-23 12:03:59 peter
Revision 1.43 1998-09-27 10:16:28 florian
* type casts pchar<->ansistring fixed
* ansistring[..] calls does now an unique call
Revision 1.42 1998/09/23 12:03:59 peter
* overloading fix for array of const
Revision 1.41 1998/09/23 09:58:55 peter