Commit cfac6e9f by Pascal Obry Committed by Geert Bosch

* Makefile.in:

	(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
parent 3d7a191f
2001-10-11 Pascal Obry <obry@gnat.com>
* Makefile.in:
(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.
2001-10-11 Geert Bosch <bosch@gnat.com>
* einfo.h: Regenerate.
......
......@@ -299,16 +299,16 @@ GNAT1_C_OBJS = b_gnat1.o adaint.o cstreams.o cio.o targtyps.o decl.o \
# Object files from Ada sources that are used by gnat1
GNAT_ADA_OBJS = \
ada.o a-charac.o a-chlat1.o a-except.o s-memory.o s-traceb.o s-mastop.o \
s-except.o ali.o alloc.o atree.o butil.o casing.o checks.o comperr.o \
csets.o cstand.o debug.o debug_a.o einfo.o elists.o errout.o eval_fat.o \
exp_attr.o exp_ch11.o exp_ch12.o exp_ch13.o exp_ch2.o exp_ch3.o exp_ch4.o \
exp_ch5.o exp_ch6.o exp_ch7.o exp_ch8.o exp_ch9.o exp_code.o exp_dbug.o \
exp_disp.o exp_dist.o exp_fixd.o exp_aggr.o exp_imgv.o \
ada.o a-charac.o a-chlat1.o a-except.o s-memory.o \
s-traceb.o s-mastop.o s-except.o ali.o alloc.o atree.o butil.o casing.o \
checks.o comperr.o csets.o cstand.o debug.o debug_a.o einfo.o elists.o \
errout.o eval_fat.o exp_attr.o exp_ch11.o exp_ch12.o exp_ch13.o exp_ch2.o \
exp_ch3.o exp_ch4.o exp_ch5.o exp_ch6.o exp_ch7.o exp_ch8.o exp_ch9.o \
exp_code.o exp_dbug.o exp_disp.o exp_dist.o exp_fixd.o exp_aggr.o exp_imgv.o \
exp_intr.o exp_pakd.o exp_prag.o exp_smem.o \
exp_strm.o exp_tss.o exp_util.o exp_vfpt.o expander.o fname.o fname-uf.o \
freeze.o frontend.o gnat.o g-hesora.o g-htable.o g-os_lib.o \
g-speche.o get_targ.o gnatvsn.o \
g-speche.o s-crc32.o get_targ.o gnatvsn.o \
hlo.o hostparm.o impunit.o \
interfac.o itypes.o inline.o krunch.o lib.o \
layout.o lib-load.o lib-util.o lib-xref.o lib-writ.o live.o \
......@@ -339,7 +339,7 @@ GNATBIND_OBJS = \
butil.o casing.o csets.o \
debug.o fname.o gnat.o g-hesora.o g-htable.o \
g-os_lib.o gnatbind.o gnatvsn.o hostparm.o \
krunch.o namet.o opt.o osint.o output.o rident.o s-assert.o \
krunch.o namet.o opt.o osint.o output.o rident.o s-crc32.o s-assert.o \
s-parame.o s-sopco3.o s-sopco4.o s-sopco5.o s-stache.o s-stalib.o \
s-stoele.o s-imgenu.o s-strops.o s-soflin.o s-wchcon.o s-wchjis.o \
sdefault.o switch.o stylesw.o validsw.o \
......@@ -392,7 +392,7 @@ GNATKR_RTL_OBJS = ada.o a-charac.o a-chahan.o a-chlat1.o a-comlin.o \
a-filico.o s-strops.o s-stratt.o s-imgenu.o a-ioexce.o s-exctab.o
GNATKR_OBJS = gnatkr.o gnatvsn.o \
krunch.o hostparm.o $(GNATKR_RTL_OBJS) $(EXTRA_GNATTOOLS_OBJS)
GNATLINK_RTL_OBJS = \
adaint.o argv.o cio.o cstreams.o \
exit.o init.o final.o raise.o tracebak.o \
......@@ -451,6 +451,7 @@ GNATLS_RTL_OBJS = \
system.o \
s-assert.o \
s-bitops.o \
s-crc32.o \
s-except.o \
s-exctab.o \
s-finroo.o \
......@@ -478,6 +479,7 @@ GNATLS_RTL_OBJS = \
s-wchcnv.o \
s-wchcon.o \
s-wchjis.o
GNATLS_OBJS = \
ali.o \
ali-util.o \
......@@ -553,7 +555,7 @@ GNATMAKE_RTL_OBJS = adaint.o argv.o raise.o exit.o a-comlin.o \
s-imgenu.o s-assert.o s-secsta.o s-stoele.o s-soflin.o s-fileio.o \
s-valenu.o s-valuti.o g-casuti.o \
system.o s-exctab.o s-strops.o s-sopco3.o s-sopco4.o s-sopco5.o \
g-htable.o g-regexp.o s-wchcnv.o
g-htable.o g-regexp.o s-crc32.o s-wchcnv.o
GNATMAKE_OBJS = ali.o ali-util.o \
alloc.o atree.o binderr.o butil.o casing.o csets.o debug.o einfo.o elists.o \
......@@ -1666,6 +1668,7 @@ GNATRTL_NONTASKING_OBJS= \
g-cgicoo.o \
g-cgideb.o \
g-comlin.o \
g-crc32.o \
g-curexc.o \
g-debuti.o \
g-debpoo.o \
......@@ -1715,6 +1718,7 @@ GNATRTL_NONTASKING_OBJS= \
s-auxdec.o \
s-bitops.o \
s-chepoo.o \
s-crc32.o \
s-direio.o \
s-errrep.o \
s-except.o \
......@@ -3930,6 +3934,8 @@ s-assert.o : ada.ads a-except.ads gnat.ads g-htable.ads system.ads \
s-bitops.o : gnat.ads g-except.ads system.ads s-bitops.ads s-bitops.adb \
s-unstyp.ads unchconv.ads
s-crc32.o : interfac.ads system.ads s-crc32.ads s-crc32.adb
s-except.o : ada.ads a-except.ads system.ads s-except.ads s-stalib.ads \
unchconv.ads
......
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- 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- --
......@@ -31,6 +31,8 @@ with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with System.CRC32;
package body ALI.Util is
-----------------------
......@@ -48,19 +50,27 @@ package body ALI.Util is
-- generate code, so it is not necessary to worry about making the right
-- sequence of calls in any error situation.
procedure Initialize_Checksum (Csum : in out Word);
-- Sets initial value of Csum before any calls to Accumulate_Checksum
-------------------------
-- Accumulate_Checksum --
-------------------------
procedure Accumulate_Checksum (C : Character; Csum : in out Word) is
begin
Csum := Csum + Csum + Character'Pos (C);
if Csum > 16#8000_0000# then
Csum := (Csum + 1) and 16#7FFF_FFFF#;
end if;
System.CRC32.Update (System.CRC32.CRC32 (Csum), C);
end Accumulate_Checksum;
---------------------
-- Checksums_Match --
---------------------
function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean is
begin
return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
end Checksums_Match;
-----------------------
-- Get_File_Checksum --
-----------------------
......@@ -101,7 +111,7 @@ package body ALI.Util is
raise Bad;
end if;
Csum := 0;
Initialize_Checksum (Csum);
Ptr := 0;
loop
......@@ -249,7 +259,7 @@ package body ALI.Util is
exception
when Bad =>
Free_Source;
return 16#FFFF_FFFF#;
return Checksum_Error;
end Get_File_Checksum;
......@@ -272,6 +282,15 @@ package body ALI.Util is
Source.Init;
end Initialize_ALI_Source;
-------------------------
-- Initialize_Checksum --
-------------------------
procedure Initialize_Checksum (Csum : in out Word) is
begin
System.CRC32.Initialize (System.CRC32.CRC32 (Csum));
end Initialize_Checksum;
--------------
-- Read_ALI --
--------------
......@@ -406,7 +425,9 @@ package body ALI.Util is
-- Update checksum flag
if Sdep.Table (D).Checksum /= Source.Table (S).Checksum then
if not Checksums_Match
(Sdep.Table (D).Checksum, Source.Table (S).Checksum)
then
Source.Table (S).All_Checksums_Match := False;
end if;
......@@ -492,8 +513,9 @@ package body ALI.Util is
-- ??? It is probably worth updating the ALI file with a new
-- field to avoid recomputing it each time.
if Get_File_Checksum (Sdep.Table (D).Sfile) =
Source.Table (Src).Checksum
if Checksums_Match
(Get_File_Checksum (Sdep.Table (D).Sfile),
Source.Table (Src).Checksum)
then
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
end if;
......
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- $Revision$
-- --
-- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
-- 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- --
......@@ -130,12 +130,26 @@ package ALI.Util is
-- Subprograms for manipulating checksums --
--------------------------------------------
Checksum_Error : constant Word := 16#FFFF_FFFF#;
-- This value is used to indicate an error in computing the checksum.
-- When comparing checksums for smart recompilation, the CRC_Error
-- value is never considered to match. This could possibly result
-- in a false negative, but that is never harmful, it just means
-- that in unusual cases an unnecessary recompilation occurs.
function Get_File_Checksum (Fname : Name_Id) return Word;
-- Compute checksum for the given file. As far as possible, this circuit
-- computes exactly the same value computed by the compiler, but it does
-- not matter if it gets it wrong in marginal cases, since the only result
-- is to miss some smart recompilation cases, correct functioning is not
-- affecte by a mis-computation. Returns an impossible checksum value,
-- with the upper bit set, if the file is missing or has an error.
-- affected by a miscomputation. Returns Checksum_Error if the file is
-- missing or has an error.
function Checksums_Match (Checksum1, Checksum2 : Word) return Boolean;
pragma Inline (Checksums_Match);
-- Returns True if Checksum1 and Checksum2 have the same value and are
-- not equal to Checksum_Error, returns False in all other cases. This
-- routine must always be used to compare for checksum equality, to
-- ensure that the case of Checksum_Error is handled properly.
end ALI.Util;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.124 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -1143,9 +1143,9 @@ package body ALI is
Chk := Chk * 16 +
Character'Pos (Nextc) - Character'Pos ('0');
elsif Nextc in 'A' .. 'F' then
elsif Nextc in 'a' .. 'f' then
Chk := Chk * 16 +
Character'Pos (Nextc) - Character'Pos ('A') + 10;
Character'Pos (Nextc) - Character'Pos ('a') + 10;
else
exit;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.39 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -511,8 +511,9 @@ package body Bcheck is
-- with the checksums in the ALI files.
elsif Check_Source_Files then
if Source.Table (S).Checksum /=
Get_File_Checksum (Source.Table (S).Sfile)
if not Checksums_Match
(Source.Table (S).Checksum,
Get_File_Checksum (Source.Table (S).Sfile))
then
Source.Table (S).All_Checksums_Match := False;
end if;
......
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- G N A T . C R C 3 2 --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Unchecked_Conversion;
package body GNAT.CRC32 is
------------
-- Update --
------------
procedure Update (C : in out CRC32; Value : String) is
begin
for K in Value'Range loop
Update (C, Value (K));
end loop;
end Update;
procedure Update (C : in out CRC32; Value : Ada.Streams.Stream_Element) is
function To_Char is new Unchecked_Conversion
(Ada.Streams.Stream_Element, Character);
V : constant Character := To_Char (Value);
begin
Update (C, V);
end Update;
procedure Update
(C : in out CRC32;
Value : Ada.Streams.Stream_Element_Array)
is
begin
for K in Value'Range loop
Update (C, Value (K));
end loop;
end Update;
-----------------
-- Wide_Update --
-----------------
procedure Wide_Update (C : in out CRC32; Value : Wide_Character) is
subtype S2 is String (1 .. 2);
function To_S2 is new Unchecked_Conversion (Wide_Character, S2);
VS : S2 := To_S2 (Value);
begin
Update (C, VS (1));
Update (C, VS (2));
end Wide_Update;
procedure Wide_Update (C : in out CRC32; Value : Wide_String) is
begin
for K in Value'Range loop
Wide_Update (C, Value (K));
end loop;
end Wide_Update;
end GNAT.CRC32;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- G N A T . C R C 3 2 --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package provides routines for computing a commonly used checksum
-- called CRC-32. This is a checksum based on treating the binary data
-- as a polynomial over a binary field, and the exact specifications of
-- the CRC-32 algorithm are as follows:
--
-- Name : "CRC-32"
-- Width : 32
-- Poly : 04C11DB7
-- Init : FFFFFFFF
-- RefIn : True
-- RefOut : True
-- XorOut : FFFFFFFF
-- Check : CBF43926
--
-- Note that this is the algorithm used by PKZip, Ethernet and FDDI.
--
-- For more information about this algorithm see:
--
-- ftp://ftp.rocksoft.com/papers/crc_v3.txt
-- "A Painless Guide to CRC Error Detection Algorithms", Ross N. Williams
--
-- "Computation of Cyclic Redundancy Checks via Table Look-Up", Communications
-- of the ACM, Vol. 31 No. 8, pp.1008-1013 Aug. 1988. Sarwate, D.V.
with Ada.Streams;
with Interfaces;
with System.CRC32;
package GNAT.CRC32 is
subtype CRC32 is System.CRC32.CRC32;
-- Used to represent CRC32 values, which are 32 bit bit-strings
procedure Initialize (C : out CRC32)
renames System.CRC32.Initialize;
-- Initialize CRC value by assigning the standard Init value (16#FFFF_FFFF)
procedure Update
(C : in out CRC32;
Value : Character)
renames System.CRC32.Update;
-- Evolve CRC by including the contribution from Character'Pos (Value)
procedure Update
(C : in out CRC32;
Value : String);
pragma Inline (Update);
-- For each character in the Value string call above routine
procedure Wide_Update
(C : in out CRC32;
Value : Wide_Character);
pragma Inline (Update);
-- Evolve CRC by including the contribution from Wide_Character'Pos (Value)
-- with the bytes being included in the natural memory order.
procedure Wide_Update
(C : in out CRC32;
Value : Wide_String);
pragma Inline (Update);
-- For each character in the Value string call above routine
procedure Update
(C : in out CRC32;
Value : Ada.Streams.Stream_Element);
pragma Inline (Update);
-- Evolve CRC by including the contribution from Value
procedure Update
(C : in out CRC32;
Value : Ada.Streams.Stream_Element_Array);
pragma Inline (Update);
-- For each element in the Value array call above routine
function Get_Value (C : CRC32) return Interfaces.Unsigned_32
renames System.CRC32.Get_Value;
-- Get_Value computes the CRC32 value by performing an XOR with the
-- standard XorOut value (16#FFFF_FFFF). Note that this does not
-- change the value of C, so it may be used to retrieve intermediate
-- values of the CRC32 value during a sequence of Update calls.
end GNAT.CRC32;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.37 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -352,7 +352,7 @@ procedure Gnatls is
FS := Tmp1;
Status := OK;
elsif Get_File_Checksum (FS) = Checksum then
elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
FS := Tmp1;
Status := Checksum_OK;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.2068 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -54,7 +54,7 @@ package Gnatvsn is
-- value should never be decreased in the future, but it would be
-- OK to increase it if absolutely necessary.
Library_Version : constant String := "GNAT Lib v3.15 ";
Library_Version : constant String := "GNAT Lib v3.15a";
-- Library version. This value must be updated whenever any change to the
-- compiler affects the library formats in such a way as to obsolete
-- previously compiled library modules.
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.14 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -411,7 +411,7 @@ package Lib.Writ is
-- time stamp representation.
-- The checksum is an 8-hex digit representation of the source
-- file checksum, with letters given in upper case.
-- file checksum, with letters given in lower case.
-- The subunit name is present only if the dependency line is for
-- a subunit. It contains the fully qualified name of the subunit
......
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- S Y S T E M . C R C 3 2 --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package body System.CRC32 is
Init : constant CRC32 := 16#FFFF_FFFF#; -- Initial value
XorOut : constant CRC32 := 16#FFFF_FFFF#; -- To compute final result.
-- The following table contains precomputed values for contributions
-- from various possible byte values. Doing a table lookup is quicker
-- than processing the byte bit by bit.
Table : array (CRC32 range 0 .. 255) of CRC32 :=
(16#0000_0000#, 16#7707_3096#, 16#EE0E_612C#, 16#9909_51BA#,
16#076D_C419#, 16#706A_F48F#, 16#E963_A535#, 16#9E64_95A3#,
16#0EDB_8832#, 16#79DC_B8A4#, 16#E0D5_E91E#, 16#97D2_D988#,
16#09B6_4C2B#, 16#7EB1_7CBD#, 16#E7B8_2D07#, 16#90BF_1D91#,
16#1DB7_1064#, 16#6AB0_20F2#, 16#F3B9_7148#, 16#84BE_41DE#,
16#1ADA_D47D#, 16#6DDD_E4EB#, 16#F4D4_B551#, 16#83D3_85C7#,
16#136C_9856#, 16#646B_A8C0#, 16#FD62_F97A#, 16#8A65_C9EC#,
16#1401_5C4F#, 16#6306_6CD9#, 16#FA0F_3D63#, 16#8D08_0DF5#,
16#3B6E_20C8#, 16#4C69_105E#, 16#D560_41E4#, 16#A267_7172#,
16#3C03_E4D1#, 16#4B04_D447#, 16#D20D_85FD#, 16#A50A_B56B#,
16#35B5_A8FA#, 16#42B2_986C#, 16#DBBB_C9D6#, 16#ACBC_F940#,
16#32D8_6CE3#, 16#45DF_5C75#, 16#DCD6_0DCF#, 16#ABD1_3D59#,
16#26D9_30AC#, 16#51DE_003A#, 16#C8D7_5180#, 16#BFD0_6116#,
16#21B4_F4B5#, 16#56B3_C423#, 16#CFBA_9599#, 16#B8BD_A50F#,
16#2802_B89E#, 16#5F05_8808#, 16#C60C_D9B2#, 16#B10B_E924#,
16#2F6F_7C87#, 16#5868_4C11#, 16#C161_1DAB#, 16#B666_2D3D#,
16#76DC_4190#, 16#01DB_7106#, 16#98D2_20BC#, 16#EFD5_102A#,
16#71B1_8589#, 16#06B6_B51F#, 16#9FBF_E4A5#, 16#E8B8_D433#,
16#7807_C9A2#, 16#0F00_F934#, 16#9609_A88E#, 16#E10E_9818#,
16#7F6A_0DBB#, 16#086D_3D2D#, 16#9164_6C97#, 16#E663_5C01#,
16#6B6B_51F4#, 16#1C6C_6162#, 16#8565_30D8#, 16#F262_004E#,
16#6C06_95ED#, 16#1B01_A57B#, 16#8208_F4C1#, 16#F50F_C457#,
16#65B0_D9C6#, 16#12B7_E950#, 16#8BBE_B8EA#, 16#FCB9_887C#,
16#62DD_1DDF#, 16#15DA_2D49#, 16#8CD3_7CF3#, 16#FBD4_4C65#,
16#4DB2_6158#, 16#3AB5_51CE#, 16#A3BC_0074#, 16#D4BB_30E2#,
16#4ADF_A541#, 16#3DD8_95D7#, 16#A4D1_C46D#, 16#D3D6_F4FB#,
16#4369_E96A#, 16#346E_D9FC#, 16#AD67_8846#, 16#DA60_B8D0#,
16#4404_2D73#, 16#3303_1DE5#, 16#AA0A_4C5F#, 16#DD0D_7CC9#,
16#5005_713C#, 16#2702_41AA#, 16#BE0B_1010#, 16#C90C_2086#,
16#5768_B525#, 16#206F_85B3#, 16#B966_D409#, 16#CE61_E49F#,
16#5EDE_F90E#, 16#29D9_C998#, 16#B0D0_9822#, 16#C7D7_A8B4#,
16#59B3_3D17#, 16#2EB4_0D81#, 16#B7BD_5C3B#, 16#C0BA_6CAD#,
16#EDB8_8320#, 16#9ABF_B3B6#, 16#03B6_E20C#, 16#74B1_D29A#,
16#EAD5_4739#, 16#9DD2_77AF#, 16#04DB_2615#, 16#73DC_1683#,
16#E363_0B12#, 16#9464_3B84#, 16#0D6D_6A3E#, 16#7A6A_5AA8#,
16#E40E_CF0B#, 16#9309_FF9D#, 16#0A00_AE27#, 16#7D07_9EB1#,
16#F00F_9344#, 16#8708_A3D2#, 16#1E01_F268#, 16#6906_C2FE#,
16#F762_575D#, 16#8065_67CB#, 16#196C_3671#, 16#6E6B_06E7#,
16#FED4_1B76#, 16#89D3_2BE0#, 16#10DA_7A5A#, 16#67DD_4ACC#,
16#F9B9_DF6F#, 16#8EBE_EFF9#, 16#17B7_BE43#, 16#60B0_8ED5#,
16#D6D6_A3E8#, 16#A1D1_937E#, 16#38D8_C2C4#, 16#4FDF_F252#,
16#D1BB_67F1#, 16#A6BC_5767#, 16#3FB5_06DD#, 16#48B2_364B#,
16#D80D_2BDA#, 16#AF0A_1B4C#, 16#3603_4AF6#, 16#4104_7A60#,
16#DF60_EFC3#, 16#A867_DF55#, 16#316E_8EEF#, 16#4669_BE79#,
16#CB61_B38C#, 16#BC66_831A#, 16#256F_D2A0#, 16#5268_E236#,
16#CC0C_7795#, 16#BB0B_4703#, 16#2202_16B9#, 16#5505_262F#,
16#C5BA_3BBE#, 16#B2BD_0B28#, 16#2BB4_5A92#, 16#5CB3_6A04#,
16#C2D7_FFA7#, 16#B5D0_CF31#, 16#2CD9_9E8B#, 16#5BDE_AE1D#,
16#9B64_C2B0#, 16#EC63_F226#, 16#756A_A39C#, 16#026D_930A#,
16#9C09_06A9#, 16#EB0E_363F#, 16#7207_6785#, 16#0500_5713#,
16#95BF_4A82#, 16#E2B8_7A14#, 16#7BB1_2BAE#, 16#0CB6_1B38#,
16#92D2_8E9B#, 16#E5D5_BE0D#, 16#7CDC_EFB7#, 16#0BDB_DF21#,
16#86D3_D2D4#, 16#F1D4_E242#, 16#68DD_B3F8#, 16#1FDA_836E#,
16#81BE_16CD#, 16#F6B9_265B#, 16#6FB0_77E1#, 16#18B7_4777#,
16#8808_5AE6#, 16#FF0F_6A70#, 16#6606_3BCA#, 16#1101_0B5C#,
16#8F65_9EFF#, 16#F862_AE69#, 16#616B_FFD3#, 16#166C_CF45#,
16#A00A_E278#, 16#D70D_D2EE#, 16#4E04_8354#, 16#3903_B3C2#,
16#A767_2661#, 16#D060_16F7#, 16#4969_474D#, 16#3E6E_77DB#,
16#AED1_6A4A#, 16#D9D6_5ADC#, 16#40DF_0B66#, 16#37D8_3BF0#,
16#A9BC_AE53#, 16#DEBB_9EC5#, 16#47B2_CF7F#, 16#30B5_FFE9#,
16#BDBD_F21C#, 16#CABA_C28A#, 16#53B3_9330#, 16#24B4_A3A6#,
16#BAD0_3605#, 16#CDD7_0693#, 16#54DE_5729#, 16#23D9_67BF#,
16#B366_7A2E#, 16#C461_4AB8#, 16#5D68_1B02#, 16#2A6F_2B94#,
16#B40B_BE37#, 16#C30C_8EA1#, 16#5A05_DF1B#, 16#2D02_EF8D#);
---------------
-- Get_Value --
---------------
function Get_Value (C : CRC32) return Interfaces.Unsigned_32 is
begin
return Interfaces.Unsigned_32 (C xor XorOut);
end Get_Value;
----------------
-- Initialize --
----------------
procedure Initialize (C : out CRC32) is
begin
C := Init;
end Initialize;
------------
-- Update --
------------
procedure Update (C : in out CRC32; Value : Character) is
V : constant CRC32 := CRC32 (Character'Pos (Value));
begin
C := Shift_Right (C, 8) xor Table (V xor (C and 16#0000_00FF#));
end Update;
end System.CRC32;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- S Y S T E M . C R C 3 2 --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 Ada Core Technologies, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package provides routines for computing a commonly used checksum
-- called CRC-32. This is a checksum based on treating the binary data
-- as a polynomial over a binary field, and the exact specifications of
-- the CRC-32 algorithm are as follows:
--
-- Name : "CRC-32"
-- Width : 32
-- Poly : 04C11DB7
-- Init : FFFFFFFF
-- RefIn : True
-- RefOut : True
-- XorOut : FFFFFFFF
-- Check : CBF43926
--
-- Note that this is the algorithm used by PKZip, Ethernet and FDDI.
--
-- For more information about this algorithm see:
--
-- ftp://ftp.rocksoft.com/papers/crc_v3.txt
-- "A Painless Guide to CRC Error Detection Algorithms", Ross N. Williams
--
-- "Computation of Cyclic Redundancy Checks via Table Look-Up", Communications
-- of the ACM, Vol. 31 No. 8, pp.1008-1013 Aug. 1988. Sarwate, D.V.
with Interfaces;
package System.CRC32 is
type CRC32 is new Interfaces.Unsigned_32;
-- Used to represent CRC32 values, which are 32 bit bit-strings
procedure Initialize (C : out CRC32);
pragma Inline (Initialize);
-- Initialize CRC value by assigning the standard Init value (16#FFFF_FFFF)
procedure Update
(C : in out CRC32;
Value : Character);
pragma Inline (Update);
-- Evolve CRC by including the contribution from Character'Pos (Value)
function Get_Value (C : CRC32) return Interfaces.Unsigned_32;
pragma Inline (Get_Value);
-- Get_Value computes the CRC32 value by performing an XOR with the
-- standard XorOut value (16#FFFF_FFFF). Note that this does not
-- change the value of C, so it may be used to retrieve intermediate
-- values of the CRC32 value during a sequence of Update calls.
end System.CRC32;
......@@ -6,9 +6,9 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.32 $
-- $Revision$
-- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
-- 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- --
......@@ -34,6 +34,7 @@
------------------------------------------------------------------------------
with Types; use Types;
package Scans is
-- The scanner maintains a current state in the global variables defined
......@@ -342,8 +343,8 @@ package Scans is
-- recovery circuits which depend on looking at the column line up.
Checksum : Word;
-- Used to accumulate a checksum representing the tokens in the source
-- file being compiled. This checksum includes only program tokens, and
-- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and
-- excludes comments.
First_Non_Blank_Location : Source_Ptr;
......
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.32 $ --
-- $Revision$ --
-- --
-- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. --
-- 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- --
......
......@@ -6,9 +6,9 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.29 $ --
-- $Revision$
-- --
-- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
-- 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- --
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.111 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -39,6 +39,7 @@ with Snames; use Snames;
with Style;
with Widechar; use Widechar;
with System.CRC32;
with System.WCh_Con; use System.WCh_Con;
package body Scn is
......@@ -73,6 +74,10 @@ package body Scn is
-- are scanned. We use the character code rather than the ASCII characters
-- so that the checksum is independent of wide character encoding method.
procedure Initialize_Checksum;
pragma Inline (Initialize_Checksum);
-- Initialize checksum value
procedure Check_End_Of_Line;
-- Called when end of line encountered. Checks that line is not
-- too long, and that other style checks for the end of line are met.
......@@ -135,20 +140,13 @@ package body Scn is
procedure Accumulate_Checksum (C : Character) is
begin
Checksum := Checksum + Checksum + Character'Pos (C);
if Checksum > 16#8000_0000# then
Checksum := (Checksum + 1) and 16#7FFF_FFFF#;
end if;
System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
end Accumulate_Checksum;
procedure Accumulate_Checksum (C : Char_Code) is
begin
Checksum := Checksum + Checksum + Char_Code'Pos (C);
if Checksum > 16#8000_0000# then
Checksum := (Checksum + 1) and 16#7FFF_FFFF#;
end if;
Accumulate_Checksum (Character'Val (C / 256));
Accumulate_Checksum (Character'Val (C mod 256));
end Accumulate_Checksum;
-----------------------
......@@ -367,6 +365,15 @@ package body Scn is
Error_Msg_S ("two consecutive underlines not permitted");
end Error_No_Double_Underline;
-------------------------
-- Initialize_Checksum --
-------------------------
procedure Initialize_Checksum is
begin
System.CRC32.Initialize (System.CRC32.CRC32 (Checksum));
end Initialize_Checksum;
------------------------
-- Initialize_Scanner --
------------------------
......@@ -465,7 +472,8 @@ package body Scn is
Token_Name := No_Name;
Start_Column := Set_Start_Column;
First_Non_Blank_Location := Scan_Ptr;
Checksum := 0;
Initialize_Checksum;
-- Set default for Comes_From_Source. All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.69 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -274,34 +274,18 @@ package Sinput is
-- minus-minus sequence starting a comment, and all control characters
-- except ESC.
-- These characters are used to compute a 31-bit checksum which is stored
-- in the variable Scans.Checksum, as follows:
-- If a character, C, is not part of a wide character sequence, then
-- either the character itself, or its lower case equivalent if it
-- is a letter outside a string literal is used in the computation:
-- Checksum := Checksum + Checksum + Character'Pos (C);
-- if Checksum > 16#8000_0000# then
-- Checksum := (Checksum + 1) and 16#7FFF_FFFF#;
-- end if;
-- For a wide character sequence, the checksum is computed using the
-- corresponding character code value C, as follows:
-- Checksum := Checksum + Checksum + Char_Code'Pos (C);
-- if Checksum > 16#8000_0000# then
-- Checksum := (Checksum + 1) and 16#7FFF_FFFF#;
-- end if;
-- The checksum algorithm used is the standard CRC-32 algorithm, as
-- implemented by System.CRC32, except that we do not bother with the
-- final XOR with all 1 bits.
-- This algorithm ensures that the checksum includes all semantically
-- significant aspects of the program represented by the source file,
-- but is insensitive to layout, presence or contents of comments, wide
-- character representation method, or casing conventions outside strings.
-- Scans.Checksum is initialized to zero at the start of scanning a file,
-- and copied into the Source_Checksum field of the file table entry when
-- the end of file is encountered.
-- Scans.Checksum is initialized appropriately at the start of scanning
-- a file, and copied into the Source_Checksum field of the file table
-- entry when the end of file is encountered.
-------------------------------------
-- Handling Generic Instantiations --
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.20 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -140,7 +140,7 @@ package body Types is
--------------------
subtype Wordh is Word range 0 .. 15;
Hex : constant array (Wordh) of Character := "0123456789ABCDEF";
Hex : constant array (Wordh) of Character := "0123456789abcdef";
function Get_Hex_String (W : Word) return Word_Hex_String is
X : Word := W;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.87 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -121,7 +121,7 @@ pragma Preelaborate (Types);
-- Procedure for freeing dynamically allocated String values
subtype Word_Hex_String is String (1 .. 8);
-- Type used to represent Word value as 8 hex digits, with upper case
-- Type used to represent Word value as 8 hex digits, with lower case
-- letters for the alphabetic cases.
function Get_Hex_String (W : Word) return Word_Hex_String;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment