This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Use CRC32 checksum for "smart" consistency checking
- To: gcc-patches at gcc dot gnu dot org
- Subject: [Ada] Use CRC32 checksum for "smart" consistency checking
- From: Geert Bosch <bosch at gnat dot com>
- Date: Thu, 11 Oct 2001 19:30:00 -0400 (EDT)
The following patch replaces the too simple checksum algorithm,
which GNAT uses for "smart" make, by a standard CRC32 one.
The final change is smaller than what would appear from the patch,
as this patch includes all revisions made during development.
-Geert
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.
*** Makefile.in 2001/09/25 02:53:14 1.1404
--- Makefile.in 2001/09/27 09:51:43 1.1405
***************
*** 1652,1657 ****
--- 1652,1658 ----
g-cgicoo.o \
g-cgideb.o \
g-comlin.o \
+ g-crc32.o \
g-curexc.o \
g-debuti.o \
g-debpoo.o \
*** Makefile.in 2001/09/27 09:51:43 1.1405
--- Makefile.in 2001/09/28 19:29:06 1.1406
***************
*** 284,299 ****
# 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 \
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 \
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 \
--- 284,299 ----
# Object files from Ada sources that are used by gnat1
GNAT_ADA_OBJS = \
! ada.o a-charac.o a-chlat1.o a-except.o a-tags.o s-memory.o a-stream.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 g-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,345 ****
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 \
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 \
--- 339,345 ----
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-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 \
***************
*** 377,383 ****
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 = \
a-adaint.o a-argv.o a-cio.o a-cstrea.o \
a-exit.o a-init.o a-final.o a-raise.o a-traceb.o \
--- 379,385 ----
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 = \
a-adaint.o a-argv.o a-cio.o a-cstrea.o \
a-exit.o a-init.o a-final.o a-raise.o a-traceb.o \
***************
*** 425,430 ****
--- 427,433 ----
a-traceb.o \
gnat.o \
g-casuti.o \
+ g-crc32.o \
g-dirope.o \
g-except.o \
g-hesora.o \
***************
*** 463,468 ****
--- 466,472 ----
s-wchcnv.o \
s-wchcon.o \
s-wchjis.o
+
GNATLS_OBJS = \
ali.o \
ali-util.o \
***************
*** 538,544 ****
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
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 \
--- 542,548 ----
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 g-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 \
*** ali-util.adb 2000/12/19 19:34:14 1.7
--- ali-util.adb 2001/09/28 19:30:41 1.8
***************
*** 8,14 ****
-- --
-- $Revision$
-- --
! -- Copyright (C) 1992-2000 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- --
--- 8,14 ----
-- --
-- $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- --
***************
*** 31,76 ****
with Opt; use Opt;
with Osint; use Osint;
! package body ALI.Util is
! -----------------------
! -- Local Subprograms --
! -----------------------
!
! procedure Accumulate_Checksum (C : Character; Csum : in out Word);
! pragma Inline (Accumulate_Checksum);
! -- This routine accumulates the checksum given character C. During the
! -- scanning of a source file, this routine is called with every character
! -- in the source, excluding blanks, and all control characters (except
! -- that ESC is included in the checksum). Upper case letters not in string
! -- literals are folded by the caller. See Sinput spec for the documentation
! -- of the checksum algorithm. Note: checksum values are only used if we
! -- generate code, so it is not necessary to worry about making the right
! -- sequence of calls in any error situation.
! -------------------------
! -- 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;
! end Accumulate_Checksum;
!
! -----------------------
! -- Get_File_Checksum --
! -----------------------
! function Get_File_Checksum (Fname : Name_Id) return Word is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
- Csum : Word;
Ptr : Source_Ptr;
Bad : exception;
-- Raised if file not found, or file format error
--- 31,68 ----
with Opt; use Opt;
with Osint; use Osint;
! with GNAT.CRC32; use GNAT.CRC32;
! package body ALI.Util is
! ---------------
! -- CRC_Match --
! ---------------
! function CRC_Match (CRC1, CRC2 : Word) return Boolean is
begin
! return (CRC1 = CRC2) and then (CRC1 /= CRC_Error);
! end CRC_Match;
! ------------------
! -- Get_File_CRC --
! ------------------
! function Get_File_CRC (Fname : Name_Id) return Word is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
Ptr : Source_Ptr;
+ CRC : CRC32;
+ -- This variable accumulates the CRC given character C. During the
+ -- scanning of a source file, this variable gets updated with every
+ -- character in the source, excluding blanks, and all control
+ -- characters (except that ESC is included in the CRC). Upper case
+ -- letters not in string literals are folded by the caller. See Sinput
+ -- spec for the documentation of the CRC algorithm. Note: CRC values
+ -- are only used if we generate code, so it is not necessary to worry
+ -- about making the right sequence of calls in any error situation.
+
Bad : exception;
-- Raised if file not found, or file format error
***************
*** 94,107 ****
Read_Source_File (Fname, 0, Hi, Src);
-- If we cannot find the file, then return an impossible checksum,
! -- impossible becaues checksums have the high order bit zero, so
-- that checksums do not match.
if Src = null then
raise Bad;
end if;
- Csum := 0;
Ptr := 0;
loop
--- 86,100 ----
Read_Source_File (Fname, 0, Hi, Src);
-- If we cannot find the file, then return an impossible checksum,
! -- impossible because checksums have the high order bit zero, so
-- that checksums do not match.
if Src = null then
raise Bad;
end if;
+
+ Initialize (CRC);
Ptr := 0;
loop
***************
*** 117,123 ****
when EOF =>
if Ptr = Hi then
Free_Source;
! return Csum;
else
Ptr := Ptr + 1;
end if;
--- 110,116 ----
when EOF =>
if Ptr = Hi then
Free_Source;
! return Word (Get_Value (CRC));
else
Ptr := Ptr + 1;
end if;
***************
*** 128,141 ****
'<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
'0' .. '9' | 'a' .. 'z'
=>
! Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
-- Upper case letters, fold to lower case
when 'A' .. 'Z' =>
! Accumulate_Checksum
! (Character'Val (Character'Pos (Src (Ptr)) + 32), Csum);
Ptr := Ptr + 1;
-- Left bracket, really should do wide character thing here,
--- 121,133 ----
'<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
'0' .. '9' | 'a' .. 'z'
=>
! Update (CRC, Src (Ptr));
Ptr := Ptr + 1;
-- Upper case letters, fold to lower case
when 'A' .. 'Z' =>
! Update (CRC, Character'Val (Character'Pos (Src (Ptr)) + 32));
Ptr := Ptr + 1;
-- Left bracket, really should do wide character thing here,
***************
*** 155,168 ****
end loop;
else
! Accumulate_Checksum ('-', Csum);
Ptr := Ptr + 1;
end if;
-- String delimited by double quote
when '"' =>
! Accumulate_Checksum ('"', Csum);
loop
Ptr := Ptr + 1;
--- 147,160 ----
end loop;
else
! Update (CRC, '-');
Ptr := Ptr + 1;
end if;
-- String delimited by double quote
when '"' =>
! Update (CRC, '"');
loop
Ptr := Ptr + 1;
***************
*** 172,187 ****
raise Bad;
end if;
! Accumulate_Checksum (Src (Ptr), Csum);
end loop;
! Accumulate_Checksum ('"', Csum);
Ptr := Ptr + 1;
-- String delimited by percent
when '%' =>
! Accumulate_Checksum ('%', Csum);
loop
Ptr := Ptr + 1;
--- 164,179 ----
raise Bad;
end if;
! Update (CRC, Src (Ptr));
end loop;
! Update (CRC, '"');
Ptr := Ptr + 1;
-- String delimited by percent
when '%' =>
! Update (CRC, '%');
loop
Ptr := Ptr + 1;
***************
*** 191,210 ****
raise Bad;
end if;
! Accumulate_Checksum (Src (Ptr), Csum);
end loop;
! Accumulate_Checksum ('%', Csum);
Ptr := Ptr + 1;
-- Quote, could be character constant
when ''' =>
! Accumulate_Checksum (''', Csum);
if Src (Ptr + 2) = ''' then
! Accumulate_Checksum (Src (Ptr + 1), Csum);
! Accumulate_Checksum (''', Csum);
Ptr := Ptr + 3;
-- Otherwise assume attribute char. We should deal with wide
--- 183,202 ----
raise Bad;
end if;
! Update (CRC, Src (Ptr));
end loop;
! Update (CRC, '%');
Ptr := Ptr + 1;
-- Quote, could be character constant
when ''' =>
! Update (CRC, ''');
if Src (Ptr + 2) = ''' then
! Update (CRC, Src (Ptr + 1));
! Update (CRC, ''');
Ptr := Ptr + 3;
-- Otherwise assume attribute char. We should deal with wide
***************
*** 219,225 ****
-- dealing with the nasty case of upper half wide encoding.
when Upper_Half_Character =>
! Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
-- Escape character, we should do the wide character thing here,
--- 211,217 ----
-- dealing with the nasty case of upper half wide encoding.
when Upper_Half_Character =>
! Update (CRC, Src (Ptr));
Ptr := Ptr + 1;
-- Escape character, we should do the wide character thing here,
***************
*** 249,257 ****
exception
when Bad =>
Free_Source;
! return 16#FFFF_FFFF#;
! end Get_File_Checksum;
---------------------------
-- Initialize_ALI_Source --
--- 241,249 ----
exception
when Bad =>
Free_Source;
! return CRC_Error;
! end Get_File_CRC;
---------------------------
-- Initialize_ALI_Source --
***************
*** 358,365 ****
-- Initialize checksum fields
! Source.Table (S).Checksum := Sdep.Table (D).Checksum;
! Source.Table (S).All_Checksums_Match := True;
-- In check source files mode, try to get time stamp from file
--- 350,357 ----
-- Initialize checksum fields
! Source.Table (S).CRC := Sdep.Table (D).CRC;
! Source.Table (S).All_CRC_Match := True;
-- In check source files mode, try to get time stamp from file
***************
*** 404,413 ****
else
S := Source_Id (Get_Name_Table_Info (F));
! -- Update checksum flag
! if Sdep.Table (D).Checksum /= Source.Table (S).Checksum then
! Source.Table (S).All_Checksums_Match := False;
end if;
-- Check for time stamp mismatch
--- 396,405 ----
else
S := Source_Id (Get_Name_Table_Info (F));
! -- Update CRC flag
! if not CRC_Match (Sdep.Table (D).CRC, Source.Table (S).CRC) then
! Source.Table (S).All_CRC_Match := False;
end if;
-- Check for time stamp mismatch
***************
*** 449,458 ****
end if;
end if;
! -- Set the checksum value in the source table
S := Source_Id (Get_Name_Table_Info (F));
! Source.Table (S).Checksum := Sdep.Table (D).Checksum;
end loop Sdep_Loop;
--- 441,450 ----
end if;
end if;
! -- Set the CRC value in the source table
S := Source_Id (Get_Name_Table_Info (F));
! Source.Table (S).CRC := Sdep.Table (D).CRC;
end loop Sdep_Loop;
***************
*** 487,499 ****
then
-- If minimal recompilation is in action, replace the stamp
! -- of the source file in the table if checksums match.
-- ??? 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
then
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
end if;
--- 479,491 ----
then
-- If minimal recompilation is in action, replace the stamp
! -- of the source file in the table if CRC match.
-- ??? It is probably worth updating the ALI file with a new
-- field to avoid recomputing it each time.
! if CRC_Match
! (Get_File_CRC (Sdep.Table (D).Sfile), Source.Table (Src).CRC)
then
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
end if;
*** ali-util.ads 1999/04/07 00:19:32 1.2
--- ali-util.ads 2001/09/28 19:31:34 1.3
***************
*** 8,14 ****
-- --
-- $Revision$ --
-- --
! -- Copyright (C) 1992-1999 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- --
--- 8,14 ----
-- --
-- $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- --
***************
*** 65,91 ****
-- This flag is set only if all files referencing this source file
-- have a matching time stamp, and also, if Source_Found is True,
-- then the stamp of the source file also matches. If this flag is
! -- True, then checksums for this file are never referenced. We only
! -- use checksums if there are time stamp mismatches.
! All_Checksums_Match : Boolean;
-- This flag is set only if all files referencing this source file
! -- have checksums, and if all these checksums match. If this flag
! -- is set to True, then the binder will ignore a timestamp mismatch.
! -- An absent checksum causes this flag to be set False, and a mismatch
! -- of checksums also causes it to be set False. The checksum of the
! -- actual source file (if Source_Found is True) is included only if
! -- All_Timestamps_Match is False (since checksums are only interesting
! -- if we have time stamp mismatches, and we want to avoid computing the
! -- checksum of the source file if it is not needed.)
! Checksum : Word;
! -- If no dependency line has a checksum for this source file (i.e. the
-- corresponding entries in the source dependency records all have the
! -- Checksum_Present flag set False), then this field is undefined. If
! -- at least one dependency entry has a checksum present, then this
! -- field contains one of the possible checksum values that has been
! -- seen. This is used to set All_Checksums_Match properly.
end record;
--- 65,91 ----
-- This flag is set only if all files referencing this source file
-- have a matching time stamp, and also, if Source_Found is True,
-- then the stamp of the source file also matches. If this flag is
! -- True, then CRC for this file are never referenced. We only
! -- use CRC if there are time stamp mismatches.
! All_CRC_Match : Boolean;
-- This flag is set only if all files referencing this source file
! -- have CRC, and if all these CRC match. If this flag is set to True,
! -- then the binder will ignore a timestamp mismatch. An absent CRC
! -- causes this flag to be set False, and a mismatch of CRC also causes
! -- it to be set False. The CRC of the actual source file (if
! -- Source_Found is True) is included only if All_Timestamps_Match is
! -- False (since CRC are only interesting if we have time stamp
! -- mismatches, and we want to avoid computing the CRC of the source
! -- file if it is not needed.)
! CRC : Word;
! -- If no dependency line has a CRC for this source file (i.e. the
-- corresponding entries in the source dependency records all have the
! -- CRC_Present flag set False), then this field is undefined. If
! -- at least one dependency entry has a CRC present, then this
! -- field contains one of the possible CRC values that has been
! -- seen. This is used to set All_CRC_Match properly.
end record;
***************
*** 126,141 ****
-- source files. In minimal recompilation mode (Minimal_Recompilation set
-- to True, no mismatch is found if the file's timestamp has not changed.
! --------------------------------------------
! -- Subprograms for manipulating checksums --
! --------------------------------------------
! 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.
end ALI.Util;
--- 126,152 ----
-- source files. In minimal recompilation mode (Minimal_Recompilation set
-- to True, no mismatch is found if the file's timestamp has not changed.
! --------------------------------------
! -- Subprograms for manipulating CRC --
! --------------------------------------
!
! CRC_Error : constant Word := 16#FFFF_FFFF#;
! -- This value will be returned by the routine below in case of error. When
! -- comparing CRC for the smart recompilation, a CRC_Error means that the
! -- CRC values does not match.
! function Get_File_CRC (Fname : Name_Id) return Word;
! -- Compute CRC 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
! -- affected by a mis-computation. Returns CRC_Error value, if the file is
! -- missing or has an error.
!
! function CRC_Match (CRC1, CRC2 : Word) return Boolean;
! pragma Inline (CRC_Match);
! -- Returns True if CRC1 and CRC2 have the same value and not equal to
! -- CRC_Error, returns False in all other cases. CRC must always be checked
! -- for equality through this function.
end ALI.Util;
*** ali.adb 2001/08/04 12:41:23 1.124
--- ali.adb 2001/09/28 19:32:08 1.125
***************
*** 1130,1151 ****
declare
Ctr : Natural;
! Chk : Word;
begin
Ctr := 0;
! Chk := 0;
loop
exit when At_Eol or else Ctr = 8;
if Nextc in '0' .. '9' then
! Chk := Chk * 16 +
Character'Pos (Nextc) - Character'Pos ('0');
! elsif Nextc in 'A' .. 'F' then
! Chk := Chk * 16 +
! Character'Pos (Nextc) - Character'Pos ('A') + 10;
else
exit;
--- 1130,1151 ----
declare
Ctr : Natural;
! CRC : Word;
begin
Ctr := 0;
! CRC := 0;
loop
exit when At_Eol or else Ctr = 8;
if Nextc in '0' .. '9' then
! CRC := CRC * 16 +
Character'Pos (Nextc) - Character'Pos ('0');
! elsif Nextc in 'a' .. 'f' then
! CRC := CRC * 16 +
! Character'Pos (Nextc) - Character'Pos ('a') + 10;
else
exit;
***************
*** 1156,1162 ****
end loop;
if Ctr = 8 and then At_End_Of_Field then
! Sdep.Table (Sdep.Last).Checksum := Chk;
else
Fatal_Error;
end if;
--- 1156,1162 ----
end loop;
if Ctr = 8 and then At_End_Of_Field then
! Sdep.Table (Sdep.Last).CRC := CRC;
else
Fatal_Error;
end if;
*** ali.ads 2001/08/04 12:41:27 1.71
--- ali.ads 2001/09/28 19:32:26 1.72
***************
*** 519,526 ****
Stamp : Time_Stamp_Type;
-- Time stamp value
! Checksum : Word;
! -- Checksum value
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
--- 519,526 ----
Stamp : Time_Stamp_Type;
-- Time stamp value
! CRC : Word;
! -- CRC value
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
*** bcheck.adb 2001/07/16 01:27:13 1.39
--- bcheck.adb 2001/09/28 19:33:06 1.40
***************
*** 476,520 ****
begin
-- First, we go through the source table to see if there are any cases
! -- in which we should go after source files and compute checksums of
-- the source files. We need to do this for any file for which we have
! -- mismatching time stamps and (so far) matching checksums.
for S in Source.First .. Source.Last loop
-- If all time stamps for a file match, then there is nothing to
! -- do, since we will not be checking checksums in that case anyway
if Source.Table (S).All_Timestamps_Match then
null;
-- If we did not find the source file, then we can't compute its
! -- checksum anyway. Note that when we have a time stamp mismatch,
-- we try to find the source file unconditionally (i.e. if
-- Check_Source_Files is False).
elsif not Source.Table (S).Source_Found then
null;
! -- If we already have non-matching or missing checksums, then no
-- need to try going after source file, since we won't trust the
! -- checksums in any case.
! elsif not Source.Table (S).All_Checksums_Match then
null;
-- Now we have the case where we have time stamp mismatches, and
! -- the source file is around, but so far all checksums match. This
! -- is the case where we need to compute the checksum from the source
-- file, since otherwise we would ignore the time stamp mismatches,
! -- and that is wrong if the checksum of the source does not agree
! -- with the checksums in the ALI files.
elsif Check_Source_Files then
! if Source.Table (S).Checksum /=
! Get_File_Checksum (Source.Table (S).Sfile)
then
! Source.Table (S).All_Checksums_Match := False;
end if;
end if;
end loop;
--- 476,520 ----
begin
-- First, we go through the source table to see if there are any cases
! -- in which we should go after source files and compute CRC of
-- the source files. We need to do this for any file for which we have
! -- mismatching time stamps and (so far) matching CRC.
for S in Source.First .. Source.Last loop
-- If all time stamps for a file match, then there is nothing to
! -- do, since we will not be checking CRC in that case anyway
if Source.Table (S).All_Timestamps_Match then
null;
-- If we did not find the source file, then we can't compute its
! -- CRC anyway. Note that when we have a time stamp mismatch,
-- we try to find the source file unconditionally (i.e. if
-- Check_Source_Files is False).
elsif not Source.Table (S).Source_Found then
null;
! -- If we already have non-matching or missing CRC, then no
-- need to try going after source file, since we won't trust the
! -- CRC in any case.
! elsif not Source.Table (S).All_CRC_Match then
null;
-- Now we have the case where we have time stamp mismatches, and
! -- the source file is around, but so far all CRC match. This
! -- is the case where we need to compute the CRC from the source
-- file, since otherwise we would ignore the time stamp mismatches,
! -- and that is wrong if the CRC of the source does not agree
! -- with the CRC in the ALI files.
elsif Check_Source_Files then
! if not CRC_Match
! (Source.Table (S).CRC, Get_File_CRC (Source.Table (S).Sfile))
then
! Source.Table (S).All_CRC_Match := False;
end if;
end if;
end loop;
***************
*** 530,540 ****
loop
Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
! -- If the time stamps match, or all checksums match, then we
-- are OK, otherwise we have a definite error.
if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
! and then not Source.Table (Src).All_Checksums_Match
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := Sdep.Table (D).Sfile;
--- 530,540 ----
loop
Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
! -- If the time stamps match, or all CRC match, then we
-- are OK, otherwise we have a definite error.
if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
! and then not Source.Table (Src).All_CRC_Match
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := Sdep.Table (D).Sfile;
*** gnatls.adb 2001/07/16 01:27:44 1.37
--- gnatls.adb 2001/09/28 19:33:33 1.38
***************
*** 54,60 ****
type File_Status is (
OK, -- matching timestamp
! Checksum_OK, -- only matching checksum
Not_Found, -- file not found on source PATH
Not_Same, -- neither checksum nor timestamp matching
Not_First_On_PATH); -- matching file hidden by Not_Same file on path
--- 54,60 ----
type File_Status is (
OK, -- matching timestamp
! CRC_OK, -- only matching CRC
Not_Found, -- file not found on source PATH
Not_Same, -- neither checksum nor timestamp matching
Not_First_On_PATH); -- matching file hidden by Not_Same file on path
***************
*** 133,142 ****
-- Determine the structure of the output (multi columns or not, etc)
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! Checksum : Word;
! Status : out File_Status);
-- Determine the file status (Status) of the file represented by FS
-- with the expected Stamp and checksum given as argument. FS will be
-- updated to the full file name if available.
--- 133,142 ----
-- Determine the structure of the output (multi columns or not, etc)
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! CRC : Word;
! Status : out File_Status);
-- Determine the file status (Status) of the file represented by FS
-- with the expected Stamp and checksum given as argument. FS will be
-- updated to the full file name if available.
***************
*** 334,343 ****
-----------------
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! Checksum : Word;
! Status : out File_Status)
is
Tmp1 : File_Name_Type;
Tmp2 : File_Name_Type;
--- 334,343 ----
-----------------
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! CRC : Word;
! Status : out File_Status)
is
Tmp1 : File_Name_Type;
Tmp2 : File_Name_Type;
***************
*** 352,360 ****
FS := Tmp1;
Status := OK;
! elsif Get_File_Checksum (FS) = Checksum then
FS := Tmp1;
! Status := Checksum_OK;
else
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
--- 352,360 ----
FS := Tmp1;
Status := OK;
! elsif CRC_Match (Get_File_CRC (FS), CRC) then
FS := Tmp1;
! Status := CRC_OK;
else
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
***************
*** 414,427 ****
procedure Output_Source (Sdep_I : Sdep_Id) is
Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
! Checksum : constant Word := Sdep.Table (Sdep_I).Checksum;
FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
Status : File_Status;
Object_Name : String_Access;
begin
if Print_Source then
! Find_Status (FS, Stamp, Checksum, Status);
Get_Name_String (FS);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
--- 414,427 ----
procedure Output_Source (Sdep_I : Sdep_Id) is
Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
! CRC : constant Word := Sdep.Table (Sdep_I).CRC;
FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
Status : File_Status;
Object_Name : String_Access;
begin
if Print_Source then
! Find_Status (FS, Stamp, CRC, Status);
Get_Name_String (FS);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
***************
*** 460,466 ****
when OK =>
Write_Str (" unchanged");
! when Checksum_OK =>
Write_Str (" slightly modified");
when Not_Found =>
--- 460,466 ----
when OK =>
Write_Str (" unchanged");
! when CRC_OK =>
Write_Str (" slightly modified");
when Not_Found =>
***************
*** 478,484 ****
when OK =>
Write_Str (" OK ");
! when Checksum_OK =>
Write_Str (" MOK ");
when Not_Found =>
--- 478,484 ----
when OK =>
Write_Str (" OK ");
! when CRC_OK =>
Write_Str (" MOK ");
when Not_Found =>
*** lib-load.adb 2001/09/05 09:39:47 1.86
--- lib-load.adb 2001/09/28 19:34:53 1.87
***************
*** 200,206 ****
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Unit_Name => No_Name,
! Version => Source_Checksum (Main_Source_File));
end if;
end Initialize;
--- 200,206 ----
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Unit_Name => No_Name,
! Version => Source_CRC (Main_Source_File));
end if;
end Initialize;
***************
*** 210,216 ****
procedure Initialize_Version (U : Unit_Number_Type) is
begin
! Units.Table (U).Version := Source_Checksum (Source_Index (U));
end Initialize_Version;
---------------
--- 210,216 ----
procedure Initialize_Version (U : Unit_Number_Type) is
begin
! Units.Table (U).Version := Source_CRC (Source_Index (U));
end Initialize_Version;
---------------
***************
*** 544,550 ****
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Unit_Name => Uname_Actual,
! Version => Source_Checksum (Src_Ind));
-- Parse the new unit
--- 544,550 ----
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Unit_Name => Uname_Actual,
! Version => Source_CRC (Src_Ind));
-- Parse the new unit
***************
*** 651,657 ****
Units.Table (Main_Unit).Cunit := N;
Units.Table (Main_Unit).Unit_Name :=
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
! Units.Table (Main_Unit).Version := Source_Checksum (Sind);
end Make_Instance_Unit;
------------------------
--- 651,657 ----
Units.Table (Main_Unit).Cunit := N;
Units.Table (Main_Unit).Unit_Name :=
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
! Units.Table (Main_Unit).Version := Source_CRC (Sind);
end Make_Instance_Unit;
------------------------
***************
*** 692,698 ****
Units.Table (Unum).Version :=
Units.Table (Unum).Version
xor
! Source_Checksum (Source_Index (Fnum));
end Version_Update;
----------------------------
--- 692,698 ----
Units.Table (Unum).Version :=
Units.Table (Unum).Version
xor
! Source_CRC (Source_Index (Fnum));
end Version_Update;
----------------------------
*** lib-writ.adb 2001/09/09 02:45:05 1.160
--- lib-writ.adb 2001/09/28 19:35:13 1.161
***************
*** 107,113 ****
Version => 0,
Error_Location => No_Location);
! -- Parse system.ads so that the checksum is set right
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard := Par (Configuration_Pragmas => False);
--- 107,113 ----
Version => 0,
Error_Location => No_Location);
! -- Parse system.ads so that the CRC is set right
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard := Par (Configuration_Pragmas => False);
***************
*** 894,900 ****
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Char (' ');
! Write_Info_Str (Get_Hex_String (Source_Checksum (Sind)));
-- If subunit, add unit name, omitting the %b at the end
--- 894,900 ----
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Char (' ');
! Write_Info_Str (Get_Hex_String (Source_CRC (Sind)));
-- If subunit, add unit name, omitting the %b at the end
*** scans.adb 2001/02/06 04:35:08 1.12
--- scans.adb 2001/09/28 19:35:51 1.13
***************
*** 46,52 ****
Token_Ptr := Saved_State.Save_Token_Ptr;
Current_Line_Start := Saved_State.Save_Current_Line_Start;
Start_Column := Saved_State.Save_Start_Column;
! Checksum := Saved_State.Save_Checksum;
First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
Token_Node := Saved_State.Save_Token_Node;
Token_Name := Saved_State.Save_Token_Name;
--- 46,52 ----
Token_Ptr := Saved_State.Save_Token_Ptr;
Current_Line_Start := Saved_State.Save_Current_Line_Start;
Start_Column := Saved_State.Save_Start_Column;
! CRC := Saved_State.Save_CRC;
First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
Token_Node := Saved_State.Save_Token_Node;
Token_Name := Saved_State.Save_Token_Name;
***************
*** 65,71 ****
Saved_State.Save_Token_Ptr := Token_Ptr;
Saved_State.Save_Current_Line_Start := Current_Line_Start;
Saved_State.Save_Start_Column := Start_Column;
! Saved_State.Save_Checksum := Checksum;
Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
Saved_State.Save_Token_Node := Token_Node;
Saved_State.Save_Token_Name := Token_Name;
--- 65,71 ----
Saved_State.Save_Token_Ptr := Token_Ptr;
Saved_State.Save_Current_Line_Start := Current_Line_Start;
Saved_State.Save_Start_Column := Start_Column;
! Saved_State.Save_CRC := CRC;
Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
Saved_State.Save_Token_Node := Token_Node;
Saved_State.Save_Token_Name := Token_Name;
*** scans.ads 2000/12/17 07:41:07 1.32
--- scans.ads 2001/09/28 19:36:38 1.33
***************
*** 8,14 ****
-- --
-- $Revision$
-- --
! -- Copyright (C) 1992-2000 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- --
--- 8,14 ----
-- --
-- $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- --
***************
*** 34,39 ****
--- 34,42 ----
------------------------------------------------------------------------------
with Types; use Types;
+
+ with GNAT.CRC32; use GNAT.CRC32;
+
package Scans is
-- The scanner maintains a current state in the global variables defined
***************
*** 341,349 ****
-- on the line containing the current token. This is used for error
-- 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
-- excludes comments.
First_Non_Blank_Location : Source_Ptr;
--- 344,352 ----
-- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up.
! CRC : CRC32;
! -- 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;
***************
*** 407,413 ****
Save_Token_Ptr : Source_Ptr;
Save_Current_Line_Start : Source_Ptr;
Save_Start_Column : Column_Number;
! Save_Checksum : Word;
Save_First_Non_Blank_Location : Source_Ptr;
Save_Token_Node : Node_Id;
Save_Token_Name : Name_Id;
--- 410,416 ----
Save_Token_Ptr : Source_Ptr;
Save_Current_Line_Start : Source_Ptr;
Save_Start_Column : Column_Number;
! Save_CRC : CRC32;
Save_First_Non_Blank_Location : Source_Ptr;
Save_Token_Node : Node_Id;
Save_Token_Name : Name_Id;
*** scn-nlit.adb 1997/11/27 22:45:31 1.32
--- scn-nlit.adb 2001/09/28 19:38:27 1.33
***************
*** 8,14 ****
-- --
-- $Revision$ --
-- --
! -- Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 8,14 ----
-- --
-- $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- --
***************
*** 103,109 ****
-- Loop through digits (allowing underlines)
loop
! Accumulate_Checksum (C);
UI_Int_Value :=
UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
Scan_Ptr := Scan_Ptr + 1;
--- 103,109 ----
-- Loop through digits (allowing underlines)
loop
! Update (CRC, C);
UI_Int_Value :=
UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
Scan_Ptr := Scan_Ptr + 1;
***************
*** 111,117 ****
C := Source (Scan_Ptr);
if C = '_' then
! Accumulate_Checksum ('_');
loop
Scan_Ptr := Scan_Ptr + 1;
--- 111,117 ----
C := Source (Scan_Ptr);
if C = '_' then
! Update (CRC, '_');
loop
Scan_Ptr := Scan_Ptr + 1;
***************
*** 158,164 ****
-- and must not be eaten up scanning a numeric literal.
while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
! Accumulate_Checksum ('.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
--- 158,164 ----
-- and must not be eaten up scanning a numeric literal.
while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
! Update (CRC, '.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
***************
*** 192,198 ****
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
! Accumulate_Checksum (C);
Base_Char := C;
UI_Base := UI_Int_Value;
--- 192,198 ----
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
! Update (CRC, C);
Base_Char := C;
UI_Base := UI_Int_Value;
***************
*** 212,228 ****
loop
if C in '0' .. '9' then
! Accumulate_Checksum (C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
elsif C in 'A' .. 'F' then
! Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
elsif C in 'a' .. 'f' then
! Accumulate_Checksum (C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
--- 212,228 ----
loop
if C in '0' .. '9' then
! Update (CRC, C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
elsif C in 'A' .. 'F' then
! Update (CRC, Character'Val (Character'Pos (C) + 32));
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
elsif C in 'a' .. 'f' then
! Update (CRC, C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
***************
*** 242,248 ****
if C = '_' then
loop
! Accumulate_Checksum ('_');
Scan_Ptr := Scan_Ptr + 1;
C := Source (Scan_Ptr);
exit when C /= '_';
--- 242,248 ----
if C = '_' then
loop
! Update (CRC, '_');
Scan_Ptr := Scan_Ptr + 1;
C := Source (Scan_Ptr);
exit when C /= '_';
***************
*** 250,256 ****
end loop;
elsif C = '.' then
! Accumulate_Checksum ('.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
--- 250,256 ----
end loop;
elsif C = '.' then
! Update (CRC, '.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
***************
*** 262,268 ****
Scale := 0;
elsif C = Base_Char then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit;
--- 262,268 ----
Scale := 0;
elsif C = Base_Char then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
exit;
***************
*** 296,311 ****
end if;
if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
! Accumulate_Checksum ('e');
Scan_Ptr := Scan_Ptr + 1;
Exponent_Is_Negative := False;
if Source (Scan_Ptr) = '+' then
! Accumulate_Checksum ('+');
Scan_Ptr := Scan_Ptr + 1;
elsif Source (Scan_Ptr) = '-' then
! Accumulate_Checksum ('-');
if not Point_Scanned then
Error_Msg_S ("negative exponent not allowed for integer literal");
--- 296,311 ----
end if;
if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
! Update (CRC, 'e');
Scan_Ptr := Scan_Ptr + 1;
Exponent_Is_Negative := False;
if Source (Scan_Ptr) = '+' then
! Update (CRC, '+');
Scan_Ptr := Scan_Ptr + 1;
elsif Source (Scan_Ptr) = '-' then
! Update (CRC, '-');
if not Point_Scanned then
Error_Msg_S ("negative exponent not allowed for integer literal");
*** scn-slit.adb 1999/03/22 02:32:48 1.29
--- scn-slit.adb 2001/09/28 19:39:26 1.30
***************
*** 8,14 ****
-- --
-- $Revision$ --
-- --
! -- Copyright (C) 1992-1999 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- --
--- 8,14 ----
-- --
-- $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- --
***************
*** 291,297 ****
-- latter case is an error detected by the character literal circuit.
Delimiter := Source (Scan_Ptr);
! Accumulate_Checksum (Delimiter);
Start_String;
Scan_Ptr := Scan_Ptr + 1;
--- 291,297 ----
-- latter case is an error detected by the character literal circuit.
Delimiter := Source (Scan_Ptr);
! Update (CRC, Delimiter);
Start_String;
Scan_Ptr := Scan_Ptr + 1;
***************
*** 301,311 ****
C := Source (Scan_Ptr);
if C = Delimiter then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
Code := Get_Char_Code (C);
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
else
--- 301,311 ----
C := Source (Scan_Ptr);
if C = Delimiter then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
Code := Get_Char_Code (C);
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
else
***************
*** 329,335 ****
Identifier_Char (Source (Scan_Ptr + 2)))
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
--- 329,335 ----
Identifier_Char (Source (Scan_Ptr + 2)))
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 337,343 ****
end if;
else
! Accumulate_Checksum (C);
if C not in Graphic_Character then
if C in Line_Terminator then
--- 337,343 ----
end if;
else
! Update (CRC, C);
if C not in Graphic_Character then
if C in Line_Terminator then
*** scn.adb 2001/03/11 20:21:08 1.111
--- scn.adb 2001/09/28 19:40:06 1.112
***************
*** 39,44 ****
--- 39,47 ----
with Style;
with Widechar; use Widechar;
+ with Ada.Streams; use Ada.Streams;
+ with GNAT.CRC32; use GNAT.CRC32;
+ with Interfaces; use Interfaces;
with System.WCh_Con; use System.WCh_Con;
package body Scn is
***************
*** 55,78 ****
-- Local Subprograms --
-----------------------
- procedure Accumulate_Checksum (C : Character);
- pragma Inline (Accumulate_Checksum);
- -- This routine accumulates the checksum given character C. During the
- -- scanning of a source file, this routine is called with every character
- -- in the source, excluding blanks, and all control characters (except
- -- that ESC is included in the checksum). Upper case letters not in string
- -- literals are folded by the caller. See Sinput spec for the documentation
- -- of the checksum algorithm. Note: checksum values are only used if we
- -- generate code, so it is not necessary to worry about making the right
- -- sequence of calls in any error situation.
-
- procedure Accumulate_Checksum (C : Char_Code);
- pragma Inline (Accumulate_Checksum);
- -- This version is identical, except that the argument, C, is a character
- -- code value instead of a character. This is used when wide characters
- -- are scanned. We use the character code rather than the ASCII characters
- -- so that the checksum is independent of wide character encoding method.
-
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.
--- 58,63 ----
***************
*** 124,156 ****
procedure Slit;
-- This is the procedure for scanning out string literals. On entry,
! -- Scan_Ptr points to the opening string quote (the checksum for this
-- character has not been accumulated yet). On return Scan_Ptr points
-- past the closing quote of the string literal, Token and Token_Node
! -- are set appropriately, and the checksum is upated.
!
! -------------------------
! -- Accumulate_Checksum --
! -------------------------
!
! 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;
! 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;
- end Accumulate_Checksum;
-
-----------------------
-- Check_End_Of_Line --
-----------------------
--- 109,127 ----
procedure Slit;
-- This is the procedure for scanning out string literals. On entry,
! -- Scan_Ptr points to the opening string quote (the CRC for this
-- character has not been accumulated yet). On return Scan_Ptr points
-- past the closing quote of the string literal, Token and Token_Node
! -- are set appropriately, and the CRC is upated.
! procedure Update_CRC (C : Char_Code);
! pragma Inline (Update_CRC);
! -- This version updates variable CRC (see Scans.CRC complete documentation
! -- of the CRC algorithm here) with the wide character C. This is used when
! -- wide characters are scanned. We use the character code rather than the
! -- ASCII characters so that the CRC is independent of wide character
! -- encoding method.
-----------------------
-- Check_End_Of_Line --
-----------------------
***************
*** 302,308 ****
function Double_Char_Token (C : Character) return Boolean is
begin
if Source (Scan_Ptr + 1) = C then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 2;
return True;
--- 273,279 ----
function Double_Char_Token (C : Character) return Boolean is
begin
if Source (Scan_Ptr + 1) = C then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 2;
return True;
***************
*** 465,471 ****
Token_Name := No_Name;
Start_Column := Set_Start_Column;
First_Non_Blank_Location := Scan_Ptr;
- Checksum := 0;
-- Set default for Comes_From_Source. All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True
--- 436,441 ----
***************
*** 480,485 ****
--- 450,459 ----
Set_License (Current_Source_File, Determine_License);
end if;
+ -- Initialize CRC
+
+ Initialize (CRC);
+
-- Scan initial token (note this initializes Prev_Token, Prev_Token_Ptr)
Scan;
***************
*** 613,619 ****
-- Ampersand
when '&' =>
! Accumulate_Checksum ('&');
if Source (Scan_Ptr + 1) = '&' then
Error_Msg_S ("'&'& should be `AND THEN`");
--- 587,593 ----
-- Ampersand
when '&' =>
! Update (CRC, '&');
if Source (Scan_Ptr + 1) = '&' then
Error_Msg_S ("'&'& should be `AND THEN`");
***************
*** 631,640 ****
-- which is the exponentiation compound delimtier).
when '*' =>
! Accumulate_Checksum ('*');
if Source (Scan_Ptr + 1) = '*' then
! Accumulate_Checksum ('*');
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Double_Asterisk;
return;
--- 605,614 ----
-- which is the exponentiation compound delimtier).
when '*' =>
! Update (CRC, '*');
if Source (Scan_Ptr + 1) = '*' then
! Update (CRC, '*');
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Double_Asterisk;
return;
***************
*** 649,655 ****
-- assignment compound delimiter.
when ':' =>
! Accumulate_Checksum (':');
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
--- 623,629 ----
-- assignment compound delimiter.
when ':' =>
! Update (CRC, ':');
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
***************
*** 674,680 ****
-- Left parenthesis
when '(' =>
! Accumulate_Checksum ('(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
if Style_Check then Style.Check_Left_Paren; end if;
--- 648,654 ----
-- Left parenthesis
when '(' =>
! Update (CRC, '(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
if Style_Check then Style.Check_Left_Paren; end if;
***************
*** 705,711 ****
-- Comma
when ',' =>
! Accumulate_Checksum (',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
if Style_Check then Style.Check_Comma; end if;
--- 679,685 ----
-- Comma
when ',' =>
! Update (CRC, ',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
if Style_Check then Style.Check_Comma; end if;
***************
*** 716,722 ****
-- a digit following the period, to give a better error message.
when '.' =>
! Accumulate_Checksum ('.');
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
--- 690,696 ----
-- a digit following the period, to give a better error message.
when '.' =>
! Update (CRC, '.');
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
***************
*** 737,743 ****
-- arrow (=>) compound delimiter.
when '=' =>
! Accumulate_Checksum ('=');
if Double_Char_Token ('>') then
Token := Tok_Arrow;
--- 711,717 ----
-- arrow (=>) compound delimiter.
when '=' =>
! Update (CRC, '=');
if Double_Char_Token ('>') then
Token := Tok_Arrow;
***************
*** 757,763 ****
-- or equal operator, or first character of a right label bracket.
when '>' =>
! Accumulate_Checksum ('>');
if Double_Char_Token ('=') then
Token := Tok_Greater_Equal;
--- 731,737 ----
-- or equal operator, or first character of a right label bracket.
when '>' =>
! Update (CRC, '>');
if Double_Char_Token ('=') then
Token := Tok_Greater_Equal;
***************
*** 778,784 ****
-- first character of a box (<>) compound delimiter.
when '<' =>
! Accumulate_Checksum ('<');
if Double_Char_Token ('=') then
Token := Tok_Less_Equal;
--- 752,758 ----
-- first character of a box (<>) compound delimiter.
when '<' =>
! Update (CRC, '<');
if Double_Char_Token ('=') then
Token := Tok_Less_Equal;
***************
*** 810,816 ****
return;
elsif Source (Scan_Ptr + 1) /= '-' then
! Accumulate_Checksum ('-');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Minus;
return;
--- 784,790 ----
return;
elsif Source (Scan_Ptr + 1) /= '-' then
! Update (CRC, '-');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Minus;
return;
***************
*** 903,909 ****
Err : Boolean;
begin
! Accumulate_Checksum (''');
Scan_Ptr := Scan_Ptr + 1;
-- Here is where we make the test to distinguish the cases. Treat
--- 877,883 ----
Err : Boolean;
begin
! Update (CRC, ''');
Scan_Ptr := Scan_Ptr + 1;
-- Here is where we make the test to distinguish the cases. Treat
***************
*** 939,945 ****
Source (Scan_Ptr + 1) = '"')
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
--- 913,919 ----
Source (Scan_Ptr + 1) = '"')
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 974,980 ****
-- Otherwise we have a (non-wide) character literal
else
! Accumulate_Checksum (Source (Scan_Ptr));
if Source (Scan_Ptr) not in Graphic_Character then
if Source (Scan_Ptr) in Upper_Half_Character then
--- 948,954 ----
-- Otherwise we have a (non-wide) character literal
else
! Update (CRC, Source (Scan_Ptr));
if Source (Scan_Ptr) not in Graphic_Character then
if Source (Scan_Ptr) in Upper_Half_Character then
***************
*** 994,1000 ****
-- Fall through here with Scan_Ptr updated past the closing
-- quote, and Code set to the Char_Code value for the literal
! Accumulate_Checksum (''');
Token := Tok_Char_Literal;
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
Set_Char_Literal_Value (Token_Node, Code);
--- 968,974 ----
-- Fall through here with Scan_Ptr updated past the closing
-- quote, and Code set to the Char_Code value for the literal
! Update (CRC, ''');
Token := Tok_Char_Literal;
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
Set_Char_Literal_Value (Token_Node, Code);
***************
*** 1008,1014 ****
-- Right parenthesis
when ')' =>
! Accumulate_Checksum (')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
if Style_Check then Style.Check_Right_Paren; end if;
--- 982,988 ----
-- Right parenthesis
when ')' =>
! Update (CRC, ')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
if Style_Check then Style.Check_Right_Paren; end if;
***************
*** 1025,1031 ****
-- Slash (can be division operator or first character of not equal)
when '/' =>
! Accumulate_Checksum ('/');
if Double_Char_Token ('=') then
Token := Tok_Not_Equal;
--- 999,1005 ----
-- Slash (can be division operator or first character of not equal)
when '/' =>
! Update (CRC, '/');
if Double_Char_Token ('=') then
Token := Tok_Not_Equal;
***************
*** 1039,1045 ****
-- Semicolon
when ';' =>
! Accumulate_Checksum (';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
if Style_Check then Style.Check_Semicolon; end if;
--- 1013,1019 ----
-- Semicolon
when ';' =>
! Update (CRC, ';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
if Style_Check then Style.Check_Semicolon; end if;
***************
*** 1048,1054 ****
-- Vertical bar
when '|' => Vertical_Bar_Case : begin
! Accumulate_Checksum ('|');
-- Special check for || to give nice message
--- 1022,1028 ----
-- Vertical bar
when '|' => Vertical_Bar_Case : begin
! Update (CRC, '|');
-- Special check for || to give nice message
***************
*** 1069,1075 ****
-- Exclamation, replacement character for vertical bar
when '!' => Exclamation_Case : begin
! Accumulate_Checksum ('!');
if Source (Scan_Ptr + 1) = '=' then
Error_Msg_S ("'!= should be /=");
--- 1043,1049 ----
-- Exclamation, replacement character for vertical bar
when '!' => Exclamation_Case : begin
! Update (CRC, '!');
if Source (Scan_Ptr + 1) = '=' then
Error_Msg_S ("'!= should be /=");
***************
*** 1088,1094 ****
-- Plus
when '+' => Plus_Case : begin
! Accumulate_Checksum ('+');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Plus;
return;
--- 1062,1068 ----
-- Plus
when '+' => Plus_Case : begin
! Update (CRC, '+');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Plus;
return;
***************
*** 1111,1117 ****
when 'a' .. 'z' =>
Name_Len := 1;
Name_Buffer (1) := Source (Scan_Ptr);
! Accumulate_Checksum (Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
--- 1085,1091 ----
when 'a' .. 'z' =>
Name_Len := 1;
Name_Buffer (1) := Source (Scan_Ptr);
! Update (CRC, Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
***************
*** 1121,1127 ****
Name_Len := 1;
Name_Buffer (1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Accumulate_Checksum (Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
--- 1095,1101 ----
Name_Len := 1;
Name_Buffer (1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Update (CRC, Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
***************
*** 1218,1229 ****
or else Source (Scan_Ptr) in '0' .. '9'
then
Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
! Accumulate_Checksum (Source (Scan_Ptr));
elsif Source (Scan_Ptr) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 1));
else
exit;
end if;
--- 1192,1203 ----
or else Source (Scan_Ptr) in '0' .. '9'
then
Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
! Update (CRC, Source (Scan_Ptr));
elsif Source (Scan_Ptr) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 1));
else
exit;
end if;
***************
*** 1234,1245 ****
or else Source (Scan_Ptr + 1) in '0' .. '9'
then
Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1);
! Accumulate_Checksum (Source (Scan_Ptr + 1));
elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 2) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 2));
else
Scan_Ptr := Scan_Ptr + 1;
--- 1208,1219 ----
or else Source (Scan_Ptr + 1) in '0' .. '9'
then
Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1);
! Update (CRC, Source (Scan_Ptr + 1));
elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 2) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 2));
else
Scan_Ptr := Scan_Ptr + 1;
***************
*** 1251,1262 ****
or else Source (Scan_Ptr + 2) in '0' .. '9'
then
Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2);
! Accumulate_Checksum (Source (Scan_Ptr + 2));
elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 3) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 3));
else
Scan_Ptr := Scan_Ptr + 2;
Name_Len := Name_Len + 2;
--- 1225,1236 ----
or else Source (Scan_Ptr + 2) in '0' .. '9'
then
Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2);
! Update (CRC, Source (Scan_Ptr + 2));
elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 3) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 3));
else
Scan_Ptr := Scan_Ptr + 2;
Name_Len := Name_Len + 2;
***************
*** 1267,1278 ****
or else Source (Scan_Ptr + 3) in '0' .. '9'
then
Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3);
! Accumulate_Checksum (Source (Scan_Ptr + 3));
elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 4) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 4));
else
Scan_Ptr := Scan_Ptr + 3;
--- 1241,1252 ----
or else Source (Scan_Ptr + 3) in '0' .. '9'
then
Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3);
! Update (CRC, Source (Scan_Ptr + 3));
elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 4) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 4));
else
Scan_Ptr := Scan_Ptr + 3;
***************
*** 1299,1305 ****
-- and for a trailing underline character
if Source (Scan_Ptr) = '_' then
! Accumulate_Checksum ('_');
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '_';
--- 1273,1279 ----
-- and for a trailing underline character
if Source (Scan_Ptr) = '_' then
! Update (CRC, '_');
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '_';
***************
*** 1322,1328 ****
elsif Source (Scan_Ptr) in Upper_Half_Character
and then not Upper_Half_Encoding
then
! Accumulate_Checksum (Source (Scan_Ptr));
Store_Encoded_Character
(Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
Scan_Ptr := Scan_Ptr + 1;
--- 1296,1302 ----
elsif Source (Scan_Ptr) in Upper_Half_Character
and then not Upper_Half_Encoding
then
! Update (CRC, Source (Scan_Ptr));
Store_Encoded_Character
(Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
Scan_Ptr := Scan_Ptr + 1;
***************
*** 1352,1358 ****
begin
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
--- 1326,1332 ----
begin
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 1566,1570 ****
--- 1540,1560 ----
----------
procedure Slit is separate;
+
+ ----------------
+ -- Update_CRC --
+ ----------------
+
+ procedure Update_CRC (C : Char_Code) is
+ Elements : Stream_Element_Array (1 .. 2);
+ -- Char_Code is a 16 bits value, put the upper and lower part in the
+ -- Elementes table.
+
+ begin
+ Elements (1) := Stream_Element (Shift_Right (Unsigned_16 (C), 8));
+ Elements (2) := Stream_Element (C and 16#00FF#);
+
+ Update (CRC, Elements);
+ end Update_CRC;
end Scn;
*** sinput-l.adb 2001/09/02 03:00:55 1.40
--- sinput-l.adb 2001/09/28 19:41:10 1.41
***************
*** 41,46 ****
--- 41,48 ----
with Unchecked_Conversion;
+ with GNAT.CRC32; use GNAT.CRC32;
+
package body Sinput.L is
Dfile : Source_File_Index;
***************
*** 108,114 ****
begin
Trim_Lines_Table (CSF);
! Source_File.Table (CSF).Source_Checksum := Checksum;
end Complete_Source_File_Entry;
-------------------------
--- 110,116 ----
begin
Trim_Lines_Table (CSF);
! Source_File.Table (CSF).Source_CRC := Word (Get_Value (Scans.CRC));
end Complete_Source_File_Entry;
-------------------------
***************
*** 417,423 ****
Num_SRef_Pragmas => 0,
Reference_Name => N,
Sloc_Adjust => 0,
! Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
--- 419,425 ----
Num_SRef_Pragmas => 0,
Reference_Name => N,
Sloc_Adjust => 0,
! Source_CRC => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
*** sinput-p.adb 2001/02/25 14:32:25 1.9
--- sinput-p.adb 2001/09/28 19:41:34 1.10
***************
*** 190,196 ****
Num_SRef_Pragmas => 0,
Reference_Name => File_Id,
Sloc_Adjust => 0,
! Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
--- 190,196 ----
Num_SRef_Pragmas => 0,
Reference_Name => File_Id,
Sloc_Adjust => 0,
! Source_CRC => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
*** sinput.adb 2001/02/26 14:10:52 1.99
--- sinput.adb 2001/09/28 19:42:00 1.100
***************
*** 1070,1079 ****
return Source_File.Table (S).Reference_Name;
end Reference_Name;
! function Source_Checksum (S : SFI) return Word is
begin
! return Source_File.Table (S).Source_Checksum;
! end Source_Checksum;
function Source_First (S : SFI) return Source_Ptr is
begin
--- 1070,1079 ----
return Source_File.Table (S).Reference_Name;
end Reference_Name;
! function Source_CRC (S : SFI) return Word is
begin
! return Source_File.Table (S).Source_CRC;
! end Source_CRC;
function Source_First (S : SFI) return Source_Ptr is
begin
*** sinput.ads 2001/02/26 14:11:48 1.69
--- sinput.ads 2001/09/28 19:42:31 1.70
***************
*** 188,196 ****
-- Time stamp of the source file. Set by Sinput.L.Load_Source_File,
-- and cannot be subsequently changed.
! -- Source_Checksum : Word;
! -- Computed checksum for contents of source file. See separate section
! -- later on in this spec for a description of the checksum algorithm.
-- Last_Source_Line : Physical_Line_Number;
-- Physical line number of last source line. Whlie a file is being
--- 188,198 ----
-- Time stamp of the source file. Set by Sinput.L.Load_Source_File,
-- and cannot be subsequently changed.
! -- Source_CRC : Word;
! -- Computed a CRC32 for contents of source file. See GNAT.CRC32 spec
! -- for a description of the CRC-32 algorithm. See also separate section
! -- later on in this spec for a description of the computation of the
! -- source CRC.
-- Last_Source_Line : Physical_Line_Number;
-- Physical line number of last source line. Whlie a file is being
***************
*** 239,245 ****
function License (S : SFI) return License_Type;
function Num_SRef_Pragmas (S : SFI) return Nat;
function Reference_Name (S : SFI) return File_Name_Type;
! function Source_Checksum (S : SFI) return Word;
function Source_First (S : SFI) return Source_Ptr;
function Source_Last (S : SFI) return Source_Ptr;
function Source_Text (S : SFI) return Source_Buffer_Ptr;
--- 241,247 ----
function License (S : SFI) return License_Type;
function Num_SRef_Pragmas (S : SFI) return Nat;
function Reference_Name (S : SFI) return File_Name_Type;
! function Source_CRC (S : SFI) return Word;
function Source_First (S : SFI) return Source_Ptr;
function Source_Last (S : SFI) return Source_Ptr;
function Source_Text (S : SFI) return Source_Buffer_Ptr;
***************
*** 265,306 ****
Main_Source_File : Source_File_Index;
-- This is set to the source file index of the main unit
! -----------------------
! -- Checksum Handling --
! -----------------------
! -- As a source file is scanned, a checksum is computed by taking all the
-- non-blank characters in the file, excluding comment characters, the
-- 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;
! -- 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.
-------------------------------------
--- 267,298 ----
Main_Source_File : Source_File_Index;
-- This is set to the source file index of the main unit
! ------------------
! -- CRC Handling --
! ------------------
! -- As a source file is scanned, a CRC is computed by taking all the
-- non-blank characters in the file, excluding comment characters, the
-- minus-minus sequence starting a comment, and all control characters
-- except ESC.
! -- These characters are used to compute a 32-bit CRC which is stored
! -- in the variable Scans.CRC, 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.
! -- For a wide character sequence, the CRC is computed using the
! -- corresponding character code value C.
! -- This algorithm ensures that the CRC 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.CRC is initialized to zero at the start of scanning a file,
! -- and copied into the Source_CRC field of the file table entry when
-- the end of file is encountered.
-------------------------------------
***************
*** 584,590 ****
Source_First : Source_Ptr;
Source_Last : Source_Ptr;
Time_Stamp : Time_Stamp_Type;
! Source_Checksum : Word;
Last_Source_Line : Physical_Line_Number;
Keyword_Casing : Casing_Type;
Identifier_Casing : Casing_Type;
--- 576,582 ----
Source_First : Source_Ptr;
Source_Last : Source_Ptr;
Time_Stamp : Time_Stamp_Type;
! Source_CRC : Word;
Last_Source_Line : Physical_Line_Number;
Keyword_Casing : Casing_Type;
Identifier_Casing : Casing_Type;
*** types.adb 2001/02/06 04:19:38 1.20
--- types.adb 2001/09/28 19:42:50 1.21
***************
*** 140,146 ****
--------------------
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;
--- 140,146 ----
--------------------
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;
*** types.ads 2001/01/20 18:27:31 1.87
--- types.ads 2001/09/28 19:43:06 1.88
***************
*** 121,127 ****
-- 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
-- letters for the alphabetic cases.
function Get_Hex_String (W : Word) return Word_Hex_String;
--- 121,127 ----
-- 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 lower case
-- letters for the alphabetic cases.
function Get_Hex_String (W : Word) return Word_Hex_String;
*** gnatvsn.ads 2001/09/28 01:03:16 1.2071
--- gnatvsn.ads 2001/09/28 19:44:10 1.2072
***************
*** 54,60 ****
-- 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. 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.
--- 54,60 ----
-- 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.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.
*** /dev/null Thu Oct 11 17:32:06 2001
--- /tmp/cvsAAA6Qaadx Thu Oct 11 17:52:14 2001
***************
*** 0 ****
--- 1,84 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
*** /dev/null Thu Oct 11 17:32:06 2001
--- /tmp/cvsAAAwTaqdx Thu Oct 11 17:52:14 2001
***************
*** 0 ****
--- 1,139 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
*** ali-util.adb 2001/09/28 19:30:41 1.8
--- ali-util.adb 2001/09/29 03:23:46 1.9
***************
*** 31,68 ****
with Opt; use Opt;
with Osint; use Osint;
! with GNAT.CRC32; use GNAT.CRC32;
package body ALI.Util is
! ---------------
! -- CRC_Match --
! ---------------
! function CRC_Match (CRC1, CRC2 : Word) return Boolean is
begin
! return (CRC1 = CRC2) and then (CRC1 /= CRC_Error);
! end CRC_Match;
! ------------------
! -- Get_File_CRC --
! ------------------
! function Get_File_CRC (Fname : Name_Id) return Word is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
Ptr : Source_Ptr;
- CRC : CRC32;
- -- This variable accumulates the CRC given character C. During the
- -- scanning of a source file, this variable gets updated with every
- -- character in the source, excluding blanks, and all control
- -- characters (except that ESC is included in the CRC). Upper case
- -- letters not in string literals are folded by the caller. See Sinput
- -- spec for the documentation of the CRC algorithm. Note: CRC values
- -- are only used if we generate code, so it is not necessary to worry
- -- about making the right sequence of calls in any error situation.
-
Bad : exception;
-- Raised if file not found, or file format error
--- 31,86 ----
with Opt; use Opt;
with Osint; use Osint;
! with System.CRC32;
package body ALI.Util is
! -----------------------
! -- Local Subprograms --
! -----------------------
!
! procedure Accumulate_Checksum (C : Character; Csum : in out Word);
! pragma Inline (Accumulate_Checksum);
! -- This routine accumulates the checksum given character C. During the
! -- scanning of a source file, this routine is called with every character
! -- in the source, excluding blanks, and all control characters (except
! -- that ESC is included in the checksum). Upper case letters not in string
! -- literals are folded by the caller. See Sinput spec for the documentation
! -- of the checksum algorithm. Note: checksum values are only used if we
! -- 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
! 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 --
! -----------------------
! function Get_File_Checksum (Fname : Name_Id) return Word is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
+ Csum : Word;
Ptr : Source_Ptr;
Bad : exception;
-- Raised if file not found, or file format error
***************
*** 86,100 ****
Read_Source_File (Fname, 0, Hi, Src);
-- If we cannot find the file, then return an impossible checksum,
! -- impossible because checksums have the high order bit zero, so
-- that checksums do not match.
if Src = null then
raise Bad;
end if;
-
- Initialize (CRC);
Ptr := 0;
loop
--- 104,117 ----
Read_Source_File (Fname, 0, Hi, Src);
-- If we cannot find the file, then return an impossible checksum,
! -- impossible becaues checksums have the high order bit zero, so
-- that checksums do not match.
if Src = null then
raise Bad;
end if;
+ Initialize_Checksum (Csum);
Ptr := 0;
loop
***************
*** 110,116 ****
when EOF =>
if Ptr = Hi then
Free_Source;
! return Word (Get_Value (CRC));
else
Ptr := Ptr + 1;
end if;
--- 127,133 ----
when EOF =>
if Ptr = Hi then
Free_Source;
! return Csum;
else
Ptr := Ptr + 1;
end if;
***************
*** 121,133 ****
'<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
'0' .. '9' | 'a' .. 'z'
=>
! Update (CRC, Src (Ptr));
Ptr := Ptr + 1;
-- Upper case letters, fold to lower case
when 'A' .. 'Z' =>
! Update (CRC, Character'Val (Character'Pos (Src (Ptr)) + 32));
Ptr := Ptr + 1;
-- Left bracket, really should do wide character thing here,
--- 138,151 ----
'<' | ')' | '/' | ';' | '|' | '!' | '+' | '_' |
'0' .. '9' | 'a' .. 'z'
=>
! Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
-- Upper case letters, fold to lower case
when 'A' .. 'Z' =>
! Accumulate_Checksum
! (Character'Val (Character'Pos (Src (Ptr)) + 32), Csum);
Ptr := Ptr + 1;
-- Left bracket, really should do wide character thing here,
***************
*** 147,160 ****
end loop;
else
! Update (CRC, '-');
Ptr := Ptr + 1;
end if;
-- String delimited by double quote
when '"' =>
! Update (CRC, '"');
loop
Ptr := Ptr + 1;
--- 165,178 ----
end loop;
else
! Accumulate_Checksum ('-', Csum);
Ptr := Ptr + 1;
end if;
-- String delimited by double quote
when '"' =>
! Accumulate_Checksum ('"', Csum);
loop
Ptr := Ptr + 1;
***************
*** 164,179 ****
raise Bad;
end if;
! Update (CRC, Src (Ptr));
end loop;
! Update (CRC, '"');
Ptr := Ptr + 1;
-- String delimited by percent
when '%' =>
! Update (CRC, '%');
loop
Ptr := Ptr + 1;
--- 182,197 ----
raise Bad;
end if;
! Accumulate_Checksum (Src (Ptr), Csum);
end loop;
! Accumulate_Checksum ('"', Csum);
Ptr := Ptr + 1;
-- String delimited by percent
when '%' =>
! Accumulate_Checksum ('%', Csum);
loop
Ptr := Ptr + 1;
***************
*** 183,202 ****
raise Bad;
end if;
! Update (CRC, Src (Ptr));
end loop;
! Update (CRC, '%');
Ptr := Ptr + 1;
-- Quote, could be character constant
when ''' =>
! Update (CRC, ''');
if Src (Ptr + 2) = ''' then
! Update (CRC, Src (Ptr + 1));
! Update (CRC, ''');
Ptr := Ptr + 3;
-- Otherwise assume attribute char. We should deal with wide
--- 201,220 ----
raise Bad;
end if;
! Accumulate_Checksum (Src (Ptr), Csum);
end loop;
! Accumulate_Checksum ('%', Csum);
Ptr := Ptr + 1;
-- Quote, could be character constant
when ''' =>
! Accumulate_Checksum (''', Csum);
if Src (Ptr + 2) = ''' then
! Accumulate_Checksum (Src (Ptr + 1), Csum);
! Accumulate_Checksum (''', Csum);
Ptr := Ptr + 3;
-- Otherwise assume attribute char. We should deal with wide
***************
*** 211,217 ****
-- dealing with the nasty case of upper half wide encoding.
when Upper_Half_Character =>
! Update (CRC, Src (Ptr));
Ptr := Ptr + 1;
-- Escape character, we should do the wide character thing here,
--- 229,235 ----
-- dealing with the nasty case of upper half wide encoding.
when Upper_Half_Character =>
! Accumulate_Checksum (Src (Ptr), Csum);
Ptr := Ptr + 1;
-- Escape character, we should do the wide character thing here,
***************
*** 241,249 ****
exception
when Bad =>
Free_Source;
! return CRC_Error;
! end Get_File_CRC;
---------------------------
-- Initialize_ALI_Source --
--- 259,267 ----
exception
when Bad =>
Free_Source;
! return Checksum_Error;
! end Get_File_Checksum;
---------------------------
-- Initialize_ALI_Source --
***************
*** 264,269 ****
--- 282,296 ----
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 --
--------------
***************
*** 350,357 ****
-- Initialize checksum fields
! Source.Table (S).CRC := Sdep.Table (D).CRC;
! Source.Table (S).All_CRC_Match := True;
-- In check source files mode, try to get time stamp from file
--- 377,384 ----
-- Initialize checksum fields
! Source.Table (S).Checksum := Sdep.Table (D).Checksum;
! Source.Table (S).All_Checksums_Match := True;
-- In check source files mode, try to get time stamp from file
***************
*** 396,405 ****
else
S := Source_Id (Get_Name_Table_Info (F));
! -- Update CRC flag
! if not CRC_Match (Sdep.Table (D).CRC, Source.Table (S).CRC) then
! Source.Table (S).All_CRC_Match := False;
end if;
-- Check for time stamp mismatch
--- 423,434 ----
else
S := Source_Id (Get_Name_Table_Info (F));
! -- Update checksum flag
! if not Checksums_Match
! (Sdep.Table (D).Checksum, Source.Table (S).Checksum)
! then
! Source.Table (S).All_Checksums_Match := False;
end if;
-- Check for time stamp mismatch
***************
*** 441,450 ****
end if;
end if;
! -- Set the CRC value in the source table
S := Source_Id (Get_Name_Table_Info (F));
! Source.Table (S).CRC := Sdep.Table (D).CRC;
end loop Sdep_Loop;
--- 470,479 ----
end if;
end if;
! -- Set the checksum value in the source table
S := Source_Id (Get_Name_Table_Info (F));
! Source.Table (S).Checksum := Sdep.Table (D).Checksum;
end loop Sdep_Loop;
***************
*** 479,491 ****
then
-- If minimal recompilation is in action, replace the stamp
! -- of the source file in the table if CRC match.
-- ??? It is probably worth updating the ALI file with a new
-- field to avoid recomputing it each time.
! if CRC_Match
! (Get_File_CRC (Sdep.Table (D).Sfile), Source.Table (Src).CRC)
then
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
end if;
--- 508,521 ----
then
-- If minimal recompilation is in action, replace the stamp
! -- of the source file in the table if checksums match.
-- ??? It is probably worth updating the ALI file with a new
-- field to avoid recomputing it each time.
! 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;
*** ali-util.ads 2001/09/28 19:31:34 1.3
--- ali-util.ads 2001/09/29 03:23:59 1.4
***************
*** 6,12 ****
-- --
-- S p e c --
-- --
! -- $Revision$ --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
--- 6,12 ----
-- --
-- S p e c --
-- --
! -- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
***************
*** 65,91 ****
-- This flag is set only if all files referencing this source file
-- have a matching time stamp, and also, if Source_Found is True,
-- then the stamp of the source file also matches. If this flag is
! -- True, then CRC for this file are never referenced. We only
! -- use CRC if there are time stamp mismatches.
! All_CRC_Match : Boolean;
-- This flag is set only if all files referencing this source file
! -- have CRC, and if all these CRC match. If this flag is set to True,
! -- then the binder will ignore a timestamp mismatch. An absent CRC
! -- causes this flag to be set False, and a mismatch of CRC also causes
! -- it to be set False. The CRC of the actual source file (if
! -- Source_Found is True) is included only if All_Timestamps_Match is
! -- False (since CRC are only interesting if we have time stamp
! -- mismatches, and we want to avoid computing the CRC of the source
! -- file if it is not needed.)
! CRC : Word;
! -- If no dependency line has a CRC for this source file (i.e. the
-- corresponding entries in the source dependency records all have the
! -- CRC_Present flag set False), then this field is undefined. If
! -- at least one dependency entry has a CRC present, then this
! -- field contains one of the possible CRC values that has been
! -- seen. This is used to set All_CRC_Match properly.
end record;
--- 65,91 ----
-- This flag is set only if all files referencing this source file
-- have a matching time stamp, and also, if Source_Found is True,
-- then the stamp of the source file also matches. If this flag is
! -- True, then checksums for this file are never referenced. We only
! -- use checksums if there are time stamp mismatches.
! All_Checksums_Match : Boolean;
-- This flag is set only if all files referencing this source file
! -- have checksums, and if all these checksums match. If this flag
! -- is set to True, then the binder will ignore a timestamp mismatch.
! -- An absent checksum causes this flag to be set False, and a mismatch
! -- of checksums also causes it to be set False. The checksum of the
! -- actual source file (if Source_Found is True) is included only if
! -- All_Timestamps_Match is False (since checksums are only interesting
! -- if we have time stamp mismatches, and we want to avoid computing the
! -- checksum of the source file if it is not needed.)
! Checksum : Word;
! -- If no dependency line has a checksum for this source file (i.e. the
-- corresponding entries in the source dependency records all have the
! -- Checksum_Present flag set False), then this field is undefined. If
! -- at least one dependency entry has a checksum present, then this
! -- field contains one of the possible checksum values that has been
! -- seen. This is used to set All_Checksums_Match properly.
end record;
***************
*** 126,152 ****
-- source files. In minimal recompilation mode (Minimal_Recompilation set
-- to True, no mismatch is found if the file's timestamp has not changed.
! --------------------------------------
! -- Subprograms for manipulating CRC --
! --------------------------------------
!
! CRC_Error : constant Word := 16#FFFF_FFFF#;
! -- This value will be returned by the routine below in case of error. When
! -- comparing CRC for the smart recompilation, a CRC_Error means that the
! -- CRC values does not match.
! function Get_File_CRC (Fname : Name_Id) return Word;
! -- Compute CRC 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
! -- affected by a mis-computation. Returns CRC_Error value, if the file is
-- missing or has an error.
! function CRC_Match (CRC1, CRC2 : Word) return Boolean;
! pragma Inline (CRC_Match);
! -- Returns True if CRC1 and CRC2 have the same value and not equal to
! -- CRC_Error, returns False in all other cases. CRC must always be checked
! -- for equality through this function.
end ALI.Util;
--- 126,155 ----
-- source files. In minimal recompilation mode (Minimal_Recompilation set
-- to True, no mismatch is found if the file's timestamp has not changed.
! --------------------------------------------
! -- 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
! -- 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;
*** ali.adb 2001/09/28 19:32:08 1.125
--- ali.adb 2001/09/29 03:24:12 1.126
***************
*** 1130,1151 ****
declare
Ctr : Natural;
! CRC : Word;
begin
Ctr := 0;
! CRC := 0;
loop
exit when At_Eol or else Ctr = 8;
if Nextc in '0' .. '9' then
! CRC := CRC * 16 +
Character'Pos (Nextc) - Character'Pos ('0');
elsif Nextc in 'a' .. 'f' then
! CRC := CRC * 16 +
! Character'Pos (Nextc) - Character'Pos ('a') + 10;
else
exit;
--- 1130,1151 ----
declare
Ctr : Natural;
! Chk : Word;
begin
Ctr := 0;
! Chk := 0;
loop
exit when At_Eol or else Ctr = 8;
if Nextc in '0' .. '9' then
! Chk := Chk * 16 +
Character'Pos (Nextc) - Character'Pos ('0');
elsif Nextc in 'a' .. 'f' then
! Chk := Chk * 16 +
! Character'Pos (Nextc) - Character'Pos ('A') + 10;
else
exit;
***************
*** 1156,1162 ****
end loop;
if Ctr = 8 and then At_End_Of_Field then
! Sdep.Table (Sdep.Last).CRC := CRC;
else
Fatal_Error;
end if;
--- 1156,1162 ----
end loop;
if Ctr = 8 and then At_End_Of_Field then
! Sdep.Table (Sdep.Last).Checksum := Chk;
else
Fatal_Error;
end if;
*** ali.ads 2001/09/28 19:32:26 1.72
--- ali.ads 2001/09/29 03:24:33 1.73
***************
*** 519,526 ****
Stamp : Time_Stamp_Type;
-- Time stamp value
! CRC : Word;
! -- CRC value
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
--- 519,526 ----
Stamp : Time_Stamp_Type;
-- Time stamp value
! Checksum : Word;
! -- Checksum value
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
*** gnatls.adb 2001/09/28 19:33:33 1.38
--- gnatls.adb 2001/09/29 03:25:09 1.39
***************
*** 54,60 ****
type File_Status is (
OK, -- matching timestamp
! CRC_OK, -- only matching CRC
Not_Found, -- file not found on source PATH
Not_Same, -- neither checksum nor timestamp matching
Not_First_On_PATH); -- matching file hidden by Not_Same file on path
--- 54,60 ----
type File_Status is (
OK, -- matching timestamp
! Checksum_OK, -- only matching checksum
Not_Found, -- file not found on source PATH
Not_Same, -- neither checksum nor timestamp matching
Not_First_On_PATH); -- matching file hidden by Not_Same file on path
***************
*** 133,142 ****
-- Determine the structure of the output (multi columns or not, etc)
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! CRC : Word;
! Status : out File_Status);
-- Determine the file status (Status) of the file represented by FS
-- with the expected Stamp and checksum given as argument. FS will be
-- updated to the full file name if available.
--- 133,142 ----
-- Determine the structure of the output (multi columns or not, etc)
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! Checksum : Word;
! Status : out File_Status);
-- Determine the file status (Status) of the file represented by FS
-- with the expected Stamp and checksum given as argument. FS will be
-- updated to the full file name if available.
***************
*** 334,343 ****
-----------------
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! CRC : Word;
! Status : out File_Status)
is
Tmp1 : File_Name_Type;
Tmp2 : File_Name_Type;
--- 334,343 ----
-----------------
procedure Find_Status
! (FS : in out File_Name_Type;
! Stamp : Time_Stamp_Type;
! Checksum : Word;
! Status : out File_Status)
is
Tmp1 : File_Name_Type;
Tmp2 : File_Name_Type;
***************
*** 352,360 ****
FS := Tmp1;
Status := OK;
! elsif CRC_Match (Get_File_CRC (FS), CRC) then
FS := Tmp1;
! Status := CRC_OK;
else
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
--- 352,360 ----
FS := Tmp1;
Status := OK;
! elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
FS := Tmp1;
! Status := Checksum_OK;
else
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
***************
*** 414,427 ****
procedure Output_Source (Sdep_I : Sdep_Id) is
Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
! CRC : constant Word := Sdep.Table (Sdep_I).CRC;
FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
Status : File_Status;
Object_Name : String_Access;
begin
if Print_Source then
! Find_Status (FS, Stamp, CRC, Status);
Get_Name_String (FS);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
--- 414,427 ----
procedure Output_Source (Sdep_I : Sdep_Id) is
Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
! Checksum : constant Word := Sdep.Table (Sdep_I).Checksum;
FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
Status : File_Status;
Object_Name : String_Access;
begin
if Print_Source then
! Find_Status (FS, Stamp, Checksum, Status);
Get_Name_String (FS);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
***************
*** 460,466 ****
when OK =>
Write_Str (" unchanged");
! when CRC_OK =>
Write_Str (" slightly modified");
when Not_Found =>
--- 460,466 ----
when OK =>
Write_Str (" unchanged");
! when Checksum_OK =>
Write_Str (" slightly modified");
when Not_Found =>
***************
*** 478,484 ****
when OK =>
Write_Str (" OK ");
! when CRC_OK =>
Write_Str (" MOK ");
when Not_Found =>
--- 478,484 ----
when OK =>
Write_Str (" OK ");
! when Checksum_OK =>
Write_Str (" MOK ");
when Not_Found =>
*** lib-load.adb 2001/09/28 19:34:53 1.87
--- lib-load.adb 2001/09/29 03:25:29 1.88
***************
*** 200,206 ****
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Unit_Name => No_Name,
! Version => Source_CRC (Main_Source_File));
end if;
end Initialize;
--- 200,206 ----
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Unit_Name => No_Name,
! Version => Source_Checksum (Main_Source_File));
end if;
end Initialize;
***************
*** 210,216 ****
procedure Initialize_Version (U : Unit_Number_Type) is
begin
! Units.Table (U).Version := Source_CRC (Source_Index (U));
end Initialize_Version;
---------------
--- 210,216 ----
procedure Initialize_Version (U : Unit_Number_Type) is
begin
! Units.Table (U).Version := Source_Checksum (Source_Index (U));
end Initialize_Version;
---------------
***************
*** 544,550 ****
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Unit_Name => Uname_Actual,
! Version => Source_CRC (Src_Ind));
-- Parse the new unit
--- 544,550 ----
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Unit_Name => Uname_Actual,
! Version => Source_Checksum (Src_Ind));
-- Parse the new unit
***************
*** 651,657 ****
Units.Table (Main_Unit).Cunit := N;
Units.Table (Main_Unit).Unit_Name :=
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
! Units.Table (Main_Unit).Version := Source_CRC (Sind);
end Make_Instance_Unit;
------------------------
--- 651,657 ----
Units.Table (Main_Unit).Cunit := N;
Units.Table (Main_Unit).Unit_Name :=
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
! Units.Table (Main_Unit).Version := Source_Checksum (Sind);
end Make_Instance_Unit;
------------------------
***************
*** 692,698 ****
Units.Table (Unum).Version :=
Units.Table (Unum).Version
xor
! Source_CRC (Source_Index (Fnum));
end Version_Update;
----------------------------
--- 692,698 ----
Units.Table (Unum).Version :=
Units.Table (Unum).Version
xor
! Source_Checksum (Source_Index (Fnum));
end Version_Update;
----------------------------
*** lib-writ.adb 2001/09/28 19:35:13 1.161
--- lib-writ.adb 2001/09/29 03:25:40 1.162
***************
*** 107,113 ****
Version => 0,
Error_Location => No_Location);
! -- Parse system.ads so that the CRC is set right
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard := Par (Configuration_Pragmas => False);
--- 107,113 ----
Version => 0,
Error_Location => No_Location);
! -- Parse system.ads so that the checksum is set right
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard := Par (Configuration_Pragmas => False);
***************
*** 894,900 ****
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Char (' ');
! Write_Info_Str (Get_Hex_String (Source_CRC (Sind)));
-- If subunit, add unit name, omitting the %b at the end
--- 894,900 ----
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Char (' ');
! Write_Info_Str (Get_Hex_String (Source_Checksum (Sind)));
-- If subunit, add unit name, omitting the %b at the end
*** lib-writ.ads 2001/08/04 12:41:44 1.14
--- lib-writ.ads 2001/09/29 03:25:45 1.15
***************
*** 411,417 ****
-- time stamp representation.
-- The checksum is an 8-hex digit representation of the source
! -- file checksum, with letters given in upper case.
-- The subunit name is present only if the dependency line is for
-- a subunit. It contains the fully qualified name of the subunit
--- 411,417 ----
-- time stamp representation.
-- The checksum is an 8-hex digit representation of the source
! -- 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
*** scans.adb 2001/09/28 19:35:51 1.13
--- scans.adb 2001/09/29 03:26:12 1.14
***************
*** 46,52 ****
Token_Ptr := Saved_State.Save_Token_Ptr;
Current_Line_Start := Saved_State.Save_Current_Line_Start;
Start_Column := Saved_State.Save_Start_Column;
! CRC := Saved_State.Save_CRC;
First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
Token_Node := Saved_State.Save_Token_Node;
Token_Name := Saved_State.Save_Token_Name;
--- 46,52 ----
Token_Ptr := Saved_State.Save_Token_Ptr;
Current_Line_Start := Saved_State.Save_Current_Line_Start;
Start_Column := Saved_State.Save_Start_Column;
! Checksum := Saved_State.Save_Checksum;
First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
Token_Node := Saved_State.Save_Token_Node;
Token_Name := Saved_State.Save_Token_Name;
***************
*** 65,71 ****
Saved_State.Save_Token_Ptr := Token_Ptr;
Saved_State.Save_Current_Line_Start := Current_Line_Start;
Saved_State.Save_Start_Column := Start_Column;
! Saved_State.Save_CRC := CRC;
Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
Saved_State.Save_Token_Node := Token_Node;
Saved_State.Save_Token_Name := Token_Name;
--- 65,71 ----
Saved_State.Save_Token_Ptr := Token_Ptr;
Saved_State.Save_Current_Line_Start := Current_Line_Start;
Saved_State.Save_Start_Column := Start_Column;
! Saved_State.Save_Checksum := Checksum;
Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
Saved_State.Save_Token_Node := Token_Node;
Saved_State.Save_Token_Name := Token_Name;
*** scans.ads 2001/09/28 19:36:38 1.33
--- scans.ads 2001/09/29 03:26:15 1.34
***************
*** 35,42 ****
with Types; use Types;
- with GNAT.CRC32; use GNAT.CRC32;
-
package Scans is
-- The scanner maintains a current state in the global variables defined
--- 35,40 ----
***************
*** 344,350 ****
-- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up.
! CRC : CRC32;
-- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and
-- excludes comments.
--- 342,348 ----
-- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up.
! Checksum : Word;
-- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and
-- excludes comments.
***************
*** 410,416 ****
Save_Token_Ptr : Source_Ptr;
Save_Current_Line_Start : Source_Ptr;
Save_Start_Column : Column_Number;
! Save_CRC : CRC32;
Save_First_Non_Blank_Location : Source_Ptr;
Save_Token_Node : Node_Id;
Save_Token_Name : Name_Id;
--- 408,414 ----
Save_Token_Ptr : Source_Ptr;
Save_Current_Line_Start : Source_Ptr;
Save_Start_Column : Column_Number;
! Save_Checksum : Word;
Save_First_Non_Blank_Location : Source_Ptr;
Save_Token_Node : Node_Id;
Save_Token_Name : Name_Id;
*** scn-nlit.adb 2001/09/28 19:38:27 1.33
--- scn-nlit.adb 2001/09/29 03:26:51 1.34
***************
*** 103,109 ****
-- Loop through digits (allowing underlines)
loop
! Update (CRC, C);
UI_Int_Value :=
UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
Scan_Ptr := Scan_Ptr + 1;
--- 103,109 ----
-- Loop through digits (allowing underlines)
loop
! Accumulate_Checksum (C);
UI_Int_Value :=
UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
Scan_Ptr := Scan_Ptr + 1;
***************
*** 111,117 ****
C := Source (Scan_Ptr);
if C = '_' then
! Update (CRC, '_');
loop
Scan_Ptr := Scan_Ptr + 1;
--- 111,117 ----
C := Source (Scan_Ptr);
if C = '_' then
! Accumulate_Checksum ('_');
loop
Scan_Ptr := Scan_Ptr + 1;
***************
*** 158,164 ****
-- and must not be eaten up scanning a numeric literal.
while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
! Update (CRC, '.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
--- 158,164 ----
-- and must not be eaten up scanning a numeric literal.
while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
! Accumulate_Checksum ('.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
***************
*** 192,198 ****
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
! Update (CRC, C);
Base_Char := C;
UI_Base := UI_Int_Value;
--- 192,198 ----
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
! Accumulate_Checksum (C);
Base_Char := C;
UI_Base := UI_Int_Value;
***************
*** 212,228 ****
loop
if C in '0' .. '9' then
! Update (CRC, C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
elsif C in 'A' .. 'F' then
! Update (CRC, Character'Val (Character'Pos (C) + 32));
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
elsif C in 'a' .. 'f' then
! Update (CRC, C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
--- 212,228 ----
loop
if C in '0' .. '9' then
! Accumulate_Checksum (C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
elsif C in 'A' .. 'F' then
! Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
elsif C in 'a' .. 'f' then
! Accumulate_Checksum (C);
Extended_Digit_Value :=
Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
***************
*** 242,248 ****
if C = '_' then
loop
! Update (CRC, '_');
Scan_Ptr := Scan_Ptr + 1;
C := Source (Scan_Ptr);
exit when C /= '_';
--- 242,248 ----
if C = '_' then
loop
! Accumulate_Checksum ('_');
Scan_Ptr := Scan_Ptr + 1;
C := Source (Scan_Ptr);
exit when C /= '_';
***************
*** 250,256 ****
end loop;
elsif C = '.' then
! Update (CRC, '.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
--- 250,256 ----
end loop;
elsif C = '.' then
! Accumulate_Checksum ('.');
if Point_Scanned then
Error_Msg_S ("duplicate point ignored");
***************
*** 262,268 ****
Scale := 0;
elsif C = Base_Char then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
exit;
--- 262,268 ----
Scale := 0;
elsif C = Base_Char then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit;
***************
*** 296,311 ****
end if;
if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
! Update (CRC, 'e');
Scan_Ptr := Scan_Ptr + 1;
Exponent_Is_Negative := False;
if Source (Scan_Ptr) = '+' then
! Update (CRC, '+');
Scan_Ptr := Scan_Ptr + 1;
elsif Source (Scan_Ptr) = '-' then
! Update (CRC, '-');
if not Point_Scanned then
Error_Msg_S ("negative exponent not allowed for integer literal");
--- 296,311 ----
end if;
if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
! Accumulate_Checksum ('e');
Scan_Ptr := Scan_Ptr + 1;
Exponent_Is_Negative := False;
if Source (Scan_Ptr) = '+' then
! Accumulate_Checksum ('+');
Scan_Ptr := Scan_Ptr + 1;
elsif Source (Scan_Ptr) = '-' then
! Accumulate_Checksum ('-');
if not Point_Scanned then
Error_Msg_S ("negative exponent not allowed for integer literal");
*** scn-slit.adb 2001/09/28 19:39:26 1.30
--- scn-slit.adb 2001/09/29 03:27:03 1.31
***************
*** 6,12 ****
-- --
-- B o d y --
-- --
! -- $Revision$ --
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
--- 6,12 ----
-- --
-- B o d y --
-- --
! -- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
***************
*** 291,297 ****
-- latter case is an error detected by the character literal circuit.
Delimiter := Source (Scan_Ptr);
! Update (CRC, Delimiter);
Start_String;
Scan_Ptr := Scan_Ptr + 1;
--- 291,297 ----
-- latter case is an error detected by the character literal circuit.
Delimiter := Source (Scan_Ptr);
! Accumulate_Checksum (Delimiter);
Start_String;
Scan_Ptr := Scan_Ptr + 1;
***************
*** 301,311 ****
C := Source (Scan_Ptr);
if C = Delimiter then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
Code := Get_Char_Code (C);
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 1;
else
--- 301,311 ----
C := Source (Scan_Ptr);
if C = Delimiter then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
exit when Source (Scan_Ptr) /= Delimiter;
Code := Get_Char_Code (C);
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 1;
else
***************
*** 329,335 ****
Identifier_Char (Source (Scan_Ptr + 2)))
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
--- 329,335 ----
Identifier_Char (Source (Scan_Ptr + 2)))
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 337,343 ****
end if;
else
! Update (CRC, C);
if C not in Graphic_Character then
if C in Line_Terminator then
--- 337,343 ----
end if;
else
! Accumulate_Checksum (C);
if C not in Graphic_Character then
if C in Line_Terminator then
*** scn.adb 2001/09/28 19:40:06 1.112
--- scn.adb 2001/09/29 03:27:37 1.113
***************
*** 39,47 ****
with Style;
with Widechar; use Widechar;
! with Ada.Streams; use Ada.Streams;
! with GNAT.CRC32; use GNAT.CRC32;
! with Interfaces; use Interfaces;
with System.WCh_Con; use System.WCh_Con;
package body Scn is
--- 39,45 ----
with Style;
with Widechar; use Widechar;
! with System.CRC32;
with System.WCh_Con; use System.WCh_Con;
package body Scn is
***************
*** 58,63 ****
--- 56,83 ----
-- Local Subprograms --
-----------------------
+ procedure Accumulate_Checksum (C : Character);
+ pragma Inline (Accumulate_Checksum);
+ -- This routine accumulates the checksum given character C. During the
+ -- scanning of a source file, this routine is called with every character
+ -- in the source, excluding blanks, and all control characters (except
+ -- that ESC is included in the checksum). Upper case letters not in string
+ -- literals are folded by the caller. See Sinput spec for the documentation
+ -- of the checksum algorithm. Note: checksum values are only used if we
+ -- generate code, so it is not necessary to worry about making the right
+ -- sequence of calls in any error situation.
+
+ procedure Accumulate_Checksum (C : Char_Code);
+ pragma Inline (Accumulate_Checksum);
+ -- This version is identical, except that the argument, C, is a character
+ -- code value instead of a character. This is used when wide characters
+ -- 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.
***************
*** 109,126 ****
procedure Slit;
-- This is the procedure for scanning out string literals. On entry,
! -- Scan_Ptr points to the opening string quote (the CRC for this
-- character has not been accumulated yet). On return Scan_Ptr points
-- past the closing quote of the string literal, Token and Token_Node
! -- are set appropriately, and the CRC is upated.
! procedure Update_CRC (C : Char_Code);
! pragma Inline (Update_CRC);
! -- This version updates variable CRC (see Scans.CRC complete documentation
! -- of the CRC algorithm here) with the wide character C. This is used when
! -- wide characters are scanned. We use the character code rather than the
! -- ASCII characters so that the CRC is independent of wide character
! -- encoding method.
-----------------------
-- Check_End_Of_Line --
--- 129,153 ----
procedure Slit;
-- This is the procedure for scanning out string literals. On entry,
! -- Scan_Ptr points to the opening string quote (the checksum for this
-- character has not been accumulated yet). On return Scan_Ptr points
-- past the closing quote of the string literal, Token and Token_Node
! -- are set appropriately, and the checksum is upated.
!
! -------------------------
! -- Accumulate_Checksum --
! -------------------------
!
! procedure Accumulate_Checksum (C : Character) is
! begin
! System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
! end Accumulate_Checksum;
! procedure Accumulate_Checksum (C : Char_Code) is
! begin
! Accumulate_Checksum (Character'Val (C / 256));
! Accumulate_Checksum (Character'Val (C mod 256));
! end Accumulate_Checksum;
-----------------------
-- Check_End_Of_Line --
***************
*** 273,279 ****
function Double_Char_Token (C : Character) return Boolean is
begin
if Source (Scan_Ptr + 1) = C then
! Update (CRC, C);
Scan_Ptr := Scan_Ptr + 2;
return True;
--- 300,306 ----
function Double_Char_Token (C : Character) return Boolean is
begin
if Source (Scan_Ptr + 1) = C then
! Accumulate_Checksum (C);
Scan_Ptr := Scan_Ptr + 2;
return True;
***************
*** 338,343 ****
--- 365,379 ----
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 --
------------------------
***************
*** 437,442 ****
--- 473,480 ----
Start_Column := Set_Start_Column;
First_Non_Blank_Location := Scan_Ptr;
+ 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
***************
*** 450,459 ****
Set_License (Current_Source_File, Determine_License);
end if;
- -- Initialize CRC
-
- Initialize (CRC);
-
-- Scan initial token (note this initializes Prev_Token, Prev_Token_Ptr)
Scan;
--- 488,493 ----
***************
*** 587,593 ****
-- Ampersand
when '&' =>
! Update (CRC, '&');
if Source (Scan_Ptr + 1) = '&' then
Error_Msg_S ("'&'& should be `AND THEN`");
--- 621,627 ----
-- Ampersand
when '&' =>
! Accumulate_Checksum ('&');
if Source (Scan_Ptr + 1) = '&' then
Error_Msg_S ("'&'& should be `AND THEN`");
***************
*** 605,614 ****
-- which is the exponentiation compound delimtier).
when '*' =>
! Update (CRC, '*');
if Source (Scan_Ptr + 1) = '*' then
! Update (CRC, '*');
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Double_Asterisk;
return;
--- 639,648 ----
-- which is the exponentiation compound delimtier).
when '*' =>
! Accumulate_Checksum ('*');
if Source (Scan_Ptr + 1) = '*' then
! Accumulate_Checksum ('*');
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Double_Asterisk;
return;
***************
*** 623,629 ****
-- assignment compound delimiter.
when ':' =>
! Update (CRC, ':');
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
--- 657,663 ----
-- assignment compound delimiter.
when ':' =>
! Accumulate_Checksum (':');
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
***************
*** 648,654 ****
-- Left parenthesis
when '(' =>
! Update (CRC, '(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
if Style_Check then Style.Check_Left_Paren; end if;
--- 682,688 ----
-- Left parenthesis
when '(' =>
! Accumulate_Checksum ('(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
if Style_Check then Style.Check_Left_Paren; end if;
***************
*** 679,685 ****
-- Comma
when ',' =>
! Update (CRC, ',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
if Style_Check then Style.Check_Comma; end if;
--- 713,719 ----
-- Comma
when ',' =>
! Accumulate_Checksum (',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
if Style_Check then Style.Check_Comma; end if;
***************
*** 690,696 ****
-- a digit following the period, to give a better error message.
when '.' =>
! Update (CRC, '.');
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
--- 724,730 ----
-- a digit following the period, to give a better error message.
when '.' =>
! Accumulate_Checksum ('.');
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
***************
*** 711,717 ****
-- arrow (=>) compound delimiter.
when '=' =>
! Update (CRC, '=');
if Double_Char_Token ('>') then
Token := Tok_Arrow;
--- 745,751 ----
-- arrow (=>) compound delimiter.
when '=' =>
! Accumulate_Checksum ('=');
if Double_Char_Token ('>') then
Token := Tok_Arrow;
***************
*** 731,737 ****
-- or equal operator, or first character of a right label bracket.
when '>' =>
! Update (CRC, '>');
if Double_Char_Token ('=') then
Token := Tok_Greater_Equal;
--- 765,771 ----
-- or equal operator, or first character of a right label bracket.
when '>' =>
! Accumulate_Checksum ('>');
if Double_Char_Token ('=') then
Token := Tok_Greater_Equal;
***************
*** 752,758 ****
-- first character of a box (<>) compound delimiter.
when '<' =>
! Update (CRC, '<');
if Double_Char_Token ('=') then
Token := Tok_Less_Equal;
--- 786,792 ----
-- first character of a box (<>) compound delimiter.
when '<' =>
! Accumulate_Checksum ('<');
if Double_Char_Token ('=') then
Token := Tok_Less_Equal;
***************
*** 784,790 ****
return;
elsif Source (Scan_Ptr + 1) /= '-' then
! Update (CRC, '-');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Minus;
return;
--- 818,824 ----
return;
elsif Source (Scan_Ptr + 1) /= '-' then
! Accumulate_Checksum ('-');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Minus;
return;
***************
*** 877,883 ****
Err : Boolean;
begin
! Update (CRC, ''');
Scan_Ptr := Scan_Ptr + 1;
-- Here is where we make the test to distinguish the cases. Treat
--- 911,917 ----
Err : Boolean;
begin
! Accumulate_Checksum (''');
Scan_Ptr := Scan_Ptr + 1;
-- Here is where we make the test to distinguish the cases. Treat
***************
*** 913,919 ****
Source (Scan_Ptr + 1) = '"')
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
--- 947,953 ----
Source (Scan_Ptr + 1) = '"')
then
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 948,954 ****
-- Otherwise we have a (non-wide) character literal
else
! Update (CRC, Source (Scan_Ptr));
if Source (Scan_Ptr) not in Graphic_Character then
if Source (Scan_Ptr) in Upper_Half_Character then
--- 982,988 ----
-- Otherwise we have a (non-wide) character literal
else
! Accumulate_Checksum (Source (Scan_Ptr));
if Source (Scan_Ptr) not in Graphic_Character then
if Source (Scan_Ptr) in Upper_Half_Character then
***************
*** 968,974 ****
-- Fall through here with Scan_Ptr updated past the closing
-- quote, and Code set to the Char_Code value for the literal
! Update (CRC, ''');
Token := Tok_Char_Literal;
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
Set_Char_Literal_Value (Token_Node, Code);
--- 1002,1008 ----
-- Fall through here with Scan_Ptr updated past the closing
-- quote, and Code set to the Char_Code value for the literal
! Accumulate_Checksum (''');
Token := Tok_Char_Literal;
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
Set_Char_Literal_Value (Token_Node, Code);
***************
*** 982,988 ****
-- Right parenthesis
when ')' =>
! Update (CRC, ')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
if Style_Check then Style.Check_Right_Paren; end if;
--- 1016,1022 ----
-- Right parenthesis
when ')' =>
! Accumulate_Checksum (')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
if Style_Check then Style.Check_Right_Paren; end if;
***************
*** 999,1005 ****
-- Slash (can be division operator or first character of not equal)
when '/' =>
! Update (CRC, '/');
if Double_Char_Token ('=') then
Token := Tok_Not_Equal;
--- 1033,1039 ----
-- Slash (can be division operator or first character of not equal)
when '/' =>
! Accumulate_Checksum ('/');
if Double_Char_Token ('=') then
Token := Tok_Not_Equal;
***************
*** 1013,1019 ****
-- Semicolon
when ';' =>
! Update (CRC, ';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
if Style_Check then Style.Check_Semicolon; end if;
--- 1047,1053 ----
-- Semicolon
when ';' =>
! Accumulate_Checksum (';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
if Style_Check then Style.Check_Semicolon; end if;
***************
*** 1022,1028 ****
-- Vertical bar
when '|' => Vertical_Bar_Case : begin
! Update (CRC, '|');
-- Special check for || to give nice message
--- 1056,1062 ----
-- Vertical bar
when '|' => Vertical_Bar_Case : begin
! Accumulate_Checksum ('|');
-- Special check for || to give nice message
***************
*** 1043,1049 ****
-- Exclamation, replacement character for vertical bar
when '!' => Exclamation_Case : begin
! Update (CRC, '!');
if Source (Scan_Ptr + 1) = '=' then
Error_Msg_S ("'!= should be /=");
--- 1077,1083 ----
-- Exclamation, replacement character for vertical bar
when '!' => Exclamation_Case : begin
! Accumulate_Checksum ('!');
if Source (Scan_Ptr + 1) = '=' then
Error_Msg_S ("'!= should be /=");
***************
*** 1062,1068 ****
-- Plus
when '+' => Plus_Case : begin
! Update (CRC, '+');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Plus;
return;
--- 1096,1102 ----
-- Plus
when '+' => Plus_Case : begin
! Accumulate_Checksum ('+');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Plus;
return;
***************
*** 1085,1091 ****
when 'a' .. 'z' =>
Name_Len := 1;
Name_Buffer (1) := Source (Scan_Ptr);
! Update (CRC, Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
--- 1119,1125 ----
when 'a' .. 'z' =>
Name_Len := 1;
Name_Buffer (1) := Source (Scan_Ptr);
! Accumulate_Checksum (Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
***************
*** 1095,1101 ****
Name_Len := 1;
Name_Buffer (1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Update (CRC, Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
--- 1129,1135 ----
Name_Len := 1;
Name_Buffer (1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Accumulate_Checksum (Name_Buffer (1));
Scan_Ptr := Scan_Ptr + 1;
goto Scan_Identifier;
***************
*** 1192,1203 ****
or else Source (Scan_Ptr) in '0' .. '9'
then
Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
! Update (CRC, Source (Scan_Ptr));
elsif Source (Scan_Ptr) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 1));
else
exit;
end if;
--- 1226,1237 ----
or else Source (Scan_Ptr) in '0' .. '9'
then
Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
! Accumulate_Checksum (Source (Scan_Ptr));
elsif Source (Scan_Ptr) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 1) :=
Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 1));
else
exit;
end if;
***************
*** 1208,1219 ****
or else Source (Scan_Ptr + 1) in '0' .. '9'
then
Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1);
! Update (CRC, Source (Scan_Ptr + 1));
elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 2) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 2));
else
Scan_Ptr := Scan_Ptr + 1;
--- 1242,1253 ----
or else Source (Scan_Ptr + 1) in '0' .. '9'
then
Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1);
! Accumulate_Checksum (Source (Scan_Ptr + 1));
elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 2) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 2));
else
Scan_Ptr := Scan_Ptr + 1;
***************
*** 1225,1236 ****
or else Source (Scan_Ptr + 2) in '0' .. '9'
then
Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2);
! Update (CRC, Source (Scan_Ptr + 2));
elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 3) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 3));
else
Scan_Ptr := Scan_Ptr + 2;
Name_Len := Name_Len + 2;
--- 1259,1270 ----
or else Source (Scan_Ptr + 2) in '0' .. '9'
then
Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2);
! Accumulate_Checksum (Source (Scan_Ptr + 2));
elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 3) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 3));
else
Scan_Ptr := Scan_Ptr + 2;
Name_Len := Name_Len + 2;
***************
*** 1241,1252 ****
or else Source (Scan_Ptr + 3) in '0' .. '9'
then
Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3);
! Update (CRC, Source (Scan_Ptr + 3));
elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 4) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32);
! Update (CRC, Name_Buffer (Name_Len + 4));
else
Scan_Ptr := Scan_Ptr + 3;
--- 1275,1286 ----
or else Source (Scan_Ptr + 3) in '0' .. '9'
then
Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3);
! Accumulate_Checksum (Source (Scan_Ptr + 3));
elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then
Name_Buffer (Name_Len + 4) :=
Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32);
! Accumulate_Checksum (Name_Buffer (Name_Len + 4));
else
Scan_Ptr := Scan_Ptr + 3;
***************
*** 1273,1279 ****
-- and for a trailing underline character
if Source (Scan_Ptr) = '_' then
! Update (CRC, '_');
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '_';
--- 1307,1313 ----
-- and for a trailing underline character
if Source (Scan_Ptr) = '_' then
! Accumulate_Checksum ('_');
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '_';
***************
*** 1296,1302 ****
elsif Source (Scan_Ptr) in Upper_Half_Character
and then not Upper_Half_Encoding
then
! Update (CRC, Source (Scan_Ptr));
Store_Encoded_Character
(Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
Scan_Ptr := Scan_Ptr + 1;
--- 1330,1336 ----
elsif Source (Scan_Ptr) in Upper_Half_Character
and then not Upper_Half_Encoding
then
! Accumulate_Checksum (Source (Scan_Ptr));
Store_Encoded_Character
(Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
Scan_Ptr := Scan_Ptr + 1;
***************
*** 1326,1332 ****
begin
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Update_CRC (Code);
if Err then
Error_Illegal_Wide_Character;
--- 1360,1366 ----
begin
Scan_Wide (Source, Scan_Ptr, Code, Err);
! Accumulate_Checksum (Code);
if Err then
Error_Illegal_Wide_Character;
***************
*** 1540,1560 ****
----------
procedure Slit is separate;
-
- ----------------
- -- Update_CRC --
- ----------------
-
- procedure Update_CRC (C : Char_Code) is
- Elements : Stream_Element_Array (1 .. 2);
- -- Char_Code is a 16 bits value, put the upper and lower part in the
- -- Elementes table.
-
- begin
- Elements (1) := Stream_Element (Shift_Right (Unsigned_16 (C), 8));
- Elements (2) := Stream_Element (C and 16#00FF#);
-
- Update (CRC, Elements);
- end Update_CRC;
end Scn;
--- 1574,1578 ----
*** sinput-p.adb 2001/09/28 19:41:34 1.10
--- sinput-p.adb 2001/09/29 03:28:21 1.11
***************
*** 190,196 ****
Num_SRef_Pragmas => 0,
Reference_Name => File_Id,
Sloc_Adjust => 0,
! Source_CRC => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
--- 190,196 ----
Num_SRef_Pragmas => 0,
Reference_Name => File_Id,
Sloc_Adjust => 0,
! Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
*** sinput.adb 2001/09/28 19:42:00 1.100
--- sinput.adb 2001/09/29 03:28:59 1.101
***************
*** 1070,1079 ****
return Source_File.Table (S).Reference_Name;
end Reference_Name;
! function Source_CRC (S : SFI) return Word is
begin
! return Source_File.Table (S).Source_CRC;
! end Source_CRC;
function Source_First (S : SFI) return Source_Ptr is
begin
--- 1070,1079 ----
return Source_File.Table (S).Reference_Name;
end Reference_Name;
! function Source_Checksum (S : SFI) return Word is
begin
! return Source_File.Table (S).Source_Checksum;
! end Source_Checksum;
function Source_First (S : SFI) return Source_Ptr is
begin
*** sinput.ads 2001/09/28 19:42:31 1.70
--- sinput.ads 2001/09/29 03:29:04 1.71
***************
*** 188,198 ****
-- Time stamp of the source file. Set by Sinput.L.Load_Source_File,
-- and cannot be subsequently changed.
! -- Source_CRC : Word;
! -- Computed a CRC32 for contents of source file. See GNAT.CRC32 spec
! -- for a description of the CRC-32 algorithm. See also separate section
! -- later on in this spec for a description of the computation of the
! -- source CRC.
-- Last_Source_Line : Physical_Line_Number;
-- Physical line number of last source line. Whlie a file is being
--- 188,196 ----
-- Time stamp of the source file. Set by Sinput.L.Load_Source_File,
-- and cannot be subsequently changed.
! -- Source_Checksum : Word;
! -- Computed checksum for contents of source file. See separate section
! -- later on in this spec for a description of the checksum algorithm.
-- Last_Source_Line : Physical_Line_Number;
-- Physical line number of last source line. Whlie a file is being
***************
*** 241,247 ****
function License (S : SFI) return License_Type;
function Num_SRef_Pragmas (S : SFI) return Nat;
function Reference_Name (S : SFI) return File_Name_Type;
! function Source_CRC (S : SFI) return Word;
function Source_First (S : SFI) return Source_Ptr;
function Source_Last (S : SFI) return Source_Ptr;
function Source_Text (S : SFI) return Source_Buffer_Ptr;
--- 239,245 ----
function License (S : SFI) return License_Type;
function Num_SRef_Pragmas (S : SFI) return Nat;
function Reference_Name (S : SFI) return File_Name_Type;
! function Source_Checksum (S : SFI) return Word;
function Source_First (S : SFI) return Source_Ptr;
function Source_Last (S : SFI) return Source_Ptr;
function Source_Text (S : SFI) return Source_Buffer_Ptr;
***************
*** 267,299 ****
Main_Source_File : Source_File_Index;
-- This is set to the source file index of the main unit
! ------------------
! -- CRC Handling --
! ------------------
! -- As a source file is scanned, a CRC is computed by taking all the
-- non-blank characters in the file, excluding comment characters, the
-- minus-minus sequence starting a comment, and all control characters
-- except ESC.
-
- -- These characters are used to compute a 32-bit CRC which is stored
- -- in the variable Scans.CRC, 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.
! -- For a wide character sequence, the CRC is computed using the
! -- corresponding character code value C.
! -- This algorithm ensures that the CRC 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.CRC is initialized to zero at the start of scanning a file,
! -- and copied into the Source_CRC field of the file table entry when
! -- the end of file is encountered.
-------------------------------------
-- Handling Generic Instantiations --
--- 265,291 ----
Main_Source_File : Source_File_Index;
-- This is set to the source file index of the main unit
! -----------------------
! -- Checksum Handling --
! -----------------------
! -- As a source file is scanned, a checksum is computed by taking all the
-- non-blank characters in the file, excluding comment characters, the
-- minus-minus sequence starting a comment, and all control characters
-- except ESC.
! -- 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 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 --
***************
*** 576,582 ****
Source_First : Source_Ptr;
Source_Last : Source_Ptr;
Time_Stamp : Time_Stamp_Type;
! Source_CRC : Word;
Last_Source_Line : Physical_Line_Number;
Keyword_Casing : Casing_Type;
Identifier_Casing : Casing_Type;
--- 568,574 ----
Source_First : Source_Ptr;
Source_Last : Source_Ptr;
Time_Stamp : Time_Stamp_Type;
! Source_Checksum : Word;
Last_Source_Line : Physical_Line_Number;
Keyword_Casing : Casing_Type;
Identifier_Casing : Casing_Type;
*** Makefile.in 2001/09/29 02:52:58 1.1407
--- Makefile.in 2001/09/29 12:18:17 1.1408
***************
*** 284,290 ****
# Object files from Ada sources that are used by gnat1
GNAT_ADA_OBJS = \
! ada.o a-charac.o a-chlat1.o a-except.o a-tags.o s-memory.o a-stream.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 \
--- 284,290 ----
# 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 \
***************
*** 293,299 ****
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 g-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 \
--- 293,299 ----
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 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 \
***************
*** 427,433 ****
a-traceb.o \
gnat.o \
g-casuti.o \
- g-crc32.o \
g-dirope.o \
g-except.o \
g-hesora.o \
--- 427,432 ----
***************
*** 439,444 ****
--- 438,444 ----
system.o \
s-assert.o \
s-bitops.o \
+ s-crc32.o \
s-except.o \
s-exctab.o \
s-finroo.o \
***************
*** 542,548 ****
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 g-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 \
--- 542,548 ----
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-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 \
***************
*** 1706,1711 ****
--- 1706,1712 ----
s-auxdec.o \
s-bitops.o \
s-chepoo.o \
+ s-crc32.o \
s-direio.o \
s-errrep.o \
s-except.o \
***************
*** 3984,3989 ****
--- 3985,3992 ----
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
*** ali.adb 2001/09/29 03:24:12 1.126
--- ali.adb 2001/10/03 17:30:20 1.127
***************
*** 1145,1151 ****
elsif Nextc in 'a' .. 'f' then
Chk := Chk * 16 +
! Character'Pos (Nextc) - Character'Pos ('A') + 10;
else
exit;
--- 1145,1151 ----
elsif Nextc in 'a' .. 'f' then
Chk := Chk * 16 +
! Character'Pos (Nextc) - Character'Pos ('a') + 10;
else
exit;
*** /dev/null Thu Oct 11 18:19:50 2001
--- s-crc32.adb Tue Oct 2 18:04:10 2001
***************
*** 0 ****
--- 1,139 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
*** /dev/null Thu Oct 11 18:19:50 2001
--- s-crc32.ads Tue Oct 2 18:04:10 2001
***************
*** 0 ****
--- 1,84 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
*** /dev/null Thu Oct 11 18:19:50 2001
--- g-crc32.ads Tue Oct 2 18:03:41 2001
***************
*** 0 ****
--- 1,117 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
*** /dev/null Thu Oct 11 18:19:50 2001
--- g-crc32.adb Tue Oct 2 18:03:41 2001
***************
*** 0 ****
--- 1,92 ----
+ ------------------------------------------------------------------------------
+ -- --
+ -- 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;
Index: sinput-l.adb
===================================================================
RCS file: /nile.c/cvs/Dev/gnat/sinput-l.adb,v
retrieving revision 1.41
retrieving revision 1.42
diff -c -r1.41 -r1.42
*** sinput-l.adb 2001/09/28 19:41:10 1.41
--- sinput-l.adb 2001/09/29 03:28:17 1.42
***************
*** 41,48 ****
with Unchecked_Conversion;
- with GNAT.CRC32; use GNAT.CRC32;
-
package body Sinput.L is
Dfile : Source_File_Index;
--- 41,46 ----
***************
*** 110,116 ****
begin
Trim_Lines_Table (CSF);
! Source_File.Table (CSF).Source_CRC := Word (Get_Value (Scans.CRC));
end Complete_Source_File_Entry;
-------------------------
--- 108,114 ----
begin
Trim_Lines_Table (CSF);
! Source_File.Table (CSF).Source_Checksum := Checksum;
end Complete_Source_File_Entry;
-------------------------
***************
*** 419,425 ****
Num_SRef_Pragmas => 0,
Reference_Name => N,
Sloc_Adjust => 0,
! Source_CRC => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
--- 417,423 ----
Num_SRef_Pragmas => 0,
Reference_Name => N,
Sloc_Adjust => 0,
! Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
Index: bcheck.adb
===================================================================
RCS file: /nile.c/cvs/Dev/gnat/bcheck.adb,v
retrieving revision 1.40
retrieving revision 1.41
diff -c -r1.40 -r1.41
*** bcheck.adb 2001/09/28 19:33:06 1.40
--- bcheck.adb 2001/09/29 03:24:43 1.41
***************
*** 476,520 ****
begin
-- First, we go through the source table to see if there are any cases
! -- in which we should go after source files and compute CRC of
-- the source files. We need to do this for any file for which we have
! -- mismatching time stamps and (so far) matching CRC.
for S in Source.First .. Source.Last loop
-- If all time stamps for a file match, then there is nothing to
! -- do, since we will not be checking CRC in that case anyway
if Source.Table (S).All_Timestamps_Match then
null;
-- If we did not find the source file, then we can't compute its
! -- CRC anyway. Note that when we have a time stamp mismatch,
-- we try to find the source file unconditionally (i.e. if
-- Check_Source_Files is False).
elsif not Source.Table (S).Source_Found then
null;
! -- If we already have non-matching or missing CRC, then no
-- need to try going after source file, since we won't trust the
! -- CRC in any case.
! elsif not Source.Table (S).All_CRC_Match then
null;
-- Now we have the case where we have time stamp mismatches, and
! -- the source file is around, but so far all CRC match. This
! -- is the case where we need to compute the CRC from the source
-- file, since otherwise we would ignore the time stamp mismatches,
! -- and that is wrong if the CRC of the source does not agree
! -- with the CRC in the ALI files.
elsif Check_Source_Files then
! if not CRC_Match
! (Source.Table (S).CRC, Get_File_CRC (Source.Table (S).Sfile))
then
! Source.Table (S).All_CRC_Match := False;
end if;
end if;
end loop;
--- 476,521 ----
begin
-- First, we go through the source table to see if there are any cases
! -- in which we should go after source files and compute checksums of
-- the source files. We need to do this for any file for which we have
! -- mismatching time stamps and (so far) matching checksums.
for S in Source.First .. Source.Last loop
-- If all time stamps for a file match, then there is nothing to
! -- do, since we will not be checking checksums in that case anyway
if Source.Table (S).All_Timestamps_Match then
null;
-- If we did not find the source file, then we can't compute its
! -- checksum anyway. Note that when we have a time stamp mismatch,
-- we try to find the source file unconditionally (i.e. if
-- Check_Source_Files is False).
elsif not Source.Table (S).Source_Found then
null;
! -- If we already have non-matching or missing checksums, then no
-- need to try going after source file, since we won't trust the
! -- checksums in any case.
! elsif not Source.Table (S).All_Checksums_Match then
null;
-- Now we have the case where we have time stamp mismatches, and
! -- the source file is around, but so far all checksums match. This
! -- is the case where we need to compute the checksum from the source
-- file, since otherwise we would ignore the time stamp mismatches,
! -- and that is wrong if the checksum of the source does not agree
! -- with the checksums in the ALI files.
elsif Check_Source_Files then
! 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;
end if;
end loop;
***************
*** 530,540 ****
loop
Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
! -- If the time stamps match, or all CRC match, then we
-- are OK, otherwise we have a definite error.
if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
! and then not Source.Table (Src).All_CRC_Match
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := Sdep.Table (D).Sfile;
--- 531,541 ----
loop
Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
! -- If the time stamps match, or all checksums match, then we
-- are OK, otherwise we have a definite error.
if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
! and then not Source.Table (Src).All_Checksums_Match
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := Sdep.Table (D).Sfile;