* range check error fixes from Peter

compiler/crc.pas

@@ -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

compiler/cutils.pas

@@ -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
 

compiler/fmodule.pas

@@ -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
 

compiler/fppu.pas

@@ -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
 

compiler/pmodules.pas

@@ -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
 

compiler/utils/ppudump.pp

@@ -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