cfac6e9fb4
(GNAT_ADA_OBJS): add g-crc32.o, a-tags.o, a-stream.o (GNATBIND_OBJS): add g-crc32.o, a-tags.o, a-stream.o (GNATLS_RTL_OBJS): add g-crc32.o (GNATMAKE_RTL_OBJS): add g-crc32.o * ali-util.adb: (CRC_Match): new function. (Get_File_Checksum): renamed Get_File_CRC. Use the GNAT.CRC32 unit instead of the previous simple checksum algorithm. (Time_Stamp_Mismatch): use CRC_Match for comparison. (Set_Source_Table): idem. * ali-util.ads: (Get_File_Checksum): renamed Get_File_CRC as now we compute CRC instead of simple checksum. (CRC_Match): new function. (CRC_Error): new constant. * ali.adb (Scan_ALI): rename variable Chk to CRC as we are handling a CRC now and not a simple checksum. A CRC uses lower-case hex letters, fixes ambiguity in parsing. * ali.ads (Sdep_Record.Checksum): renamed Sdep_Record.CRC as this is what this variable will store. * bcheck.adb: Change reference to chechsum in comments by CRC. (Check_Consistency): Rename Get_File_Checksum to Get_File_CRC. rename All_Checksum_Match to All_CRC_Match. Change due to API renaming since now GNAT does not use a simple checksum but a CRC using GNAT.CRC32. * gnatls.adb: Rename Checksum to CRC in many places, we use a CRC now and not anymore a simple checksum. * lib-load.adb: Use Source_CRC instead of Source_Checksum in many places. * lib-writ.adb (Write_ALI): Use Source_CRC instead of Source_Checksum. * scans.adb: (Restore_Scan_State): rename Checksum to CRC. (Save_Scan_State): idem. * scans.ads: With GNAT.CRC32. (Checksum): rename to CRC. (Saved_Scan_State): Save_Checksum field renamed to Save_CRC * scn-nlit.adb: Rename many Accumulate_Checksum to Update (from GNAT.CRC32). Update copyright notice. * scn-slit.adb: Rename many Accumulate_Checksum to Update (from GNAT.CRC32). Update copyright notice. * scn.adb: (Accumulate_Checksum): removed. (Update): new procedure. Add a wide-character into the CRC. * sinput-l.adb: (Complete_Source_File_Entry): use CRC32 instead of simple checksum. (Load_File): fix initialization of S (change Source_Checksum to Source_CRC) * sinput-p.adb (Load_Project_File): rename Source_Checksum to Source_CRC in S initialization. * sinput.adb (Source_Checksum): renamed to Source_CRC. * sinput.ads (Source_Checksum): renamed to Source_CRC. Update comments for the CRC. * types.adb (Hex): Use lowercase for the letter part. * types.ads (Get_Hex_String): Returns the hexadecimal representation for a word. This is currently used only for CRC. In previous version, the checksum was using a representation with all letter being upper-case. With the new implementation (using CRC) we do not remove the 32th bit of the CRC, so we can have an upper-case starting letter in the CRC. This is not possible to parse in Scan_ALI (ali.adb). It is ambigous since the CRC was optional and could be followed by options like EB, EE. So now this routines uses lower-case letter for the hexadecimal representation. Strange enough only lower case letters where checked in Scan_ALI (even if this was not a possible case). * gnatvsn.ads (Library_Version): changed to 3.15a. * s-crc32.ads: Initial version from GNAT.CRC32. This is the version for the compiler. * s-crc32.adb: Initial version from GNAT.CRC32. This is the version for the compiler. * ali-util.adb: Redo previous change to avoid using word CRC everywhere Add 2001 to copyright notice (Accumulate_Checksum): Modify to use System.CRC32. * ali-util.ads: Redo changes of previous revision to continue to use the word Checksum. Add 2001 to copyright notice. * ali.adb: Undo some of previous changes, not needed. Keep the change for lower case letters in the checksum. * ali.ads: Undo previous change not needed. * bcheck.adb: Undo most of previous change, not needed. But do use Checksums_Match for checksum comparison. * gnatls.adb: Undo most of previous change, not needed. But do use Checksums_Match for comparing checksums. * lib-load.adb: Undo previous change, not needed. * lib-writ.adb: Undo previous change, not needed. * lib-writ.ads: Document that checksums use lower case, not upper case letters. * scans.adb: Undo previous change, not needed * scans.ads: Undo previous change, not needed. * scn-nlit.adb: Undo previous changes, not needed. * scn-slit.adb: Undo previous change, not needed. Fix header format. * scn.adb: (Accumulate_Checksum): Use System.CRC32. (Initialize_Checksum): New procedure. Remove other changes of previous revision. * sinput-p.adb: Undo previous change, not needed. * sinput.adb: Undo previous change, not needed. * sinput-l.adb: Undo previous change, not needed. * sinput.ads: Undo previous change, not needed. Keep only comment on new checksum algorithm * Makefile.in: Add s-crc32 as needed, remove g-crc32. Also remove a-tags and a-stream from GNAT sources. * ali.adb (Scan_ALI): fix typo introduce in latest check-in. * Makefile.in (GNATRTL_NONTASKING_OBJS): Add g-crc32.o. From-SVN: r46206
236 lines
7.7 KiB
Ada
236 lines
7.7 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- T Y P E S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision$
|
|
-- --
|
|
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT 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 distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 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. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
package body Types is
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat;
|
|
-- Extract two decimal digit value from time stamp
|
|
|
|
---------
|
|
-- "<" --
|
|
---------
|
|
|
|
function "<" (Left, Right : Time_Stamp_Type) return Boolean is
|
|
begin
|
|
return not (Left = Right) and then String (Left) < String (Right);
|
|
end "<";
|
|
|
|
----------
|
|
-- "<=" --
|
|
----------
|
|
|
|
function "<=" (Left, Right : Time_Stamp_Type) return Boolean is
|
|
begin
|
|
return not (Left > Right);
|
|
end "<=";
|
|
|
|
---------
|
|
-- "=" --
|
|
---------
|
|
|
|
function "=" (Left, Right : Time_Stamp_Type) return Boolean is
|
|
Sleft : Nat;
|
|
Sright : Nat;
|
|
|
|
begin
|
|
if String (Left) = String (Right) then
|
|
return True;
|
|
|
|
elsif Left (1) = ' ' or else Right (1) = ' ' then
|
|
return False;
|
|
end if;
|
|
|
|
-- In the following code we check for a difference of 2 seconds or less
|
|
|
|
-- Recall that the time stamp format is:
|
|
|
|
-- Y Y Y Y M M D D H H M M S S
|
|
-- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
|
|
|
|
-- Note that we do not bother to worry about shifts in the day.
|
|
-- It seems unlikely that such shifts could ever occur in practice
|
|
-- and even if they do we err on the safe side, ie we say that the time
|
|
-- stamps are different.
|
|
|
|
Sright := V (Right, 13) + 60 * (V (Right, 11) + 60 * V (Right, 09));
|
|
Sleft := V (Left, 13) + 60 * (V (Left, 11) + 60 * V (Left, 09));
|
|
|
|
-- So the check is: dates must be the same, times differ 2 sec at most
|
|
|
|
return abs (Sleft - Sright) <= 2
|
|
and then String (Left (1 .. 8)) = String (Right (1 .. 8));
|
|
end "=";
|
|
|
|
---------
|
|
-- ">" --
|
|
---------
|
|
|
|
function ">" (Left, Right : Time_Stamp_Type) return Boolean is
|
|
begin
|
|
return not (Left = Right) and then String (Left) > String (Right);
|
|
end ">";
|
|
|
|
----------
|
|
-- ">=" --
|
|
----------
|
|
|
|
function ">=" (Left, Right : Time_Stamp_Type) return Boolean is
|
|
begin
|
|
return not (Left < Right);
|
|
end ">=";
|
|
|
|
-------------------
|
|
-- Get_Char_Code --
|
|
-------------------
|
|
|
|
function Get_Char_Code (C : Character) return Char_Code is
|
|
begin
|
|
return Char_Code'Val (Character'Pos (C));
|
|
end Get_Char_Code;
|
|
|
|
-------------------
|
|
-- Get_Character --
|
|
-------------------
|
|
|
|
-- Note: raises Constraint_Error if checks on and C out of range
|
|
|
|
function Get_Character (C : Char_Code) return Character is
|
|
begin
|
|
return Character'Val (C);
|
|
end Get_Character;
|
|
|
|
--------------------
|
|
-- Get_Hex_String --
|
|
--------------------
|
|
|
|
subtype Wordh is Word range 0 .. 15;
|
|
Hex : constant array (Wordh) of Character := "0123456789abcdef";
|
|
|
|
function Get_Hex_String (W : Word) return Word_Hex_String is
|
|
X : Word := W;
|
|
WS : Word_Hex_String;
|
|
|
|
begin
|
|
for J in reverse 1 .. 8 loop
|
|
WS (J) := Hex (X mod 16);
|
|
X := X / 16;
|
|
end loop;
|
|
|
|
return WS;
|
|
end Get_Hex_String;
|
|
|
|
------------------------
|
|
-- In_Character_Range --
|
|
------------------------
|
|
|
|
function In_Character_Range (C : Char_Code) return Boolean is
|
|
begin
|
|
return (C <= 255);
|
|
end In_Character_Range;
|
|
|
|
---------------------
|
|
-- Make_Time_Stamp --
|
|
---------------------
|
|
|
|
procedure Make_Time_Stamp
|
|
(Year : Nat;
|
|
Month : Nat;
|
|
Day : Nat;
|
|
Hour : Nat;
|
|
Minutes : Nat;
|
|
Seconds : Nat;
|
|
TS : out Time_Stamp_Type)
|
|
is
|
|
Z : constant := Character'Pos ('0');
|
|
|
|
begin
|
|
TS (01) := Character'Val (Z + Year / 1000);
|
|
TS (02) := Character'Val (Z + (Year / 100) mod 10);
|
|
TS (03) := Character'Val (Z + (Year / 10) mod 10);
|
|
TS (04) := Character'Val (Z + Year mod 10);
|
|
TS (05) := Character'Val (Z + Month / 10);
|
|
TS (06) := Character'Val (Z + Month mod 10);
|
|
TS (07) := Character'Val (Z + Day / 10);
|
|
TS (08) := Character'Val (Z + Day mod 10);
|
|
TS (09) := Character'Val (Z + Hour / 10);
|
|
TS (10) := Character'Val (Z + Hour mod 10);
|
|
TS (11) := Character'Val (Z + Minutes / 10);
|
|
TS (12) := Character'Val (Z + Minutes mod 10);
|
|
TS (13) := Character'Val (Z + Seconds / 10);
|
|
TS (14) := Character'Val (Z + Seconds mod 10);
|
|
end Make_Time_Stamp;
|
|
|
|
----------------------
|
|
-- Split_Time_Stamp --
|
|
----------------------
|
|
|
|
procedure Split_Time_Stamp
|
|
(TS : Time_Stamp_Type;
|
|
Year : out Nat;
|
|
Month : out Nat;
|
|
Day : out Nat;
|
|
Hour : out Nat;
|
|
Minutes : out Nat;
|
|
Seconds : out Nat)
|
|
is
|
|
|
|
begin
|
|
-- Y Y Y Y M M D D H H M M S S
|
|
-- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
|
|
|
|
Year := 100 * V (TS, 01) + V (TS, 03);
|
|
Month := V (TS, 05);
|
|
Day := V (TS, 07);
|
|
Hour := V (TS, 09);
|
|
Minutes := V (TS, 11);
|
|
Seconds := V (TS, 13);
|
|
end Split_Time_Stamp;
|
|
|
|
-------
|
|
-- V --
|
|
-------
|
|
|
|
function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat is
|
|
begin
|
|
return 10 * (Character'Pos (T (X)) - Character'Pos ('0')) +
|
|
Character'Pos (T (X + 1)) - Character'Pos ('0');
|
|
end V;
|
|
|
|
end Types;
|