paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 12:50:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* add support for loading of typed const strings with resourcestrings,

Browse Source 
made the loading also a bit more generic
This commit is contained in:
peter 2000-05-17 17:10:06 +00:00
parent c7efe8fd6c
commit 6029115a7d
2 changed files with 108 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
compiler/ptconst.pas
View File

@ -36,6 +36,8 @@ unit ptconst;
uses uses
{$ifdef Delphi} {$ifdef Delphi}
sysutils, sysutils,
{$else}
strings,
{$endif Delphi} {$endif Delphi}
globtype,systems,tokens, globtype,systems,tokens,
cobjects,globals,scanner, cobjects,globals,scanner,
@ -76,6 +78,7 @@ unit ptconst;
obj : pobjectdef; obj : pobjectdef;
symt : psymtable; symt : psymtable;
value : bestreal; value : bestreal;
strval : pchar;
procedure check_range; procedure check_range;
begin begin
@ -413,107 +416,94 @@ unit ptconst;
begin begin
p:=comp_expr(true); p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
{ first take care of prefixes for long and ansi strings } { load strval and strlength of the constant tree }
case pstringdef(def)^.string_typ of if p^.treetype=stringconstn then
st_shortstring: begin
begin strlength:=p^.length;
if p^.treetype=stringconstn then strval:=p^.value_str;
end
else if is_constcharnode(p) then
begin
strval:=pchar(@p^.value);
strlength:=1
end
else if is_constresourcestringnode(p) then
begin
strval:=pchar(pconstsym(p^.symtableentry)^.value);
strlength:=pconstsym(p^.symtableentry)^.len;
end
else
begin
Message(cg_e_illegal_expression);
strlength:=-1;
end;
if strlength>=0 then
begin
case pstringdef(def)^.string_typ of
st_shortstring:
begin
if strlength>=def^.size then
begin begin
if p^.length>=def^.size then message2(parser_w_string_too_long,strpas(strval),tostr(def^.size-1));
begin strlength:=def^.size-1;
message2(parser_w_string_too_long,strpas(p^.value_str),tostr(def^.size-1));
strlength:=def^.size-1;
end
else
strlength:=p^.length;
curconstsegment^.concat(new(pai_const,init_8bit(strlength)));
{ this can also handle longer strings }
getmem(ca,strlength+1);
move(p^.value_str^,ca^,strlength);
ca[strlength]:=#0;
curconstsegment^.concat(new(pai_string,init_length_pchar(ca,strlength)));
end
else if is_constcharnode(p) then
begin
curconstsegment^.concat(new(pai_string,init(#1+char(byte(p^.value)))));
strlength:=1;
end
else Message(cg_e_illegal_expression);
if def^.size>strlength then
begin
getmem(ca,def^.size-strlength);
{ def^.size contains also the leading length, so we }
{ we have to subtract one }
fillchar(ca[0],def^.size-strlength-1,' ');
ca[def^.size-strlength-1]:=#0;
{ this can also handle longer strings }
curconstsegment^.concat(new(pai_string,init_length_pchar(ca,def^.size-strlength-1)));
end; end;
end; curconstsegment^.concat(new(pai_const,init_8bit(strlength)));
{ this can also handle longer strings }
getmem(ca,strlength+1);
move(strval^,ca^,strlength);
ca[strlength]:=#0;
curconstsegment^.concat(new(pai_string,init_length_pchar(ca,strlength)));
{ fillup with spaces if size is shorter }
if def^.size>strlength then
begin
getmem(ca,def^.size-strlength);
{ def^.size contains also the leading length, so we }
{ we have to subtract one }
fillchar(ca[0],def^.size-strlength-1,' ');
ca[def^.size-strlength-1]:=#0;
{ this can also handle longer strings }
curconstsegment^.concat(new(pai_string,init_length_pchar(ca,def^.size-strlength-1)));
end;
end;
{$ifdef UseLongString} {$ifdef UseLongString}
st_longstring: st_longstring:
begin begin
if is_constcharnode(p) then { first write the maximum size }
strlength:=1 curconstsegment^.concat(new(pai_const,init_32bit(strlength)))));
else { fill byte }
strlength:=p^.length; curconstsegment^.concat(new(pai_const,init_8bit(0)));
{ first write the maximum size } getmem(ca,strlength+1);
curconstsegment^.concat(new(pai_const,init_32bit(strlength))))); move(strval^,ca^,strlength);
{ fill byte } ca[strlength]:=#0;
curconstsegment^.concat(new(pai_const,init_8bit(0))); generate_pascii(consts,ca,strlength);
if p^.treetype=stringconstn then curconstsegment^.concat(new(pai_const,init_8bit(0)));
begin end;
getmem(ca,strlength+1);
move(p^.value_str^,ca^,strlength);
ca[strlength]:=#0;
generate_pascii(consts,ca,strlength);
end
else if is_constcharnode(p) then
begin
consts^.concat(new(pai_const,init_8bit(p^.value)));
end
else Message(cg_e_illegal_expression);
curconstsegment^.concat(new(pai_const,init_8bit(0)));
end;
{$endif UseLongString} {$endif UseLongString}
st_ansistring: st_ansistring:
begin begin
{ an empty ansi string is nil! } { an empty ansi string is nil! }
if (p^.treetype=stringconstn) and (p^.length=0) then if (strlength=0) then
curconstsegment^.concat(new(pai_const,init_32bit(0))) curconstsegment^.concat(new(pai_const,init_32bit(0)))
else else
begin begin
if is_constcharnode(p) then getdatalabel(ll);
strlength:=1 curconstsegment^.concat(new(pai_const_symbol,init(ll)));
else { first write the maximum size }
strlength:=p^.length; consts^.concat(new(pai_const,init_32bit(strlength)));
getdatalabel(ll); { second write the real length }
curconstsegment^.concat(new(pai_const_symbol,init(ll))); consts^.concat(new(pai_const,init_32bit(strlength)));
{ first write the maximum size } { redondent with maxlength but who knows ... (PM) }
consts^.concat(new(pai_const,init_32bit(strlength))); { third write use count (set to -1 for safety ) }
{ second write the real length } consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_const,init_32bit(strlength))); consts^.concat(new(pai_label,init(ll)));
{ redondent with maxlength but who knows ... (PM) } getmem(ca,strlength+1);
{ third write use count (set to -1 for safety ) } move(strval^,ca^,strlength);
consts^.concat(new(pai_const,init_32bit(-1))); ca[strlength]:=#0;
consts^.concat(new(pai_label,init(ll))); consts^.concat(new(pai_string,init_length_pchar(ca,strlength)));
if p^.treetype=stringconstn then end;
begin end;
getmem(ca,strlength+1); end;
move(p^.value_str^,ca^,strlength); end;
ca[strlength]:=#0;
consts^.concat(new(pai_string,init_length_pchar(ca,strlength)));
end
else if is_constcharnode(p) then
begin
consts^.concat(new(pai_const,init_8bit(p^.value)));
end
else Message(cg_e_illegal_expression);
consts^.concat(new(pai_const,init_8bit(0)));
end;
end;
end;
disposetree(p); disposetree(p);
end; end;
arraydef: arraydef:
@ -800,7 +790,11 @@ unit ptconst;
end. end.
{ {
$Log$ $Log$
Revision 1.66 2000-05-12 06:02:01 pierre Revision 1.67 2000-05-17 17:10:06 peter
* add support for loading of typed const strings with resourcestrings,
made the loading also a bit more generic
Revision 1.66 2000/05/12 06:02:01 pierre
* * get it to compile with Delphi by Kovacs Attila Zoltan * * get it to compile with Delphi by Kovacs Attila Zoltan
Revision 1.65 2000/05/11 09:15:15 pierre Revision 1.65 2000/05/11 09:15:15 pierre

17
compiler/tree.pas
View File

@ -354,6 +354,8 @@ unit tree;
function is_constboolnode(p : ptree) : boolean; function is_constboolnode(p : ptree) : boolean;
function is_constrealnode(p : ptree) : boolean; function is_constrealnode(p : ptree) : boolean;
function is_constcharnode(p : ptree) : boolean; function is_constcharnode(p : ptree) : boolean;
function is_constresourcestringnode(p : ptree) : boolean;
function str_length(p : ptree) : longint; function str_length(p : ptree) : longint;
function is_emptyset(p : ptree):boolean; function is_emptyset(p : ptree):boolean;
@ -2035,6 +2037,15 @@ unit tree;
is_constboolnode:=(p^.treetype=ordconstn) and is_boolean(p^.resulttype); is_constboolnode:=(p^.treetype=ordconstn) and is_boolean(p^.resulttype);
end; end;
function is_constresourcestringnode(p : ptree) : boolean;
begin
is_constresourcestringnode:=(p^.treetype=loadn) and
(p^.symtableentry^.typ=constsym) and
(pconstsym(p^.symtableentry)^.consttyp=constresourcestring);
end;
function str_length(p : ptree) : longint; function str_length(p : ptree) : longint;
begin begin
@ -2110,7 +2121,11 @@ unit tree;
end. end.
{ {
$Log$ $Log$
Revision 1.119 2000-04-25 14:43:37 jonas Revision 1.120 2000-05-17 17:10:06 peter
* add support for loading of typed const strings with resourcestrings,
made the loading also a bit more generic
Revision 1.119 2000/04/25 14:43:37 jonas
- disabled "string_var := string_var + ... " and "string_var + char_var" - disabled "string_var := string_var + ... " and "string_var + char_var"
optimizations (were only active with -dnewoptimizations) because of optimizations (were only active with -dnewoptimizations) because of
several internal issues several internal issues