🚀 go-pugleaf

 Please take note that the FST Modula-2 compiler, version 3.1,
 may allow invalid assignments to variant record fields.

 The following code demonstrates the error: allowing a LONGCARD
 variant field to be assigned as a LONGINT.  Even though the
 desired result achieved, the assignment should be illegal under
 Modula-2's strong type checking rules.

 I've notified Roger, at FST, and he is looking into the matter.
(********************************************************************)
 MODULE FileCRC;        (* Compiler: FST Modula-2 v3.1 (shareware)  *)
(* CRC-32 function (c) 1993 Greg Vigneault      [GSV]               *)
(* P.O.Box 7169, Station A, Toronto, Ontario, Canada M5W 1X8.       *)
(* greg.vigneault@bville.gts.org       gregsv@eastern.com           *)

 FROM Files     IMPORT  Open, Read, Close,  (* file I/O functions   *)
                        READ,               (* file access mode     *)
                        FileStatus;         (* file I/O result code *)
 FROM InOut     IMPORT  Write, WriteHex, WriteLn, WriteString;
 FROM Storage   IMPORT  ALLOCATE, DEALLOCATE;   (* re NEW & DISPOSE *)
 FROM System    IMPORT  GetArg, Terminate;
 FROM SYSTEM    IMPORT  ADDRESS;
(*------------------------------------------------------------------*)
 CONST  Beep            = 7C;               (* ASCII bell tone      *)
        BufferSize      = 4000H;            (* file input buffer    *)
 TYPE   BufferPointer   = POINTER TO ARRAY [0..BufferSize-1] OF CHAR;
        LongCard        = RECORD            (* CRC-32 value         *)
                            CASE Wide : BOOLEAN OF
                                TRUE  : Long    : LONGCARD |
                                FALSE : Lo      : BITSET;
                                        Hi      : BITSET;
                            END; (* case *)
                          END; (* record *)
 VAR    CRC32           : LongCard;         (* running CRC-32       *)
        ArgSize,                            (* input string length  *)
        BytesReceived   : CARDINAL;         (* bytes read from file *)
        DataPointer     : BufferPointer;    (* data buffer pointer  *)
        FileHandle      : INTEGER;                  (* file handle  *)
        FileName        : ARRAY [0..127] OF CHAR;   (* ASCIIZ name  *)
(*------------------------------------------------------------------*)
 PROCEDURE UpdateCRC32( VAR CRC32 : LongCard;
                            Block : ADDRESS;
                            Count : CARDINAL);
    VAR ByteCount, BitCount : CARDINAL;
        Carry               : BOOLEAN;
    BEGIN
    FOR ByteCount := 1 TO Count DO
        CRC32.Lo := CRC32.Lo / (BITSET(Block^) * {0..7});
        FOR BitCount := 1 TO 8 DO
            Carry := 0 IN CRC32.Lo;
            CRC32.Long := CRC32.Long DIV 2L;
            IF Carry THEN
                CRC32.Hi := CRC32.Hi / BITSET(0EDB8H);
                CRC32.Lo := CRC32.Lo / BITSET(08320H);
                END; (* if Carry *)
            END; (* for BitCount *)
        INC( Block );
        END; (* for ByteCount *)
    END UpdateCRC32;
(*------------------------------------------------------------------*)
 BEGIN  (* MODULE FileCRC *)
        GetArg( FileName, ArgSize );        (* get user input       *)
        IF (ArgSize = 0) THEN               (* was there any?       *)
            WriteString( "Use: FILECRC FileName" ); (* no: abort    *)
            Write( Beep );  WriteLn;
            Terminate(1);                   (* with ERRORLEVEL code *)
            END; (* if ArgSize *)
        Open( FileHandle, FileName, READ ); (* open input file      *)
        IF (FileHandle = -1) THEN               (* failed?          *)
            WriteString( "Can't OPEN " );       (* yes: abort       *)
            WriteString( FileName );  Write( Beep );  WriteLn;
            Terminate(2);
            END; (* if FileHandle *)
(*!!!*) CRC32.Long := -1L;           (* CRC-32 initially 0FFFFFFFFH *)
        (* Alternative to above is  CRC32.Long := MAX(LONGCARD);    *)
        NEW( DataPointer );          (* heap space for input buffer *)
        REPEAT
        Read( FileHandle, DataPointer, BufferSize, BytesReceived );
        IF (FileStatus # 0) THEN
            WriteString( "ERROR reading file" );  WriteLn;
            Close( FileHandle );  Write( Beep );  Terminate(3);
            END; (* if FileStatus *)
        UpdateCRC32( CRC32, DataPointer, BytesReceived );
        UNTIL (BytesReceived # BufferSize);
        Close( FileHandle );                    (* close the file   *)
        DISPOSE( DataPointer );                 (* deallocate memory*)
        CRC32.Hi := CRC32.Hi / {0..15};         (* toggle all bits  *)
        CRC32.Lo := CRC32.Lo / {0..15};
        WriteLn; WriteString("The CRC-32 of file ");
        WriteString( FileName ); WriteString(" is 0x");
        (* write hex CRC-32, padding with leading 0's if needed     *)
        WriteHex( CARDINAL(CRC32.Hi), 4 );  (* min field width = 4  *)
        WriteHex( CARDINAL(CRC32.Lo), 4 ); WriteLn;
 END FileCRC.
(********************************************************************)

 Greg_

 Jan.21.1993.Toronto.Canada.        greg.vigneault@bville.gts.org

----
|     Baudeville BBS - Over 2200 conferences in 12 networks       |
|     Over 2 gigabytes of shareware.  1-416-283-0114 v32bis/HST   |
|                                                                 |
|=========Be kind to our feeds.  No email over 15K please.========|