{
$Id: cresstr.pas,v 1.20 2003/12/29 19:31:20 florian Exp $
Copyright (c) 1998-2002 by Michael van Canneyt
Handles resourcestrings
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cresstr;
{$i fpcdefs.inc}
interface
uses
cclasses;
Type
{ These are used to form a singly-linked list, ordered by hash value }
TResourceStringItem = class(TLinkedListItem)
Name : String;
Value : Pchar;
Len : Longint;
hash : Cardinal;
constructor Create(const AName:string;AValue:pchar;ALen:longint);
destructor Destroy;override;
procedure CalcHash;
end;
TResourceStrings=class
private
List : TLinkedList;
public
ResStrCount : longint;
constructor Create;
destructor Destroy;override;
function Register(Const name : string;p : pchar;len : longint) : longint;
procedure CreateResourceStringList;
Procedure WriteResourceFile(const FileName : String);
end;
var
ResourceStrings : TResourceStrings;
implementation
uses
cutils,globals,
symdef,
verbose,fmodule,
aasmbase,aasmtai,
aasmcpu,cpuinfo;
{ ---------------------------------------------------------------------
Calculate hash value, based on the string
---------------------------------------------------------------------}
{ ---------------------------------------------------------------------
TRESOURCESTRING_ITEM
---------------------------------------------------------------------}
constructor TResourceStringItem.Create(const AName:string;AValue:pchar;ALen:longint);
begin
inherited Create;
Name:=AName;
Len:=ALen;
GetMem(Value,Len);
Move(AValue^,Value^,Len);
CalcHash;
end;
destructor TResourceStringItem.Destroy;
begin
FreeMem(Value,Len);
end;
{$ifopt r+}
{$define rangeon}
{$r-}
{$endif}
procedure TResourceStringItem.CalcHash;
Var
g : Cardinal;
I : longint;
begin
hash:=0;
For I:=0 to Len-1 do { 0 terminated }
begin
hash:=hash shl 4;
inc(Hash,Ord(Value[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
Hash:=Not(0);
end;
{$ifdef rangeon}
{$r+}
{$undef rangeon}
{$endif}
{ ---------------------------------------------------------------------
TRESOURCESTRINGS
---------------------------------------------------------------------}
Constructor TResourceStrings.Create;
begin
List:=TStringList.Create;
ResStrCount:=0;
end;
Destructor TResourceStrings.Destroy;
begin
List.Free;
end;
{ ---------------------------------------------------------------------
Create the full asmlist for resourcestrings.
---------------------------------------------------------------------}
procedure TResourceStrings.CreateResourceStringList;
Procedure AppendToAsmResList (P : TResourceStringItem);
Var
l1 : tasmlabel;
s : pchar;
l : longint;
begin
With P Do
begin
if (Value=nil) or (len=0) then
resourcestringlist.concat(tai_const.create_32bit(0))
else
begin
objectlibrary.getdatalabel(l1);
resourcestringlist.concat(tai_const_symbol.create(l1));
consts.concat(tai_align.Create(const_align(pointer_size)));
consts.concat(tai_const.create_32bit(len));
consts.concat(tai_const.create_32bit(len));
consts.concat(tai_const.create_32bit(cardinal(-1)));
consts.concat(tai_label.create(l1));
getmem(s,len+1);
move(Value^,s^,len);
s[len]:=#0;
consts.concat(tai_string.create_length_pchar(s,len));
consts.concat(tai_const.create_8bit(0));
end;
{ append Current value (nil) and hash...}
resourcestringlist.concat(tai_const.create_32bit(0));
resourcestringlist.concat(tai_const.create_32bit(hash));
{ Append the name as a ansistring. }
objectlibrary.getdatalabel(l1);
L:=Length(Name);
resourcestringlist.concat(tai_const_symbol.create(l1));
consts.concat(tai_align.Create(const_align(pointer_size)));
consts.concat(tai_const.create_32bit(l));
consts.concat(tai_const.create_32bit(l));
consts.concat(tai_const.create_32bit(cardinal(-1)));
consts.concat(tai_label.create(l1));
getmem(s,l+1);
move(Name[1],s^,l);
s[l]:=#0;
consts.concat(tai_string.create_length_pchar(s,l));
consts.concat(tai_const.create_8bit(0));
end;
end;
Var
R : tresourceStringItem;
begin
if not(assigned(resourcestringlist)) then
resourcestringlist:=taasmoutput.create;
resourcestringlist.insert(tai_const.create_32bit(resstrcount));
resourcestringlist.insert(tai_symbol.createdataname_global(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),0));
resourcestringlist.insert(tai_align.Create(const_align(pointer_size)));
R:=TResourceStringItem(List.First);
While assigned(R) do
begin
AppendToAsmResList(R);
R:=TResourceStringItem(R.Next);
end;
resourcestringlist.concat(tai_symbol_end.createname(current_module.modulename^+'_'+'RESOURCESTRINGLIST'));
end;
{ ---------------------------------------------------------------------
Insert 1 resource string in all tables.
---------------------------------------------------------------------}
function TResourceStrings.Register(const name : string;p : pchar;len : longint) : longint;
begin
List.Concat(tResourceStringItem.Create(lower(current_module.modulename^+'.'+Name),p,len));
Register:=ResStrCount;
inc(ResStrCount);
end;
Procedure TResourceStrings.WriteResourceFile(const FileName : String);
Type
TMode = (quoted,unquoted);
Var
F : Text;
Mode : TMode;
R : TResourceStringItem;
C : char;
Col,i : longint;
Procedure Add(Const S : String);
begin
Write(F,S);
Col:=Col+length(s);
end;
begin
If List.Empty then
exit;
message1 (general_i_writingresourcefile,SplitFileName(filename));
Assign(F,Filename);
{$i-}
Rewrite(f);
{$i+}
If IOresult<>0 then
begin
message1(general_e_errorwritingresourcefile,filename);
exit;
end;
R:=TResourceStringItem(List.First);
While assigned(R) do
begin
writeln(f);
Writeln(f,'# hash value = ',R.hash);
col:=0;
Add(R.Name+'=');
Mode:=unquoted;
For I:=0 to R.Len-1 do
begin
C:=R.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);
R:=TResourceStringItem(R.Next);
end;
close(f);
end;
end.
{
$Log: cresstr.pas,v $
Revision 1.20 2003/12/29 19:31:20 florian
* fixed error message, if a resource file can't be written
Revision 1.19 2003/12/08 22:34:24 peter
* tai_const.create_32bit changed to cardinal
Revision 1.18 2003/10/29 19:48:50 peter
* renamed mangeldname_prefix to make_mangledname and made it more
generic
* make_mangledname is now also used for internal threadvar/resstring
lists
* Add P$ in front of program modulename to prevent duplicated symbols
at assembler level, because the main program can have the same name
as a unit, see webtbs/tw1251b
Revision 1.17 2002/11/09 15:39:03 carl
+ resource string tables are now aligned
Revision 1.16 2002/08/11 14:32:26 peter
* renamed current_library to objectlibrary
Revision 1.15 2002/08/11 13:24:11 peter
* saving of asmsymbols in ppu supported
* asmsymbollist global is removed and moved into a new class
tasmlibrarydata that will hold the info of a .a file which
corresponds with a single module. Added librarydata to tmodule
to keep the library info stored for the module. In the future the
objectfiles will also be stored to the tasmlibrarydata class
* all getlabel/newasmsymbol and friends are moved to the new class
Revision 1.14 2002/07/01 18:46:22 peter
* internal linker
* reorganized aasm layer
Revision 1.13 2002/05/18 13:34:06 peter
* readded missing revisions
Revision 1.12 2002/05/16 19:46:35 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
}
syntax highlighted by Code2HTML, v. 0.9.1