mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 23:52:25 +00:00
5326e1d4bb
riders are not very useful because PosixFileDesc, Files and StdChannels are not ported.
Former-commit-id: e05e466d38
529 lines
14 KiB
Modula-2
529 lines
14 KiB
Modula-2
(* $Id: BinaryRider.Mod,v 1.10 1999/10/31 13:49:45 ooc-devel Exp $ *)
|
|
MODULE oocBinaryRider (*[OOC_EXTENSIONS]*);
|
|
|
|
(*
|
|
BinaryRider - Binary-level input/output of Oberon variables.
|
|
Copyright (C) 1998, 1999 Michael van Acken
|
|
Copyright (C) 1997 Michael Griebling
|
|
|
|
This module is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU Lesser General Public License as
|
|
published by the Free Software Foundation; either version 2 of the
|
|
License, or (at your option) any later version.
|
|
|
|
This module is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU Lesser General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
*)
|
|
|
|
IMPORT
|
|
Strings := oocStrings, Channel := oocChannel, SYSTEM, Msg := oocMsg;
|
|
|
|
CONST
|
|
(* result codes *)
|
|
done* = Channel.done;
|
|
invalidFormat* = Channel.invalidFormat;
|
|
readAfterEnd* = Channel.readAfterEnd;
|
|
|
|
(* possible endian settings *)
|
|
nativeEndian* = 0; (* do whatever the host machine uses *)
|
|
littleEndian* = 1; (* read/write least significant byte first *)
|
|
bigEndian* = 2; (* read/write most significant byte first *)
|
|
|
|
TYPE
|
|
Reader* = POINTER TO ReaderDesc;
|
|
ReaderDesc* = RECORD
|
|
res*: Msg.Msg; (* READ-ONLY *)
|
|
byteOrder-: SHORTINT; (* endian settings for the reader *)
|
|
byteReader-: Channel.Reader; (* only to be used by extensions of Reader *)
|
|
base-: Channel.Channel;
|
|
END;
|
|
|
|
Writer* = POINTER TO WriterDesc;
|
|
WriterDesc* = RECORD
|
|
res*: Msg.Msg; (* READ-ONLY *)
|
|
byteOrder-: SHORTINT; (* endian settings for the writer *)
|
|
byteWriter-: Channel.Writer; (* only to be used by extensions of Writer *)
|
|
base-: Channel.Channel;
|
|
END;
|
|
|
|
VAR
|
|
systemByteOrder: SHORTINT; (* default CPU endian setting *)
|
|
|
|
|
|
TYPE
|
|
ErrorContext = POINTER TO ErrorContextDesc;
|
|
ErrorContextDesc* = RECORD
|
|
(* this record is exported, so that extensions of Channel can access the
|
|
error descriptions by extending `ErrorContextDesc' *)
|
|
(Channel.ErrorContextDesc)
|
|
END;
|
|
|
|
VAR
|
|
errorContext: ErrorContext;
|
|
|
|
|
|
PROCEDURE GetError (code: Msg.Code): Msg.Msg;
|
|
BEGIN
|
|
RETURN Msg.New (errorContext, code)
|
|
END GetError;
|
|
|
|
|
|
(* Reader methods
|
|
------------------------------------------------------------------------ *)
|
|
|
|
(* The following methods read a value of the given type from the current
|
|
position in the BinaryReader.
|
|
Iff the value is invalid for its type, 'r.res' is 'invalidFormat'
|
|
Iff there aren't enough bytes to satisfy the request, 'r.res' is
|
|
'readAfterEnd'.
|
|
*)
|
|
|
|
PROCEDURE (r: Reader) Pos* () : LONGINT;
|
|
BEGIN
|
|
RETURN r.byteReader.Pos()
|
|
END Pos;
|
|
|
|
PROCEDURE (r: Reader) SetPos* (newPos: LONGINT);
|
|
BEGIN
|
|
IF (r. res = done) THEN
|
|
r.byteReader.SetPos(newPos);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END SetPos;
|
|
|
|
PROCEDURE (r: Reader) ClearError*;
|
|
BEGIN
|
|
r.byteReader.ClearError;
|
|
r.res := done
|
|
END ClearError;
|
|
|
|
PROCEDURE (r: Reader) Available * () : LONGINT;
|
|
BEGIN
|
|
RETURN r.byteReader.Available()
|
|
END Available;
|
|
|
|
PROCEDURE (r: Reader) ReadBytes * (VAR x: ARRAY OF SYSTEM.BYTE;
|
|
start, n: LONGINT);
|
|
(* Read the bytes according to the native machine byte order. *)
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.byteReader.ReadBytes(x, start, n);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadBytes;
|
|
|
|
PROCEDURE (r: Reader) ReadBytesOrdered (VAR x: ARRAY OF SYSTEM.BYTE);
|
|
(* Read the bytes according to the Reader byte order setting. *)
|
|
VAR i: LONGINT;
|
|
BEGIN
|
|
IF (r.byteOrder=nativeEndian) OR (r.byteOrder=systemByteOrder) THEN
|
|
r.byteReader.ReadBytes(x, 0, LEN(x))
|
|
ELSE (* swap bytes of value *)
|
|
FOR i:=LEN(x)-1 TO 0 BY -1 DO r.byteReader.ReadByte(x[i]) END
|
|
END
|
|
END ReadBytesOrdered;
|
|
|
|
PROCEDURE (r: Reader) ReadBool*(VAR bool: BOOLEAN);
|
|
VAR byte: SHORTINT;
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r. byteReader. ReadByte (byte);
|
|
IF (r. byteReader. res = done) & (byte # 0) & (byte # 1) THEN
|
|
r. res := GetError (invalidFormat)
|
|
ELSE
|
|
r. res := r. byteReader. res
|
|
END;
|
|
bool := (byte # 0)
|
|
END
|
|
END ReadBool;
|
|
|
|
PROCEDURE (r: Reader) ReadChar* (VAR ch: CHAR);
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r. byteReader.ReadByte (ch);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadChar;
|
|
|
|
PROCEDURE (r: Reader) ReadLChar*(VAR ch: CHAR);
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r. ReadBytesOrdered (ch);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadLChar;
|
|
|
|
PROCEDURE (r: Reader) ReadString* (VAR s: ARRAY OF CHAR);
|
|
(* A string is filled until 0X is encountered, there are no more characters
|
|
in the channel or the string is filled. It is always terminated with 0X.
|
|
*)
|
|
VAR
|
|
cnt, len: INTEGER;
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
len:=SHORT(LEN(s)-1); cnt:=-1;
|
|
REPEAT
|
|
INC(cnt); r.ReadChar(s[cnt])
|
|
UNTIL (s[cnt]=0X) OR (r.byteReader.res#done) OR (cnt=len);
|
|
IF (r. byteReader. res = done) & (s[cnt] # 0X) THEN
|
|
r.byteReader.res := GetError (invalidFormat);
|
|
s[cnt]:=0X
|
|
ELSE
|
|
r.res := r.byteReader.res
|
|
END
|
|
END
|
|
END ReadString;
|
|
|
|
PROCEDURE (r: Reader) ReadLString* (VAR s: ARRAY OF CHAR);
|
|
(* A string is filled until 0X is encountered, there are no more characters
|
|
in the channel or the string is filled. It is always terminated with 0X.
|
|
*)
|
|
VAR
|
|
cnt, len: INTEGER;
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
len:=SHORT(LEN(s)-1); cnt:=-1;
|
|
REPEAT
|
|
INC(cnt); r.ReadLChar(s[cnt])
|
|
UNTIL (s[cnt]=0X) OR (r.byteReader.res#done) OR (cnt=len);
|
|
IF (r. byteReader. res = done) & (s[cnt] # 0X) THEN
|
|
r.byteReader.res := GetError (invalidFormat);
|
|
s[cnt]:=0X
|
|
ELSE
|
|
r.res := r.byteReader.res
|
|
END
|
|
END
|
|
END ReadLString;
|
|
|
|
PROCEDURE (r: Reader) ReadSInt*(VAR sint: SHORTINT);
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.byteReader.ReadByte(sint); (* SIZE(SYSTEM.BYTE) = SIZE(SHORTINT) *) ;
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadSInt;
|
|
|
|
PROCEDURE (r: Reader) ReadInt*(VAR int: INTEGER);
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.ReadBytesOrdered(int);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadInt;
|
|
|
|
PROCEDURE (r: Reader) ReadLInt*(VAR lint: LONGINT);
|
|
(* see ReadInt *)
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.ReadBytesOrdered(lint);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadLInt;
|
|
|
|
PROCEDURE (r: Reader) ReadNum*(VAR num: LONGINT);
|
|
(* Read integers in a compressed and portable format. *)
|
|
VAR s: SHORTINT; x: CHAR; y: LONGINT;
|
|
BEGIN
|
|
s:=0; y:=0; r.ReadChar(x);
|
|
WHILE (s < 28) & (x >= 80X) DO
|
|
INC(y, ASH(LONG(ORD(x))-128, s)); INC(s, 7);
|
|
r.ReadChar(x)
|
|
END;
|
|
(* Q: (s = 28) OR (x < 80X) *)
|
|
IF (x >= 80X) OR (* with s=28 this means we have more than 5 digits *)
|
|
(s = 28) & (8X <= x) & (x < 78X) & (* overflow in most sig byte *)
|
|
(r. byteReader. res = done) THEN
|
|
r. res := GetError (invalidFormat)
|
|
ELSE
|
|
num:=ASH(SYSTEM.LSH(LONG(ORD(x)), 25), s-25)+y;
|
|
r. res := r. byteReader. res
|
|
END
|
|
END ReadNum;
|
|
|
|
PROCEDURE (r: Reader) ReadReal*(VAR real: REAL);
|
|
(* see ReadInt *)
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.ReadBytesOrdered(real);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadReal;
|
|
|
|
PROCEDURE (r: Reader) ReadLReal*(VAR lreal: LONGREAL);
|
|
(* see ReadInt *)
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.ReadBytesOrdered(lreal);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadLReal;
|
|
|
|
PROCEDURE (r: Reader) ReadSet*(VAR s: SET);
|
|
BEGIN
|
|
IF (r.res = done) THEN
|
|
r.ReadBytesOrdered(s);
|
|
r.res := r.byteReader.res
|
|
END
|
|
END ReadSet;
|
|
|
|
PROCEDURE (r: Reader) SetByteOrder* (order: SHORTINT);
|
|
BEGIN
|
|
ASSERT((order>=nativeEndian) & (order<=bigEndian));
|
|
r.byteOrder:=order
|
|
END SetByteOrder;
|
|
|
|
(* Writer methods
|
|
------------------------------------------------------------------------ *)
|
|
|
|
(* The Write-methods write the value to the underlying channel. It is
|
|
possible that only part of the value is written
|
|
*)
|
|
|
|
PROCEDURE (w: Writer) Pos* () : LONGINT;
|
|
BEGIN
|
|
RETURN w.byteWriter.Pos()
|
|
END Pos;
|
|
|
|
PROCEDURE (w: Writer) SetPos* (newPos: LONGINT);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.byteWriter.SetPos(newPos);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END SetPos;
|
|
|
|
PROCEDURE (w: Writer) ClearError*;
|
|
BEGIN
|
|
w.byteWriter.ClearError;
|
|
w.res := done
|
|
END ClearError;
|
|
|
|
PROCEDURE (w: Writer) WriteBytes * (VAR x: ARRAY OF SYSTEM.BYTE;
|
|
start, n: LONGINT);
|
|
(* Write the bytes according to the native machine byte order. *)
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.byteWriter.WriteBytes(x, start, n);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteBytes;
|
|
|
|
PROCEDURE (w: Writer) WriteBytesOrdered (VAR x: ARRAY OF SYSTEM.BYTE);
|
|
(* Write the bytes according to the Writer byte order setting. *)
|
|
VAR i: LONGINT;
|
|
BEGIN
|
|
IF (w.byteOrder=nativeEndian) OR (w.byteOrder=systemByteOrder) THEN
|
|
w.byteWriter.WriteBytes(x, 0, LEN(x))
|
|
ELSE
|
|
FOR i:=LEN(x)-1 TO 0 BY -1 DO w.byteWriter.WriteByte(x[i]) END
|
|
END
|
|
END WriteBytesOrdered;
|
|
|
|
PROCEDURE (w: Writer) WriteBool*(bool: BOOLEAN);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
IF bool THEN
|
|
w. byteWriter. WriteByte (1)
|
|
ELSE
|
|
w. byteWriter. WriteByte (0)
|
|
END;
|
|
w. res := w. byteWriter. res
|
|
END
|
|
END WriteBool;
|
|
|
|
PROCEDURE (w: Writer) WriteChar*(ch: CHAR);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w. byteWriter. WriteByte(ch);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteChar;
|
|
|
|
PROCEDURE (w: Writer) WriteLChar*(ch: CHAR);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w. WriteBytesOrdered (ch);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteLChar;
|
|
|
|
PROCEDURE (w: Writer) WriteString*(s(*[NO_COPY]*): ARRAY OF CHAR);
|
|
(* The terminating 0X is also written *)
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.byteWriter.WriteBytes (s, 0, Strings.Length (s)+1);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteString;
|
|
|
|
PROCEDURE (w: Writer) WriteLString*(s(*[NO_COPY]*): ARRAY OF CHAR);
|
|
(* The terminating 0X is also written *)
|
|
VAR
|
|
i: LONGINT;
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
i := -1;
|
|
REPEAT
|
|
INC (i);
|
|
w. WriteLChar (s[i])
|
|
UNTIL (s[i] = 0X);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteLString;
|
|
|
|
PROCEDURE (w: Writer) WriteSInt*(sint: SHORTINT);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.byteWriter.WriteByte(sint);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteSInt;
|
|
|
|
PROCEDURE (w: Writer) WriteInt*(int: INTEGER);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.WriteBytesOrdered(int);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteInt;
|
|
|
|
PROCEDURE (w: Writer) WriteLInt*(lint: LONGINT);
|
|
(* see WriteInt *)
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.WriteBytesOrdered(lint);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteLInt;
|
|
|
|
PROCEDURE (w: Writer) WriteNum*(lint: LONGINT);
|
|
(* Write integers in a compressed and portable format. *)
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
WHILE (lint<-64) OR (lint>63) DO
|
|
w.WriteChar(CHR(lint MOD 128+128));
|
|
lint:=lint DIV 128
|
|
END;
|
|
w.WriteChar(CHR(lint MOD 128));
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteNum;
|
|
|
|
(* see WriteInt *)
|
|
PROCEDURE (w: Writer) WriteReal*(real: REAL);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.WriteBytesOrdered(real);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteReal;
|
|
|
|
PROCEDURE (w: Writer) WriteLReal*(lreal: LONGREAL);
|
|
(* see WriteInt *)
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.WriteBytesOrdered(lreal);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteLReal;
|
|
|
|
PROCEDURE (w: Writer) WriteSet*(s: SET);
|
|
BEGIN
|
|
IF (w.res = done) THEN
|
|
w.WriteBytesOrdered(s);
|
|
w.res := w.byteWriter.res
|
|
END
|
|
END WriteSet;
|
|
|
|
PROCEDURE (w: Writer) SetByteOrder* (order: SHORTINT);
|
|
BEGIN
|
|
ASSERT((order>=nativeEndian) & (order<=bigEndian));
|
|
w.byteOrder:=order
|
|
END SetByteOrder;
|
|
|
|
(* Reader Procedures
|
|
------------------------------------------------------------------------ *)
|
|
|
|
(* Create a new Reader and attach it to the Channel ch. NIL is
|
|
returned when it is not possible to read from the channel.
|
|
The Reader is positioned at the beginning for positionable
|
|
channels and at the current position for non-positionable channels.
|
|
*)
|
|
|
|
PROCEDURE InitReader* (r: Reader; ch: Channel.Channel; byteOrder: SHORTINT);
|
|
BEGIN
|
|
r. res := done;
|
|
r. byteReader := ch. NewReader();
|
|
r. byteOrder := byteOrder;
|
|
r. base := ch;
|
|
END InitReader;
|
|
|
|
PROCEDURE ConnectReader*(ch: Channel.Channel): Reader;
|
|
VAR
|
|
r: Reader;
|
|
BEGIN
|
|
NEW (r);
|
|
InitReader (r, ch, littleEndian);
|
|
IF (r. byteReader = NIL) THEN
|
|
RETURN NIL
|
|
ELSE
|
|
RETURN r
|
|
END
|
|
END ConnectReader;
|
|
|
|
(* Writer Procedures
|
|
------------------------------------------------------------------------ *)
|
|
|
|
(* Create a new Writer and attach it to the Channel ch. NIL is
|
|
returned when it is not possible to write to the channel.
|
|
The Writer is positioned at the beginning for positionable
|
|
channels and at the current position for non-positionable channels.
|
|
*)
|
|
PROCEDURE InitWriter* (w: Writer; ch: Channel.Channel; byteOrder: SHORTINT);
|
|
BEGIN
|
|
w. res := done;
|
|
w. byteWriter := ch. NewWriter();
|
|
w. byteOrder := byteOrder;
|
|
w. base := ch;
|
|
END InitWriter;
|
|
|
|
PROCEDURE ConnectWriter*(ch: Channel.Channel): Writer;
|
|
VAR
|
|
w: Writer;
|
|
BEGIN
|
|
NEW (w);
|
|
InitWriter (w, ch, littleEndian);
|
|
IF (w. byteWriter = NIL) THEN
|
|
RETURN NIL
|
|
ELSE
|
|
RETURN w
|
|
END
|
|
END ConnectWriter;
|
|
|
|
PROCEDURE SetDefaultByteOrder(VAR x: ARRAY OF SYSTEM.BYTE);
|
|
BEGIN
|
|
IF SYSTEM.VAL(CHAR, x[0])=1X THEN
|
|
systemByteOrder:=littleEndian
|
|
ELSE
|
|
systemByteOrder:=bigEndian
|
|
END
|
|
END SetDefaultByteOrder;
|
|
|
|
PROCEDURE Init;
|
|
VAR i: INTEGER;
|
|
BEGIN
|
|
i:=1; SetDefaultByteOrder(i)
|
|
END Init;
|
|
|
|
BEGIN
|
|
NEW (errorContext);
|
|
Msg.InitContext (errorContext, "OOC:Core:BinaryRider");
|
|
Init
|
|
END oocBinaryRider.
|