File : templates_parser-cached_files.adb
------------------------------------------------------------------------------
-- Templates Parser --
-- --
-- Copyright (C) 1999 - 2001 --
-- Pascal Obry --
-- --
-- This library 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 library 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 library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- $Id: templates_parser-cached_files.adb,v 1.2 2004/02/24 15:40:18 Jano Exp $
separate (Templates_Parser)
package body Cached_Files is
Initial_Size : constant := 20; -- cache initial size
Growing_Size : constant := 50; -- cache growing size
type File_Array is array (Positive range <>) of Tree;
type File_Array_Access is access File_Array;
Files : File_Array_Access;
Index : Natural := 0;
procedure Growth;
-- Growth the size (by Growing_Size places) of Files array.
function Get (Filename : in String) return Natural;
-- Look for Filename into the set and return its index. Returns 0 if
-- filename was not found.
function Up_To_Date (T : in Tree) return Boolean;
-- Returns True if the file tree is up to date (the templates files
-- have not been modified on disk) or False otherwise.
protected body Prot is
---------
-- Add --
---------
procedure Add
(Filename : in String;
T : in Tree;
Old : out Tree)
is
L_Filename : constant Unbounded_String
:= To_Unbounded_String (Filename);
S : Natural := 1;
E : Natural := Index;
N : Natural;
begin
-- Does the table initialized and do we have enough place on it ?
if Files = null or else Index = Files'Last then
Growth;
end if;
loop
exit when S > E;
N := (S + E) / 2;
if Files (N).Filename = L_Filename then
-- This is a file that was already loaded. If loaded again
-- it is because the file timestamp has changed. We want to
-- just update the tree and not the info node.
Old := Files (N).Next;
-- This is a pointer to the C_Info tree node, skipping the
-- info node (first node).
Files (N).Next := T.Next;
Files (N).Timestamp := T.Timestamp;
-- This part is tricky, the tree could be currently used
-- (parsed). So we need to be careful to not release the tree
-- too early.
if Old.Used = 0 then
-- File is not currently used, we can release it safely.
Release (Old);
Old := T.Next;
else
-- Tree is used, mark it as obsoleted, it will be removed
-- when no more used by the Prot.Release call.
Old.Used := Old.Used + 1;
Old.Obsolete := True;
-- But current tree is not used, it has been posted here
-- for futur used. But if replaced right away it should be
-- freed.
Files (N).Next.Used := 0;
end if;
-- Nothing more to do in this case.
return;
elsif Files (N).Filename < L_Filename then
S := N + 1;
else
E := N - 1;
end if;
end loop;
-- Filename was not found, insert it in the array at position S
Files (S + 1 .. Index + 1) := Files (S .. Index);
Index := Index + 1;
Files (S) := T;
Old := T.Next;
-- Old point to the current C_Info tree.
end Add;
---------
-- Get --
---------
procedure Get
(Filename : in String;
Load : in Boolean;
Result : out Static_Tree)
is
N : constant Natural := Get (Filename);
begin
if N = 0 then
Result := (null, null);
else
if Load then
Files (N).Ref := Files (N).Ref + 1;
end if;
Files (N).Next.Used := Files (N).Next.Used + 1;
Result := (Files (N), Files (N).Next);
end if;
end Get;
-------------
-- Release --
-------------
procedure Release (T : in out Static_Tree) is
begin
pragma Assert (T.C_Info /= null);
T.C_Info.Used := T.C_Info.Used - 1;
if T.C_Info.Obsolete and then T.C_Info.Used = 0 then
pragma Assert (T.Info.Next /= T.C_Info);
Release (T.C_Info);
end if;
end Release;
end Prot;
---------
-- Get --
---------
function Get (Filename : in String) return Natural is
use type GNAT.OS_Lib.OS_Time;
L_Filename : constant Unbounded_String
:= To_Unbounded_String (Filename);
S : Natural := 1;
E : Natural := Index;
N : Natural;
begin
loop
exit when S > E;
N := (S + E) / 2;
if Files (N).Filename = L_Filename then
if Up_To_Date (Files (N)) then
return N;
else
-- File has changed on disk, we need to read it again. Just
-- pretend that the file was not found.
return 0;
end if;
elsif Files (N).Filename < L_Filename then
S := N + 1;
else
E := N - 1;
end if;
end loop;
return 0;
end Get;
------------
-- Growth --
------------
procedure Growth is
procedure Free is
new Ada.Unchecked_Deallocation (File_Array, File_Array_Access);
begin
if Files = null then
Files := new File_Array (1 .. Initial_Size);
else
declare
New_Array : File_Array_Access;
begin
New_Array := new File_Array (1 .. Files'Length + Growing_Size);
New_Array (1 .. Files'Length) := Files.all;
Free (Files);
Files := New_Array;
end;
end if;
end Growth;
----------------
-- Up_To_Date --
----------------
function Up_To_Date (T : in Tree) return Boolean is
use GNAT;
use type GNAT.OS_Lib.OS_Time;
P : Tree;
begin
-- Check main file
if OS_Lib.File_Time_Stamp (To_String (T.Filename)) /= T.Timestamp then
return False;
end if;
-- Check all include files
P := T.I_File;
while P /= null loop
if OS_Lib.File_Time_Stamp (To_String (P.File.Info.Filename))
/= P.File.Info.Timestamp
then
return False;
end if;
P := P.Next;
end loop;
return True;
end Up_To_Date;
end Cached_Files;