mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 23:22:25 +00:00
added BinaryRider, TextRider, JulianDay.
riders are not very useful because PosixFileDesc, Files and StdChannels are not ported.
This commit is contained in:
Norayr Chilingarian
parent
0358bfac55
commit
e05e466d38
9 changed files with 2287 additions and 0 deletions
1
makefile
1
makefile
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP oocRealConv.Mod oocRealStr.Mod
|
||||
$(VOCSTATIC) -sP oocMsg.Mod oocChannel.Mod
|
||||
$(VOCSTATIC) -sP oocStrings2.Mod oocRts.Mod oocFilenames.Mod
|
||||
$(VOCSTATIC) -sP oocTextRider.Mod oocBinaryRider.Mod oocJulianDay.Mod
|
||||
$(VOCSTATIC) -sP oocwrapperlibc.Mod
|
||||
$(VOCSTATIC) -sP ulmSYSTEM.Mod
|
||||
$(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod
|
||||
|
|
|
|||
529
src/lib/ooc/oocBinaryRider.Mod
Normal file
529
src/lib/ooc/oocBinaryRider.Mod
Normal file
|
|
@ -0,0 +1,529 @@
|
|||
(* $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.
|
||||
132
src/lib/ooc/oocJulianDay.Mod
Normal file
132
src/lib/ooc/oocJulianDay.Mod
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
(* $Id: JulianDay.Mod,v 1.4 1999/09/02 13:08:31 acken Exp $ *)
|
||||
MODULE oocJulianDay;
|
||||
|
||||
(*
|
||||
JulianDay - convert to/from day/month/year and modified Julian days.
|
||||
Copyright (C) 1996 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
|
||||
|
||||
*)
|
||||
|
||||
CONST
|
||||
daysPerYear = 365.25D0; (* used in Julian date calculations *)
|
||||
daysPerMonth = 30.6001D0;
|
||||
startMJD* = 2400000.5D0; (* zero basis for modified Julian Day in Julian days *)
|
||||
startTJD* = startMJD+40000.0D0; (* zero basis for truncated modified Julian Day *)
|
||||
|
||||
VAR
|
||||
UseGregorian-: BOOLEAN; (* TRUE when Gregorian calendar is in use *)
|
||||
startGregor: LONGREAL; (* start of the Gregorian calendar in Julian days *)
|
||||
|
||||
|
||||
(* ------------------------------------------------------------- *)
|
||||
(* Conversion functions *)
|
||||
|
||||
PROCEDURE DateToJD * (day, month: SHORTINT; year: INTEGER) : LONGREAL;
|
||||
(* Returns a Julian date in days for the given `day', `month',
|
||||
and `year' at 0000 UTC. Any date with a positive year is valid.
|
||||
Algorithm by William H. Jefferys (with some modifications) at:
|
||||
http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
|
||||
VAR
|
||||
A, B, C: LONGINT; JD: LONGREAL;
|
||||
BEGIN
|
||||
IF month<3 THEN DEC(year); INC(month, 12) END;
|
||||
IF UseGregorian THEN A:=year DIV 100; B:=A DIV 4; C:=2-A+B
|
||||
ELSE C:=0
|
||||
END;
|
||||
JD:=C+day+ENTIER(daysPerYear*(year+4716))+ENTIER(daysPerMonth*(month+1))-1524.5D0;
|
||||
IF UseGregorian & (JD>=startGregor) THEN RETURN JD
|
||||
ELSE RETURN JD-C
|
||||
END
|
||||
END DateToJD;
|
||||
|
||||
PROCEDURE DateToDays * (day, month: SHORTINT; year: INTEGER) : LONGINT;
|
||||
(* Returns a modified Julian date in days for the given `day', `month',
|
||||
and `year' at 0000 UTC. Any date with a positive year is valid.
|
||||
The returned value is the number of days since 17 November 1858. *)
|
||||
BEGIN
|
||||
RETURN ENTIER(DateToJD(day, month, year)-startMJD)
|
||||
END DateToDays;
|
||||
|
||||
PROCEDURE DateToTJD * (day, month: SHORTINT; year: INTEGER) : LONGINT;
|
||||
(* Returns a truncated modified Julian date in days for the given `day',
|
||||
`month', and `year' at 0000 UTC. Any date with a positive year is
|
||||
valid. The returned value is the *)
|
||||
BEGIN
|
||||
RETURN ENTIER(DateToJD(day, month, year)-startTJD)
|
||||
END DateToTJD;
|
||||
|
||||
PROCEDURE JDToDate * (jd: LONGREAL; VAR day, month: SHORTINT; VAR year: INTEGER);
|
||||
(* Converts a Julian date in days to a date given by the `day', `month', and
|
||||
`year'. Algorithm by William H. Jefferys (with some modifications) at
|
||||
http://quasar.as.utexas.edu/BillInfo/JulianDatesG.html *)
|
||||
VAR
|
||||
W, D, B: LONGINT;
|
||||
BEGIN
|
||||
jd:=jd+0.5;
|
||||
IF UseGregorian & (jd>=startGregor) THEN
|
||||
W:=ENTIER((jd-1867216.25D0)/36524.25D0);
|
||||
B:=ENTIER(jd+1525+W-ENTIER(W/4.0D0))
|
||||
ELSE B:=ENTIER(jd+1524)
|
||||
END;
|
||||
year:=SHORT(ENTIER((B-122.1D0)/daysPerYear));
|
||||
D:=ENTIER(daysPerYear*year);
|
||||
month:=SHORT(SHORT(ENTIER((B-D)/daysPerMonth)));
|
||||
day:=SHORT(SHORT(B-D-ENTIER(daysPerMonth*month)));
|
||||
IF month>13 THEN DEC(month, 13) ELSE DEC(month) END;
|
||||
IF month<3 THEN DEC(year, 4715) ELSE DEC(year, 4716) END
|
||||
END JDToDate;
|
||||
|
||||
PROCEDURE DaysToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
|
||||
(* Converts a modified Julian date in days to a date given by the `day',
|
||||
`month', and `year'. *)
|
||||
BEGIN
|
||||
JDToDate(jd+startMJD, day, month, year)
|
||||
END DaysToDate;
|
||||
|
||||
PROCEDURE TJDToDate * (jd: LONGINT; VAR day, month: SHORTINT; VAR year: INTEGER);
|
||||
(* Converts a truncated modified Julian date in days to a date given by the `day',
|
||||
`month', and `year'. *)
|
||||
BEGIN
|
||||
JDToDate(jd+startTJD, day, month, year)
|
||||
END TJDToDate;
|
||||
|
||||
PROCEDURE SetGregorianStart * (day, month: SHORTINT; year: INTEGER);
|
||||
(* Sets the start date when the Gregorian calendar was first used
|
||||
where the date in `d' is in the Julian calendar. The default
|
||||
date used is 3 Sep 1752 (when the calendar correction occurred
|
||||
according to the Julian calendar).
|
||||
|
||||
The Gregorian calendar was introduced in 4 Oct 1582 by Pope
|
||||
Gregory XIII but was not adopted by many Protestant countries
|
||||
until 2 Sep 1752. In all cases, to make up for an inaccuracy
|
||||
in the calendar, 10 days were skipped during adoption of the
|
||||
new calendar. *)
|
||||
VAR
|
||||
gFlag: BOOLEAN;
|
||||
BEGIN
|
||||
gFlag:=UseGregorian; UseGregorian:=FALSE; (* use Julian calendar *)
|
||||
startGregor:=DateToJD(day, month, year);
|
||||
UseGregorian:=gFlag (* back to default *)
|
||||
END SetGregorianStart;
|
||||
|
||||
BEGIN
|
||||
(* by default we use the Gregorian calendar *)
|
||||
UseGregorian:=TRUE; startGregor:=0;
|
||||
|
||||
(* Gregorian calendar default start date *)
|
||||
SetGregorianStart(3, 9, 1752)
|
||||
END oocJulianDay.
|
||||
1620
src/lib/ooc/oocTextRider.Mod
Normal file
1620
src/lib/ooc/oocTextRider.Mod
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue