* made resourcestrings OOP so it's easier to handle it per module

compiler/cresstr.pas

@@ -21,142 +21,107 @@
  ****************************************************************************
 }
 unit cresstr;
-
 interface
 
-  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
-
 uses
-   globals,aasm,verbose,files;
+  cobjects;
 
 Type
   { These are used to form a singly-linked list, ordered by hash value }
-  PResourcestring = ^TResourceString;
-  TResourceString = record
-    Name : String;
+  PResourceStringItem = ^TResourceStringItem;
+  TResourceStringItem = object(TLinkedList_Item)
+    Name  : String;
     Value : Pchar;
-    Len,hash : longint;
-    Next : PResourcestring;
-    end;
+    Len,
+    hash  : longint;
+    constructor Init(const AName:string;AValue:pchar;ALen:longint);
+    destructor  Done;virtual;
+    procedure CalcHash;
+  end;
 
-const
-   { we can use a static constant because we compile a program only once }
-   { per compiler call                                                   }
-   resstrcount : longint = 0;
-   resourcefilename = 'resource.rst';
+  PResourceStrings=^TResourceStrings;
+  TResourceStrings=object
+  private
+    List : TLinkedList;
+  public
+    ResStrCount : longint;
+    constructor Init;
+    destructor  Done;
+    function  Register(Const name : string;p : pchar;len : longint) : longint;
+    procedure CreateResourceStringList;
+    Procedure WriteResourceFile(FileName : String);
+  end;
+
+var
+  ResourceStrings : PResourceStrings;
+
+
+implementation
+
+uses
+   globals,aasm,verbose,files;
 
-Var
-  ResourceListRoot : PResourceString;
-  ResourceListCurrent : PResourceString;
 
 { ---------------------------------------------------------------------
    Calculate hash value, based on the string
   ---------------------------------------------------------------------}
 
-function calc_resstring_hashvalue(P : Pchar; Len : longint) : longint;
+{ ---------------------------------------------------------------------
+                          TRESOURCESTRING_ITEM
+  ---------------------------------------------------------------------}
 
-  Var hash,g,I : longint;
+constructor TResourceStringItem.Init(const AName:string;AValue:pchar;ALen:longint);
+begin
+  inherited Init;
+  Name:=AName;
+  Len:=ALen;
+  GetMem(Value,Len);
+  Move(AValue^,Value^,Len);
+  CalcHash;
+end;
 
-  begin
-     hash:=0;
-     For I:=0 to Len-1 do { 0 terminated }
-       begin
-       hash:=hash shl 4;
-       inc(Hash,Ord(P[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;
 
+destructor TResourceStringItem.Done;
+begin
+  FreeMem(Value,Len);
+end;
 
-{ ---------------------------------------------------------------------
-    Append 1 resourcestring to the linked list of resource strings.
-  ---------------------------------------------------------------------}
 
-Function AppendToResourceList(const name : string;p : pchar;len,hash : longint) : longint;
+procedure TResourceStringItem.CalcHash;
+Var
+  g,I : longint;
 begin
-  If ResourceListCurrent<>Nil then
-    begin
-    New(ResourceListCurrent^.Next);
-    ResourceListCurrent:=ResourceListCurrent^.Next;
-    end
-  else
-    begin
-    New(ResourceListCurrent);
-    ResourceListRoot:=ResourceListCurrent;
-    end;
-  ResourceListCurrent^.Next:=Nil;
-  { 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);
+  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;
 
+
 { ---------------------------------------------------------------------
-    Append 1 resource string to the resourcestring asm list
+                          TRESOURCESTRINGS
   ---------------------------------------------------------------------}
 
-Procedure AppendToAsmResList (P : PResourceString);
+Constructor TResourceStrings.Init;
+begin
+  List.Init;
+  ResStrCount:=0;
+end;
 
-Var
- l1 : pasmlabel;
- s : pchar;
- l : longint;
 
+Destructor TResourceStrings.Done;
 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);
-   L:=Length(Name);
-   resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
-   consts^.concat(new(pai_const,init_32bit(l)));
-   consts^.concat(new(pai_const,init_32bit(l)));
-   consts^.concat(new(pai_const,init_32bit(-1)));
-   consts^.concat(new(pai_label,init(l1)));
-   getmem(s,l+1);
-   move(Name[1],s^,l);
-   s[l]:=#0;
-   consts^.concat(new(pai_string,init_length_pchar(s,l)));
-   consts^.concat(new(pai_const,init_8bit(0)));
-   end;
+  List.Done;
 end;
 
 
@@ -164,63 +129,98 @@ end;
     Create the full asmlist for resourcestrings.
   ---------------------------------------------------------------------}
 
-procedure insertresourcestrings;
-
-  Var R : PresourceString;
+procedure TResourceStrings.CreateResourceStringList;
 
+  Procedure AppendToAsmResList (P : PResourceStringItem);
+  Var
+    l1 : pasmlabel;
+    s : pchar;
+    l : longint;
   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);
+       L:=Length(Name);
+       resourcestringlist^.concat(new(pai_const_symbol,init(l1)));
+       consts^.concat(new(pai_const,init_32bit(l)));
+       consts^.concat(new(pai_const,init_32bit(l)));
+       consts^.concat(new(pai_const,init_32bit(-1)));
+       consts^.concat(new(pai_label,init(l1)));
+       getmem(s,l+1);
+       move(Name[1],s^,l);
+       s[l]:=#0;
+       consts^.concat(new(pai_string,init_length_pchar(s,l)));
+       consts^.concat(new(pai_const,init_8bit(0)));
+     end;
+  end;
+
+Var
+  R : PresourceStringItem;
+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(current_module^.modulename^+'_'+'RESOURCESTRINGLIST',0)));
-  R:=ResourceListRoot;
-  While R<>Nil do
-    begin
-    AppendToAsmResList(R);
-    R:=R^.Next;
-    end;
+  R:=PResourceStringItem(List.First);
+  While assigned(R) do
+   begin
+     AppendToAsmResList(R);
+     R:=PResourceStringItem(R^.Next);
+   end;
   resourcestringlist^.concat(new(pai_symbol_end,initname(current_module^.modulename^+'_'+'RESOURCESTRINGLIST')));
+end;
 
-  end;
 
 { ---------------------------------------------------------------------
     Insert 1 resource string in all tables.
   ---------------------------------------------------------------------}
 
-function  registerresourcestring(const name : string;p : pchar;len : longint) : longint;
-
-var
-   fullname : string;
-   hash : longint;
+function  TResourceStrings.Register(const name : string;p : pchar;len : longint) : 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);
+  inc(ResStrCount);
+  List.Concat(new(PResourceStringItem,Init(lower(current_module^.modulename^+'.'+Name),p,len)));
+  Register:=ResStrCount;
 end;
 
-Procedure WriteResourceFile(Filename : String);
 
+Procedure TResourceStrings.WriteResourceFile(Filename : String);
 Type
-   TMode = (quoted,unquoted);
-
-Var F : Text;
-    Mode : TMode;
-    old : PresourceString;
-    C : char;
-    Col,i : longint;
-
-   Procedure Add(Const S : String);
+  TMode = (quoted,unquoted);
+Var
+  F : Text;
+  Mode : TMode;
+  R : PResourceStringItem;
+  C : char;
+  Col,i : longint;
 
-   begin
-     Write(F,S);
-     Col:=Col+length(s);
-   end;
+  Procedure Add(Const S : String);
+  begin
+    Write(F,S);
+    Col:=Col+length(s);
+  end;
 
 begin
-  If (ResourceListRoot=Nil) then
+  If List.Empty then
     exit;
   FileName:=ForceExtension(lower(FileName),'.rst');
   message1 (general_i_writingresourcefile,filename);
@@ -233,83 +233,61 @@ begin
     message(general_e_errorwritingresourcefile);
     exit;
     end;
-  While ResourceListRoot<>Nil do
-    With ResourceListRoot^ do
-      begin
-      writeln(f);
-      Writeln (f,'# hash value = ',hash);
+  R:=PResourceStringItem(List.First);
+  While assigned(R) do
+   begin
+     writeln(f);
+     Writeln(f,'# hash value = ',R^.hash);
      col:=0;
-     Add(Name+'=');
+     Add(R^.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
+     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
+           If mode=Quoted then
+            Add(c)
+           else
+            begin
+              Add(''''+c);
+              mode:=quoted
+            end;
          end
-       else
+        else
          begin
-         If Mode=quoted then
-           begin
-           Add('''');
-           mode:=unquoted;
-           end;
-         Add('#'+tostr(ord(c)));
+           If Mode=quoted then
+            begin
+              Add('''');
+              mode:=unquoted;
+            end;
+           Add('#'+tostr(ord(c)));
          end;
-       If Col>72 then
+        If Col>72 then
          begin
-         if mode=quoted then
-           Write (F,'''');
-         Writeln(F,'+');
-         Col:=0;
-         Mode:=unQuoted;
+           if mode=quoted then
+            Write (F,'''');
+           Writeln(F,'+');
+           Col:=0;
+           Mode:=unQuoted;
          end;
-       end;
-     if mode=quoted then writeln (f,'''');
+      end;
+     if mode=quoted then
+      writeln (f,'''');
      Writeln(f);
-     Old :=ResourceListRoot;
-     ResourceListRoot:=old^.Next;
-     FreeMem(Old^.Value,Len);
-     Dispose(Old);
-     end;
-   close(f);
+     R:=PResourceStringItem(R^.Next);
+   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;
-  ResourceListCurrent:=Nil;
-  ResourceListRoot:=Nil;
-end;
-
 end.
 {
   $Log$
-  Revision 1.16  2000-01-07 01:14:23  peter
+  Revision 1.17  2000-06-01 19:09:57  peter
+    * made resourcestrings OOP so it's easier to handle it per module
+
+  Revision 1.16  2000/01/07 01:14:23  peter
     * updated copyright to 2000
 
   Revision 1.15  1999/11/06 14:34:20  peter

compiler/hcodegen.pas

@@ -356,12 +356,15 @@ implementation
          withdebuglist:=new(paasmoutput,init);
          consts:=new(paasmoutput,init);
          rttilist:=new(paasmoutput,init);
+         ResourceStringList:=Nil;
          importssection:=nil;
          exportssection:=nil;
          resourcesection:=nil;
          { assembler symbols }
          asmsymbollist:=new(pasmsymbollist,init);
          asmsymbollist^.usehash;
+         { resourcestrings }
+         new(ResourceStrings,Init);
       end;
 
 
@@ -383,6 +386,8 @@ implementation
          dispose(withdebuglist,done);
          dispose(consts,done);
          dispose(rttilist,done);
+         if assigned(ResourceStringList) then
+          dispose(ResourceStringList,done);
          if assigned(importssection) then
           dispose(importssection,done);
          if assigned(exportssection) then
@@ -400,8 +405,8 @@ implementation
 {$ifdef MEMDEBUG}
          d.done;
 {$endif}
-         { resourcestrings }
-         ResetResourceStrings;
+         { resource strings }
+         dispose(ResourceStrings,done);
       end;
 
 
@@ -445,7 +450,10 @@ end.
 
 {
   $Log$
-  Revision 1.58  2000-04-02 18:30:12  florian
+  Revision 1.59  2000-06-01 19:09:57  peter
+    * made resourcestrings OOP so it's easier to handle it per module
+
+  Revision 1.58  2000/04/02 18:30:12  florian
     * fixed another problem with readln(<floating point register variable>);
     * the register allocator takes now care of necessary pushes/pops for
       readln/writeln

compiler/parser.pas

@@ -261,6 +261,8 @@ unit parser;
          oldwithdebuglist,
          oldconsts     : paasmoutput;
          oldasmsymbollist : pasmsymbollist;
+       { resourcestrings }
+         OldResourceStrings : PResourceStrings;
        { akt.. things }
          oldaktlocalswitches  : tlocalswitches;
          oldaktmoduleswitches : tmoduleswitches;
@@ -324,6 +326,7 @@ unit parser;
          oldresource:=resourcesection;
          oldresourcestringlist:=resourcestringlist;
          oldasmsymbollist:=asmsymbollist;
+         OldResourceStrings:=ResourceStrings;
        { save akt... state }
        { handle the postponed case first }
         if localswitcheschanged then
@@ -514,8 +517,8 @@ unit parser;
               resourcesection:=oldresource;
               rttilist:=oldrttilist;
               resourcestringlist:=oldresourcestringlist;
-
               asmsymbollist:=oldasmsymbollist;
+              ResourceStrings:=OldResourceStrings;
               { restore symtable state }
               refsymtable:=oldrefsymtable;
               symtablestack:=oldsymtablestack;
@@ -604,7 +607,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.104  2000-05-29 10:04:40  pierre
+  Revision 1.105  2000-06-01 19:09:57  peter
+    * made resourcestrings OOP so it's easier to handle it per module
+
+  Revision 1.104  2000/05/29 10:04:40  pierre
     * New bunch of Gabor changes
 
   Revision 1.103  2000/05/11 06:52:37  pierre

compiler/pmodules.pas

@@ -1285,13 +1285,13 @@ unit pmodules;
          { the last char should always be a point }
          consume(_POINT);
 
-         If ResourceStringList<>Nil then
+         If ResourceStrings^.ResStrCount>0 then
           begin
-            insertresourcestrings;
+            ResourceStrings^.CreateResourceStringList;
             current_module^.flags:=current_module^.flags or uf_has_resources;
             { only write if no errors found }
             if (Errorcount=0) then
-             WriteResourceFile(Current_module^.ModuleName^);
+             ResourceStrings^.WriteResourceFile(Current_module^.ModuleName^);
           end;
 
          { avoid self recursive destructor call !! PM }
@@ -1585,12 +1585,12 @@ unit pmodules;
          current_module^.globalsymtable:=current_module^.localsymtable;
          current_module^.localsymtable:=nil;
 
-         If ResourceStringList<>Nil then
+         If ResourceStrings^.ResStrCount>0 then
           begin
-            insertresourcestrings;
+            ResourceStrings^.CreateResourceStringList;
             { only write if no errors found }
             if (Errorcount=0) then
-             WriteResourceFile(Current_module^.ModuleName^);
+             ResourceStrings^.WriteResourceFile(Current_module^.ModuleName^);
           end;
 
          codegen_doneprocedure;
@@ -1706,7 +1706,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.195  2000-05-11 09:40:11  pierre
+  Revision 1.196  2000-06-01 19:09:57  peter
+    * made resourcestrings OOP so it's easier to handle it per module
+
+  Revision 1.195  2000/05/11 09:40:11  pierre
     * some DBX changes but it still does not work !
 
   Revision 1.194  2000/05/08 13:18:09  peter

compiler/symsym.inc

@@ -1672,7 +1672,7 @@
          consttype.reset;
          len:=l;
          if t=constresourcestring then
-           ResStrIndex:=registerresourcestring(name,pchar(value),len);
+           ResStrIndex:=ResourceStrings^.Register(name,pchar(value),len);
       end;
 
     constructor tconstsym.load;
@@ -2162,7 +2162,10 @@
 
 {
   $Log$
-  Revision 1.146  2000-05-18 17:05:17  peter
+  Revision 1.147  2000-06-01 19:09:56  peter
+    * made resourcestrings OOP so it's easier to handle it per module
+
+  Revision 1.146  2000/05/18 17:05:17  peter
     * fixed size of const parameters in asm readers
 
   Revision 1.145  2000/05/03 14:34:05  pierre