home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / comp / lang / modula2 / 1719 < prev    next >
Encoding:
Internet Message Format  |  1993-01-22  |  5.8 KB

  1. Path: sparky!uunet!elroy.jpl.nasa.gov!sdd.hp.com!hplabs!ucbvax!BVILLE.GTS.ORG!greg.vigneault
  2. From: greg.vigneault@BVILLE.GTS.ORG (Greg Vigneault)
  3. Newsgroups: comp.lang.modula2
  4. Subject: FST MODULA-2 V3.1 BUG
  5. Message-ID: <446.492.uupcb@bville.gts.org>
  6. Date: 21 Jan 93 10:59:00 GMT
  7. Sender: daemon@ucbvax.BERKELEY.EDU
  8. Reply-To: Modula2 List <INFO-M2%UCF1VM.BITNET@uga.cc.uga.edu>
  9. Distribution: world
  10. Organization: Baudeville BBS - Toronto, Ontario, Canada 416-283-0114
  11. Lines: 106
  12.  
  13.  
  14.  Please take note that the FST Modula-2 compiler, version 3.1,
  15.  may allow invalid assignments to variant record fields.
  16.  
  17.  The following code demonstrates the error: allowing a LONGCARD
  18.  variant field to be assigned as a LONGINT.  Even though the
  19.  desired result achieved, the assignment should be illegal under
  20.  Modula-2's strong type checking rules.
  21.  
  22.  I've notified Roger, at FST, and he is looking into the matter.
  23. (********************************************************************)
  24.  MODULE FileCRC;        (* Compiler: FST Modula-2 v3.1 (shareware)  *)
  25. (* CRC-32 function (c) 1993 Greg Vigneault      [GSV]               *)
  26. (* P.O.Box 7169, Station A, Toronto, Ontario, Canada M5W 1X8.       *)
  27. (* greg.vigneault@bville.gts.org       gregsv@eastern.com           *)
  28.  
  29.  FROM Files     IMPORT  Open, Read, Close,  (* file I/O functions   *)
  30.                         READ,               (* file access mode     *)
  31.                         FileStatus;         (* file I/O result code *)
  32.  FROM InOut     IMPORT  Write, WriteHex, WriteLn, WriteString;
  33.  FROM Storage   IMPORT  ALLOCATE, DEALLOCATE;   (* re NEW & DISPOSE *)
  34.  FROM System    IMPORT  GetArg, Terminate;
  35.  FROM SYSTEM    IMPORT  ADDRESS;
  36. (*------------------------------------------------------------------*)
  37.  CONST  Beep            = 7C;               (* ASCII bell tone      *)
  38.         BufferSize      = 4000H;            (* file input buffer    *)
  39.  TYPE   BufferPointer   = POINTER TO ARRAY [0..BufferSize-1] OF CHAR;
  40.         LongCard        = RECORD            (* CRC-32 value         *)
  41.                             CASE Wide : BOOLEAN OF
  42.                                 TRUE  : Long    : LONGCARD |
  43.                                 FALSE : Lo      : BITSET;
  44.                                         Hi      : BITSET;
  45.                             END; (* case *)
  46.                           END; (* record *)
  47.  VAR    CRC32           : LongCard;         (* running CRC-32       *)
  48.         ArgSize,                            (* input string length  *)
  49.         BytesReceived   : CARDINAL;         (* bytes read from file *)
  50.         DataPointer     : BufferPointer;    (* data buffer pointer  *)
  51.         FileHandle      : INTEGER;                  (* file handle  *)
  52.         FileName        : ARRAY [0..127] OF CHAR;   (* ASCIIZ name  *)
  53. (*------------------------------------------------------------------*)
  54.  PROCEDURE UpdateCRC32( VAR CRC32 : LongCard;
  55.                             Block : ADDRESS;
  56.                             Count : CARDINAL);
  57.     VAR ByteCount, BitCount : CARDINAL;
  58.         Carry               : BOOLEAN;
  59.     BEGIN
  60.     FOR ByteCount := 1 TO Count DO
  61.         CRC32.Lo := CRC32.Lo / (BITSET(Block^) * {0..7});
  62.         FOR BitCount := 1 TO 8 DO
  63.             Carry := 0 IN CRC32.Lo;
  64.             CRC32.Long := CRC32.Long DIV 2L;
  65.             IF Carry THEN
  66.                 CRC32.Hi := CRC32.Hi / BITSET(0EDB8H);
  67.                 CRC32.Lo := CRC32.Lo / BITSET(08320H);
  68.                 END; (* if Carry *)
  69.             END; (* for BitCount *)
  70.         INC( Block );
  71.         END; (* for ByteCount *)
  72.     END UpdateCRC32;
  73. (*------------------------------------------------------------------*)
  74.  BEGIN  (* MODULE FileCRC *)
  75.         GetArg( FileName, ArgSize );        (* get user input       *)
  76.         IF (ArgSize = 0) THEN               (* was there any?       *)
  77.             WriteString( "Use: FILECRC FileName" ); (* no: abort    *)
  78.             Write( Beep );  WriteLn;
  79.             Terminate(1);                   (* with ERRORLEVEL code *)
  80.             END; (* if ArgSize *)
  81.         Open( FileHandle, FileName, READ ); (* open input file      *)
  82.         IF (FileHandle = -1) THEN               (* failed?          *)
  83.             WriteString( "Can't OPEN " );       (* yes: abort       *)
  84.             WriteString( FileName );  Write( Beep );  WriteLn;
  85.             Terminate(2);
  86.             END; (* if FileHandle *)
  87. (*!!!*) CRC32.Long := -1L;           (* CRC-32 initially 0FFFFFFFFH *)
  88.         (* Alternative to above is  CRC32.Long := MAX(LONGCARD);    *)
  89.         NEW( DataPointer );          (* heap space for input buffer *)
  90.         REPEAT
  91.         Read( FileHandle, DataPointer, BufferSize, BytesReceived );
  92.         IF (FileStatus # 0) THEN
  93.             WriteString( "ERROR reading file" );  WriteLn;
  94.             Close( FileHandle );  Write( Beep );  Terminate(3);
  95.             END; (* if FileStatus *)
  96.         UpdateCRC32( CRC32, DataPointer, BytesReceived );
  97.         UNTIL (BytesReceived # BufferSize);
  98.         Close( FileHandle );                    (* close the file   *)
  99.         DISPOSE( DataPointer );                 (* deallocate memory*)
  100.         CRC32.Hi := CRC32.Hi / {0..15};         (* toggle all bits  *)
  101.         CRC32.Lo := CRC32.Lo / {0..15};
  102.         WriteLn; WriteString("The CRC-32 of file ");
  103.         WriteString( FileName ); WriteString(" is 0x");
  104.         (* write hex CRC-32, padding with leading 0's if needed     *)
  105.         WriteHex( CARDINAL(CRC32.Hi), 4 );  (* min field width = 4  *)
  106.         WriteHex( CARDINAL(CRC32.Lo), 4 ); WriteLn;
  107.  END FileCRC.
  108. (********************************************************************)
  109.  
  110.  Greg_
  111.  
  112.  Jan.21.1993.Toronto.Canada.        greg.vigneault@bville.gts.org
  113.  
  114. ----
  115. |     Baudeville BBS - Over 2200 conferences in 12 networks       |
  116. |     Over 2 gigabytes of shareware.  1-416-283-0114 v32bis/HST   |
  117. |                                                                 |
  118. |=========Be kind to our feeds.  No email over 15K please.========|
  119.