paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-20 09:09:41 +01:00
Code Issues Packages Projects Releases Wiki Activity

* range check error fixes from Peter

Browse Source
This commit is contained in:
Jonas Maebe 2001-05-09 14:11:10 +00:00
parent 05cfc07952
commit d5526ff45c
6 changed files with 72 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/crc.pas
View File

@ -26,9 +26,9 @@ Unit CRC;
Interface
Function Crc32(Const HStr:String):longint;
Function UpdateCrc32(InitCrc:longint;var InBuf;InLen:Longint):longint;
Function UpdCrc32(InitCrc:longint;b:byte):longint;
Function Crc32(Const HStr:String):cardinal;
Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:integer):cardinal;
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
Implementation
@ -38,19 +38,19 @@ Implementation
*****************************************************************************}
var
Crc32Tbl : array[0..255] of longint;
Crc32Tbl : array[0..255] of cardinal;
procedure MakeCRC32Tbl;
var
crc : longint;
i,n : byte;
crc : cardinal;
i,n : integer;
begin
for i:=0 to 255 do
begin
crc:=i;
for n:=1 to 8 do
if odd(crc) then
crc:=(crc shr 1) xor longint($edb88320)
if (crc and 1)<>0 then
crc:=(crc shr 1) xor cardinal($edb88320)
else
crc:=crc shr 1;
Crc32Tbl[i]:=crc;
@ -58,19 +58,14 @@ begin
end;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
{CRC 32}
Function Crc32(Const HStr:String):longint;
Function Crc32(Const HStr:String):cardinal;
var
i,InitCrc : longint;
i : integer;
InitCrc : cardinal;
begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
InitCrc:=longint($ffffffff);
InitCrc:=cardinal($ffffffff);
for i:=1 to Length(Hstr) do
InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(Hstr[i])] xor (InitCrc shr 8);
Crc32:=InitCrc;
@ -78,9 +73,9 @@ end;
Function UpdateCrc32(InitCrc:longint;var InBuf;InLen:Longint):longint;
Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:Integer):cardinal;
var
i : word;
i : integer;
p : pchar;
begin
if Crc32Tbl[1]=0 then
@ -89,29 +84,27 @@ begin
for i:=1 to InLen do
begin
InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
inc(longint(p));
inc(p);
end;
UpdateCrc32:=InitCrc;
end;
Function UpdCrc32(InitCrc:longint;b:byte):longint;
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
end;
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end.
{
$Log$
Revision 1.4 2000-09-24 15:06:14 peter
Revision 1.5 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.4 2000/09/24 15:06:14 peter
* use defines.inc
Revision 1.3 2000/08/13 13:04:38 peter

9
compiler/cutils.pas
View File

@ -45,7 +45,7 @@ interface
function lower(const s : string) : string;
function trimspace(const s:string):string;
procedure uppervar(var s : string);
function hexstr(val : longint;cnt : byte) : string;
function hexstr(val : cardinal;cnt : byte) : string;
function tostru(i:cardinal) : string;
function tostr(i : longint) : string;
function int64tostr(i : int64) : string;
@ -267,7 +267,7 @@ uses
end;
function hexstr(val : longint;cnt : byte) : string;
function hexstr(val : cardinal;cnt : byte) : string;
const
HexTbl : array[0..15] of char='0123456789ABCDEF';
var
@ -633,7 +633,10 @@ initialization
end.
{
$Log$
Revision 1.5 2000-12-24 12:25:31 peter
Revision 1.6 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.5 2000/12/24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class

11
compiler/fmodule.pas
View File

@ -139,14 +139,14 @@ interface
unitid : longint;
name : pstring;
checksum,
interface_checksum : longint;
interface_checksum : cardinal;
loaded : boolean;
in_uses,
in_interface,
is_stab_written : boolean;
u : tmodule;
constructor create(_u : tmodule;intface:boolean);
constructor create_to_load(const n:string;c,intfc:longint;intface:boolean);
constructor create_to_load(const n:string;c,intfc:cardinal;intface:boolean);
destructor destroy;override;
end;
@ -319,7 +319,7 @@ uses
end;
constructor tused_unit.create_to_load(const n:string;c,intfc:longint;intface:boolean);
constructor tused_unit.create_to_load(const n:string;c,intfc:cardinal;intface:boolean);
begin
u:=nil;
in_interface:=intface;
@ -636,7 +636,10 @@ uses
end.
{
$Log$
Revision 1.14 2001-05-06 14:49:16 peter
Revision 1.15 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.14 2001/05/06 14:49:16 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu

19
compiler/fppu.pas
View File

@ -191,8 +191,8 @@ uses
{ Show Debug info }
Message1(unit_u_ppu_time,filetimestring(ppufiletime));
Message1(unit_u_ppu_flags,tostr(flags));
Message1(unit_u_ppu_crc,tostr(ppufile.header.checksum));
Message1(unit_u_ppu_crc,tostr(ppufile.header.interface_checksum)+' (intfc)');
Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
do_compile:=false;
openppu:=true;
end;
@ -394,8 +394,8 @@ uses
ppufile.putstring(hp.name^);
{ the checksum should not affect the crc of this unit ! (PFV) }
ppufile.do_crc:=false;
ppufile.putlongint(hp.checksum);
ppufile.putlongint(hp.interface_checksum);
ppufile.putlongint(longint(hp.checksum));
ppufile.putlongint(longint(hp.interface_checksum));
ppufile.putbyte(byte(hp.in_interface));
ppufile.do_crc:=true;
hp:=tused_unit(hp.next);
@ -570,14 +570,14 @@ uses
var
hs : string;
intfchecksum,
checksum : longint;
checksum : cardinal;
in_interface : boolean;
begin
while not ppufile.endofentry do
begin
hs:=ppufile.getstring;
checksum:=ppufile.getlongint;
intfchecksum:=ppufile.getlongint;
checksum:=cardinal(ppufile.getlongint);
intfchecksum:=cardinal(ppufile.getlongint);
in_interface:=(ppufile.getbyte<>0);
used_units.concat(tused_unit.create_to_load(hs,checksum,intfchecksum,in_interface));
end;
@ -1143,7 +1143,10 @@ uses
end.
{
$Log$
Revision 1.3 2001-05-08 21:06:30 florian
Revision 1.4 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.3 2001/05/08 21:06:30 florian
* some more support for widechars commited especially
regarding type casting and constants

11
compiler/pmodules.pas
View File

@ -668,7 +668,7 @@ implementation
{$ifdef GDB}
pu : tused_unit;
{$endif GDB}
store_crc,store_interface_crc : longint;
store_crc,store_interface_crc : cardinal;
s2 : ^string; {Saves stack space}
force_init_final : boolean;
@ -1031,12 +1031,12 @@ implementation
if not(cs_compilesystem in aktmoduleswitches) then
if store_interface_crc<>current_module.interface_crc then
Comment(V_Warning,current_module.ppufilename^+' Interface CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
hexstr(store_crc,8)+'<>'+hexstr(current_module.interface_crc,8));
{$ifdef EXTDEBUG}
if not(cs_compilesystem in aktmoduleswitches) then
if (store_crc<>current_module.crc) and simplify_ppu then
Comment(V_Warning,current_module.ppufilename^+' implementation CRC changed '+
tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
hexstr(store_crc,8)+'<>'+hexstr(current_module.interface_crc,8));
{$endif EXTDEBUG}
{ remove static symtable (=refsymtable) here to save some mem }
@ -1300,7 +1300,10 @@ implementation
end.
{
$Log$
Revision 1.30 2001-05-06 14:49:17 peter
Revision 1.31 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.30 2001/05/06 14:49:17 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu

24
compiler/utils/ppudump.pp
View File

@ -153,6 +153,21 @@ begin
end;
function hexstr(val : cardinal;cnt : byte) : string;
const
HexTbl : array[0..15] of char='0123456789ABCDEF';
var
i : longint;
begin
hexstr[0]:=char(cnt);
for i:=cnt downto 1 do
begin
hexstr[i]:=hextbl[val and $f];
val:=val shr 4;
end;
end;
{****************************************************************************
Read Routines
****************************************************************************}
@ -1349,8 +1364,8 @@ begin
WriteLn('Target operating system : ',Target2Str(target));
Writeln('Unit flags : ',PPUFlags2Str(flags));
Writeln('FileSize (w/o header) : ',size);
Writeln('Checksum : ',checksum);
Writeln('Interface Checksum : ',interface_checksum);
Writeln('Checksum : ',hexstr(checksum,8));
Writeln('Interface Checksum : ',hexstr(interface_checksum,8));
end;
end;
{read the general stuff}
@ -1528,7 +1543,10 @@ begin
end.
{
$Log$
Revision 1.2 2001-05-06 14:49:19 peter
Revision 1.3 2001-05-09 14:11:10 jonas
* range check error fixes from Peter
Revision 1.2 2001/05/06 14:49:19 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu