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

* Hopefully final attempt at resourcestrings

Browse Source
This commit is contained in:
michael 1999-08-23 11:45:39 +00:00
parent 1ef759bc9a
commit d57e16aec2
4 changed files with 289 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/cg386ld.pas
View File

@ -80,7 +80,7 @@ implementation
begin
pushusedregisters(pushed,$ff);
emit_const(A_PUSH,S_L,
pconstsym(p^.symtableentry)^.reshash);
pconstsym(p^.symtableentry)^.resstrindex);
emitcall('FPC_GETRESOURCESTRING');
hregister:=getexplicitregister32(R_EAX);
@ -964,7 +964,10 @@ implementation
end.
{
$Log$
Revision 1.75 1999-08-19 13:08:49 pierre
Revision 1.76 1999-08-23 11:45:39 michael
* Hopefully final attempt at resourcestrings
Revision 1.75 1999/08/19 13:08:49 pierre
* emit_??? used
Revision 1.74 1999/08/17 13:26:06 peter

504
compiler/cresstr.pas
View File

@ -21,258 +21,296 @@
}
unit cresstr;
interface
interface
procedure insertresourcestrings;
function registerresourcestring(Const name : string;p : pchar;len : longint) : longint;
function calc_resstring_hashvalue(N : String) : longint;
Procedure WriteResourceFile(FileName : String);
Procedure ResetResourceStrings;
Procedure InsertResourceStrings;
Function registerresourcestring(Const name : string;p : pchar;len : longint) : longint;
Function calc_resstring_hashvalue(P : Pchar; Len : longint) : longint;
Procedure WriteResourceFile(FileName : String);
implementation
implementation
uses
globals,aasm,verbose,files;
uses
globals,aasm,verbose,files;
Type
{ These are used to form a singly-linked list, ordered by hash value }
PResourcestring = ^TResourceString;
TResourceString = record
Name : String;
Value : Pchar;
Len,hash : longint;
Next : PResourcestring;
end;
const
{ we can use a static constant because we compile a program only once }
{ per compiler call }
resstrcount : longint = 0;
resourcefilename = 'resource.rst';
Var
ResourceListRoot : PResourceString;
{ Calculate hash value, based on the name of the string }
function calc_resstring_hashvalue(N : String) : longint;
Var hash,g,I : longint;
begin
hash:=0;
For I:=0 to Length(N)-1 do { 0 terminated }
begin
hash:=hash shl 4;
inc(Hash,Ord(N[i]));
g:=hash and ($f shl 28);
if g<>0 then
begin
hash:=hash xor (g shr 24);
hash:=hash xor g;
end;
end;
If Hash=0 then
Calc_resstring_hashvalue:=Not(0)
else
calc_resstring_hashvalue:=Hash;
end;
Procedure AppendToResourceList(const name : string;p : pchar;len,hash : longint);
Var R,Run,prev : PResourceString;
begin
inc(resstrcount);
New(R);
{ name is lower case... }
R^.Name:=Name;
r^.Len:=Len;
R^.Hash:=hash;
GetMem(R^.Value,Len);
Move(P^,R^.Value^,Len);
{ insert at correct position }
Run:=ResourceListRoot;
Prev:=Nil;
While (Run<>Nil) and (Run^.Hash<Hash) do
begin
Prev:=Run;
Run:=Run^.Next;
end;
If Prev<>Nil Then
Prev^.next:=R;
R^.Next:=Run;
If ResourceListRoot=Nil then
ResourceListRoot:=R;
Type
{ These are used to form a singly-linked list, ordered by hash value }
PResourcestring = ^TResourceString;
TResourceString = record
Name : String;
Value : Pchar;
Len,hash : longint;
Next : PResourcestring;
end;
Procedure AppendToAsmResList (P : PResourceString);
const
{ we can use a static constant because we compile a program only once }
{ per compiler call }
resstrcount : longint = 0;
resourcefilename = 'resource.rst';
Var
l1 : pasmlabel;
s : pchar;
begin
With P^ Do
Var
ResourceListRoot : PResourceString;
ResourceListCurrent : PResourceString;
{ ---------------------------------------------------------------------
Calculate hash value, based on the string
---------------------------------------------------------------------}
function calc_resstring_hashvalue(P : Pchar; Len : longint) : longint;
Var hash,g,I : longint;
begin
hash:=0;
For I:=0 to Len-1 do { 0 terminated }
begin
if (Value=nil) or (len=0) then
resourcestringlist^.concat(new(pai_const,init_32bit(0)))
else
hash:=hash shl 4;
inc(Hash,Ord(P[i]));
g:=hash and ($f shl 28);
if g<>0 then
begin
getdatalabel(l1);
resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_label,init(l1)));
getmem(s,len+1);
move(Value^,s^,len);
s[len]:=#0;
consts^.concat(new(pai_string,init_length_pchar(s,len)));
consts^.concat(new(pai_const,init_8bit(0)));
hash:=hash xor (g shr 24);
hash:=hash xor g;
end;
{ append Current value (nil) and hash...}
resourcestringlist^.concat(new(pai_const,init_32bit(0)));
resourcestringlist^.concat(new(pai_const,init_32bit(hash)));
{ Append the name as a ansistring. }
getdatalabel(l1);
Len:=Length(Name);
resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_label,init(l1)));
getmem(s,len+1);
move(Name[1],s^,len);
s[len]:=#0;
consts^.concat(new(pai_string,init_length_pchar(s,len)));
consts^.concat(new(pai_const,init_8bit(0)));
end;
If Hash=0 then
Calc_resstring_hashvalue:=Not(0)
else
calc_resstring_hashvalue:=Hash;
end;
{ ---------------------------------------------------------------------
Append 1 resourcestring to the linked list of resource strings.
---------------------------------------------------------------------}
Function AppendToResourceList(const name : string;p : pchar;len,hash : longint) : longint;
Var R : PResourceString;
Index : longint;
begin
If ResourceListCurrent<>Nil then
begin
New(ResourceListCurrent^.Next);
ResourceListCurrent:=ResourceListCurrent^.Next;
end
else
begin
New(ResourceListCurrent);
ResourceListRoot:=ResourceListCurrent;
end;
{ name is lower case... }
ResourceListCurrent^.Name:=Name;
ResourceListCurrent^.Len:=Len;
ResourceListCurrent^.Hash:=hash;
GetMem(ResourceListCurrent^.Value,Len);
Move(P^,ResourceListCurrent^.Value^,Len);
AppendToResourceList:=ResStrCount;
inc(Resstrcount);
end;
{ ---------------------------------------------------------------------
Append 1 resource string to the resourcestring asm list
---------------------------------------------------------------------}
Procedure AppendToAsmResList (P : PResourceString);
Var
l1 : pasmlabel;
s : pchar;
begin
With P^ Do
begin
if (Value=nil) or (len=0) then
resourcestringlist^.concat(new(pai_const,init_32bit(0)))
else
begin
getdatalabel(l1);
resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_label,init(l1)));
getmem(s,len+1);
move(Value^,s^,len);
s[len]:=#0;
consts^.concat(new(pai_string,init_length_pchar(s,len)));
consts^.concat(new(pai_const,init_8bit(0)));
end;
{ append Current value (nil) and hash...}
resourcestringlist^.concat(new(pai_const,init_32bit(0)));
resourcestringlist^.concat(new(pai_const,init_32bit(hash)));
{ Append the name as a ansistring. }
getdatalabel(l1);
Len:=Length(Name);
resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(len)));
consts^.concat(new(pai_const,init_32bit(-1)));
consts^.concat(new(pai_label,init(l1)));
getmem(s,len+1);
move(Name[1],s^,len);
s[len]:=#0;
consts^.concat(new(pai_string,init_length_pchar(s,len)));
consts^.concat(new(pai_const,init_8bit(0)));
end;
end;
{ ---------------------------------------------------------------------
Create the full asmlist for resourcestrings.
---------------------------------------------------------------------}
procedure insertresourcestrings;
Var R : PresourceString;
begin
if not(assigned(resourcestringlist)) then
resourcestringlist:=new(paasmoutput,init);
resourcestringlist^.insert(new(pai_const,init_32bit(resstrcount)));
resourcestringlist^.insert(new(pai_symbol,initname_global('RESOURCESTRINGLIST',0)));
R:=ResourceListRoot;
While R<>Nil do
begin
AppendToAsmResList(R);
R:=R^.Next;
end;
resourcestringlist^.concat(new(pai_symbol_end,initname('RESOURCESTRINGLIST')));
end;
{ ---------------------------------------------------------------------
Insert 1 resource string in all tables.
---------------------------------------------------------------------}
function registerresourcestring(const name : string;p : pchar;len : longint) : longint;
var
fullname : string;
hash : longint;
begin
{ Calculate result }
fullname:=lower(current_module^.modulename^+'.'+Name);
hash:=calc_resstring_hashvalue(p,len);
if not(assigned(resourcestringlist)) then
resourcestringlist:=new(paasmoutput,init);
registerresourcestring:=AppendToResourceList(fullname,P,Len,Hash);
end;
Procedure WriteResourceFile(Filename : String);
Type
TMode = (quoted,unquoted);
Var F : Text;
Mode : TMode;
old : PresourceString;
C : char;
Col,i : longint;
Procedure Add(Const S : String);
begin
Write(F,S);
Col:=Col+length(s);
end;
procedure insertresourcestrings;
Var R : PresourceString;
begin
if not(assigned(resourcestringlist)) then
resourcestringlist:=new(paasmoutput,init);
resourcestringlist^.insert(new(pai_const,init_32bit(resstrcount)));
resourcestringlist^.insert(new(pai_symbol,initname_global('RESOURCESTRINGLIST',0)));
R:=ResourceListRoot;
While R<>Nil do
begin
AppendToAsmResList(R);
R:=R^.Next;
end;
resourcestringlist^.concat(new(pai_symbol_end,initname('RESOURCESTRINGLIST')));
end;
function registerresourcestring(const name : string;p : pchar;len : longint) : longint;
var
fullname : string;
hash : longint;
begin
{ Calculate result }
fullname:=lower(current_module^.modulename^+'.'+Name);
hash:=calc_resstring_hashvalue(FullName);
registerresourcestring:=hash;
{ we don't need to generate consts in units }
if (main_module^.is_unit) then
exit;
if not(assigned(resourcestringlist)) then
resourcestringlist:=new(paasmoutput,init);
AppendToResourceList(fullname,P,Len,Hash);
end;
Procedure WriteResourceFile(Filename : String);
Type
TMode = (quoted,unquoted);
Var F : Text;
Mode : TMode;
old : PresourceString;
C : char;
Col,i : longint;
Procedure Add(Const S : String);
begin
Write(F,S);
Col:=Col+length(s);
end;
begin
If resstrCount=0 then
exit;
FileName:=ForceExtension(lower(FileName),'.rst');
message1 (general_i_writingresourcefile,filename);
Assign(F,Filename);
{$i-}
Rewrite(f);
{$i+}
If IOresult<>0 then
begin
If resstrCount=0 then
exit;
FileName:=ForceExtension(lower(FileName),'.rst');
message1 (general_i_writingresourcefile,filename);
Assign(F,Filename);
{$i-}
Rewrite(f);
{$i+}
If IOresult<>0 then
begin
message(general_e_errorwritingresourcefile);
exit;
end;
While ResourceListRoot<>Nil do
With ResourceListRoot^ do
begin
writeln(f);
Writeln (f,'# hash value = ',hash);
col:=0;
Add(Name+'=');
Mode:=unquoted;
For I:=0 to Len-1 do
begin
C:=Value[i];
If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
begin
If mode=Quoted then
Add(c)
else
begin
Add(''''+c);
mode:=quoted
end
end
else
begin
If Mode=quoted then
begin
Add('''');
mode:=unquoted;
end;
Add('#'+tostr(ord(c)));
end;
If Col>72 then
begin
if mode=quoted then
Write (F,'''');
Writeln(F,'+');
Col:=0;
Mode:=unQuoted;
end;
end;
if mode=quoted then writeln (f,'''');
Writeln(f);
Old :=ResourceListRoot;
ResourceListRoot:=old^.Next;
FreeMem(Old^.Value,Len);
Dispose(Old);
end;
close(f);
message(general_e_errorwritingresourcefile);
exit;
end;
While ResourceListRoot<>Nil do
With ResourceListRoot^ do
begin
writeln(f);
Writeln (f,'# hash value = ',hash);
col:=0;
Add(Name+'=');
Mode:=unquoted;
For I:=0 to Len-1 do
begin
C:=Value[i];
If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
begin
If mode=Quoted then
Add(c)
else
begin
Add(''''+c);
mode:=quoted
end
end
else
begin
If Mode=quoted then
begin
Add('''');
mode:=unquoted;
end;
Add('#'+tostr(ord(c)));
end;
If Col>72 then
begin
if mode=quoted then
Write (F,'''');
Writeln(F,'+');
Col:=0;
Mode:=unQuoted;
end;
end;
if mode=quoted then writeln (f,'''');
Writeln(f);
Old :=ResourceListRoot;
ResourceListRoot:=old^.Next;
FreeMem(Old^.Value,Len);
Dispose(Old);
end;
close(f);
end;
Procedure ResetResourceStrings;
Var R,T : PResourceString;
begin
If ResourceStringList<>Nil then
begin
Dispose(ResourceStringlist,Done);
ResourceStringList:=Nil;
end;
R:=ResourceListRoot;
While R<>Nil do
begin
FreeMem(R^.Value,R^.Len);
T:=R^.Next;
Dispose(R);
R:=T;
end;
ResStrCount:=0;
end;
end.
{
$Log$
Revision 1.9 1999-08-15 21:57:59 michael
Revision 1.10 1999-08-23 11:45:41 michael
* Hopefully final attempt at resourcestrings
Revision 1.9 1999/08/15 21:57:59 michael
Changes for resource strings
Revision 1.8 1999/07/29 20:54:01 peter

12
compiler/symsym.inc
View File

@ -1633,7 +1633,7 @@
typ:=constsym;
consttype:=t;
value:=v;
reshash:=0;
ResStrIndex:=0;
definition:=nil;
len:=0;
end;
@ -1659,7 +1659,7 @@
definition:=nil;
len:=l;
if t=constresourcestring then
reshash:=registerresourcestring(name,pchar(value),len);
ResStrIndex:=registerresourcestring(name,pchar(value),len);
end;
constructor tconstsym.load;
@ -1685,7 +1685,7 @@
getmem(pchar(value),len+1);
current_ppu^.getdata(pchar(value)^,len);
if consttype=constresourcestring then
reshash:=registerresourcestring(name,pchar(value),len);
ResStrIndex:=readlong;
end;
constreal :
begin
@ -1753,6 +1753,7 @@
begin
writelong(len);
current_ppu^.putdata(pchar(value)^,len);
writelong(ResStrIndex);
end;
constreal :
writereal(pbestreal(value)^);
@ -2153,7 +2154,10 @@
{
$Log$
Revision 1.114 1999-08-15 21:57:58 michael
Revision 1.115 1999-08-23 11:45:42 michael
* Hopefully final attempt at resourcestrings
Revision 1.114 1999/08/15 21:57:58 michael
Changes for resource strings
Revision 1.113 1999/08/14 00:39:00 peter

7
compiler/symsymh.inc
View File

@ -286,7 +286,7 @@
tconstsym = object(tsym)
definition : pdef;
consttype : tconsttype;
reshash, { needed for resource strings }
resstrindex, { needed for resource strings }
value,
len : longint; { len is needed for string length }
constructor init(const n : string;t : tconsttype;v : longint);
@ -336,7 +336,10 @@
{
$Log$
Revision 1.32 1999-08-14 00:39:01 peter
Revision 1.33 1999-08-23 11:45:45 michael
* Hopefully final attempt at resourcestrings
Revision 1.32 1999/08/14 00:39:01 peter
* hack to support property with record fields
Revision 1.31 1999/08/10 12:33:38 pierre