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

* handling of ansi string constants should now work

Browse Source
This commit is contained in:
florian 1998-07-20 18:40:10 +00:00
parent 814ae50075
commit a824e04fc5
5 changed files with 145 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/cg386con.pas
View File

@ -136,7 +136,7 @@ implementation
procedure secondstringconst(var p : ptree); procedure secondstringconst(var p : ptree);
var var
hp1 : pai; hp1 : pai;
lastlabel : plabel; lastlabel,l1 : plabel;
pc : pchar; pc : pchar;
same_string : boolean; same_string : boolean;
i : word; i : word;
@ -161,8 +161,14 @@ implementation
{ currently, this is no problem, because } { currently, this is no problem, because }
{ typed consts have no leading length or } { typed consts have no leading length or }
{ they have no trailing zero } { they have no trailing zero }
{$ifdef UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=p^.length+2) then
{$else UseAnsiString}
if (hp1^.typ=ait_string) and (lastlabel<>nil) and if (hp1^.typ=ait_string) and (lastlabel<>nil) and
(pai_string(hp1)^.len=length(p^.values^)+2) then (pai_string(hp1)^.len=length(p^.values^)+2) then
{$endif UseAnsiString}
begin begin
same_string:=true; same_string:=true;
{$ifndef UseAnsiString} {$ifndef UseAnsiString}
@ -205,16 +211,26 @@ implementation
case p^.stringtype of case p^.stringtype of
st_ansistring: st_ansistring:
begin begin
{ an empty ansi string is nil! }
concat_constlabel(lastlabel,conststring); concat_constlabel(lastlabel,conststring);
if p^.length=0 then
consts^.concat(new(pai_const,init_32bit(0)))
else
begin
getlabel(l1);
consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(l1)))));
consts^.concat(new(pai_const,init_32bit(p^.length))); consts^.concat(new(pai_const,init_32bit(p^.length)));
consts^.concat(new(pai_const,init_32bit(p^.length))); consts^.concat(new(pai_const,init_32bit(p^.length)));
consts^.concat(new(pai_const,init_32bit(-1))); consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_label,init(l1)));
getmem(pc,p^.length+1); getmem(pc,p^.length+1);
move(p^.values^,pc^,p^.length+1); move(p^.values^,pc^,p^.length+1);
{ to overcome this problem we set the length explicitly } { to overcome this problem we set the length explicitly }
{ with the ending null char } { with the ending null char }
consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1))); consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
end; end;
end;
st_shortstring: st_shortstring:
begin begin
getmem(pc,p^.length+3); getmem(pc,p^.length+3);
@ -346,7 +362,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-07-20 10:23:00 florian Revision 1.9 1998-07-20 18:40:10 florian
* handling of ansi string constants should now work
Revision 1.8 1998/07/20 10:23:00 florian
* better ansi string assignement * better ansi string assignement
Revision 1.7 1998/07/18 22:54:25 florian Revision 1.7 1998/07/18 22:54:25 florian

17
compiler/hcodegen.pas
View File

@ -137,7 +137,7 @@ unit hcodegen;
{ concates/inserts the ASCII string from pchar to the data segment } { concates/inserts the ASCII string from pchar to the data segment }
{ WARNING : if hs has no #0 and strlen(hs)=length } { WARNING : if hs has no #0 and strlen(hs)=length }
{ the terminal zero is not written } { the terminal zero is not written }
procedure generate_pascii(hs : pchar;length : longint); procedure generate_pascii(a : paasmoutput;hs : pchar;length : longint);
procedure generate_pascii_insert(hs : pchar;length : longint); procedure generate_pascii_insert(hs : pchar;length : longint);
{ convert/concats a label for constants in the consts section } { convert/concats a label for constants in the consts section }
@ -294,8 +294,8 @@ implementation
end; end;
{ concates the ASCII string from pchar to the const segment } { concates the ASCII string from pchar to the asmslist a }
procedure generate_pascii(hs : pchar;length : longint); procedure generate_pascii(a : paasmoutput;hs : pchar;length : longint);
var var
real_end,current_begin,current_end : pchar; real_end,current_begin,current_end : pchar;
c :char; c :char;
@ -313,10 +313,12 @@ implementation
{ store the char for next loop } { store the char for next loop }
c:=current_end[0]; c:=current_end[0];
current_end[0]:=#0; current_end[0]:=#0;
datasegment^.concat(new(pai_string,init_length_pchar(strnew(current_begin,32),32))); a^.concat(new(pai_string,init_length_pchar(strnew(current_begin,32),32)));
current_begin:=current_end;
length:=length-32; length:=length-32;
end; end;
datasegment^.concat(new(pai_string,init_length_pchar(strnew(current_begin,length),length))); current_begin[0]:=c;
a^.concat(new(pai_string,init_length_pchar(strnew(current_begin,length),length)));
end; end;
end; end;
@ -401,7 +403,10 @@ end.
{ {
$Log$ $Log$
Revision 1.9 1998-06-05 16:13:34 pierre Revision 1.10 1998-07-20 18:40:13 florian
* handling of ansi string constants should now work
Revision 1.9 1998/06/05 16:13:34 pierre
* fix for real and string consts inside inlined procs * fix for real and string consts inside inlined procs
Revision 1.8 1998/06/04 23:51:40 peter Revision 1.8 1998/06/04 23:51:40 peter

9
compiler/pass_1.pas
View File

@ -3664,7 +3664,11 @@ unit pass_1;
{ evalutes length of constant strings direct } { evalutes length of constant strings direct }
if (p^.left^.treetype=stringconstn) then if (p^.left^.treetype=stringconstn) then
begin begin
{$ifdef UseAnsiString}
hp:=genordinalconstnode(p^.left^.length,s32bitdef);
{$else UseAnsiString}
hp:=genordinalconstnode(length(p^.left^.values^),s32bitdef); hp:=genordinalconstnode(length(p^.left^.values^),s32bitdef);
{$endif UseAnsiString}
disposetree(p); disposetree(p);
firstpass(hp); firstpass(hp);
p:=hp; p:=hp;
@ -5044,7 +5048,10 @@ unit pass_1;
end. end.
{ {
$Log$ $Log$
Revision 1.42 1998-07-20 10:23:01 florian Revision 1.43 1998-07-20 18:40:14 florian
* handling of ansi string constants should now work
Revision 1.42 1998/07/20 10:23:01 florian
* better ansi string assignement * better ansi string assignement
Revision 1.41 1998/07/18 22:54:27 florian Revision 1.41 1998/07/18 22:54:27 florian

88
compiler/ptconst.pas
View File

@ -246,31 +246,9 @@ unit ptconst;
p:=comp_expr(true); p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
{ first take care of prefixes for long and ansi strings } { first take care of prefixes for long and ansi strings }
{$ifdef UseLongString} case pstringdef(def)^.string_typ of
if pstringdef(def)^.string_typ=longstring then st_shortstring:
begin begin
{ first write the maximum size }
datasegment^.concat(new(pai_const,init_32bit(p^.length)))));
end else
{$endif UseLongString}
{$ifdef UseAnsiString}
if pstringdef(def)^.string_typ=st_ansistring then
begin
{$ifdef debug}
datasegment^.concat(new(pai_asm_comment,init('Header of ansistring')));
{$endif debug}
{ first write the maximum size }
datasegment^.concat(new(pai_const,init_32bit(pstringdef(def)^.len)));
{ second write the real length }
datasegment^.concat(new(pai_const,init_32bit(p^.length)));
{ redondent with maxlength but who knows ... (PM) }
{ third write use count (set to -1 for safety ) }
datasegment^.concat(new(pai_const,init_32bit(-1)));
if assigned(sym) then
sym^.really_insert_in_data;
end;
{$endif UseAnsiString}
{ the actual write is independent of the string_typ }
if p^.treetype=stringconstn then if p^.treetype=stringconstn then
begin begin
{$ifdef UseAnsiString} {$ifdef UseAnsiString}
@ -278,8 +256,9 @@ unit ptconst;
strlength:=def^.size-1 strlength:=def^.size-1
else else
strlength:=p^.length; strlength:=p^.length;
datasegment^.concat(new(pai_const,init_8bit(strlength)));
{ this can also handle longer strings } { this can also handle longer strings }
generate_pascii(p^.values,strlength); generate_pascii(datasegment,p^.values,strlength);
{$else UseAnsiString} {$else UseAnsiString}
if length(p^.values^)>=def^.size then if length(p^.values^)>=def^.size then
strlength:=def^.size-1 strlength:=def^.size-1
@ -294,6 +273,7 @@ unit ptconst;
strlength:=1; strlength:=1;
end end
else Message(cg_e_illegal_expression); else Message(cg_e_illegal_expression);
if def^.size>strlength then if def^.size>strlength then
begin begin
getmem(ca,def^.size-strlength); getmem(ca,def^.size-strlength);
@ -301,13 +281,62 @@ unit ptconst;
ca[def^.size-strlength-1]:=#0; ca[def^.size-strlength-1]:=#0;
{$ifdef UseAnsiString} {$ifdef UseAnsiString}
{ this can also handle longer strings } { this can also handle longer strings }
generate_pascii(ca,def^.size-strlength); { def^.size contains also the leading length, so we }
{ we have to subtract one }
generate_pascii(datasegment,ca,def^.size-strlength-1);
{$else UseAnsiString} {$else UseAnsiString}
datasegment^.concat(new(pai_string,init_pchar(ca))); datasegment^.concat(new(pai_string,init_pchar(ca)));
{$endif UseAnsiString} {$endif UseAnsiString}
disposetree(p);
end; end;
end; end;
{$ifdef UseLongString}
st_longstring:
begin
{ first write the maximum size }
datasegment^.concat(new(pai_const,init_32bit(p^.length)))));
writestringdata(datasegment);
end;
{$endif UseLongString}
{$ifdef UseAnsiString}
st_ansistring:
begin
{ an empty ansi string is nil! }
if (p^.treetype=stringconstn) and (p^.length=0) then
datasegment^.concat(new(pai_const,init_32bit(0)))
else
begin
getlabel(ll);
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
{ first write the maximum size }
consts^.concat(new(pai_const,init_32bit(p^.length)));
{ second write the real length }
consts^.concat(new(pai_const,init_32bit(p^.length)));
{ redondent with maxlength but who knows ... (PM) }
{ third write use count (set to -1 for safety ) }
consts^.concat(new(pai_const,init_32bit(-1)));
{ not longer necessary, because it insert_indata
if assigned(sym) then
sym^.really_insert_in_data;
}
consts^.concat(new(pai_label,init(ll)));
if p^.treetype=stringconstn then
begin
{ this can also handle longer strings }
generate_pascii(consts,p^.values,p^.length);
end
else if is_constcharnode(p) then
begin
consts^.concat(new(pai_const,init_8bit(p^.value)));
strlength:=1;
end
else Message(cg_e_illegal_expression);
consts^.concat(new(pai_const,init_8bit(0)));
end;
end;
{$endif UseAnsiString}
end;
disposetree(p);
end;
arraydef: arraydef:
begin begin
if token=LKLAMMER then if token=LKLAMMER then
@ -450,7 +479,10 @@ unit ptconst;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-07-18 22:54:29 florian Revision 1.8 1998-07-20 18:40:15 florian
* handling of ansi string constants should now work
Revision 1.7 1998/07/18 22:54:29 florian
* some ansi/wide/longstring support fixed: * some ansi/wide/longstring support fixed:
o parameter passing o parameter passing
o returning as result from functions o returning as result from functions

9
compiler/symsym.inc
View File

@ -1245,8 +1245,10 @@
begin begin
{ here there is a problem for ansistrings !! } { here there is a problem for ansistrings !! }
{ we must write the label only after the 12 header bytes (PM) } { we must write the label only after the 12 header bytes (PM)
if not is_ansistring(definition) then if not is_ansistring(definition) then
}
{ solved, the ansis string is moved to consts (FK) }
really_insert_in_data; really_insert_in_data;
end; end;
@ -1644,7 +1646,10 @@
{ {
$Log$ $Log$
Revision 1.23 1998-07-14 21:37:24 peter Revision 1.24 1998-07-20 18:40:16 florian
* handling of ansi string constants should now work
Revision 1.23 1998/07/14 21:37:24 peter
* fixed packrecords as discussed at the alias * fixed packrecords as discussed at the alias
Revision 1.22 1998/07/14 14:47:08 peter Revision 1.22 1998/07/14 14:47:08 peter