--- /dev/null
+*.o
+bin/
+lib/
+CONFIG
+src/Config.h
+obnc
+obnc-compile
+obnc-path
+obncdoc
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Files;
+module Files;
(**Operations on files
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
(*implemented in C*)
- TYPE
- File* = POINTER TO Handle;
+ type
+ File* = pointer to Handle;
- Handle = RECORD END;
+ Handle = record end;
- Rider* = RECORD
+ Rider* = record
eof*: BOOLEAN;
res*: INTEGER;
base: File;
pos: INTEGER
- END;
+ end;
- PROCEDURE Old*(name: ARRAY OF CHAR): File;
-(**Old(fn) searches the name fn in the directory and returns the corresponding file. If the name is not found, it returns NIL.*)
- RETURN NIL
- END Old;
+ procedure Old*(name: array of CHAR): File;
+(**Old(fn) searches the name fn in the directory and returns the corresponding file. If the name is not found, it returns nil.*)
+ return nil
+ end Old;
- PROCEDURE New*(name: ARRAY OF CHAR): File;
+ procedure New*(name: array of CHAR): File;
(**New(fn) creates and returns a new file. The name fn is remembered for the later use of the operation Register. The file is only entered into the directory when Register is called.*)
- RETURN NIL
- END New;
+ return nil
+ end New;
- PROCEDURE Register*(f: File);
+ procedure Register*(f: File);
(**enters the file f into the directory together with the name provided in the operation New that created f. The file buffers are written back. Any existing mapping of this name to another file is overwritten.*)
- END Register;
+ end Register;
- PROCEDURE Close*(f: File);
+ procedure Close*(f: File);
(**writes back the file buffers of f. The file is still accessible by its handle f and the riders positioned on it. If a file is not modified it is not necessary to close it.*)
- END Close;
+ end Close;
- PROCEDURE Purge*(f: File);
+ procedure Purge*(f: File);
(**resets the length of file f to 0*)
- END Purge;
+ end Purge;
- PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER);
+ procedure Delete*(name: array of CHAR; var res: INTEGER);
(**Delete(fn, res) removes the directory entry for the file fn without deleting the file. If res = 0 the file has been successfully deleted. If there are variables referring to the file while Delete is called, they can still be used.*)
- END Delete;
+ end Delete;
- PROCEDURE Rename*(old, new: ARRAY OF CHAR; VAR res: INTEGER);
+ procedure Rename*(old, new: array of CHAR; var res: INTEGER);
(**Rename(oldfn, newfn, res) renames the directory entry oldfn to newfn. If res = 0 the file has been successfully renamed. If there are variables referring to the file while Rename is called, they can still be used.*)
- END Rename;
+ end Rename;
- PROCEDURE Length*(f: File): INTEGER;
+ procedure Length*(f: File): INTEGER;
(**returns the number of bytes in file f*)
- RETURN 0
- END Length;
+ return 0
+ end Length;
- PROCEDURE GetDate*(f: File; VAR t, d: INTEGER);
-(**returns the time t and date d of the last modification of file f. The encoding is: hour = t DIV 4096; minute = t DIV 64 MOD 64; second = t MOD 64; year = d DIV 512; month = d DIV 32 MOD 16; day = d MOD 32.*)
- END GetDate;
+ procedure GetDate*(f: File; var t, d: INTEGER);
+(**returns the time t and date d of the last modification of file f. The encoding is: hour = t div 4096; minute = t div 64 mod 64; second = t mod 64; year = d div 512; month = d div 32 mod 16; day = d mod 32.*)
+ end GetDate;
- PROCEDURE Set*(VAR r: Rider; f: File; pos: INTEGER);
-(**sets the rider r to position pos in file f. The field r.eof is set to FALSE. The
+ procedure Set*(var r: Rider; f: File; pos: INTEGER);
+(**sets the rider r to position pos in file f. The field r.eof is set to false. The
operation requires that 0 <= pos <= Length(f)*)
- END Set;
+ end Set;
- PROCEDURE Pos*(VAR r: Rider): INTEGER;
+ procedure Pos*(var r: Rider): INTEGER;
(**returns the position of the rider r*)
- RETURN 0
- END Pos;
+ return 0
+ end Pos;
- PROCEDURE Base*(VAR r: Rider): File;
+ procedure Base*(var r: Rider): File;
(**returns the file to which the rider r has been set*)
- RETURN NIL
- END Base;
+ return nil
+ end Base;
- PROCEDURE Read*(VAR r: Rider; VAR x: BYTE);
+ procedure Read*(var r: Rider; var x: BYTE);
(**reads the next byte x from rider r and advances r accordingly*)
- END Read;
+ end Read;
- PROCEDURE ReadInt*(VAR r: Rider; VAR i: INTEGER);
+ procedure ReadInt*(var r: Rider; var i: INTEGER);
(**reads an integer i from rider r and advances r accordingly.*)
- END ReadInt;
+ end ReadInt;
- PROCEDURE ReadReal*(VAR r: Rider; VAR x: REAL);
+ procedure ReadReal*(var r: Rider; var x: REAL);
(**reads a real number x from rider r and advances r accordingly.*)
- END ReadReal;
+ end ReadReal;
- PROCEDURE ReadNum*(VAR r: Rider; VAR i: INTEGER);
+ procedure ReadNum*(var r: Rider; var i: INTEGER);
(**reads an integer i from rider r and advances r accordingly. The number i is compactly encoded*)
- END ReadNum;
+ end ReadNum;
- PROCEDURE ReadString*(VAR r: Rider; VAR s: ARRAY OF CHAR);
+ procedure ReadString*(var r: Rider; var s: array of CHAR);
(**reads a sequence of characters (including the terminating 0X) from rider r and returns it in s. The rider is advanced accordingly. The actual parameter corresponding to s must be long enough to hold the character sequence plus the terminating 0X.*)
- END ReadString;
+ end ReadString;
- PROCEDURE ReadSet*(VAR r: Rider; VAR s: SET);
+ procedure ReadSet*(var r: Rider; var s: SET);
(**reads a set s from rider r and advances r accordingly*)
- END ReadSet;
+ end ReadSet;
- PROCEDURE ReadBool*(VAR r: Rider; VAR b: BOOLEAN);
+ procedure ReadBool*(var r: Rider; var b: BOOLEAN);
(**reads a Boolean value b from rider r and advances r accordingly*)
- END ReadBool;
+ end ReadBool;
- PROCEDURE ReadBytes*(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
+ procedure ReadBytes*(var r: Rider; var buf: array of BYTE; n: INTEGER);
(**reads n bytes into buffer buf starting at the rider position r. The rider is advanced accordingly. If less than n bytes could be read, r.res contains the number of requested but unread bytes.*)
- END ReadBytes;
+ end ReadBytes;
- PROCEDURE Write*(VAR r: Rider; x: BYTE);
+ procedure Write*(var r: Rider; x: BYTE);
(**writes the byte x to rider r and advances r accordingly*)
- END Write;
+ end Write;
- PROCEDURE WriteInt*(VAR r: Rider; i: INTEGER);
+ procedure WriteInt*(var r: Rider; i: INTEGER);
(**writes the integer i to rider r and advances r accordingly*)
- END WriteInt;
+ end WriteInt;
- PROCEDURE WriteReal*(VAR r: Rider; x: REAL);
+ procedure WriteReal*(var r: Rider; x: REAL);
(**writes the real number x to rider r and advances r accordingly*)
- END WriteReal;
+ end WriteReal;
- PROCEDURE WriteNum*(VAR r: Rider; i: INTEGER);
+ procedure WriteNum*(var r: Rider; i: INTEGER);
(**writes the integer i to rider r and advances r accordingly. The number i is compactly encoded.*)
- END WriteNum;
+ end WriteNum;
- PROCEDURE WriteString*(VAR r: Rider; s: ARRAY OF CHAR);
+ procedure WriteString*(var r: Rider; s: array of CHAR);
(**writes the sequence of characters s (including the terminating 0X) to rider r and advances r accordingly*)
- END WriteString;
+ end WriteString;
- PROCEDURE WriteSet*(VAR r: Rider; s: SET);
+ procedure WriteSet*(var r: Rider; s: SET);
(**writes the set s to rider r and advances r accordingly*)
- END WriteSet;
+ end WriteSet;
- PROCEDURE WriteBool*(VAR r: Rider; b: BOOLEAN);
+ procedure WriteBool*(var r: Rider; b: BOOLEAN);
(**writes the Boolean value b to rider r and advances r accordingly.*)
- END WriteBool;
+ end WriteBool;
- PROCEDURE WriteBytes*(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
+ procedure WriteBytes*(var r: Rider; var buf: array of BYTE; n: INTEGER);
(**writes the first n bytes from buf to rider r and advances r accordingly. r.res contains the number of bytes that could not be written (e.g., due to a disk full error).*)
- END WriteBytes;
+ end WriteBytes;
-END Files.
+end Files.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE FilesTest;
+module FilesTest;
- IMPORT Files, SYSTEM;
+ import Files, SYSTEM;
- PROCEDURE TestOld;
- VAR f: Files.File;
- BEGIN
+ procedure TestOld;
+ var f: Files.File;
+ begin
f := Files.Old("FilesTest.obn");
- ASSERT(f # NIL);
- ASSERT(f IS Files.File)
- END TestOld;
+ ASSERT(f # nil);
+ ASSERT(f is Files.File)
+ end TestOld;
- PROCEDURE TestNew;
- VAR f: Files.File;
- BEGIN
+ procedure TestNew;
+ var f: Files.File;
+ begin
f := Files.New("NewTest");
- ASSERT(f # NIL);
- ASSERT(f IS Files.File)
- END TestNew;
+ ASSERT(f # nil);
+ ASSERT(f is Files.File)
+ end TestNew;
- PROCEDURE TestRegister;
- VAR f: Files.File;
+ procedure TestRegister;
+ var f: Files.File;
r: Files.Rider;
res: INTEGER;
- PROCEDURE IsRider(VAR r: Files.Rider): BOOLEAN;
- RETURN r IS Files.Rider
- END IsRider;
- BEGIN
+ procedure IsRider(var r: Files.Rider): BOOLEAN;
+ return r is Files.Rider
+ end IsRider;
+ begin
f := Files.New("RegisterTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
ASSERT(IsRider(r));
Files.Register(f);
f := Files.Old("RegisterTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Delete("RegisterTest", res);
ASSERT(res = 0);
f := Files.New("RegisterTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.Write(r, 37);
Files.Close(f);
ASSERT(Files.Length(f) = 1);
f := Files.Old("RegisterTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
ASSERT(Files.Length(f) = 1);
Files.Delete("RegisterTest", res);
ASSERT(res = 0)
- END TestRegister;
+ end TestRegister;
- PROCEDURE TestClose;
- VAR f: Files.File;
+ procedure TestClose;
+ var f: Files.File;
r: Files.Rider;
- BEGIN
+ begin
f := Files.New("CloseTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.Write(r, 65);
ASSERT(Files.Length(f) <= 1);
Files.Close(f);
ASSERT(Files.Length(f) = 1)
- END TestClose;
+ end TestClose;
- PROCEDURE TestPurge;
- VAR f: Files.File;
+ procedure TestPurge;
+ var f: Files.File;
r: Files.Rider;
- BEGIN
+ begin
f := Files.New("PurgeTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.Write(r, 65);
Files.Purge(f);
ASSERT(Files.Length(f) = 0)
- END TestPurge;
+ end TestPurge;
- PROCEDURE TestDelete;
- VAR f: Files.File;
+ procedure TestDelete;
+ var f: Files.File;
res: INTEGER;
- BEGIN
+ begin
f := Files.New("DeleteTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Register(f);
f := Files.Old("DeleteTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Delete("DeleteTest", res);
ASSERT(res = 0);
f := Files.Old("DeleteTest");
- ASSERT(f = NIL)
- END TestDelete;
+ ASSERT(f = nil)
+ end TestDelete;
- PROCEDURE TestRename;
- VAR f: Files.File;
+ procedure TestRename;
+ var f: Files.File;
res: INTEGER;
- BEGIN
+ begin
f := Files.New("RenameTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Register(f);
f := Files.Old("RenameTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Rename("RenameTest", "RenameTest1", res);
ASSERT(res = 0);
f := Files.Old("RenameTest");
- ASSERT(f = NIL);
+ ASSERT(f = nil);
f := Files.Old("RenameTest1");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Delete("RenameTest1", res);
ASSERT(res = 0)
- END TestRename;
+ end TestRename;
- PROCEDURE TestLength;
- VAR f: Files.File;
+ procedure TestLength;
+ var f: Files.File;
res: INTEGER;
- BEGIN
+ begin
f := Files.New("LengthTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Register(f);
ASSERT(Files.Length(f) = 0);
Files.Delete("LengthTest", res);
ASSERT(res = 0)
- END TestLength;
+ end TestLength;
- PROCEDURE TestDate;
- VAR f: Files.File;
+ procedure TestDate;
+ var f: Files.File;
t, d: INTEGER;
hour, minute, second, year, month, day: INTEGER;
- BEGIN
+ begin
f := Files.Old("FilesTest.obn");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.GetDate(f, t, d);
- hour := t DIV 4096;
+ hour := t div 4096;
ASSERT(hour >= 0);
ASSERT(hour < 24);
- minute := t DIV 64 MOD 64;
+ minute := t div 64 mod 64;
ASSERT(minute >= 0);
ASSERT(minute < 60);
- second := t MOD 64;
+ second := t mod 64;
ASSERT(second >= 0);
ASSERT(second < 60);
- year := d DIV 512;
+ year := d div 512;
ASSERT(year >= 0);
- month := d DIV 32 MOD 16;
+ month := d div 32 mod 16;
ASSERT(month >= 1);
ASSERT(month <= 12);
- day := d MOD 32;
+ day := d mod 32;
ASSERT(day >= 1);
ASSERT(day <= 31)
- END TestDate;
+ end TestDate;
- PROCEDURE TestSet;
- VAR f: Files.File;
+ procedure TestSet;
+ var f: Files.File;
r: Files.Rider;
- BEGIN
+ begin
f := Files.New("SetTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
ASSERT(~r.eof)
- END TestSet;
+ end TestSet;
- PROCEDURE TestPos;
- VAR f: Files.File;
+ procedure TestPos;
+ var f: Files.File;
r: Files.Rider;
- BEGIN
+ begin
f := Files.New("PosTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
ASSERT(Files.Pos(r) = 0)
- END TestPos;
+ end TestPos;
- PROCEDURE TestBase;
- VAR f: Files.File;
+ procedure TestBase;
+ var f: Files.File;
r: Files.Rider;
- BEGIN
+ begin
f := Files.New("BaseTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
ASSERT(Files.Base(r) = f)
- END TestBase;
+ end TestBase;
- PROCEDURE TestReadWrite;
- VAR f: Files.File;
+ procedure TestReadWrite;
+ var f: Files.File;
r: Files.Rider;
b: BYTE;
- BEGIN
+ begin
f := Files.New("ReadWriteTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.Write(r, 65);
Files.Close(f);
ASSERT(~r.eof);
ASSERT(b = 65);
ASSERT(Files.Pos(r) = 1)
- END TestReadWrite;
+ end TestReadWrite;
- PROCEDURE TestReadWriteInt;
- VAR f: Files.File;
+ procedure TestReadWriteInt;
+ var f: Files.File;
r: Files.Rider;
i: INTEGER;
- BEGIN
+ begin
f := Files.New("ReadWriteIntTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteInt(r, 100);
ASSERT(i = -1000);
Files.ReadInt(r, i);
ASSERT(r.eof)
- END TestReadWriteInt;
+ end TestReadWriteInt;
- PROCEDURE TestReadWriteReal;
- VAR f: Files.File;
+ procedure TestReadWriteReal;
+ var f: Files.File;
r: Files.Rider;
x: REAL;
- BEGIN
+ begin
f := Files.New("ReadWriteRealTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteReal(r, 3.14);
ASSERT(ABS(x - (-3.14)) < 1.0E-6);
Files.ReadReal(r, x);
ASSERT(r.eof)
- END TestReadWriteReal;
+ end TestReadWriteReal;
- PROCEDURE TestReadWriteNum;
- VAR f: Files.File;
+ procedure TestReadWriteNum;
+ var f: Files.File;
r: Files.Rider;
i: INTEGER;
- BEGIN
+ begin
f := Files.New("ReadWriteNumTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteNum(r, 100);
ASSERT(i = -1000);
Files.ReadNum(r, i);
ASSERT(r.eof)
- END TestReadWriteNum;
+ end TestReadWriteNum;
- PROCEDURE TestReadWriteString;
- VAR f: Files.File;
+ procedure TestReadWriteString;
+ var f: Files.File;
r: Files.Rider;
- s: ARRAY 32 OF CHAR;
- BEGIN
+ s: array 32 of CHAR;
+ begin
f := Files.New("ReadWriteStringTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteString(r, "hello");
ASSERT(s = "");
Files.ReadString(r, s);
ASSERT(r.eof)
- END TestReadWriteString;
+ end TestReadWriteString;
- PROCEDURE TestReadWriteSet;
- VAR f: Files.File;
+ procedure TestReadWriteSet;
+ var f: Files.File;
r: Files.Rider;
s: SET;
- BEGIN
+ begin
f := Files.New("ReadWriteSetTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteSet(r, {});
ASSERT(s = {0, 1});
Files.ReadSet(r, s);
ASSERT(r.eof)
- END TestReadWriteSet;
+ end TestReadWriteSet;
- PROCEDURE TestReadWriteBool;
- VAR f: Files.File;
+ procedure TestReadWriteBool;
+ var f: Files.File;
r: Files.Rider;
b: BOOLEAN;
- BEGIN
+ begin
f := Files.New("ReadWriteBoolTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
- Files.WriteBool(r, TRUE);
- Files.WriteBool(r, FALSE);
+ Files.WriteBool(r, true);
+ Files.WriteBool(r, false);
Files.Close(f);
Files.Set(r, f, 0);
ASSERT(~b);
Files.ReadBool(r, b);
ASSERT(r.eof)
- END TestReadWriteBool;
+ end TestReadWriteBool;
- PROCEDURE TestReadWriteBytes;
- VAR f: Files.File;
+ procedure TestReadWriteBytes;
+ var f: Files.File;
r: Files.Rider;
- buf: ARRAY 4 OF BYTE;
+ buf: array 4 of BYTE;
i: INTEGER;
- BEGIN
- FOR i := 0 TO LEN(buf) - 1 DO buf[i] := i + 1 END;
+ begin
+ for i := 0 to LEN(buf) - 1 do buf[i] := i + 1 end;
f := Files.New("ReadWriteBytesTest");
- ASSERT(f # NIL);
+ ASSERT(f # nil);
Files.Set(r, f, 0);
Files.WriteBytes(r, buf, LEN(buf));
Files.WriteBytes(r, buf, LEN(buf));
Files.Close(f);
- FOR i := 0 TO LEN(buf) - 1 DO buf[i] := 0 END;
+ for i := 0 to LEN(buf) - 1 do buf[i] := 0 end;
Files.Set(r, f, 0);
Files.ReadBytes(r, buf, LEN(buf));
ASSERT(~r.eof);
- FOR i := 0 TO LEN(buf) - 1 DO
+ for i := 0 to LEN(buf) - 1 do
ASSERT(buf[i] = i + 1)
- END;
+ end;
Files.ReadBytes(r, buf, LEN(buf));
ASSERT(~r.eof);
- FOR i := 0 TO LEN(buf) - 1 DO
+ for i := 0 to LEN(buf) - 1 do
ASSERT(buf[i] = i + 1)
- END;
+ end;
Files.ReadBytes(r, buf, LEN(buf));
ASSERT(r.eof)
- END TestReadWriteBytes;
+ end TestReadWriteBytes;
-BEGIN
+begin
TestOld;
TestNew;
TestRegister;
TestDelete;
TestRename;
TestLength;
- IF SYSTEM.SIZE(INTEGER) >= 4 THEN
+ if SYSTEM.SIZE(INTEGER) >= 4 then
TestDate
- END;
+ end;
TestSet;
TestPos;
TestBase;
TestReadWrite;
TestReadWriteInt;
TestReadWriteReal;
- IF SYSTEM.SIZE(INTEGER) >= 4 THEN
+ if SYSTEM.SIZE(INTEGER) >= 4 then
TestReadWriteNum;
- END;
+ end;
TestReadWriteString;
TestReadWriteSet;
TestReadWriteBool;
TestReadWriteBytes
-END FilesTest.
+end FilesTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE In;
+module In;
(**Input from the standard input stream
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All read operations except Char and Line skips over preceding whitespace.*)
(*implemented in C*)
- VAR Done*: BOOLEAN; (**status of last operation*)
+ var Done*: BOOLEAN; (**status of last operation*)
- PROCEDURE Open*;
+ procedure Open*;
(**included for compatibility with "The Oakwood Guidelines". On a typical Unix-like system, stdin cannot be rewinded. If Open is called when the file position is not at the beginning of stdin, the program aborts.*)
- END Open;
+ end Open;
- PROCEDURE Char*(VAR ch: CHAR);
+ procedure Char*(var ch: CHAR);
(**returns in ch the character at the current position*)
- END Char;
+ end Char;
- PROCEDURE Int*(VAR i: INTEGER);
+ procedure Int*(var i: INTEGER);
(**returns in i the integer constant at the current position according to the format
integer = digit {digit} | digit {hexDigit} "H".
hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F".
*)
- END Int;
+ end Int;
- PROCEDURE Real*(VAR x: REAL);
+ procedure Real*(var x: REAL);
(**returns in x the real constant at the current position according to the format
real = digit {digit} "." {digit} [ScaleFactor].
ScaleFactor = "E" ["+" | "-"] digit {digit}.
*)
- END Real;
+ end Real;
- PROCEDURE String*(VAR str: ARRAY OF CHAR);
+ procedure String*(var str: array of CHAR);
(**returns in str the string at the current position according to the format
string = """ {character} """ | digit {hexdigit} "X" .
*)
- END String;
+ end String;
- PROCEDURE Name*(VAR name: ARRAY OF CHAR);
+ procedure Name*(var name: array of CHAR);
(**Name(s) returns in s the sequence of graphical (non-whitespace) characters at the current position*)
- END Name;
+ end Name;
- PROCEDURE Line*(VAR line: ARRAY OF CHAR);
+ procedure Line*(var line: array of CHAR);
(**Line(s) returns in s the sequence of characters from the current position to the end of the line. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
- END Line;
+ end Line;
-END In.
+end In.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE InTest;
+module InTest;
- IMPORT In;
+ import In;
- CONST
+ const
eps = 0.001;
- VAR
+ var
ch: CHAR;
n: INTEGER;
x: REAL;
- s: ARRAY 12 OF CHAR;
+ s: array 12 of CHAR;
-BEGIN
+begin
In.Char(ch);
ASSERT(In.Done);
ASSERT(ch = "a");
In.Line(s);
ASSERT(In.Done);
ASSERT(s = "foo bar")
-END InTest.
+end InTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Input;
+module Input;
(**Access to keyboard, mouse and clock
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". This module is implemented to be used in tandem with basic module XYplane. For a console application, use module Input0 instead.*)
(*implemented in C*)
- IMPORT Input0;
+ import Input0;
- VAR TimeUnit*: INTEGER; (**clock ticks per second*)
+ var TimeUnit*: INTEGER; (**clock ticks per second*)
- PROCEDURE Available*(): INTEGER;
+ procedure Available*(): INTEGER;
(**returns the number of characters in the keyboard buffer*)
- RETURN 0 (*dummy value*)
- END Available;
+ return 0 (*dummy value*)
+ end Available;
- PROCEDURE Read*(VAR ch: CHAR);
+ procedure Read*(var ch: CHAR);
(**returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)
- END Read;
+ end Read;
- PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER);
+ procedure Mouse*(var keys: SET; var x, y: INTEGER);
(**returns the current mouse position (x, y) in pixels relative to the lower left corner of the screen. keys is the set of the currently pressed mouse keys (left = 2, middle = 1, right = 0).*)
- END Mouse;
+ end Mouse;
- PROCEDURE SetMouseLimits*(w, h: INTEGER);
+ procedure SetMouseLimits*(w, h: INTEGER);
(**defines the rectangle where the mouse moves (in pixels). Subsequent calls to the operation Mouse will return coordinates for x in the range 0 .. w - 1 and y in the range 0 .. h - 1.*)
- END SetMouseLimits;
+ end SetMouseLimits;
- PROCEDURE Time*(): INTEGER;
+ procedure Time*(): INTEGER;
(**returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)
- RETURN 0 (*dummy value*)
- END Time;
+ return 0 (*dummy value*)
+ end Time;
-BEGIN
+begin
ASSERT(Input0.TimeUnit > 0) (*silence "Input0 unused" compiler note*)
-END Input.
+end Input.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Input0;
+module Input0;
(**Access to keyboard and clock
Implements a subset of basic module Input applicable to console applications. Import with Input := Input0 to emphasize the compatibility.*)
(*implemented in C*)
- VAR TimeUnit*: INTEGER; (**clock ticks per second*)
+ var TimeUnit*: INTEGER; (**clock ticks per second*)
- PROCEDURE Available*(): INTEGER;
+ procedure Available*(): INTEGER;
(**returns the number of characters in the keyboard buffer*)
- RETURN 0
- END Available;
+ return 0
+ end Available;
- PROCEDURE Read*(VAR ch: CHAR);
+ procedure Read*(var ch: CHAR);
(**returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)
- END Read;
+ end Read;
- PROCEDURE Time*(): INTEGER;
+ procedure Time*(): INTEGER;
(**returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)
- RETURN 0
- END Time;
+ return 0
+ end Time;
-END Input0.
+end Input0.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE Input0Test;
+module Input0Test;
- IMPORT Input := Input0, Out;
+ import Input := Input0, Out;
- PROCEDURE TestAvailable;
- VAR n: INTEGER; ch: CHAR;
- BEGIN
+ procedure TestAvailable;
+ var n: INTEGER; ch: CHAR;
+ begin
Out.String("Press abc...");
Out.Ln;
- REPEAT
+ repeat
n := Input.Available()
- UNTIL n >= 3;
+ until n >= 3;
Input.Read(ch);
ASSERT(ch = "a");
Input.Read(ch);
ASSERT(ch = "c");
Out.String("OK");
Out.Ln;
- END TestAvailable;
+ end TestAvailable;
- PROCEDURE TestRead;
- VAR ch: CHAR;
- BEGIN
+ procedure TestRead;
+ var ch: CHAR;
+ begin
Out.String("Press space ... ");
Out.Ln;
Input.Read(ch);
ASSERT(ch = "$");
Out.String("OK");
Out.Ln
- END TestRead;
+ end TestRead;
- PROCEDURE TestTime;
- BEGIN
+ procedure TestTime;
+ begin
ASSERT(Input.TimeUnit > 0);
ASSERT(Input.Time() > 0)
- END TestTime;
+ end TestTime;
-BEGIN
+begin
TestAvailable;
TestRead;
TestTime
-END Input0Test.
+end Input0Test.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE InputTest;
+module InputTest;
- IMPORT Input, Out, XYplane;
+ import Input, Out, XYplane;
- PROCEDURE TestAvailable;
- VAR n: INTEGER; ch: CHAR;
- BEGIN
+ procedure TestAvailable;
+ var n: INTEGER; ch: CHAR;
+ begin
Out.String("Press any key ... ");
Out.Ln;
- REPEAT
+ repeat
n := Input.Available()
- UNTIL n # 0;
+ until n # 0;
ASSERT(n > 0);
Out.String("OK");
Out.Ln;
Input.Read(ch)
- END TestAvailable;
+ end TestAvailable;
- PROCEDURE TestRead;
- VAR ch: CHAR;
- BEGIN
+ procedure TestRead;
+ var ch: CHAR;
+ begin
Out.String("Press space ... ");
Out.Ln;
Input.Read(ch);
ASSERT(ch = "$");
Out.String("OK");
Out.Ln
- END TestRead;
+ end TestRead;
- PROCEDURE TestButton(button: INTEGER);
- VAR buttonLabels: ARRAY 3, 8 OF CHAR;
+ procedure TestButton(button: INTEGER);
+ var buttonLabels: array 3, 8 of CHAR;
buttons: SET; x, y: INTEGER;
- BEGIN
+ begin
buttonLabels[0] := "right";
buttonLabels[1] := "middle";
buttonLabels[2] := "left";
Out.String(buttonLabels[button]);
Out.String(" mouse button ... ");
Out.Ln;
- REPEAT
+ repeat
Input.Mouse(buttons, x, y);
- UNTIL buttons # {};
- ASSERT(button IN buttons);
+ until buttons # {};
+ ASSERT(button in buttons);
ASSERT(x >= 0);
ASSERT(y >= 0);
Out.String("OK");
Out.Ln;
- REPEAT (*wait until button has been released*)
+ repeat (*wait until button has been released*)
Input.Mouse(buttons, x, y);
- UNTIL buttons = {}
- END TestButton;
+ until buttons = {}
+ end TestButton;
- PROCEDURE TestMouse;
- BEGIN
+ procedure TestMouse;
+ begin
TestButton(0);
TestButton(1);
TestButton(2)
- END TestMouse;
+ end TestMouse;
- PROCEDURE TestTime;
- BEGIN
+ procedure TestTime;
+ begin
ASSERT(Input.TimeUnit > 0);
ASSERT(Input.Time() > 0)
- END TestTime;
+ end TestTime;
-BEGIN
+begin
XYplane.Open;
TestAvailable;
TestRead;
TestMouse;
TestTime
-END InputTest.
+end InputTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Math;
+module Math;
(**General purpose mathematical functions
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
(*implemented in C*)
- CONST
+ const
pi* = 3.14159265358979;
e* = 2.71828182845905;
dummy = 0.0;
- PROCEDURE sqrt*(x: REAL): REAL;
+ procedure sqrt*(x: REAL): REAL;
(**returns the square root of x, where x must be positive*)
- RETURN dummy
- END sqrt;
+ return dummy
+ end sqrt;
- PROCEDURE power*(base, exp: REAL): REAL;
+ procedure power*(base, exp: REAL): REAL;
(**returns base raised to exp*)
- RETURN dummy
- END power;
+ return dummy
+ end power;
- PROCEDURE exp*(x: REAL): REAL;
+ procedure exp*(x: REAL): REAL;
(**returns the constant e raised to x*)
- RETURN dummy
- END exp;
+ return dummy
+ end exp;
- PROCEDURE ln*(x: REAL): REAL;
+ procedure ln*(x: REAL): REAL;
(**returns the natural logarithm of x with base e*)
- RETURN dummy
- END ln;
+ return dummy
+ end ln;
- PROCEDURE log*(x, base: REAL): REAL;
+ procedure log*(x, base: REAL): REAL;
(**log(x, b) returns the logarithm of x with base b*)
- RETURN dummy
- END log;
+ return dummy
+ end log;
- PROCEDURE round*(x: REAL): REAL;
+ procedure round*(x: REAL): REAL;
(**returns x rounded to the nearest integer. If the fraction part of x is in range 0.0 to 0.5 then the result is the largest integer not greater than x, otherwise the result is x rounded up to the next highest whole number. Note that integer values cannot always be exactly represented in REAL format.*)
- RETURN dummy
- END round;
+ return dummy
+ end round;
- PROCEDURE sin*(x: REAL): REAL;
+ procedure sin*(x: REAL): REAL;
(**returns the sine of a radian value x*)
- RETURN dummy
- END sin;
+ return dummy
+ end sin;
- PROCEDURE cos*(x: REAL): REAL;
+ procedure cos*(x: REAL): REAL;
(**returns the cosine of a radian value x*)
- RETURN dummy
- END cos;
+ return dummy
+ end cos;
- PROCEDURE tan*(x: REAL): REAL;
+ procedure tan*(x: REAL): REAL;
(**returns the tangent of a radian value x*)
- RETURN dummy
- END tan;
+ return dummy
+ end tan;
- PROCEDURE arcsin*(x: REAL): REAL;
+ procedure arcsin*(x: REAL): REAL;
(**returns the inverse sine of x in radians, where -1 <= x <= 1*)
- RETURN dummy
- END arcsin;
+ return dummy
+ end arcsin;
- PROCEDURE arccos*(x: REAL): REAL;
+ procedure arccos*(x: REAL): REAL;
(**returns the inverse cosine of x in radians, where -1 <= x <= 1*)
- RETURN dummy
- END arccos;
+ return dummy
+ end arccos;
- PROCEDURE arctan*(x: REAL): REAL;
+ procedure arctan*(x: REAL): REAL;
(**returns the inverse tangent of x in radians, where -1 <= x <= 1*)
- RETURN dummy
- END arctan;
+ return dummy
+ end arctan;
- PROCEDURE arctan2*(y, x: REAL): REAL;
+ procedure arctan2*(y, x: REAL): REAL;
(**returns the inverse tangent in radians of y/x based on the signs of both values to determine the correct quadrant.*)
- RETURN dummy
- END arctan2;
+ return dummy
+ end arctan2;
- PROCEDURE sinh*(x: REAL): REAL;
+ procedure sinh*(x: REAL): REAL;
(**returns the hyperbolic sine of x*)
- RETURN dummy
- END sinh;
+ return dummy
+ end sinh;
- PROCEDURE cosh*(x: REAL): REAL;
+ procedure cosh*(x: REAL): REAL;
(**returns the hyperbolic cosine of x*)
- RETURN dummy
- END cosh;
+ return dummy
+ end cosh;
- PROCEDURE tanh*(x: REAL): REAL;
+ procedure tanh*(x: REAL): REAL;
(**returns the hyperbolic tangent of x*)
- RETURN dummy
- END tanh;
+ return dummy
+ end tanh;
- PROCEDURE arcsinh*(x: REAL): REAL;
+ procedure arcsinh*(x: REAL): REAL;
(**returns the inverse hyperbolic sine of x*)
- RETURN dummy
- END arcsinh;
+ return dummy
+ end arcsinh;
- PROCEDURE arccosh*(x: REAL): REAL;
+ procedure arccosh*(x: REAL): REAL;
(**returns the inverse hyperbolic cosine of x*)
- RETURN dummy
- END arccosh;
+ return dummy
+ end arccosh;
- PROCEDURE arctanh*(x: REAL): REAL;
+ procedure arctanh*(x: REAL): REAL;
(**returns the inverse hyperbolic tangent of x*)
- RETURN dummy
- END arctanh;
+ return dummy
+ end arctanh;
-END Math.
+end Math.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE MathTest;
+module MathTest;
- IMPORT Math;
+ import Math;
- CONST
+ const
eps = 0.01;
-BEGIN
+begin
ASSERT(ABS(Math.sqrt(1.0) - 1.0) < eps);
ASSERT(ABS(Math.sqrt(4.0) - 2.0) < eps);
ASSERT(ABS(Math.arctanh(0.0) - 0.0) < eps);
ASSERT(ABS(Math.arctanh((Math.e - 1.0 / Math.e) / (Math.e + 1.0 / Math.e)) - 1.0) < eps)
-END MathTest.
+end MathTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Out;
+module Out;
(**Output to the standard output stream
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
(*implemented in C*)
- PROCEDURE Open*;
+ procedure Open*;
(**does nothing (included for compatibility with "The Oakwood Guidelines")*)
- END Open;
+ end Open;
- PROCEDURE Char*(ch: CHAR);
+ procedure Char*(ch: CHAR);
(**writes the character ch to the end of the output stream*)
- END Char;
+ end Char;
- PROCEDURE String*(s: ARRAY OF CHAR);
+ procedure String*(s: array of CHAR);
(**writes the null-terminated character sequence s to the end of the output stream (without 0X).*)
- END String;
+ end String;
- PROCEDURE Int*(i, n: INTEGER);
+ procedure Int*(i, n: INTEGER);
(**writes the integer i to the end of the output stream. If the textual representation of i requires m characters, i is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign is not written.*)
- END Int;
+ end Int;
- PROCEDURE Hex*(i: INTEGER);
+ procedure Hex*(i: INTEGER);
(**writes the integer i to the end of the output stream as a zero-padded unsigned hexadecimal number with a leading space. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
- END Hex;
+ end Hex;
- PROCEDURE Real*(x: REAL; n: INTEGER);
+ procedure Real*(x: REAL; n: INTEGER);
(**writes the real number x to the end of the output stream using an exponential form. If the textual representation of x requires m characters (including a two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign of the mantissa is not written.*)
- END Real;
+ end Real;
- PROCEDURE Ln*;
+ procedure Ln*;
(**writes an end-of-line symbol to the end of the output stream*)
- END Ln;
+ end Ln;
-END Out.
+end Out.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE OutTest;
+module OutTest;
- IMPORT Out;
+ import Out;
-BEGIN
+begin
Out.Char("a"); Out.Ln;
Out.String("abc"); Out.Ln;
Out.Int(-07FFFH - 1, 0); Out.Ln; (*minimum 16-bit integer*)
Out.Real(1.0, 0); Out.Ln;
Out.Real(37.0, 0); Out.Ln;
Out.Real(0.37, 0); Out.Ln
-END OutTest.
+end OutTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE Strings;
+module Strings;
(**Operations on strings
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All character arrays are assumed to contain 0X as a terminator and positions start at 0.*)
- PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
+ procedure Length*(s: array of CHAR): INTEGER;
(**Length(s) returns the number of characters in s up to and excluding the first 0X.*)
- VAR i: INTEGER;
- BEGIN
+ var i: INTEGER;
+ begin
i := 0;
- WHILE s[i] # 0X DO
+ while s[i] # 0X do
INC(i)
- END
- RETURN i
- END Length;
+ end
+ return i
+ end Length;
- PROCEDURE Min(a, b: INTEGER): INTEGER;
- BEGIN IF a > b THEN a := b END
- RETURN a
- END Min;
+ procedure Min(a, b: INTEGER): INTEGER;
+ begin if a > b then a := b end
+ return a
+ end Min;
- PROCEDURE Insert*(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
+ procedure Insert*(source: array of CHAR; pos: INTEGER; var dest: array of CHAR);
(**Insert(src, pos, dst) inserts the string src into the string dst at position pos (0 <= pos <= Length(dst)). If pos = Length(dst), src is appended to dst. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)
- VAR sourceLength, destLength, newLength: INTEGER;
+ var sourceLength, destLength, newLength: INTEGER;
i, lim: INTEGER;
- BEGIN
+ begin
destLength := Length(dest);
ASSERT(pos >= 0);
ASSERT(pos <= destLength);
(*make room for source in dest*)
dest[newLength] := 0X;
- FOR i := newLength - 1 TO pos + sourceLength BY -1 DO
+ for i := newLength - 1 to pos + sourceLength by -1 do
dest[i] := dest[i - sourceLength]
- END;
+ end;
(*copy source to dest*)
lim := Min(pos + sourceLength - 1, newLength - 1);
- FOR i := pos TO lim DO
+ for i := pos to lim do
dest[i] := source[i - pos];
- END
- END Insert;
+ end
+ end Insert;
- PROCEDURE Append*(extra: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
+ procedure Append*(extra: array of CHAR; var dest: array of CHAR);
(**Append(s, dst) has the same effect as Insert(s, Length(dst), dst).*)
- VAR destLength, newLength: INTEGER;
+ var destLength, newLength: INTEGER;
i: INTEGER;
- BEGIN
+ begin
destLength := Length(dest);
newLength := Min(destLength + Length(extra), LEN(dest) - 1);
- FOR i := destLength TO newLength - 1 DO
+ for i := destLength to newLength - 1 do
dest[i] := extra[i - destLength]
- END;
+ end;
dest[newLength] := 0X
- END Append;
+ end Append;
- PROCEDURE Delete*(VAR s: ARRAY OF CHAR; pos, n: INTEGER);
+ procedure Delete*(var s: array of CHAR; pos, n: INTEGER);
(**Delete(s, pos, n) deletes n characters from s starting at position pos (0 <= pos <= Length(s)). If n > Length(s) - pos, the new length of s is pos.*)
- VAR length, n1, i: INTEGER;
- BEGIN
+ var length, n1, i: INTEGER;
+ begin
length := Length(s);
ASSERT(pos >= 0);
ASSERT(pos <= length);
ASSERT(n >= 0);
n1 := Min(n, length - pos); (*actual number of characters to delete*)
- FOR i := pos TO length - n1 DO
+ for i := pos to length - n1 do
s[i] := s[i + n1]
- END
- END Delete;
+ end
+ end Delete;
- PROCEDURE Replace*(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
+ procedure Replace*(source: array of CHAR; pos: INTEGER; var dest: array of CHAR);
(**Replace(src, pos, dst) has the same effect as Delete(dst, pos, Length(src)) followed by an Insert(src, pos, dst).*)
- VAR destLength, n, i: INTEGER;
- BEGIN
+ var destLength, n, i: INTEGER;
+ begin
destLength := Length(dest);
ASSERT(pos >= 0);
ASSERT(pos <= destLength);
n := Min(Length(source), LEN(dest) - 1 - pos); (*actual number of characters to replace*)
(*replace characters*)
- FOR i := 0 TO n - 1 DO
+ for i := 0 to n - 1 do
dest[pos + i] := source[i]
- END;
+ end;
- IF pos + n > destLength THEN
+ if pos + n > destLength then
dest[pos + n] := 0X
- END
- END Replace;
+ end
+ end Replace;
- PROCEDURE Extract*(source: ARRAY OF CHAR; pos, n: INTEGER; VAR dest: ARRAY OF CHAR);
+ procedure Extract*(source: array of CHAR; pos, n: INTEGER; var dest: array of CHAR);
(**Extract(src, pos, n, dst) extracts a substring dst with n characters from position pos (0 <= pos <= Length(src)) in src. If n > Length(src) - pos, dst is only the part of src from pos to the end of src, i.e. Length(src) - 1. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)
- VAR sourceLength, n1, i: INTEGER;
- BEGIN
+ var sourceLength, n1, i: INTEGER;
+ begin
sourceLength := Length(source);
ASSERT(pos >= 0);
ASSERT(pos <= sourceLength);
n1 := Min(n, Min(sourceLength - pos, LEN(dest) - 1)); (*actual number of characters to extract*)
- FOR i := 0 TO n1 - 1 DO
+ for i := 0 to n1 - 1 do
dest[i] := source[pos + i]
- END;
+ end;
dest[n1] := 0X
- END Extract;
+ end Extract;
- PROCEDURE Pos*(pattern, s: ARRAY OF CHAR; pos: INTEGER): INTEGER;
+ procedure Pos*(pattern, s: array of CHAR; pos: INTEGER): INTEGER;
(**Pos(pat, s, pos) returns the position of the first occurrence of pat in s. Searching starts at position pos (0 <= pos <= Length(s)). If pat is not found, -1 is returned.*)
- VAR is, ip, result: INTEGER;
- BEGIN
+ var idxs, idxp, result: INTEGER;
+ begin
ASSERT(pos >= 0);
ASSERT(pos < LEN(s));
- is := pos - 1;
- REPEAT
- INC(is);
- ip := 0;
- WHILE (pattern[ip] # 0X) & (s[is + ip] = pattern[ip]) DO
- INC(ip)
- END
- UNTIL (pattern[ip] = 0X) OR (s[is + ip] = 0X);
-
- IF pattern[ip] = 0X THEN
- result := is
- ELSE
+ idxs := pos - 1;
+ repeat
+ INC(idxs);
+ idxp := 0;
+ while (pattern[idxp] # 0X) & (s[idxs + idxp] = pattern[idxp]) do
+ INC(idxp)
+ end
+ until (pattern[idxp] = 0X) or (s[idxs + idxp] = 0X);
+
+ if pattern[idxp] = 0X then
+ result := idxs
+ else
result := -1
- END;
+ end;
- ASSERT((result = -1) OR (result >= 0) & (result + ip < LEN(s)))
- RETURN result
- END Pos;
+ ASSERT((result = -1) or (result >= 0) & (result + idxp < LEN(s)))
+ return result
+ end Pos;
- PROCEDURE Cap*(VAR s: ARRAY OF CHAR);
+ procedure Cap*(var s: array of CHAR);
(**Cap(s) replaces each lower case letter within s by its upper case equivalent.*)
- VAR i: INTEGER;
- BEGIN
+ var i: INTEGER;
+ begin
i := 0;
- WHILE s[i] # 0X DO
- IF (s[i] >= "a") & (s[i] <= "z") THEN
+ while s[i] # 0X do
+ if (s[i] >= "a") & (s[i] <= "z") then
s[i] := CHR(ORD("A") + ORD(s[i]) - ORD("a"));
- END;
+ end;
INC(i)
- END
- END Cap;
+ end
+ end Cap;
-END Strings.
+end Strings.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE StringsTest;
+module StringsTest;
- IMPORT Strings;
+ import Strings;
- VAR
- shortStr: ARRAY 4 OF CHAR;
- s: ARRAY 14 OF CHAR;
+ var
+ shortStr: array 4 of CHAR;
+ s: array 14 of CHAR;
-BEGIN
+begin
(*test Length*)
ASSERT(Strings.Length("") = 0);
shortStr := "";
s := "foo Bar BAZ";
Strings.Cap(s);
ASSERT(s = "FOO BAR BAZ")
-END StringsTest.
+end StringsTest.
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.*)
-MODULE XYplane;
+module XYplane;
(**Basic facilities for graphics programming
Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". The drawing plane is repainted when Key is invoked. Fullscreen mode is toggled with Ctrl-f; it can also be exited with Esc.*)
(*implemented in C*)
- IMPORT Input; (*required by the implementation*)
+ import Input; (*required by the implementation*)
- CONST
+ const
(**drawing modes*)
draw* = 1;
erase* = 0;
- VAR
+ var
X*, Y*: INTEGER; (**X = 0 and Y = 0. Included for compatibility with The Oakwood Guidelines.*)
W*, H*: INTEGER; (**width and height of the drawing plane in pixels*)
- PROCEDURE Open*;
+ procedure Open*;
(**initializes the drawing plane*)
- END Open;
+ end Open;
- PROCEDURE Clear*;
+ procedure Clear*;
(**erases all pixels in the drawing plane*)
- END Clear;
+ end Clear;
- PROCEDURE Dot*(x, y, mode: INTEGER);
+ procedure Dot*(x, y, mode: INTEGER);
(**Dot(x, y, m) draws or erases the pixel at the coordinates (x, y) relative to the lower left corner of the plane. If m = draw the pixel is drawn, if m = erase the pixel is erased.*)
- END Dot;
+ end Dot;
- PROCEDURE IsDot*(x, y: INTEGER): BOOLEAN;
-(**returns TRUE if the pixel at the coordinates (x, y) relative to the lower left corner of the screen is drawn, otherwise it returns FALSE*)
- RETURN FALSE (*dummy value*)
- END IsDot;
+ procedure IsDot*(x, y: INTEGER): BOOLEAN;
+(**returns true if the pixel at the coordinates (x, y) relative to the lower left corner of the screen is drawn, otherwise it returns false*)
+ return false (*dummy value*)
+ end IsDot;
- PROCEDURE Key*(): CHAR;
+ procedure Key*(): CHAR;
(**reads the keyboard. If a key was pressed prior to invocation, its character value is returned, otherwise the result is 0X.*)
- RETURN CHR(0) (*dummy value*)
- END Key;
+ return CHR(0) (*dummy value*)
+ end Key;
- PROCEDURE SetSize*(width, height: INTEGER);
+ procedure SetSize*(width, height: INTEGER);
(**sets the width and height of the drawing plane. The setting takes effect when Open is called. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
- END SetSize;
+ end SetSize;
- PROCEDURE UseColor*(color: INTEGER);
+ procedure UseColor*(color: INTEGER);
(**sets the red, green and blue components of the drawing color as a three-byte value. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
- END UseColor;
+ end UseColor;
- PROCEDURE Color*(x, y: INTEGER): INTEGER;
+ procedure Color*(x, y: INTEGER): INTEGER;
(**returns the color of the pixel at the coordinates (x, y). NOTE: This procedure is an extension to The Oakwood Guidelines.*)
- RETURN 0 (*dummy value*)
- END Color;
+ return 0 (*dummy value*)
+ end Color;
(**Example:
-MODULE drawpixels;
+module drawpixels;
(*click or drag the mouse to draw pixels*)
- IMPORT Input, XYplane;
+ import Input, XYplane;
- VAR
+ var
x, y: INTEGER;
keys: SET;
-BEGIN
+begin
XYplane.Open;
- REPEAT
+ repeat
Input.Mouse(keys, x, y);
- IF 2 IN keys THEN
+ if 2 in keys then
XYplane.Dot(x, y, XYplane.draw)
- END
- UNTIL XYplane.Key() = "q"
-END drawpixels.
+ end
+ until XYplane.Key() = "q"
+end drawpixels.
*)
-BEGIN
+begin
ASSERT(Input.TimeUnit > 0) (*silence "Input unused" compiler note*)
-END XYplane.
+end XYplane.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE XYplaneTest;
+module XYplaneTest;
- IMPORT XYplane;
+ import XYplane;
- PROCEDURE TestPosition(x, y: INTEGER);
- VAR withinBounds: BOOLEAN;
- BEGIN
+ procedure TestPosition(x, y: INTEGER);
+ var withinBounds: BOOLEAN;
+ begin
withinBounds := (x >= 0) & (x < XYplane.W)
& (y >= 0) & (y < XYplane.H);
XYplane.Clear;
XYplane.Dot(x, y, XYplane.draw);
ASSERT(withinBounds & XYplane.IsDot(x, y)
- OR ~withinBounds & ~XYplane.IsDot(x, y));
+ or ~withinBounds & ~XYplane.IsDot(x, y));
XYplane.Dot(x, y, XYplane.erase);
ASSERT(~XYplane.IsDot(x, y))
- END TestPosition;
+ end TestPosition;
- PROCEDURE Run;
- VAR x, y, w, h: INTEGER;
- BEGIN
+ procedure Run;
+ var x, y, w, h: INTEGER;
+ begin
x := XYplane.X;
y := XYplane.Y;
w := XYplane.W;
XYplane.Dot(100, 100, XYplane.draw);
ASSERT(XYplane.Color(100, 100) = 0);
ASSERT(~XYplane.IsDot(100, 100))
- END Run;
+ end Run;
-BEGIN
+begin
Run
-END XYplaneTest.
+end XYplaneTest.
+++ /dev/null
-DEFINITION Files;
-(*Operations on files
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
-
- TYPE
- File = POINTER TO Handle;
-
- Rider = RECORD
- eof: BOOLEAN;
- res: INTEGER;
- END;
-
- PROCEDURE Old(name: ARRAY OF CHAR): File;
-(*Old(fn) searches the name fn in the directory and returns the corresponding file. If the name is not found, it returns NIL.*)
-
- PROCEDURE New(name: ARRAY OF CHAR): File;
-(*New(fn) creates and returns a new file. The name fn is remembered for the later use of the operation Register. The file is only entered into the directory when Register is called.*)
-
- PROCEDURE Register(f: File);
-(*enters the file f into the directory together with the name provided in the operation New that created f. The file buffers are written back. Any existing mapping of this name to another file is overwritten.*)
-
- PROCEDURE Close(f: File);
-(*writes back the file buffers of f. The file is still accessible by its handle f and the riders positioned on it. If a file is not modified it is not necessary to close it.*)
-
- PROCEDURE Purge(f: File);
-(*resets the length of file f to 0*)
-
- PROCEDURE Delete(name: ARRAY OF CHAR; VAR res: INTEGER);
-(*Delete(fn, res) removes the directory entry for the file fn without deleting the file. If res = 0 the file has been successfully deleted. If there are variables referring to the file while Delete is called, they can still be used.*)
-
- PROCEDURE Rename(old, new: ARRAY OF CHAR; VAR res: INTEGER);
-(*Rename(oldfn, newfn, res) renames the directory entry oldfn to newfn. If res = 0 the file has been successfully renamed. If there are variables referring to the file while Rename is called, they can still be used.*)
-
- PROCEDURE Length(f: File): INTEGER;
-(*returns the number of bytes in file f*)
-
- PROCEDURE GetDate(f: File; VAR t, d: INTEGER);
-(*returns the time t and date d of the last modification of file f. The encoding is: hour = t DIV 4096; minute = t DIV 64 MOD 64; second = t MOD 64; year = d DIV 512; month = d DIV 32 MOD 16; day = d MOD 32.*)
-
- PROCEDURE Set(VAR r: Rider; f: File; pos: INTEGER);
-(*sets the rider r to position pos in file f. The field r.eof is set to FALSE. The
-operation requires that 0 <= pos <= Length(f)*)
-
- PROCEDURE Pos(VAR r: Rider): INTEGER;
-(*returns the position of the rider r*)
-
- PROCEDURE Base(VAR r: Rider): File;
-(*returns the file to which the rider r has been set*)
-
- PROCEDURE Read(VAR r: Rider; VAR x: BYTE);
-(*reads the next byte x from rider r and advances r accordingly*)
-
- PROCEDURE ReadInt(VAR r: Rider; VAR i: INTEGER);
-(*reads an integer i from rider r and advances r accordingly.*)
-
- PROCEDURE ReadReal(VAR r: Rider; VAR x: REAL);
-(*reads a real number x from rider r and advances r accordingly.*)
-
- PROCEDURE ReadNum(VAR r: Rider; VAR i: INTEGER);
-(*reads an integer i from rider r and advances r accordingly. The number i is compactly encoded*)
-
- PROCEDURE ReadString(VAR r: Rider; VAR s: ARRAY OF CHAR);
-(*reads a sequence of characters (including the terminating 0X) from rider r and returns it in s. The rider is advanced accordingly. The actual parameter corresponding to s must be long enough to hold the character sequence plus the terminating 0X.*)
-
- PROCEDURE ReadSet(VAR r: Rider; VAR s: SET);
-(*reads a set s from rider r and advances r accordingly*)
-
- PROCEDURE ReadBool(VAR r: Rider; VAR b: BOOLEAN);
-(*reads a Boolean value b from rider r and advances r accordingly*)
-
- PROCEDURE ReadBytes(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
-(*reads n bytes into buffer buf starting at the rider position r. The rider is advanced accordingly. If less than n bytes could be read, r.res contains the number of requested but unread bytes.*)
-
- PROCEDURE Write(VAR r: Rider; x: BYTE);
-(*writes the byte x to rider r and advances r accordingly*)
-
- PROCEDURE WriteInt(VAR r: Rider; i: INTEGER);
-(*writes the integer i to rider r and advances r accordingly*)
-
- PROCEDURE WriteReal(VAR r: Rider; x: REAL);
-(*writes the real number x to rider r and advances r accordingly*)
-
- PROCEDURE WriteNum(VAR r: Rider; i: INTEGER);
-(*writes the integer i to rider r and advances r accordingly. The number i is compactly encoded.*)
-
- PROCEDURE WriteString(VAR r: Rider; s: ARRAY OF CHAR);
-(*writes the sequence of characters s (including the terminating 0X) to rider r and advances r accordingly*)
-
- PROCEDURE WriteSet(VAR r: Rider; s: SET);
-(*writes the set s to rider r and advances r accordingly*)
-
- PROCEDURE WriteBool(VAR r: Rider; b: BOOLEAN);
-(*writes the Boolean value b to rider r and advances r accordingly.*)
-
- PROCEDURE WriteBytes(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
-(*writes the first n bytes from buf to rider r and advances r accordingly. r.res contains the number of bytes that could not be written (e.g., due to a disk full error).*)
-
-END Files.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Files</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Files</em>;
-<span class='comment'>(*Operations on files
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)</span>
-
- TYPE
- File = POINTER TO Handle;
-
- Rider = RECORD
- eof: BOOLEAN;
- res: INTEGER;
- END;
-
- PROCEDURE <em>Old</em>(name: ARRAY OF CHAR): File;
-<span class='comment'>(*Old(fn) searches the name fn in the directory and returns the corresponding file. If the name is not found, it returns NIL.*)</span>
-
- PROCEDURE <em>New</em>(name: ARRAY OF CHAR): File;
-<span class='comment'>(*New(fn) creates and returns a new file. The name fn is remembered for the later use of the operation Register. The file is only entered into the directory when Register is called.*)</span>
-
- PROCEDURE <em>Register</em>(f: File);
-<span class='comment'>(*enters the file f into the directory together with the name provided in the operation New that created f. The file buffers are written back. Any existing mapping of this name to another file is overwritten.*)</span>
-
- PROCEDURE <em>Close</em>(f: File);
-<span class='comment'>(*writes back the file buffers of f. The file is still accessible by its handle f and the riders positioned on it. If a file is not modified it is not necessary to close it.*)</span>
-
- PROCEDURE <em>Purge</em>(f: File);
-<span class='comment'>(*resets the length of file f to 0*)</span>
-
- PROCEDURE <em>Delete</em>(name: ARRAY OF CHAR; VAR res: INTEGER);
-<span class='comment'>(*Delete(fn, res) removes the directory entry for the file fn without deleting the file. If res = 0 the file has been successfully deleted. If there are variables referring to the file while Delete is called, they can still be used.*)</span>
-
- PROCEDURE <em>Rename</em>(old, new: ARRAY OF CHAR; VAR res: INTEGER);
-<span class='comment'>(*Rename(oldfn, newfn, res) renames the directory entry oldfn to newfn. If res = 0 the file has been successfully renamed. If there are variables referring to the file while Rename is called, they can still be used.*)</span>
-
- PROCEDURE <em>Length</em>(f: File): INTEGER;
-<span class='comment'>(*returns the number of bytes in file f*)</span>
-
- PROCEDURE <em>GetDate</em>(f: File; VAR t, d: INTEGER);
-<span class='comment'>(*returns the time t and date d of the last modification of file f. The encoding is: hour = t DIV 4096; minute = t DIV 64 MOD 64; second = t MOD 64; year = d DIV 512; month = d DIV 32 MOD 16; day = d MOD 32.*)</span>
-
- PROCEDURE <em>Set</em>(VAR r: Rider; f: File; pos: INTEGER);
-<span class='comment'>(*sets the rider r to position pos in file f. The field r.eof is set to FALSE. The
-operation requires that 0 <= pos <= Length(f)*)</span>
-
- PROCEDURE <em>Pos</em>(VAR r: Rider): INTEGER;
-<span class='comment'>(*returns the position of the rider r*)</span>
-
- PROCEDURE <em>Base</em>(VAR r: Rider): File;
-<span class='comment'>(*returns the file to which the rider r has been set*)</span>
-
- PROCEDURE <em>Read</em>(VAR r: Rider; VAR x: BYTE);
-<span class='comment'>(*reads the next byte x from rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>ReadInt</em>(VAR r: Rider; VAR i: INTEGER);
-<span class='comment'>(*reads an integer i from rider r and advances r accordingly.*)</span>
-
- PROCEDURE <em>ReadReal</em>(VAR r: Rider; VAR x: REAL);
-<span class='comment'>(*reads a real number x from rider r and advances r accordingly.*)</span>
-
- PROCEDURE <em>ReadNum</em>(VAR r: Rider; VAR i: INTEGER);
-<span class='comment'>(*reads an integer i from rider r and advances r accordingly. The number i is compactly encoded*)</span>
-
- PROCEDURE <em>ReadString</em>(VAR r: Rider; VAR s: ARRAY OF CHAR);
-<span class='comment'>(*reads a sequence of characters (including the terminating 0X) from rider r and returns it in s. The rider is advanced accordingly. The actual parameter corresponding to s must be long enough to hold the character sequence plus the terminating 0X.*)</span>
-
- PROCEDURE <em>ReadSet</em>(VAR r: Rider; VAR s: SET);
-<span class='comment'>(*reads a set s from rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>ReadBool</em>(VAR r: Rider; VAR b: BOOLEAN);
-<span class='comment'>(*reads a Boolean value b from rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>ReadBytes</em>(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
-<span class='comment'>(*reads n bytes into buffer buf starting at the rider position r. The rider is advanced accordingly. If less than n bytes could be read, r.res contains the number of requested but unread bytes.*)</span>
-
- PROCEDURE <em>Write</em>(VAR r: Rider; x: BYTE);
-<span class='comment'>(*writes the byte x to rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>WriteInt</em>(VAR r: Rider; i: INTEGER);
-<span class='comment'>(*writes the integer i to rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>WriteReal</em>(VAR r: Rider; x: REAL);
-<span class='comment'>(*writes the real number x to rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>WriteNum</em>(VAR r: Rider; i: INTEGER);
-<span class='comment'>(*writes the integer i to rider r and advances r accordingly. The number i is compactly encoded.*)</span>
-
- PROCEDURE <em>WriteString</em>(VAR r: Rider; s: ARRAY OF CHAR);
-<span class='comment'>(*writes the sequence of characters s (including the terminating 0X) to rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>WriteSet</em>(VAR r: Rider; s: SET);
-<span class='comment'>(*writes the set s to rider r and advances r accordingly*)</span>
-
- PROCEDURE <em>WriteBool</em>(VAR r: Rider; b: BOOLEAN);
-<span class='comment'>(*writes the Boolean value b to rider r and advances r accordingly.*)</span>
-
- PROCEDURE <em>WriteBytes</em>(VAR r: Rider; VAR buf: ARRAY OF BYTE; n: INTEGER);
-<span class='comment'>(*writes the first n bytes from buf to rider r and advances r accordingly. r.res contains the number of bytes that could not be written (e.g., due to a disk full error).*)</span>
-
-END Files.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION FilesTest;
-END FilesTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION FilesTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>FilesTest</em>;
-END FilesTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION In;
-(*Input from the standard input stream
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All read operations except Char and Line skips over preceding whitespace.*)
-
- VAR Done: BOOLEAN; (*status of last operation*)
-
- PROCEDURE Open;
-(*included for compatibility with "The Oakwood Guidelines". On a typical Unix-like system, stdin cannot be rewinded. If Open is called when the file position is not at the beginning of stdin, the program aborts.*)
-
- PROCEDURE Char(VAR ch: CHAR);
-(*returns in ch the character at the current position*)
-
- PROCEDURE Int(VAR i: INTEGER);
-(*returns in i the integer constant at the current position according to the format
-
- integer = digit {digit} | digit {hexDigit} "H".
- hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F".
-*)
-
- PROCEDURE Real(VAR x: REAL);
-(*returns in x the real constant at the current position according to the format
-
- real = digit {digit} "." {digit} [ScaleFactor].
- ScaleFactor = "E" ["+" | "-"] digit {digit}.
-*)
-
- PROCEDURE String(VAR str: ARRAY OF CHAR);
-(*returns in str the string at the current position according to the format
-
- string = """ {character} """ | digit {hexdigit} "X" .
-*)
-
- PROCEDURE Name(VAR name: ARRAY OF CHAR);
-(*Name(s) returns in s the sequence of graphical (non-whitespace) characters at the current position*)
-
- PROCEDURE Line(VAR line: ARRAY OF CHAR);
-(*Line(s) returns in s the sequence of characters from the current position to the end of the line. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
-
-END In.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION In</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>In</em>;
-<span class='comment'>(*Input from the standard input stream
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All read operations except Char and Line skips over preceding whitespace.*)</span>
-
- VAR Done: BOOLEAN; <span class='comment'>(*status of last operation*)</span>
-
- PROCEDURE <em>Open</em>;
-<span class='comment'>(*included for compatibility with "The Oakwood Guidelines". On a typical Unix-like system, stdin cannot be rewinded. If Open is called when the file position is not at the beginning of stdin, the program aborts.*)</span>
-
- PROCEDURE <em>Char</em>(VAR ch: CHAR);
-<span class='comment'>(*returns in ch the character at the current position*)</span>
-
- PROCEDURE <em>Int</em>(VAR i: INTEGER);
-<span class='comment'>(*returns in i the integer constant at the current position according to the format
-
- integer = digit {digit} | digit {hexDigit} "H".
- hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F".
-*)</span>
-
- PROCEDURE <em>Real</em>(VAR x: REAL);
-<span class='comment'>(*returns in x the real constant at the current position according to the format
-
- real = digit {digit} "." {digit} [ScaleFactor].
- ScaleFactor = "E" ["+" | "-"] digit {digit}.
-*)</span>
-
- PROCEDURE <em>String</em>(VAR str: ARRAY OF CHAR);
-<span class='comment'>(*returns in str the string at the current position according to the format
-
- string = """ {character} """ | digit {hexdigit} "X" .
-*)</span>
-
- PROCEDURE <em>Name</em>(VAR name: ARRAY OF CHAR);
-<span class='comment'>(*Name(s) returns in s the sequence of graphical (non-whitespace) characters at the current position*)</span>
-
- PROCEDURE <em>Line</em>(VAR line: ARRAY OF CHAR);
-<span class='comment'>(*Line(s) returns in s the sequence of characters from the current position to the end of the line. NOTE: This procedure is an extension to The Oakwood Guidelines.*)</span>
-
-END In.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION InTest;
-END InTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION InTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>InTest</em>;
-END InTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Input;
-(*Access to keyboard, mouse and clock
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". This module is implemented to be used in tandem with basic module XYplane. For a console application, use module Input0 instead.*)
-
- VAR TimeUnit: INTEGER; (*clock ticks per second*)
-
- PROCEDURE Available(): INTEGER;
-(*returns the number of characters in the keyboard buffer*)
-
- PROCEDURE Read(VAR ch: CHAR);
-(*returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)
-
- PROCEDURE Mouse(VAR keys: SET; VAR x, y: INTEGER);
-(*returns the current mouse position (x, y) in pixels relative to the lower left corner of the screen. keys is the set of the currently pressed mouse keys (left = 2, middle = 1, right = 0).*)
-
- PROCEDURE SetMouseLimits(w, h: INTEGER);
-(*defines the rectangle where the mouse moves (in pixels). Subsequent calls to the operation Mouse will return coordinates for x in the range 0 .. w - 1 and y in the range 0 .. h - 1.*)
-
- PROCEDURE Time(): INTEGER;
-(*returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)
-
-END Input.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Input</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Input</em>;
-<span class='comment'>(*Access to keyboard, mouse and clock
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". This module is implemented to be used in tandem with basic module XYplane. For a console application, use module Input0 instead.*)</span>
-
- VAR TimeUnit: INTEGER; <span class='comment'>(*clock ticks per second*)</span>
-
- PROCEDURE <em>Available</em>(): INTEGER;
-<span class='comment'>(*returns the number of characters in the keyboard buffer*)</span>
-
- PROCEDURE <em>Read</em>(VAR ch: CHAR);
-<span class='comment'>(*returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)</span>
-
- PROCEDURE <em>Mouse</em>(VAR keys: SET; VAR x, y: INTEGER);
-<span class='comment'>(*returns the current mouse position (x, y) in pixels relative to the lower left corner of the screen. keys is the set of the currently pressed mouse keys (left = 2, middle = 1, right = 0).*)</span>
-
- PROCEDURE <em>SetMouseLimits</em>(w, h: INTEGER);
-<span class='comment'>(*defines the rectangle where the mouse moves (in pixels). Subsequent calls to the operation Mouse will return coordinates for x in the range 0 .. w - 1 and y in the range 0 .. h - 1.*)</span>
-
- PROCEDURE <em>Time</em>(): INTEGER;
-<span class='comment'>(*returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)</span>
-
-END Input.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Input0;
-(*Access to keyboard and clock
-
-Implements a subset of basic module Input applicable to console applications. Import with Input := Input0 to emphasize the compatibility.*)
-
- VAR TimeUnit: INTEGER; (*clock ticks per second*)
-
- PROCEDURE Available(): INTEGER;
-(*returns the number of characters in the keyboard buffer*)
-
- PROCEDURE Read(VAR ch: CHAR);
-(*returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)
-
- PROCEDURE Time(): INTEGER;
-(*returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)
-
-END Input0.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Input0</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Input0</em>;
-<span class='comment'>(*Access to keyboard and clock
-
-Implements a subset of basic module Input applicable to console applications. Import with Input := Input0 to emphasize the compatibility.*)</span>
-
- VAR TimeUnit: INTEGER; <span class='comment'>(*clock ticks per second*)</span>
-
- PROCEDURE <em>Available</em>(): INTEGER;
-<span class='comment'>(*returns the number of characters in the keyboard buffer*)</span>
-
- PROCEDURE <em>Read</em>(VAR ch: CHAR);
-<span class='comment'>(*returns (and removes) the next character from the keyboard buffer. If the buffer is empty, Read waits until a key is pressed.*)</span>
-
- PROCEDURE <em>Time</em>(): INTEGER;
-<span class='comment'>(*returns the time elapsed since system startup in units of size 1 / TimeUnit seconds*)</span>
-
-END Input0.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Input0Test;
-END Input0Test.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Input0Test</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Input0Test</em>;
-END Input0Test.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION InputTest;
-END InputTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION InputTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>InputTest</em>;
-END InputTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Math;
-(*General purpose mathematical functions
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
-
- CONST
- pi = 3.14159265358979;
- e = 2.71828182845905;
-
- PROCEDURE sqrt(x: REAL): REAL;
-(*returns the square root of x, where x must be positive*)
-
- PROCEDURE power(base, exp: REAL): REAL;
-(*returns base raised to exp*)
-
- PROCEDURE exp(x: REAL): REAL;
-(*returns the constant e raised to x*)
-
- PROCEDURE ln(x: REAL): REAL;
-(*returns the natural logarithm of x with base e*)
-
- PROCEDURE log(x, base: REAL): REAL;
-(*log(x, b) returns the logarithm of x with base b*)
-
- PROCEDURE round(x: REAL): REAL;
-(*returns x rounded to the nearest integer. If the fraction part of x is in range 0.0 to 0.5 then the result is the largest integer not greater than x, otherwise the result is x rounded up to the next highest whole number. Note that integer values cannot always be exactly represented in REAL format.*)
-
- PROCEDURE sin(x: REAL): REAL;
-(*returns the sine of a radian value x*)
-
- PROCEDURE cos(x: REAL): REAL;
-(*returns the cosine of a radian value x*)
-
- PROCEDURE tan(x: REAL): REAL;
-(*returns the tangent of a radian value x*)
-
- PROCEDURE arcsin(x: REAL): REAL;
-(*returns the inverse sine of x in radians, where -1 <= x <= 1*)
-
- PROCEDURE arccos(x: REAL): REAL;
-(*returns the inverse cosine of x in radians, where -1 <= x <= 1*)
-
- PROCEDURE arctan(x: REAL): REAL;
-(*returns the inverse tangent of x in radians, where -1 <= x <= 1*)
-
- PROCEDURE arctan2(y, x: REAL): REAL;
-(*returns the inverse tangent in radians of y/x based on the signs of both values to determine the correct quadrant.*)
-
- PROCEDURE sinh(x: REAL): REAL;
-(*returns the hyperbolic sine of x*)
-
- PROCEDURE cosh(x: REAL): REAL;
-(*returns the hyperbolic cosine of x*)
-
- PROCEDURE tanh(x: REAL): REAL;
-(*returns the hyperbolic tangent of x*)
-
- PROCEDURE arcsinh(x: REAL): REAL;
-(*returns the inverse hyperbolic sine of x*)
-
- PROCEDURE arccosh(x: REAL): REAL;
-(*returns the inverse hyperbolic cosine of x*)
-
- PROCEDURE arctanh(x: REAL): REAL;
-(*returns the inverse hyperbolic tangent of x*)
-
-END Math.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Math</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Math</em>;
-<span class='comment'>(*General purpose mathematical functions
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)</span>
-
- CONST
- pi = 3.14159265358979;
- e = 2.71828182845905;
-
- PROCEDURE <em>sqrt</em>(x: REAL): REAL;
-<span class='comment'>(*returns the square root of x, where x must be positive*)</span>
-
- PROCEDURE <em>power</em>(base, exp: REAL): REAL;
-<span class='comment'>(*returns base raised to exp*)</span>
-
- PROCEDURE <em>exp</em>(x: REAL): REAL;
-<span class='comment'>(*returns the constant e raised to x*)</span>
-
- PROCEDURE <em>ln</em>(x: REAL): REAL;
-<span class='comment'>(*returns the natural logarithm of x with base e*)</span>
-
- PROCEDURE <em>log</em>(x, base: REAL): REAL;
-<span class='comment'>(*log(x, b) returns the logarithm of x with base b*)</span>
-
- PROCEDURE <em>round</em>(x: REAL): REAL;
-<span class='comment'>(*returns x rounded to the nearest integer. If the fraction part of x is in range 0.0 to 0.5 then the result is the largest integer not greater than x, otherwise the result is x rounded up to the next highest whole number. Note that integer values cannot always be exactly represented in REAL format.*)</span>
-
- PROCEDURE <em>sin</em>(x: REAL): REAL;
-<span class='comment'>(*returns the sine of a radian value x*)</span>
-
- PROCEDURE <em>cos</em>(x: REAL): REAL;
-<span class='comment'>(*returns the cosine of a radian value x*)</span>
-
- PROCEDURE <em>tan</em>(x: REAL): REAL;
-<span class='comment'>(*returns the tangent of a radian value x*)</span>
-
- PROCEDURE <em>arcsin</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse sine of x in radians, where -1 <= x <= 1*)</span>
-
- PROCEDURE <em>arccos</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse cosine of x in radians, where -1 <= x <= 1*)</span>
-
- PROCEDURE <em>arctan</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse tangent of x in radians, where -1 <= x <= 1*)</span>
-
- PROCEDURE <em>arctan2</em>(y, x: REAL): REAL;
-<span class='comment'>(*returns the inverse tangent in radians of y/x based on the signs of both values to determine the correct quadrant.*)</span>
-
- PROCEDURE <em>sinh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the hyperbolic sine of x*)</span>
-
- PROCEDURE <em>cosh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the hyperbolic cosine of x*)</span>
-
- PROCEDURE <em>tanh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the hyperbolic tangent of x*)</span>
-
- PROCEDURE <em>arcsinh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse hyperbolic sine of x*)</span>
-
- PROCEDURE <em>arccosh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse hyperbolic cosine of x*)</span>
-
- PROCEDURE <em>arctanh</em>(x: REAL): REAL;
-<span class='comment'>(*returns the inverse hyperbolic tangent of x*)</span>
-
-END Math.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION MathTest;
-END MathTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION MathTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>MathTest</em>;
-END MathTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Out;
-(*Output to the standard output stream
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)
-
- PROCEDURE Open;
-(*does nothing (included for compatibility with "The Oakwood Guidelines")*)
-
- PROCEDURE Char(ch: CHAR);
-(*writes the character ch to the end of the output stream*)
-
- PROCEDURE String(s: ARRAY OF CHAR);
-(*writes the null-terminated character sequence s to the end of the output stream (without 0X).*)
-
- PROCEDURE Int(i, n: INTEGER);
-(*writes the integer i to the end of the output stream. If the textual representation of i requires m characters, i is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign is not written.*)
-
- PROCEDURE Hex(i: INTEGER);
-(*writes the integer i to the end of the output stream as a zero-padded unsigned hexadecimal number with a leading space. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
-
- PROCEDURE Real(x: REAL; n: INTEGER);
-(*writes the real number x to the end of the output stream using an exponential form. If the textual representation of x requires m characters (including a two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign of the mantissa is not written.*)
-
- PROCEDURE Ln;
-(*writes an end-of-line symbol to the end of the output stream*)
-
-END Out.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Out</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Out</em>;
-<span class='comment'>(*Output to the standard output stream
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers".*)</span>
-
- PROCEDURE <em>Open</em>;
-<span class='comment'>(*does nothing (included for compatibility with "The Oakwood Guidelines")*)</span>
-
- PROCEDURE <em>Char</em>(ch: CHAR);
-<span class='comment'>(*writes the character ch to the end of the output stream*)</span>
-
- PROCEDURE <em>String</em>(s: ARRAY OF CHAR);
-<span class='comment'>(*writes the null-terminated character sequence s to the end of the output stream (without 0X).*)</span>
-
- PROCEDURE <em>Int</em>(i, n: INTEGER);
-<span class='comment'>(*writes the integer i to the end of the output stream. If the textual representation of i requires m characters, i is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign is not written.*)</span>
-
- PROCEDURE <em>Hex</em>(i: INTEGER);
-<span class='comment'>(*writes the integer i to the end of the output stream as a zero-padded unsigned hexadecimal number with a leading space. NOTE: This procedure is an extension to The Oakwood Guidelines.*)</span>
-
- PROCEDURE <em>Real</em>(x: REAL; n: INTEGER);
-<span class='comment'>(*writes the real number x to the end of the output stream using an exponential form. If the textual representation of x requires m characters (including a two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign of the mantissa is not written.*)</span>
-
- PROCEDURE <em>Ln</em>;
-<span class='comment'>(*writes an end-of-line symbol to the end of the output stream*)</span>
-
-END Out.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION OutTest;
-END OutTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION OutTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>OutTest</em>;
-END OutTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION Strings;
-(*Operations on strings
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All character arrays are assumed to contain 0X as a terminator and positions start at 0.*)
-
- PROCEDURE Length(s: ARRAY OF CHAR): INTEGER;
-(*Length(s) returns the number of characters in s up to and excluding the first 0X.*)
-
- PROCEDURE Insert(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
-(*Insert(src, pos, dst) inserts the string src into the string dst at position pos (0 <= pos <= Length(dst)). If pos = Length(dst), src is appended to dst. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)
-
- PROCEDURE Append(extra: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
-(*Append(s, dst) has the same effect as Insert(s, Length(dst), dst).*)
-
- PROCEDURE Delete(VAR s: ARRAY OF CHAR; pos, n: INTEGER);
-(*Delete(s, pos, n) deletes n characters from s starting at position pos (0 <= pos <= Length(s)). If n > Length(s) - pos, the new length of s is pos.*)
-
- PROCEDURE Replace(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
-(*Replace(src, pos, dst) has the same effect as Delete(dst, pos, Length(src)) followed by an Insert(src, pos, dst).*)
-
- PROCEDURE Extract(source: ARRAY OF CHAR; pos, n: INTEGER; VAR dest: ARRAY OF CHAR);
-(*Extract(src, pos, n, dst) extracts a substring dst with n characters from position pos (0 <= pos <= Length(src)) in src. If n > Length(src) - pos, dst is only the part of src from pos to the end of src, i.e. Length(src) - 1. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)
-
- PROCEDURE Pos(pattern, s: ARRAY OF CHAR; pos: INTEGER): INTEGER;
-(*Pos(pat, s, pos) returns the position of the first occurrence of pat in s. Searching starts at position pos (0 <= pos <= Length(s)). If pat is not found, -1 is returned.*)
-
- PROCEDURE Cap(VAR s: ARRAY OF CHAR);
-(*Cap(s) replaces each lower case letter within s by its upper case equivalent.*)
-
-END Strings.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION Strings</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>Strings</em>;
-<span class='comment'>(*Operations on strings
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". All character arrays are assumed to contain 0X as a terminator and positions start at 0.*)</span>
-
- PROCEDURE <em>Length</em>(s: ARRAY OF CHAR): INTEGER;
-<span class='comment'>(*Length(s) returns the number of characters in s up to and excluding the first 0X.*)</span>
-
- PROCEDURE <em>Insert</em>(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
-<span class='comment'>(*Insert(src, pos, dst) inserts the string src into the string dst at position pos (0 <= pos <= Length(dst)). If pos = Length(dst), src is appended to dst. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)</span>
-
- PROCEDURE <em>Append</em>(extra: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
-<span class='comment'>(*Append(s, dst) has the same effect as Insert(s, Length(dst), dst).*)</span>
-
- PROCEDURE <em>Delete</em>(VAR s: ARRAY OF CHAR; pos, n: INTEGER);
-<span class='comment'>(*Delete(s, pos, n) deletes n characters from s starting at position pos (0 <= pos <= Length(s)). If n > Length(s) - pos, the new length of s is pos.*)</span>
-
- PROCEDURE <em>Replace</em>(source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
-<span class='comment'>(*Replace(src, pos, dst) has the same effect as Delete(dst, pos, Length(src)) followed by an Insert(src, pos, dst).*)</span>
-
- PROCEDURE <em>Extract</em>(source: ARRAY OF CHAR; pos, n: INTEGER; VAR dest: ARRAY OF CHAR);
-<span class='comment'>(*Extract(src, pos, n, dst) extracts a substring dst with n characters from position pos (0 <= pos <= Length(src)) in src. If n > Length(src) - pos, dst is only the part of src from pos to the end of src, i.e. Length(src) - 1. If the size of dst is not large enough to hold the result of the operation, the result is truncated so that dst is always terminated with a 0X.*)</span>
-
- PROCEDURE <em>Pos</em>(pattern, s: ARRAY OF CHAR; pos: INTEGER): INTEGER;
-<span class='comment'>(*Pos(pat, s, pos) returns the position of the first occurrence of pat in s. Searching starts at position pos (0 <= pos <= Length(s)). If pat is not found, -1 is returned.*)</span>
-
- PROCEDURE <em>Cap</em>(VAR s: ARRAY OF CHAR);
-<span class='comment'>(*Cap(s) replaces each lower case letter within s by its upper case equivalent.*)</span>
-
-END Strings.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION StringsTest;
-END StringsTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION StringsTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>StringsTest</em>;
-END StringsTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION XYplane;
-(*Basic facilities for graphics programming
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". The drawing plane is repainted when Key is invoked. Fullscreen mode is toggled with Ctrl-f; it can also be exited with Esc.*)
-
- CONST
- (*drawing modes*)
- draw = 1;
- erase = 0;
-
- VAR
- X, Y: INTEGER; (*X = 0 and Y = 0. Included for compatibility with The Oakwood Guidelines.*)
- W, H: INTEGER; (*width and height of the drawing plane in pixels*)
-
- PROCEDURE Open;
-(*initializes the drawing plane*)
-
- PROCEDURE Clear;
-(*erases all pixels in the drawing plane*)
-
- PROCEDURE Dot(x, y, mode: INTEGER);
-(*Dot(x, y, m) draws or erases the pixel at the coordinates (x, y) relative to the lower left corner of the plane. If m = draw the pixel is drawn, if m = erase the pixel is erased.*)
-
- PROCEDURE IsDot(x, y: INTEGER): BOOLEAN;
-(*returns TRUE if the pixel at the coordinates (x, y) relative to the lower left corner of the screen is drawn, otherwise it returns FALSE*)
-
- PROCEDURE Key(): CHAR;
-(*reads the keyboard. If a key was pressed prior to invocation, its character value is returned, otherwise the result is 0X.*)
-
- PROCEDURE SetSize(width, height: INTEGER);
-(*sets the width and height of the drawing plane. The setting takes effect when Open is called. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
-
- PROCEDURE UseColor(color: INTEGER);
-(*sets the red, green and blue components of the drawing color as a three-byte value. NOTE: This procedure is an extension to The Oakwood Guidelines.*)
-
- PROCEDURE Color(x, y: INTEGER): INTEGER;
-(*returns the color of the pixel at the coordinates (x, y). NOTE: This procedure is an extension to The Oakwood Guidelines.*)
-
-(*Example:
-
-MODULE drawpixels;
-
- (*click or drag the mouse to draw pixels*)
-
- IMPORT Input, XYplane;
-
- VAR
- x, y: INTEGER;
- keys: SET;
-
-BEGIN
- XYplane.Open;
- REPEAT
- Input.Mouse(keys, x, y);
- IF 2 IN keys THEN
- XYplane.Dot(x, y, XYplane.draw)
- END
- UNTIL XYplane.Key() = "q"
-END drawpixels.
-*)
-
-END XYplane.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION XYplane</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>XYplane</em>;
-<span class='comment'>(*Basic facilities for graphics programming
-
-Implements the basic library module from "The Oakwood Guidelines for Oberon-2 Compiler Developers". The drawing plane is repainted when Key is invoked. Fullscreen mode is toggled with Ctrl-f; it can also be exited with Esc.*)</span>
-
- CONST
- <span class='comment'>(*drawing modes*)</span>
- draw = 1;
- erase = 0;
-
- VAR
- X, Y: INTEGER; <span class='comment'>(*X = 0 and Y = 0. Included for compatibility with The Oakwood Guidelines.*)</span>
- W, H: INTEGER; <span class='comment'>(*width and height of the drawing plane in pixels*)</span>
-
- PROCEDURE <em>Open</em>;
-<span class='comment'>(*initializes the drawing plane*)</span>
-
- PROCEDURE <em>Clear</em>;
-<span class='comment'>(*erases all pixels in the drawing plane*)</span>
-
- PROCEDURE <em>Dot</em>(x, y, mode: INTEGER);
-<span class='comment'>(*Dot(x, y, m) draws or erases the pixel at the coordinates (x, y) relative to the lower left corner of the plane. If m = draw the pixel is drawn, if m = erase the pixel is erased.*)</span>
-
- PROCEDURE <em>IsDot</em>(x, y: INTEGER): BOOLEAN;
-<span class='comment'>(*returns TRUE if the pixel at the coordinates (x, y) relative to the lower left corner of the screen is drawn, otherwise it returns FALSE*)</span>
-
- PROCEDURE <em>Key</em>(): CHAR;
-<span class='comment'>(*reads the keyboard. If a key was pressed prior to invocation, its character value is returned, otherwise the result is 0X.*)</span>
-
- PROCEDURE <em>SetSize</em>(width, height: INTEGER);
-<span class='comment'>(*sets the width and height of the drawing plane. The setting takes effect when Open is called. NOTE: This procedure is an extension to The Oakwood Guidelines.*)</span>
-
- PROCEDURE <em>UseColor</em>(color: INTEGER);
-<span class='comment'>(*sets the red, green and blue components of the drawing color as a three-byte value. NOTE: This procedure is an extension to The Oakwood Guidelines.*)</span>
-
- PROCEDURE <em>Color</em>(x, y: INTEGER): INTEGER;
-<span class='comment'>(*returns the color of the pixel at the coordinates (x, y). NOTE: This procedure is an extension to The Oakwood Guidelines.*)</span>
-
-<span class='comment'>(*Example:
-
-MODULE drawpixels;
-
- (*click or drag the mouse to draw pixels*)
-
- IMPORT Input, XYplane;
-
- VAR
- x, y: INTEGER;
- keys: SET;
-
-BEGIN
- XYplane.Open;
- REPEAT
- Input.Mouse(keys, x, y);
- IF 2 IN keys THEN
- XYplane.Dot(x, y, XYplane.draw)
- END
- UNTIL XYplane.Key() = "q"
-END drawpixels.
-*)</span>
-
-END XYplane.
-</pre>
- </body>
-</html>
+++ /dev/null
-DEFINITION XYplaneTest;
-END XYplaneTest.
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>DEFINITION XYplaneTest</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='index.html'>Index</a></p>
-
- <pre>
-DEFINITION <em>XYplaneTest</em>;
-END XYplaneTest.
-</pre>
- </body>
-</html>
+++ /dev/null
-<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>
-<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>
- <head>
- <meta name='viewport' content='width=device-width, initial-scale=1.0' />
- <meta http-equiv='Content-Type' content='text/html; charset=utf-8' />
- <title>Index of obnc</title>
- <link rel='stylesheet' type='text/css' href='style.css' />
- </head>
- <body>
- <p><a href='../index.html'>Index</a></p>
-
- <pre>
-DEFINITION <a href='Files.def.html'>Files</a>
-DEFINITION <a href='In.def.html'>In</a>
-DEFINITION <a href='Input.def.html'>Input</a>
-DEFINITION <a href='Input0.def.html'>Input0</a>
-DEFINITION <a href='Math.def.html'>Math</a>
-DEFINITION <a href='Out.def.html'>Out</a>
-DEFINITION <a href='Strings.def.html'>Strings</a>
-DEFINITION <a href='XYplane.def.html'>XYplane</a>
- </pre>
- </body>
-</html>
+++ /dev/null
-body {
- font-family: sans-serif;
- margin: 1em;
-}
-
-pre {
- font-family: inherit;
- font-size: inherit;
-
- -moz-tab-size: 4;
- -o-tab-size: 4;
- tab-size: 4;
-}
-
-pre em {
- font-style: normal;
- font-weight: bold;
-}
-
-pre .comment {
- color: #800000;
- display: inline-block;
- max-width: 42em;
- vertical-align: text-top;
-
- white-space: pre-wrap;
- white-space: -moz-pre-wrap;
- white-space: -pre-wrap;
- white-space: -o-pre-wrap;
- word-wrap: break-word;
-}
-
-pre .string {
- color: #767676;
-}
static int KeywordToken(const char word[])
{
- static const char *keywords[] = {"ARRAY", "BEGIN", "BY", "CASE", "CONST", "DIV", "DO", "ELSE", "ELSIF", "END", "FALSE", "FOR", "IF", "IMPORT", "IN", "IS", "MOD", "MODULE", "NIL", "OF", "OR", "POINTER", "PROCEDURE", "RECORD", "REPEAT", "RETURN", "THEN", "TO", "TRUE", "TYPE", "UNTIL", "VAR", "WHILE"};
+ static const char *keywords[] = {"array", "begin", "by", "case", "const", "div", "do", "else", "elsif", "end", "false", "for", "if", "import", "in", "is", "mod", "module", "nil", "of", "or", "pointer", "procedure", "record", "repeat", "return", "then", "to", "true", "type", "until", "var", "while"};
static const int keywordTokens[] = {ARRAY, BEGIN_, BY, CASE, CONST, DIV, DO, ELSE, ELSIF, END, FALSE, FOR, IF, IMPORT, IN, IS, MOD, MODULE, NIL, OF, OR, POINTER, PROCEDURE, RECORD, REPEAT, RETURN, THEN, TO, TRUE, TYPE, UNTIL, VAR, WHILE};
static int KeywordToken(const char word[])
{
- static const char *keywords[] = {"ARRAY", "BEGIN", "BY", "CASE", "CONST", "DIV", "DO", "ELSE", "ELSIF", "END", "FALSE", "FOR", "IF", "IMPORT", "IN", "IS", "MOD", "MODULE", "NIL", "OF", "OR", "POINTER", "PROCEDURE", "RECORD", "REPEAT", "RETURN", "THEN", "TO", "TRUE", "TYPE", "UNTIL", "VAR", "WHILE"};
+ static const char *keywords[] = {"array", "begin", "by", "case", "const", "div", "do", "else", "elsif", "end", "false", "for", "if", "import", "in", "is", "mod", "module", "nil", "of", "or", "pointer", "procedure", "record", "repeat", "return", "then", "to", "true", "type", "until", "var", "while"};
static const int keywordTokens[] = {ARRAY, BEGIN_, BY, CASE, CONST, DIV, DO, ELSE, ELSIF, END, FALSE, FOR, IF, IMPORT, IN, IS, MOD, MODULE, NIL, OF, OR, POINTER, PROCEDURE, RECORD, REPEAT, RETURN, THEN, TO, TRUE, TYPE, UNTIL, VAR, WHILE};
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE A;
+module A;
- TYPE
- P* = POINTER TO RECORD END;
+ type
+ P* = pointer to record end;
- VAR
+ var
n*: INTEGER;
- r*: RECORD f: INTEGER END;
+ r*: record f: INTEGER end;
p*: P;
-END A.
+end A.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE B;
-END B.
+module B;
+end B.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T0UnterminatedComment;
+module T0UnterminatedComment;
(*(**)
-END T0UnterminatedComment.
+end T0UnterminatedComment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2PointerToNonRecord;
+module T2PointerToNonRecord;
- TYPE
- P = POINTER TO ARRAY 10 OF INTEGER;
+ type
+ P = pointer to array 10 of INTEGER;
-END T2PointerToNonRecord.
+end T2PointerToNonRecord.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2RecursiveRecord;
+module T2RecursiveRecord;
- TYPE
- T = RECORD
+ type
+ T = record
f: T
- END;
+ end;
-END T2RecursiveRecord.
+end T2RecursiveRecord.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2RedeclaredField;
+module T2RedeclaredField;
- TYPE
- T = RECORD
+ type
+ T = record
f: INTEGER
- END;
+ end;
- T1 = RECORD (T)
+ T1 = record (T)
f: INTEGER
- END;
+ end;
-END T2RedeclaredField.
+end T2RedeclaredField.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2RepeatedParameterIdent;
+module T2RepeatedParameterIdent;
- TYPE
- Proc = PROCEDURE (x: INTEGER; x: INTEGER);
+ type
+ Proc = procedure (x: INTEGER; x: INTEGER);
-END T2RepeatedParameterIdent.
+end T2RepeatedParameterIdent.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2SelfDeclaration;
+module T2SelfDeclaration;
- TYPE T = T;
+ type T = T;
-END T2SelfDeclaration.
+end T2SelfDeclaration.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2SelfReferringBaseType;
+module T2SelfReferringBaseType;
- TYPE
- T = POINTER TO TDesc;
- TDesc = RECORD (T) END;
+ type
+ T = pointer to TDesc;
+ TDesc = record (T) end;
-END T2SelfReferringBaseType.
+end T2SelfReferringBaseType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2UnresolvedAnonType;
+module T2UnresolvedAnonType;
- VAR
- x: POINTER TO T;
+ var
+ x: pointer to T;
-END T2UnresolvedAnonType.
+end T2UnresolvedAnonType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2UnresolvedType;
+module T2UnresolvedType;
- TYPE
- P = POINTER TO T;
+ type
+ P = pointer to T;
-END T2UnresolvedType.
+end T2UnresolvedType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2WrongResolvedType;
+module T2WrongResolvedType;
- TYPE
- P = POINTER TO T;
+ type
+ P = pointer to T;
T = INTEGER;
-END T2WrongResolvedType.
+end T2WrongResolvedType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T3RepeatedField;
+module T3RepeatedField;
- VAR
- x: RECORD
+ var
+ x: record
f, f: INTEGER
- END;
+ end;
-END T3RepeatedField.
+end T3RepeatedField.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T3RepeatedVar;
+module T3RepeatedVar;
- VAR
+ var
x, x: INTEGER;
-END T3RepeatedVar.
+end T3RepeatedVar.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4InvalidPointerComparison;
+module T4InvalidPointerComparison;
- VAR
- p: POINTER TO RECORD END;
- q: POINTER TO RECORD END;
+ var
+ p: pointer to record end;
+ q: pointer to record end;
-BEGIN
- IF p = q THEN END
-END T4InvalidPointerComparison.
+begin
+ if p = q then end
+end T4InvalidPointerComparison.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4InvalidProcedureComparison;
+module T4InvalidProcedureComparison;
- PROCEDURE P;
- END P;
+ procedure P;
+ end P;
- PROCEDURE Q(x: INTEGER);
- END Q;
+ procedure Q(x: INTEGER);
+ end Q;
-BEGIN
- IF P = Q THEN END (*P and Q should have equal types*)
-END T4InvalidProcedureComparison.
+begin
+ if P = Q then end (*P and Q should have equal types*)
+end T4InvalidProcedureComparison.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4NegativeSetElement;
+module T4NegativeSetElement;
- CONST
+ const
A = {-1};
-END T4NegativeSetElement.
+end T4NegativeSetElement.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4SelectorOnConstant;
+module T4SelectorOnConstant;
- CONST str = "abc";
+ const str = "abc";
-BEGIN
+begin
str[0] := 0X
-END T4SelectorOnConstant.
+end T4SelectorOnConstant.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4TypeGuardOnNonVarParamRecord;
+module T4TypeGuardOnNonVarParamRecord;
- TYPE
- T = RECORD f: INTEGER END;
+ type
+ T = record f: INTEGER end;
- VAR
+ var
x: T;
-BEGIN
- IF x(T).f = 0 THEN END
-END T4TypeGuardOnNonVarParamRecord.
+begin
+ if x(T).f = 0 then end
+end T4TypeGuardOnNonVarParamRecord.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5AssignPredefinedProcedure;
+module T5AssignPredefinedProcedure;
- VAR p: PROCEDURE (x: INTEGER): BOOLEAN;
+ var p: procedure (x: INTEGER): BOOLEAN;
-BEGIN
+begin
p := ODD
-END T5AssignPredefinedProcedure.
+end T5AssignPredefinedProcedure.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5AssignToImportedVariable;
+module T5AssignToImportedVariable;
- IMPORT A;
+ import A;
-BEGIN
+begin
A.n := 0
-END T5AssignToImportedVariable.
+end T5AssignToImportedVariable.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5FunctionProcedureStatement;
+module T5FunctionProcedureStatement;
- PROCEDURE F(): INTEGER;
- RETURN 0
- END F;
+ procedure F(): INTEGER;
+ return 0
+ end F;
-BEGIN
+begin
F
-END T5FunctionProcedureStatement.
+end T5FunctionProcedureStatement.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5InvalidArrayAssignment;
+module T5InvalidArrayAssignment;
- VAR
- s: ARRAY 32 OF CHAR;
- t: ARRAY 32 OF CHAR;
+ var
+ s: array 32 of CHAR;
+ t: array 32 of CHAR;
-BEGIN
+begin
s := "test";
t := s
-END T5InvalidArrayAssignment.
+end T5InvalidArrayAssignment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5NonConstForLoopInc;
+module T5NonConstForLoopInc;
- VAR i: INTEGER;
+ var i: INTEGER;
-BEGIN
- FOR i := 1 TO 10 BY i DO END
-END T5NonConstForLoopInc.
+begin
+ for i := 1 to 10 by i do end
+end T5NonConstForLoopInc.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5PointerVarParamExt;
+module T5PointerVarParamExt;
- TYPE
- P0 = POINTER TO RECORD END;
- P1 = POINTER TO RECORD (P0) END;
+ type
+ P0 = pointer to record end;
+ P1 = pointer to record (P0) end;
- VAR
+ var
x: P1;
- PROCEDURE P(VAR x: P0);
- END P;
+ procedure P(var x: P0);
+ end P;
-BEGIN
+begin
P(x) (*variable pointer parameter cannot be an extended type*)
-END T5PointerVarParamExt.
+end T5PointerVarParamExt.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5StringAssignment;
+module T5StringAssignment;
- VAR s: ARRAY 4 OF CHAR;
+ var s: array 4 of CHAR;
-BEGIN
+begin
s := "help" (*null character won't fit*)
-END T5StringAssignment.
+end T5StringAssignment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5StructValueParamAssignment;
+module T5StructValueParamAssignment;
- TYPE
- String = ARRAY 32 OF CHAR;
+ type
+ String = array 32 of CHAR;
- PROCEDURE P(s: String);
- BEGIN
+ procedure P(s: String);
+ begin
s := s
- END P;
+ end P;
-END T5StructValueParamAssignment.
+end T5StructValueParamAssignment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6ExtendedPointerVarParam;
+module T6ExtendedPointerVarParam;
- TYPE
- Ta = RECORD a : INTEGER END;
- Tb = RECORD (Ta) b : INTEGER END;
+ type
+ Ta = record a : INTEGER end;
+ Tb = record (Ta) b : INTEGER end;
- Pa = POINTER TO Ta;
- Pb = POINTER TO Tb;
+ Pa = pointer to Ta;
+ Pb = pointer to Tb;
- VAR
+ var
pb : Pb;
- PROCEDURE F(VAR pa : Pa);
- END F;
+ procedure F(var pa : Pa);
+ end F;
-BEGIN
+begin
F(pb)
-END T6ExtendedPointerVarParam.
+end T6ExtendedPointerVarParam.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6ForgottenReturnType;
+module T6ForgottenReturnType;
- PROCEDURE F(m: INTEGER);
- VAR n: INTEGER;
- BEGIN
+ procedure F(m: INTEGER);
+ var n: INTEGER;
+ begin
n := F(0)
- RETURN n
- END F;
+ return n
+ end F;
-END T6ForgottenReturnType.
+end T6ForgottenReturnType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6LocalParamTypeRef;
+module T6LocalParamTypeRef;
- PROCEDURE P;
- TYPE T = INTEGER;
+ procedure P;
+ type T = INTEGER;
- PROCEDURE Q(x: T): T;
- RETURN 0
- END Q;
- END P;
+ procedure Q(x: T): T;
+ return 0
+ end Q;
+ end P;
-END T6LocalParamTypeRef.
+end T6LocalParamTypeRef.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6NonScalarResultType;
+module T6NonScalarResultType;
- TYPE
- String = ARRAY 60 OF CHAR;
+ type
+ String = array 60 of CHAR;
- PROCEDURE P(): String;
- VAR s: String;
- RETURN s
- END P;
+ procedure P(): String;
+ var s: String;
+ return s
+ end P;
-END T6NonScalarResultType.
+end T6NonScalarResultType.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6ReadOnlyParam;
+module T6ReadOnlyParam;
- PROCEDURE P(VAR a: ARRAY OF INTEGER);
- END P;
+ procedure P(var a: array of INTEGER);
+ end P;
- PROCEDURE Q(a: ARRAY OF INTEGER);
- BEGIN
+ procedure Q(a: array of INTEGER);
+ begin
P(a)
- END Q;
+ end Q;
-END T6ReadOnlyParam.
+end T6ReadOnlyParam.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7AccessNonExportedField;
+module T7AccessNonExportedField;
- IMPORT A;
+ import A;
- VAR
+ var
n: INTEGER;
-BEGIN
+begin
n := A.r.f
-END T7AccessNonExportedField.
+end T7AccessNonExportedField.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ActualVarParamImported;
+module T7ActualVarParamImported;
- IMPORT A;
+ import A;
- PROCEDURE P(VAR x: A.P);
- END P;
+ procedure P(var x: A.P);
+ end P;
-BEGIN
+begin
P(A.p)
-END T7ActualVarParamImported.
+end T7ActualVarParamImported.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ActualVarParamImported1;
+module T7ActualVarParamImported1;
- IMPORT A;
+ import A;
-BEGIN
+begin
NEW(A.p)
-END T7ActualVarParamImported1.
+end T7ActualVarParamImported1.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ExportLocalIdent;
+module T7ExportLocalIdent;
- PROCEDURE P;
- VAR x*: INTEGER;
- END P;
+ procedure P;
+ var x*: INTEGER;
+ end P;
-END T7ExportLocalIdent.
+end T7ExportLocalIdent.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportDuplicate;
- IMPORT A, A;
-END T7ImportDuplicate.
+module T7ImportDuplicate;
+ import A, A;
+end T7ImportDuplicate.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportDuplicateWithAlias;
+module T7ImportDuplicateWithAlias;
- IMPORT A := B, B;
+ import A := B, B;
-END T7ImportDuplicateWithAlias.
+end T7ImportDuplicateWithAlias.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportLibraryLocal;
+module T7ImportLibraryLocal;
- IMPORT Local;
+ import Local;
-END T7ImportLibraryLocal.
+end T7ImportLibraryLocal.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportNonExisting;
+module T7ImportNonExisting;
- IMPORT NonExistingModule;
+ import NonExistingModule;
-END T7ImportNonExisting.
+end T7ImportNonExisting.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportRedeclaration;
+module T7ImportRedeclaration;
- IMPORT A;
+ import A;
- CONST A = 0;
+ const A = 0;
-END T7ImportRedeclaration.
+end T7ImportRedeclaration.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportRedeclarationAlias;
+module T7ImportRedeclarationAlias;
- IMPORT B := A;
+ import B := A;
- CONST B = 0;
+ const B = 0;
-END T7ImportRedeclarationAlias.
+end T7ImportRedeclarationAlias.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportSelf;
- IMPORT T7ImportSelf;
-END T7ImportSelf.
+module T7ImportSelf;
+ import T7ImportSelf;
+end T7ImportSelf.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportSelfWithAlias;
- IMPORT M := T7ImportSelfWithAlias;
-END T7ImportSelfWithAlias.
+module T7ImportSelfWithAlias;
+ import M := T7ImportSelfWithAlias;
+end T7ImportSelfWithAlias.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ImportWithDuplicateAlias;
- IMPORT B := A, B;
-END T7ImportWithDuplicateAlias.
+module T7ImportWithDuplicateAlias;
+ import B := A, B;
+end T7ImportWithDuplicateAlias.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7ModuleIdentifierNonMatch;
-END T7ModuleIdentifierNonMatchFoo.
+module T7ModuleIdentifierNonMatch;
+end T7ModuleIdentifierNonMatchFoo.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE Local;
-END Local.
+module Local;
+end Local.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4FailingTypeGuard;
+module T4FailingTypeGuard;
- TYPE
- T = RECORD END;
+ type
+ T = record end;
- T1 = RECORD (T)
+ T1 = record (T)
f: INTEGER
- END;
+ end;
- VAR
+ var
x: T;
- PROCEDURE P(VAR x: T);
- BEGIN
+ procedure P(var x: T);
+ begin
x(T1).f := 0
- END P;
+ end P;
-BEGIN
+begin
P(x)
-END T4FailingTypeGuard.
+end T4FailingTypeGuard.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5AssignStringToOpenArray;
+module T5AssignStringToOpenArray;
- VAR
- str: ARRAY 4 OF CHAR;
+ var
+ str: array 4 of CHAR;
- PROCEDURE P(VAR s: ARRAY OF CHAR);
- BEGIN
+ procedure P(var s: array of CHAR);
+ begin
s := "test"
- END P;
+ end P;
-BEGIN
+begin
P(str)
-END T5AssignStringToOpenArray.
+end T5AssignStringToOpenArray.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5CallNilProcedure;
+module T5CallNilProcedure;
- VAR
- p: PROCEDURE;
+ var
+ p: procedure;
-BEGIN
- p := NIL;
+begin
+ p := nil;
p
-END T5CallNilProcedure.
+end T5CallNilProcedure.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5OpenArrayAssignment;
+module T5OpenArrayAssignment;
- VAR
- s1: ARRAY 8 OF CHAR;
+ var
+ s1: array 8 of CHAR;
- PROCEDURE P(s: ARRAY OF CHAR);
- BEGIN
+ procedure P(s: array of CHAR);
+ begin
s1 := s
- END P;
+ end P;
-BEGIN
+begin
P("testing, testing...")
-END T5OpenArrayAssignment.
+end T5OpenArrayAssignment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5RecordVarParamAssignment;
+module T5RecordVarParamAssignment;
- TYPE
- T = RECORD END;
- T1 = RECORD (T) END;
+ type
+ T = record end;
+ T1 = record (T) end;
- VAR
+ var
x: T;
y: T1;
- PROCEDURE P(VAR x, y: T);
- BEGIN
+ procedure P(var x, y: T);
+ begin
y := x
- END P;
+ end P;
-BEGIN
+begin
P(x, y)
-END T5RecordVarParamAssignment.
+end T5RecordVarParamAssignment.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE A;
+module A;
- IMPORT B;
+ import B;
- CONST
- boolConst* = TRUE;
+ const
+ boolConst* = true;
charConst* = CHR(22H);
intConst* = 1;
realConst* = 2.3;
charMax* = 0FFX;
setConst* = {0, 2, 3, 5};
- TYPE
+ type
Integer = INTEGER;
- String = ARRAY 256 OF CHAR;
- EmptyRecord* = RECORD END;
- EmptyExtendedRecord* = RECORD (EmptyRecord) END;
- EmptyPointer* = POINTER TO RECORD END;
- EmptyExtendedPointer* = POINTER TO RECORD (EmptyPointer) END;
- List* = POINTER TO Node;
- Node = RECORD
+ String = array 256 of CHAR;
+ EmptyRecord* = record end;
+ EmptyExtendedRecord* = record (EmptyRecord) end;
+ EmptyPointer* = pointer to record end;
+ EmptyExtendedPointer* = pointer to record (EmptyPointer) end;
+ List* = pointer to Node;
+ Node = record
key: String;
next: List
- END;
- Nested* = RECORD
+ end;
+ Nested* = record
f*: B.U
- END;
- Proc* = PROCEDURE;
- Proc1* = PROCEDURE (n: Node);
- Proc2* = PROCEDURE (): List;
- Proc3* = PROCEDURE (n: Node): List;
- Proc4* = PROCEDURE (n, n1: Node): List;
- Proc5* = PROCEDURE (n: Node; i: INTEGER);
- Proc6* = PROCEDURE (n, n1: Node; i: INTEGER);
+ end;
+ Proc* = procedure;
+ Proc1* = procedure (n: Node);
+ Proc2* = procedure (): List;
+ Proc3* = procedure (n: Node): List;
+ Proc4* = procedure (n, n1: Node): List;
+ Proc5* = procedure (n: Node; i: INTEGER);
+ Proc6* = procedure (n, n1: Node; i: INTEGER);
T* = B.T;
P1* = B.P1;
- VAR
+ var
boolVar*: BOOLEAN;
charVar*: CHAR;
intVar*: Integer;
byteVar*: BYTE;
setVar*: SET;
strVar*: String;
- recVar*, recVar1: RECORD
+ recVar*, recVar1: record
f*: INTEGER
- END;
- ptrVar*: POINTER TO Node;
- procVar*: PROCEDURE (s: String);
+ end;
+ ptrVar*: pointer to Node;
+ procVar*: procedure (s: String);
alias: B.CTAlias;
- PROCEDURE P*(s: String);
- END P;
+ procedure P*(s: String);
+ end P;
- PROCEDURE Q*(x: B.T);
- END Q;
+ procedure Q*(x: B.T);
+ end Q;
- PROCEDURE R*(A: ARRAY OF ARRAY OF INTEGER);
- END R;
+ procedure R*(A: array of array of INTEGER);
+ end R;
- PROCEDURE S*(x: T);
- END S;
+ procedure S*(x: T);
+ end S;
- PROCEDURE S1*(VAR x: P1);
- END S1;
+ procedure S1*(var x: P1);
+ end S1;
-BEGIN
+begin
boolVar := boolConst;
charVar := charConst;
intVar := intConst;
strVar := strConst;
recVar.f := 1;
recVar1.f := 0;
- ptrVar := NIL;
+ ptrVar := nil;
procVar := P;
B.P(alias)
-END A.
+end A.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE B;
+module B;
- IMPORT C1 := C;
+ import C1 := C;
- TYPE
- T* = RECORD (C1.T) END;
- P1* = POINTER TO RECORD (C1.P0) END;
- U* = POINTER TO UDesc;
- UDesc* = RECORD f*: INTEGER END;
+ type
+ T* = record (C1.T) end;
+ P1* = pointer to record (C1.P0) end;
+ U* = pointer to UDesc;
+ UDesc* = record f*: INTEGER end;
CTAlias* = C1.T;
- PROCEDURE P*(VAR x: CTAlias);
- END P;
+ procedure P*(var x: CTAlias);
+ end P;
-END B.
+end B.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE C;
+module C;
- TYPE
- T* = RECORD END;
- P0* = POINTER TO RECORD END;
+ type
+ T* = record end;
+ P0* = pointer to record end;
-END C.
+end C.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE D;
+module D;
- CONST b* = TRUE;
+ const b* = true;
-END D.
+end D.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE OBNC; (*should not cause a conflict with system C module OBNC*)
+module OBNC; (*should not cause a conflict with system C module OBNC*)
(*generated identifiers with suffixes should not conflict with identifiers declared in system module OBNC*)
- CONST b* = TRUE;
+ const b* = true;
- TYPE
- OBNC = RECORD f: INTEGER END;
+ type
+ OBNC = record f: INTEGER end;
- VAR
- a: ARRAY 1 OF INTEGER;
+ var
+ a: array 1 of INTEGER;
x: OBNC;
- PROCEDURE Q(OBNC: ARRAY OF INTEGER);
- END Q;
+ procedure Q(OBNC: array of INTEGER);
+ end Q;
-BEGIN
+begin
Q(a);
x.f := 0
-END OBNC.
+end OBNC.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T1ConstantDeclarations;
+module T1ConstantDeclarations;
- CONST
- null = NIL;
- valid = FALSE;
+ const
+ null = nil;
+ valid = false;
singleCharStr = "x";
lineFeed = 0AX;
quotes = 22X;
(*nan = 0.0 / 0.0;*)
lastDigits = {0, 2 .. 3, 5};
- VAR
- p: PROCEDURE;
+ var
+ p: procedure;
b: BOOLEAN;
ch: CHAR;
- s: ARRAY 8 OF CHAR;
+ s: array 8 of CHAR;
i: INTEGER;
x: REAL;
j: BYTE;
A: SET;
-BEGIN
+begin
p := null;
b := valid;
ch := singleCharStr;
(*x := inf;*)
(*x := nan;*)
A := lastDigits
-END T1ConstantDeclarations.
+end T1ConstantDeclarations.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T2TypeDeclarations;
+module T2TypeDeclarations;
- CONST left = 0;
+ const left = 0;
- TYPE
- String = ARRAY 32 OF CHAR;
+ type
+ String = array 32 of CHAR;
StringAlias = String;
- ProcTable = ARRAY 1 OF PROCEDURE;
+ ProcTable = array 1 of procedure;
- Element = POINTER TO RECORD END;
+ Element = pointer to record end;
- Tree = POINTER TO RECORD
+ Tree = pointer to record
content: Element;
- proc: PROCEDURE (t: Tree; VAR t1: Tree): Tree;
- n: POINTER TO Node;
+ proc: procedure (t: Tree; var t1: Tree): Tree;
+ n: pointer to Node;
left, right: Tree
- END;
+ end;
- IntegerNode = POINTER TO RECORD (Element)
+ IntegerNode = pointer to record (Element)
value: INTEGER
- END;
+ end;
- List = POINTER TO Node;
- List1 = POINTER TO Node;
- Node = RECORD
+ List = pointer to Node;
+ List1 = pointer to Node;
+ Node = record
elem: INTEGER;
next: List;
- next1: POINTER TO Node;
+ next1: pointer to Node;
next2: List1;
- p: PROCEDURE (n: Node; VAR n1: Node)
- END;
+ p: procedure (n: Node; var n1: Node)
+ end;
- ArrayRecPtr = POINTER TO RECORD
- f: ARRAY 10 OF ArrayRecPtr;
- g: RECORD
+ ArrayRecPtr = pointer to record
+ f: array 10 of ArrayRecPtr;
+ g: record
f: ArrayRecPtr
- END
- END;
+ end
+ end;
- ProcRecArray = ARRAY 10 OF RECORD
- f: PROCEDURE (x: ArrayRecPtr): INTEGER
- END;
+ ProcRecArray = array 10 of record
+ f: procedure (x: ArrayRecPtr): INTEGER
+ end;
- T = RECORD i: INTEGER END;
+ T = record i: INTEGER end;
- VAR
+ var
s: String;
s1: StringAlias;
table: ProcTable;
p: ArrayRecPtr;
a: ProcRecArray;
- PROCEDURE TestMemoryAllocation;
- TYPE
- Ta0 = RECORD
- ptr: POINTER TO RECORD END
- END;
- Tb0 = RECORD
- proc: PROCEDURE
- END;
- Ta1 = RECORD (Ta0) END;
- Tb1 = RECORD (Tb0) END;
-
- VAR
- x: POINTER TO Ta1;
- y: POINTER TO Tb1;
- z: POINTER TO RECORD
- ptr: POINTER TO RECORD END;
- proc: PROCEDURE
- END;
- BEGIN
+ procedure TestMemoryAllocation;
+ type
+ Ta0 = record
+ ptr: pointer to record end
+ end;
+ Tb0 = record
+ proc: procedure
+ end;
+ Ta1 = record (Ta0) end;
+ Tb1 = record (Tb0) end;
+
+ var
+ x: pointer to Ta1;
+ y: pointer to Tb1;
+ z: pointer to record
+ ptr: pointer to record end;
+ proc: procedure
+ end;
+ begin
NEW(x);
- ASSERT(x.ptr = NIL);
+ ASSERT(x.ptr = nil);
NEW(y);
- ASSERT(y.proc = NIL);
+ ASSERT(y.proc = nil);
NEW(z);
- ASSERT(z.ptr = NIL);
- ASSERT(z.proc = NIL)
- END TestMemoryAllocation;
+ ASSERT(z.ptr = nil);
+ ASSERT(z.proc = nil)
+ end TestMemoryAllocation;
- PROCEDURE TreeProc(t: Tree; VAR t1: Tree): Tree;
- RETURN NIL
- END TreeProc;
+ procedure TreeProc(t: Tree; var t1: Tree): Tree;
+ return nil
+ end TreeProc;
- PROCEDURE NodeProc(n: Node; VAR n1: Node);
- END NodeProc;
+ procedure NodeProc(n: Node; var n1: Node);
+ end NodeProc;
- PROCEDURE TestScope;
- TYPE P = POINTER TO T;
- T = RECORD f: INTEGER END;
- VAR x: P;
+ procedure TestScope;
+ type P = pointer to T;
+ T = record f: INTEGER end;
+ var x: P;
y: T;
- BEGIN
+ begin
NEW(x);
x.i := 1;
y.f := 1
- END TestScope;
+ end TestScope;
-BEGIN
+begin
TestMemoryAllocation;
s1 := s;
- table[0] := NIL;
+ table[0] := nil;
NEW(t);
NEW(i);
t.content := i;
t.proc := TreeProc;
NEW(e);
n.elem := left;
- n.next := NIL;
+ n.next := nil;
n.p := NodeProc;
NEW(p);
- a[0].f := NIL;
+ a[0].f := nil;
TestScope
-END T2TypeDeclarations.
+end T2TypeDeclarations.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T3VariableDeclarations;
+module T3VariableDeclarations;
- TYPE
- Vector = RECORD
+ type
+ Vector = record
x, y: REAL
- END;
+ end;
- ShapeDesc = RECORD
+ ShapeDesc = record
pos: Vector
- END;
+ end;
- Rectangle = POINTER TO RectangleDesc;
- RectangleDesc = RECORD (ShapeDesc)
+ Rectangle = pointer to RectangleDesc;
+ RectangleDesc = record (ShapeDesc)
size: Vector
- END;
+ end;
- PROCEDURE TestInitialization;
- VAR s: ShapeDesc;
+ procedure TestInitialization;
+ var s: ShapeDesc;
r: RectangleDesc;
- rs: ARRAY 10 OF RectangleDesc;
+ rs: array 10 of RectangleDesc;
rp: Rectangle;
- PROCEDURE AssertVector(VAR v: Vector);
- BEGIN
- ASSERT(v IS Vector)
- END AssertVector;
+ procedure AssertVector(var v: Vector);
+ begin
+ ASSERT(v is Vector)
+ end AssertVector;
- BEGIN
+ begin
AssertVector(s.pos);
AssertVector(r.pos);
AssertVector(r.size);
AssertVector(rs[0].size);
NEW(rp);
- ASSERT(rp IS Rectangle);
+ ASSERT(rp is Rectangle);
AssertVector(rp.pos);
AssertVector(rp.size);
- END TestInitialization;
+ end TestInitialization;
-BEGIN
+begin
TestInitialization
-END T3VariableDeclarations.
+end T3VariableDeclarations.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T4Expressions;
+module T4Expressions;
- IMPORT Out, SYSTEM;
+ import Out, SYSTEM;
- PROCEDURE IncReturnZero(VAR x: INTEGER): INTEGER;
- BEGIN
+ procedure IncReturnZero(var x: INTEGER): INTEGER;
+ begin
INC(x)
- RETURN 0
- END IncReturnZero;
+ return 0
+ end IncReturnZero;
- PROCEDURE IncReturnEmpty(VAR x: INTEGER): SET;
- BEGIN
+ procedure IncReturnEmpty(var x: INTEGER): SET;
+ begin
INC(x)
- RETURN {}
- END IncReturnEmpty;
+ return {}
+ end IncReturnEmpty;
- PROCEDURE TestDesignators;
- VAR s: ARRAY 32 OF CHAR;
- A: ARRAY 3, 4 OF INTEGER;
+ procedure TestDesignators;
+ var s: array 32 of CHAR;
+ A: array 3, 4 of INTEGER;
i, j: INTEGER;
- a: ARRAY 10 OF POINTER TO RECORD
- a: ARRAY 10 OF INTEGER;
- f: PROCEDURE (): INTEGER
- END;
+ a: array 10 of pointer to record
+ a: array 10 of INTEGER;
+ f: procedure (): INTEGER
+ end;
- PROCEDURE F(): INTEGER;
- RETURN 1
- END F;
+ procedure F(): INTEGER;
+ return 1
+ end F;
- BEGIN
+ begin
s := "hello";
ASSERT(s[1] = "e");
ASSERT(a[0].a[0] = 1);
a[0]^.f := F;
ASSERT(a[0].f() = 1);
- END TestDesignators;
+ end TestDesignators;
- PROCEDURE TestSetConstructors;
- VAR
+ procedure TestSetConstructors;
+ var
a, b, i, j: INTEGER;
A: SET;
- BEGIN
+ begin
a := 4;
b := 6;
Out.Int(ORD({1, 2, a, 5, b, 8}), 0); Out.Ln;
ASSERT(A = {0});
ASSERT(i = 1);
ASSERT(j = 1)
- END TestSetConstructors;
+ end TestSetConstructors;
- PROCEDURE TestRelationalOperations;
- TYPE
- T = POINTER TO RECORD END;
- T1 = POINTER TO RECORD (T) END;
+ procedure TestRelationalOperations;
+ type
+ T = pointer to record end;
+ T1 = pointer to record (T) end;
- VAR b, b1: BOOLEAN;
+ var b, b1: BOOLEAN;
ch, ch1: CHAR;
i, j, n: INTEGER;
x: REAL;
y: BYTE;
A, B: SET;
- str: ARRAY 24 OF CHAR;
- strs: ARRAY 2, 32 OF CHAR;
+ str: array 24 of CHAR;
+ strs: array 2, 32 of CHAR;
t: T;
t1: T1;
- BEGIN
+ begin
(*booleans*)
- ASSERT(TRUE = TRUE);
- ASSERT(TRUE # FALSE);
- b := TRUE;
- b1 := FALSE;
- ASSERT(b = TRUE);
- ASSERT(b1 # TRUE);
+ ASSERT(true = true);
+ ASSERT(true # false);
+ b := true;
+ b1 := false;
+ ASSERT(b = true);
+ ASSERT(b1 # true);
(*characters / single-character strings*)
ch := 0X;
ASSERT(1 > 0);
ASSERT(0 >= 0);
ASSERT(1 >= 0);
- ASSERT(0 IN {0});
- ASSERT(~(1 IN {0}));
+ ASSERT(0 in {0});
+ ASSERT(~(1 in {0}));
n := 0;
ASSERT(n = 0);
ASSERT(n # 1);
ASSERT(n < 1);
ASSERT(n >= 0);
ASSERT(n >= -1);
- ASSERT(n IN {0});
- ASSERT(~(1 IN {n}));
+ ASSERT(n in {0});
+ ASSERT(~(1 in {n}));
i := 0;
j := 0;
- b := IncReturnZero(i) IN IncReturnEmpty(j);
+ b := IncReturnZero(i) in IncReturnEmpty(j);
ASSERT(i = 1);
ASSERT(j = 1);
ASSERT(y <= 1);
ASSERT(1 > y);
(*ASSERT(y >= 0);*)
- ASSERT(y IN {0});
- ASSERT(~(1 IN {y}));
+ ASSERT(y in {0});
+ ASSERT(~(1 in {y}));
(*sets*)
ASSERT({0, 1} = {1, 0});
t := t1;
ASSERT(t = t1);
ASSERT(t1 = t);
- t := NIL;
- ASSERT((t IS T) OR ~(t IS T)) (*The value of NIL IS T is undefined.*)
- END TestRelationalOperations;
+ t := nil;
+ ASSERT((t is T) or ~(t is T)) (*The value of nil is T is undefined.*)
+ end TestRelationalOperations;
- PROCEDURE TestAdditiveOperations;
- CONST eps = 0.01;
- VAR b: BOOLEAN;
+ procedure TestAdditiveOperations;
+ const eps = 0.01;
+ var b: BOOLEAN;
n: INTEGER;
x: REAL;
y: BYTE;
A: SET;
- BEGIN
+ begin
(*booleans*)
- ASSERT(TRUE OR TRUE);
- ASSERT(TRUE OR FALSE);
- ASSERT(FALSE OR TRUE);
- b := TRUE;
- ASSERT(b OR TRUE);
- ASSERT(b OR FALSE);
- ASSERT(FALSE OR b);
+ ASSERT(true or true);
+ ASSERT(true or false);
+ ASSERT(false or true);
+ b := true;
+ ASSERT(b or true);
+ ASSERT(b or false);
+ ASSERT(false or b);
(*integers*)
ASSERT(1 + 1 = 2);
ASSERT(-x + 1.0 <= eps);
ASSERT(-x - 1.0 >= -2.0 - eps);
ASSERT(-x - 1.0 <= -2.0 + eps);
- IF SYSTEM.SIZE(REAL) > 8 THEN
+ if SYSTEM.SIZE(REAL) > 8 then
x := 2.0E+308; (*greater than maximum value of binary64*)
ASSERT(x > 1.0E+308);
ASSERT(x < 3.0E+308)
- END;
+ end;
(*bytes*)
y := 1;
ASSERT(A + (-{0, 1}) = -{});
ASSERT(A + {0, 2} = {0 .. 2});
ASSERT(A - {0, 2} = {1})
- END TestAdditiveOperations;
+ end TestAdditiveOperations;
- PROCEDURE TestMultiplicativeOperations;
- CONST eps = 0.01;
- VAR b: BOOLEAN;
+ procedure TestMultiplicativeOperations;
+ const eps = 0.01;
+ var b: BOOLEAN;
i, j, n: INTEGER;
x: REAL;
y: BYTE;
A: SET;
- BEGIN
+ begin
(*booleans*)
- ASSERT(TRUE & TRUE);
- b := TRUE;
- ASSERT(b & TRUE);
+ ASSERT(true & true);
+ b := true;
+ ASSERT(b & true);
(*integers*)
ASSERT(9 * 2 = 18);
- ASSERT(9 DIV 4 = 2);
- ASSERT((-9) DIV 4 = -3);
- ASSERT(9 MOD 4 = 1);
- ASSERT((-9) MOD 4 = 3);
+ ASSERT(9 div 4 = 2);
+ ASSERT((-9) div 4 = -3);
+ ASSERT(9 mod 4 = 1);
+ ASSERT((-9) mod 4 = 3);
n := -9;
y := 4;
ASSERT(n * y = -36);
- ASSERT(n DIV y = -3);
- ASSERT(n MOD y = 3);
+ ASSERT(n div y = -3);
+ ASSERT(n mod y = 3);
i := 1;
j := 1;
- n := (IncReturnZero(i) + 3) DIV (IncReturnZero(j) + 2);
+ n := (IncReturnZero(i) + 3) div (IncReturnZero(j) + 2);
ASSERT(n = 1);
ASSERT(i = 2);
ASSERT(j = 2);
- n := IncReturnZero(i) MOD (IncReturnZero(j) + 1);
+ n := IncReturnZero(i) mod (IncReturnZero(j) + 1);
ASSERT(i = 3);
ASSERT(j = 3);
(*bytes*)
y := 9;
ASSERT(y * 2 = 18);
- (*ASSERT(y DIV 4 = 2);
- ASSERT(y MOD 4 = 1);*)
+ (*ASSERT(y div 4 = 2);
+ ASSERT(y mod 4 = 1);*)
(*sets*)
ASSERT({0, 1} * {1, 2} = {1});
A := {0, 1};
ASSERT(A * {1, 2} = {1});
ASSERT(A / {1, 2} = {0, 2})
- END TestMultiplicativeOperations;
+ end TestMultiplicativeOperations;
- PROCEDURE TestPredeclaredFunctionProcedures;
- CONST eps = 0.01;
+ procedure TestPredeclaredFunctionProcedures;
+ const eps = 0.01;
(*make sure function procedures with constant parameters are constant expressions*)
absConst = ABS(0);
oddConst = ODD(0);
rorConst = ROR(0, 1);
floorConst = FLOOR(eps);
fltConst = FLT(0);
- ordConst = ORD(TRUE);
+ ordConst = ORD(true);
chrConst = CHR(0);
- VAR a: ARRAY 10 OF CHAR;
+ var a: array 10 of CHAR;
b: BOOLEAN;
ch: CHAR;
i, j, k: INTEGER;
r: REAL;
x: BYTE;
s: SET;
- BEGIN
+ begin
ASSERT(ABS(-1) = 1);
ASSERT(ABS(0) = 0);
ASSERT(ABS(1) = 1);
ch := 0FFX;
ASSERT(ORD(ch) = 0FFH);
- ASSERT(ORD(FALSE) = 0);
- b := FALSE;
+ ASSERT(ORD(false) = 0);
+ b := false;
ASSERT(ORD(b) = 0);
- ASSERT(ORD(TRUE) = 1);
- b := TRUE;
+ ASSERT(ORD(true) = 1);
+ b := true;
ASSERT(ORD(b) = 1);
ASSERT(ORD({}) = 0);
r := fltConst;
i := ordConst;
ch := chrConst
- END TestPredeclaredFunctionProcedures;
+ end TestPredeclaredFunctionProcedures;
-BEGIN
+begin
TestDesignators;
TestSetConstructors;
TestRelationalOperations;
TestAdditiveOperations;
TestMultiplicativeOperations;
TestPredeclaredFunctionProcedures;
-END T4Expressions.
+end T4Expressions.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5Statements;
+module T5Statements;
- TYPE
- T0 = RECORD END;
- T1 = RECORD (T0) END;
+ type
+ T0 = record end;
+ T1 = record (T0) end;
- Shape = POINTER TO ShapeDesc;
- ShapeDesc = RECORD
+ Shape = pointer to ShapeDesc;
+ ShapeDesc = record
x, y: REAL
- END;
+ end;
- Rectangle = POINTER TO RectangleDesc;
- RectangleDesc = RECORD (ShapeDesc)
+ Rectangle = pointer to RectangleDesc;
+ RectangleDesc = record (ShapeDesc)
w, h: REAL
- END;
+ end;
- Circle = POINTER TO CircleDesc;
- CircleDesc = RECORD (ShapeDesc)
+ Circle = pointer to CircleDesc;
+ CircleDesc = record (ShapeDesc)
r: REAL
- END;
+ end;
- String = ARRAY 256 OF CHAR;
+ String = array 256 of CHAR;
- VAR
+ var
globalInteger: INTEGER;
- PROCEDURE TestBasicAssignments;
- VAR b, b1: BOOLEAN;
+ procedure TestBasicAssignments;
+ var b, b1: BOOLEAN;
ch, ch1: CHAR;
n, n1: INTEGER;
x, x1: REAL;
y, y1: BYTE;
A, A1: SET;
- BEGIN
- b := TRUE;
- b1 := FALSE;
+ begin
+ b := true;
+ b1 := false;
b := b1;
ASSERT(b = b1);
ch := "a";
A1 := {0, 1};
A := A1;
ASSERT(A = A1);
- END TestBasicAssignments;
+ end TestBasicAssignments;
- PROCEDURE TestArrayAssignments;
- VAR str, str1: ARRAY 60 OF CHAR;
- strs, strs1: ARRAY 2 OF String;
- strs2: ARRAY 1, 2 OF String;
+ procedure TestArrayAssignments;
+ var str, str1: array 60 of CHAR;
+ strs, strs1: array 2 of String;
+ strs2: array 1, 2 of String;
- PROCEDURE AssignString(VAR s: ARRAY OF CHAR);
- BEGIN
+ procedure AssignString(var s: array of CHAR);
+ begin
s := "hello"
- END AssignString;
+ end AssignString;
- PROCEDURE AssignOpenArray(s: ARRAY OF CHAR);
- VAR t: ARRAY 128 OF CHAR;
- BEGIN
+ procedure AssignOpenArray(s: array of CHAR);
+ var t: array 128 of CHAR;
+ begin
t := s;
ASSERT(t = s)
- END AssignOpenArray;
+ end AssignOpenArray;
- PROCEDURE AssignMultiDimOpenArray(s: ARRAY OF ARRAY OF String);
- VAR t: ARRAY 2 OF String;
- BEGIN
+ procedure AssignMultiDimOpenArray(s: array of array of String);
+ var t: array 2 of String;
+ begin
t := s[0];
ASSERT(t[0] = s[0, 0]);
ASSERT(t[1] = s[0, 1])
- END AssignMultiDimOpenArray;
+ end AssignMultiDimOpenArray;
- BEGIN
+ begin
str := "testing, testing...";
str1 := "more testing...";
str := str1;
ASSERT(strs1[1] = "bar");
AssignMultiDimOpenArray(strs2)
- END TestArrayAssignments;
+ end TestArrayAssignments;
- PROCEDURE TestRecordAssignments;
- CONST eps = 0.01;
- VAR foo, bar: RECORD ch: CHAR; i: INTEGER END;
+ procedure TestRecordAssignments;
+ const eps = 0.01;
+ var foo, bar: record ch: CHAR; i: INTEGER end;
s: ShapeDesc;
r: RectangleDesc;
c: CircleDesc;
- a: ARRAY 10 OF CircleDesc;
+ a: array 10 of CircleDesc;
- PROCEDURE P(VAR s: ShapeDesc);
- BEGIN
- ASSERT(s IS CircleDesc);
+ procedure P(var s: ShapeDesc);
+ begin
+ ASSERT(s is CircleDesc);
s(CircleDesc) := s(CircleDesc);
s(CircleDesc).r := 1.0
- END P;
+ end P;
- PROCEDURE Copy(VAR source, target: ShapeDesc);
- BEGIN
+ procedure Copy(var source, target: ShapeDesc);
+ begin
target := source
- END Copy;
+ end Copy;
- BEGIN
+ begin
foo.i := 37;
bar := foo;
ASSERT(bar.i = 37);
P(a[9]);
Copy(r, r)
- END TestRecordAssignments;
+ end TestRecordAssignments;
- PROCEDURE TestPointerAssignments;
- VAR x: Rectangle;
+ procedure TestPointerAssignments;
+ var x: Rectangle;
y: Shape;
- s: POINTER TO ShapeDesc;
- r: POINTER TO RectangleDesc;
- r1: POINTER TO RectangleDesc;
- BEGIN
+ s: pointer to ShapeDesc;
+ r: pointer to RectangleDesc;
+ r1: pointer to RectangleDesc;
+ begin
NEW(x);
y := x;
- ASSERT(y IS Rectangle);
+ ASSERT(y is Rectangle);
NEW(r);
s := r;
- ASSERT(s IS RectangleDesc);
+ ASSERT(s is RectangleDesc);
r1 := r;
- ASSERT(r1 IS RectangleDesc)
- END TestPointerAssignments;
+ ASSERT(r1 is RectangleDesc)
+ end TestPointerAssignments;
- PROCEDURE P;
- END P;
+ procedure P;
+ end P;
- PROCEDURE P1(n: INTEGER);
- END P1;
+ procedure P1(n: INTEGER);
+ end P1;
- PROCEDURE P2(n: INTEGER; x: REAL);
- END P2;
+ procedure P2(n: INTEGER; x: REAL);
+ end P2;
- PROCEDURE F(): INTEGER;
- RETURN 0
- END F;
+ procedure F(): INTEGER;
+ return 0
+ end F;
- PROCEDURE F1(n: INTEGER): INTEGER;
- RETURN 0
- END F1;
+ procedure F1(n: INTEGER): INTEGER;
+ return 0
+ end F1;
- PROCEDURE F2(VAR n: INTEGER; x: REAL; s: ARRAY OF CHAR): INTEGER;
- RETURN 0
- END F2;
+ procedure F2(var n: INTEGER; x: REAL; s: array of CHAR): INTEGER;
+ return 0
+ end F2;
- PROCEDURE TestProcedureAssignments;
- TYPE
- PT = PROCEDURE;
- PT1 = PROCEDURE (n: INTEGER);
- PT2 = PROCEDURE (n: INTEGER; x: REAL);
- FT = PROCEDURE (): INTEGER;
- FT1 = PROCEDURE (n: INTEGER): INTEGER;
- FT2 = PROCEDURE (VAR n: INTEGER; x: REAL; s: ARRAY OF CHAR): INTEGER;
- VAR p: PT; p1: PT1; p2: PT2;
+ procedure TestProcedureAssignments;
+ type
+ PT = procedure;
+ PT1 = procedure (n: INTEGER);
+ PT2 = procedure (n: INTEGER; x: REAL);
+ FT = procedure (): INTEGER;
+ FT1 = procedure (n: INTEGER): INTEGER;
+ FT2 = procedure (var n: INTEGER; x: REAL; s: array of CHAR): INTEGER;
+ var p: PT; p1: PT1; p2: PT2;
f: FT; f1: FT1; f2, g2: FT2;
n: INTEGER;
- PROCEDURE Local;
- END Local;
+ procedure Local;
+ end Local;
- BEGIN
- p := NIL;
+ begin
+ p := nil;
p := P;
p := Local;
p1 := P1;
f1 := F1;
f2 := F2;
g2 := f2
- END TestProcedureAssignments;
+ end TestProcedureAssignments;
- PROCEDURE TestAssignments;
- BEGIN
+ procedure TestAssignments;
+ begin
TestBasicAssignments;
TestArrayAssignments;
TestRecordAssignments;
TestPointerAssignments;
TestProcedureAssignments
- END TestAssignments;
+ end TestAssignments;
- PROCEDURE TestProcedureCalls;
- VAR s: ARRAY 16 OF CHAR;
- p0: POINTER TO T0;
- p1: POINTER TO T1;
+ procedure TestProcedureCalls;
+ var s: array 16 of CHAR;
+ p0: pointer to T0;
+ p1: pointer to T1;
- PROCEDURE P1;
- END P1;
+ procedure P1;
+ end P1;
- PROCEDURE P2(n: INTEGER);
- END P2;
+ procedure P2(n: INTEGER);
+ end P2;
- PROCEDURE P3(a, b: INTEGER);
- END P3;
+ procedure P3(a, b: INTEGER);
+ end P3;
- PROCEDURE P4(a: INTEGER; b: INTEGER);
- END P4;
+ procedure P4(a: INTEGER; b: INTEGER);
+ end P4;
- PROCEDURE P5(ch: CHAR);
- END P5;
+ procedure P5(ch: CHAR);
+ end P5;
- PROCEDURE P6(s: ARRAY OF CHAR);
- END P6;
+ procedure P6(s: array of CHAR);
+ end P6;
- PROCEDURE P7(VAR t: T0);
- BEGIN
- ASSERT(t IS T1)
- END P7;
+ procedure P7(var t: T0);
+ begin
+ ASSERT(t is T1)
+ end P7;
- BEGIN
+ begin
P1;
P2(0);
P3(0, 0);
NEW(p1);
p0 := p1;
P7(p0^)
- END TestProcedureCalls;
+ end TestProcedureCalls;
- PROCEDURE TestPredeclaredProperProcedures;
- CONST eps = 0.01;
- VAR n, i, j: INTEGER;
+ procedure TestPredeclaredProperProcedures;
+ const eps = 0.01;
+ var n, i, j: INTEGER;
A: SET;
x: REAL;
- a: ARRAY 1 OF REAL;
- b: ARRAY 1 OF INTEGER;
- v: POINTER TO RECORD f: INTEGER END;
+ a: array 1 of REAL;
+ b: array 1 of INTEGER;
+ v: pointer to record f: INTEGER end;
- PROCEDURE IncReturnZero(VAR x: INTEGER): INTEGER;
- BEGIN
+ procedure IncReturnZero(var x: INTEGER): INTEGER;
+ begin
INC(x)
- RETURN 0
- END IncReturnZero;
+ return 0
+ end IncReturnZero;
- BEGIN
+ begin
n := 0;
INC(n);
ASSERT(n = 1);
ASSERT(A = {});
NEW(v);
- ASSERT(v # NIL);
+ ASSERT(v # nil);
v.f := 1;
ASSERT(v.f = 1);
ASSERT(b[0] = 2);
ASSERT(i = 1);
ASSERT(j = 1)
- END TestPredeclaredProperProcedures;
+ end TestPredeclaredProperProcedures;
- PROCEDURE TestIfStatements;
- VAR n: INTEGER;
- BEGIN
+ procedure TestIfStatements;
+ var n: INTEGER;
+ begin
n := 0;
- IF n = 0 THEN
+ if n = 0 then
n := 1
- END;
+ end;
ASSERT(n = 1);
n := 1;
- IF n = 0 THEN
+ if n = 0 then
n := 1
- ELSE
+ else
n := 2
- END;
+ end;
ASSERT(n = 2);
n := 2;
- IF n = 0 THEN
+ if n = 0 then
n := 1
- ELSIF n = 1 THEN
+ elsif n = 1 then
n := 2
- ELSE
+ else
n := 3
- END;
+ end;
ASSERT(n = 3)
- END TestIfStatements;
+ end TestIfStatements;
- PROCEDURE TestCaseStatements;
- CONST
+ procedure TestCaseStatements;
+ const
C = 0;
- VAR
+ var
n: INTEGER;
ch: CHAR;
sp: Shape;
rp: Rectangle;
c: CircleDesc;
- PROCEDURE P(VAR s: ShapeDesc);
- BEGIN
- CASE s OF
+ procedure P(var s: ShapeDesc);
+ begin
+ case s of
(*ShapeDesc:
s.x := 0.0; s.y := 0.0
| *)RectangleDesc:
s.w := 1.0; s.h := 0.0
| CircleDesc:
s.r := 1.0
- END;
- END P;
+ end;
+ end P;
- BEGIN
+ begin
n := 15;
- CASE n OF
+ case n of
C:
- CASE 1 OF
+ case 1 of
1:
- END
+ end
| 1, 2:
- CASE sp OF END
+ case sp of end
| 4, 5, 7:
| 8 .. 9:
| 10, 12 .. 20:
n := 0
- END;
+ end;
ASSERT(n = 0);
ch := "u";
- CASE ch OF
+ case ch of
| 0X:
| "a", "b":
| "d", "e", "f":
| "h" .. "k":
| "l", "m" .. "z":
ch := 0X
- END;
+ end;
ASSERT(ch = 0X);
NEW(rp);
sp := rp;
- CASE sp OF
+ case sp of
(*Shape:
sp.x := 0.0; sp.y := 0.0
| *)Rectangle:
sp := sp
| Circle:
sp.r := 1.0
- END;
+ end;
ASSERT(sp(Rectangle).w = 1.0);
ASSERT(sp(Rectangle).h = 2.0);
P(c);
ASSERT(c.r = 1.0);
- END TestCaseStatements;
+ end TestCaseStatements;
- PROCEDURE TestWhileStatements;
- VAR n, n1, i: INTEGER;
- BEGIN
+ procedure TestWhileStatements;
+ var n, n1, i: INTEGER;
+ begin
n := 0;
i := 1;
- WHILE i <= 10 DO
+ while i <= 10 do
n := n + 1;
i := i + 1
- END;
+ end;
ASSERT(n = 10);
n := 4;
n1 := 6;
- WHILE n > n1 DO
+ while n > n1 do
n := n - n1
- ELSIF n1 > n DO
+ elsif n1 > n do
n1 := n1 - n
- END;
+ end;
ASSERT(n = 2);
ASSERT(n1 = 2);
n := 5;
n1 := 6;
- WHILE n > n1 DO
+ while n > n1 do
n := n - n1
- ELSIF n1 > n DO
+ elsif n1 > n do
n1 := n1 - n
- END;
+ end;
ASSERT(n = 1);
ASSERT(n1 = 1);
- END TestWhileStatements;
+ end TestWhileStatements;
- PROCEDURE TestRepeatStatements;
- VAR n, i: INTEGER;
- BEGIN
+ procedure TestRepeatStatements;
+ var n, i: INTEGER;
+ begin
n:= 0;
i := 1;
- REPEAT
+ repeat
INC(n);
INC(i)
- UNTIL i = 11;
+ until i = 11;
ASSERT(n = 10);
- END TestRepeatStatements;
+ end TestRepeatStatements;
- PROCEDURE IncGlobalIntegerReturnOne(): INTEGER;
- BEGIN
+ procedure IncGlobalIntegerReturnOne(): INTEGER;
+ begin
INC(globalInteger)
- RETURN 1
- END IncGlobalIntegerReturnOne;
+ return 1
+ end IncGlobalIntegerReturnOne;
- PROCEDURE TestForStatements;
- VAR n, i: INTEGER;
+ procedure TestForStatements;
+ var n, i: INTEGER;
x: REAL;
- BEGIN
+ begin
n := 0;
- FOR i := 1 TO 10 DO
+ for i := 1 to 10 do
n := n + 1
- END;
+ end;
ASSERT(n = 10);
n := 0;
- FOR i := 1 TO 20 BY 2 DO
+ for i := 1 to 20 by 2 do
n := n + 1
- END;
+ end;
ASSERT(n = 10);
n := 0;
- FOR i := 20 TO 1 BY -2 DO
+ for i := 20 to 1 by -2 do
n := n + 1
- END;
+ end;
ASSERT(n = 10);
globalInteger := 0;
- FOR i := 0 TO IncGlobalIntegerReturnOne() DO (*make sure the limit function is called three times*)
+ for i := 0 to IncGlobalIntegerReturnOne() do (*make sure the limit function is called three times*)
x := x + 1.0
- END;
+ end;
ASSERT(globalInteger = 3)
- END TestForStatements;
+ end TestForStatements;
-BEGIN
+begin
TestAssignments;
TestProcedureCalls;
TestPredeclaredProperProcedures;
TestWhileStatements;
TestRepeatStatements;
TestForStatements
-END T5Statements.
+end T5Statements.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T5SystemStatements;
+module T5SystemStatements;
- IMPORT SYSTEM;
+ import SYSTEM;
- PROCEDURE Test;
- CONST byte = SYSTEM.VAL(BYTE, 100);
- TYPE Array = ARRAY 2 OF INTEGER;
- Pointer = POINTER TO RECORD END;
- VAR b, b1: BOOLEAN;
+ procedure Test;
+ const byte = SYSTEM.VAL(BYTE, 100);
+ type Array = array 2 of INTEGER;
+ Pointer = pointer to record end;
+ var b, b1: BOOLEAN;
ch, ch1: CHAR;
i, i1: INTEGER;
r, r1: REAL;
x, x1: BYTE;
- xs: ARRAY 2 OF BYTE;
+ xs: array 2 of BYTE;
s, s1: SET;
a, a1: Array;
- a2: ARRAY SYSTEM.SIZE(Array) + 1 OF INTEGER;
- BEGIN
+ a2: array SYSTEM.SIZE(Array) + 1 of INTEGER;
+ begin
ASSERT(SYSTEM.SIZE(INTEGER) = SYSTEM.SIZE(Pointer));
(*ADR, PUT, GET*)
- b := TRUE;
+ b := true;
SYSTEM.GET(SYSTEM.ADR(b), b1);
ASSERT(b1 = b);
- SYSTEM.PUT(SYSTEM.ADR(b), FALSE);
+ SYSTEM.PUT(SYSTEM.ADR(b), false);
ASSERT(~b);
ch := "a";
SYSTEM.GET(SYSTEM.ADR(ch), ch1);
(*silence "unused" compiler notifications*)
x := byte;
a2[0] := 0
- END Test;
+ end Test;
-BEGIN
+begin
Test
-END T5SystemStatements.
+end T5SystemStatements.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T6ProcedureDeclarations;
+module T6ProcedureDeclarations;
- TYPE
- Row = ARRAY 20 OF INTEGER;
- Matrix = ARRAY 10, 20 OF INTEGER;
- Ptr = POINTER TO RECORD f: INTEGER END;
- Proc = PROCEDURE;
- T0 = RECORD END;
- T1 = RECORD (T0) END;
- T2 = RECORD (T1)
+ type
+ Row = array 20 of INTEGER;
+ Matrix = array 10, 20 of INTEGER;
+ Ptr = pointer to record f: INTEGER end;
+ Proc = procedure;
+ T0 = record end;
+ T1 = record (T0) end;
+ T2 = record (T1)
f: INTEGER
- END;
+ end;
- PROCEDURE TestValueParameters;
- VAR ptr: Ptr;
+ procedure TestValueParameters;
+ var ptr: Ptr;
proc: Proc;
A: Matrix;
- B: ARRAY 10 OF Row;
+ B: array 10 of Row;
- PROCEDURE P(x: INTEGER);
- BEGIN
+ procedure P(x: INTEGER);
+ begin
x := 0
- END P;
+ end P;
- PROCEDURE P1(x: Ptr);
- BEGIN
- x := NIL
- END P1;
+ procedure P1(x: Ptr);
+ begin
+ x := nil
+ end P1;
- PROCEDURE P2(x: Proc);
- BEGIN
- x := NIL
- END P2;
+ procedure P2(x: Proc);
+ begin
+ x := nil
+ end P2;
- PROCEDURE P3(A: Matrix);
- BEGIN
+ procedure P3(A: Matrix);
+ begin
ASSERT(LEN(A) = 10);
ASSERT(LEN(A[0]) = 20)
- END P3;
+ end P3;
- PROCEDURE P4(A: ARRAY OF Row);
- END P4;
+ procedure P4(A: array of Row);
+ end P4;
- BEGIN
+ begin
P(0);
NEW(ptr);
P1(ptr);
P2(proc);
P3(A);
P4(B)
- END TestValueParameters;
+ end TestValueParameters;
- PROCEDURE TestVarParameters;
- VAR x: Ptr;
+ procedure TestVarParameters;
+ var x: Ptr;
A: Matrix;
y: T2;
- PROCEDURE Alloc(VAR p: Ptr);
- BEGIN
+ procedure Alloc(var p: Ptr);
+ begin
NEW(p);
p.f := 1
- END Alloc;
+ end Alloc;
- PROCEDURE P(VAR A: Matrix);
- BEGIN
+ procedure P(var A: Matrix);
+ begin
ASSERT(LEN(A) = 10);
ASSERT(LEN(A[0]) = 20)
- END P;
+ end P;
- PROCEDURE Q(VAR x: T0);
- PROCEDURE R(VAR x: T1);
- BEGIN
+ procedure Q(var x: T0);
+ procedure R(var x: T1);
+ begin
x(T2).f := 1
- END R;
- BEGIN
+ end R;
+ begin
R(x(T1))
- END Q;
+ end Q;
- BEGIN
+ begin
Alloc(x);
ASSERT(x.f = 1);
P(A);
y.f := 0;
Q(y)
- END TestVarParameters;
+ end TestVarParameters;
- PROCEDURE TestOpenArrayParameters;
- VAR
- a: ARRAY 2 OF INTEGER;
- M: ARRAY 2, 3 OF INTEGER;
- T: ARRAY 2, 3, 4 OF INTEGER;
+ procedure TestOpenArrayParameters;
+ var
+ a: array 2 of INTEGER;
+ M: array 2, 3 of INTEGER;
+ T: array 2, 3, 4 of INTEGER;
c, i, j, k: INTEGER;
- PROCEDURE P(a: ARRAY OF INTEGER);
- VAR i: INTEGER;
- BEGIN
- FOR i := 0 TO LEN(a) - 1 DO
+ procedure P(a: array of INTEGER);
+ var i: INTEGER;
+ begin
+ for i := 0 to LEN(a) - 1 do
ASSERT(a[i] = i + 1)
- END
- END P;
+ end
+ end P;
- PROCEDURE Q(M: ARRAY OF ARRAY OF INTEGER);
- VAR a: ARRAY 3 OF INTEGER;
+ procedure Q(M: array of array of INTEGER);
+ var a: array 3 of INTEGER;
- PROCEDURE Inner(M: ARRAY OF ARRAY OF INTEGER);
- VAR c, i, j: INTEGER;
- BEGIN
+ procedure Inner(M: array of array of INTEGER);
+ var c, i, j: INTEGER;
+ begin
c := 0;
- FOR i := 0 TO LEN(M) - 1 DO
- FOR j := 0 TO LEN(M[0]) - 1 DO
+ for i := 0 to LEN(M) - 1 do
+ for j := 0 to LEN(M[0]) - 1 do
ASSERT(M[i, j] = c);
INC(c)
- END
- END;
- END Inner;
+ end
+ end;
+ end Inner;
- PROCEDURE Inner1(row: ARRAY OF INTEGER);
- VAR c, j: INTEGER;
- BEGIN
+ procedure Inner1(row: array of INTEGER);
+ var c, j: INTEGER;
+ begin
c := LEN(row);
- FOR j := 0 TO LEN(row) - 1 DO
+ for j := 0 to LEN(row) - 1 do
ASSERT(row[j] = c);
INC(c)
- END
- END Inner1;
+ end
+ end Inner1;
- BEGIN
+ begin
Inner(M);
Inner1(M[1]);
a := M[1]
- END Q;
+ end Q;
- PROCEDURE R(VAR T: ARRAY OF ARRAY OF ARRAY OF INTEGER);
- VAR c, i, j, k: INTEGER;
- BEGIN
+ procedure R(var T: array of array of array of INTEGER);
+ var c, i, j, k: INTEGER;
+ begin
c := 0;
- FOR i := 0 TO LEN(T) - 1 DO
- FOR j := 0 TO LEN(T[0]) - 1 DO
- FOR k := 0 TO LEN(T[0, 0]) - 1 DO
+ for i := 0 to LEN(T) - 1 do
+ for j := 0 to LEN(T[0]) - 1 do
+ for k := 0 to LEN(T[0, 0]) - 1 do
ASSERT(T[i, j, k] = c);
INC(c)
- END
- END
- END;
+ end
+ end
+ end;
T[0, 0, 0] := 0
- END R;
+ end R;
- BEGIN
- FOR i := 0 TO LEN(a) - 1 DO
+ begin
+ for i := 0 to LEN(a) - 1 do
a[i] := i + 1
- END;
+ end;
P(a);
c := 0;
- FOR i := 0 TO LEN(M) - 1 DO
- FOR j := 0 TO LEN(M[0]) - 1 DO
+ for i := 0 to LEN(M) - 1 do
+ for j := 0 to LEN(M[0]) - 1 do
M[i, j] := c;
INC(c)
- END
- END;
+ end
+ end;
Q(M);
c := 0;
- FOR i := 0 TO LEN(T) - 1 DO
- FOR j := 0 TO LEN(T[0]) - 1 DO
- FOR k := 0 TO LEN(T[0, 0]) - 1 DO
+ for i := 0 to LEN(T) - 1 do
+ for j := 0 to LEN(T[0]) - 1 do
+ for k := 0 to LEN(T[0, 0]) - 1 do
T[i, j, k] := c;
INC(c)
- END
- END
- END;
+ end
+ end
+ end;
R(T)
- END TestOpenArrayParameters;
+ end TestOpenArrayParameters;
- PROCEDURE TestResultExpressions;
- VAR x: Ptr;
+ procedure TestResultExpressions;
+ var x: Ptr;
- PROCEDURE P(): Ptr;
- TYPE PtrExt = POINTER TO RECORD (Ptr) END;
- VAR y: PtrExt;
- BEGIN
+ procedure P(): Ptr;
+ type PtrExt = pointer to record (Ptr) end;
+ var y: PtrExt;
+ begin
NEW(y)
- RETURN y
- END P;
+ return y
+ end P;
- BEGIN
+ begin
x := P()
- END TestResultExpressions;
+ end TestResultExpressions;
- PROCEDURE TestLocalProcedures;
- VAR s: INTEGER;
+ procedure TestLocalProcedures;
+ var s: INTEGER;
- PROCEDURE Sum(n: INTEGER): INTEGER;
+ procedure Sum(n: INTEGER): INTEGER;
- PROCEDURE Inner(i, acc: INTEGER): INTEGER;
- VAR result: INTEGER;
- BEGIN
- IF i >= 1 THEN
+ procedure Inner(i, acc: INTEGER): INTEGER;
+ var result: INTEGER;
+ begin
+ if i >= 1 then
result := Inner(i - 1, acc + i)
- ELSE
+ else
result := acc
- END
- RETURN result
- END Inner;
+ end
+ return result
+ end Inner;
- RETURN Inner(n, 0)
- END Sum;
+ return Inner(n, 0)
+ end Sum;
- BEGIN
+ begin
s := Sum(10);
ASSERT(s = 55)
- END TestLocalProcedures;
+ end TestLocalProcedures;
- PROCEDURE TestScope;
- TYPE
- List = POINTER TO Node;
- Node = RECORD
+ procedure TestScope;
+ type
+ List = pointer to Node;
+ Node = record
item: INTEGER;
next: List
- END;
- Proc = PROCEDURE (x: List): List;
- VAR
- TestScope: PROCEDURE;
+ end;
+ Proc = procedure (x: List): List;
+ var
+ TestScope: procedure;
p: Proc;
- BEGIN
- TestScope := NIL;
- p := NIL
- END TestScope;
+ begin
+ TestScope := nil;
+ p := nil
+ end TestScope;
-BEGIN
+begin
TestValueParameters;
TestVarParameters;
TestOpenArrayParameters;
TestResultExpressions;
TestLocalProcedures;
TestScope
-END T6ProcedureDeclarations.
+end T6ProcedureDeclarations.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE T7Modules;
+module T7Modules;
- IMPORT
+ import
A,
B1 := B,
B := C,
lib1M,
OBNC;
- TYPE
- ListExt = POINTER TO RECORD (A.List) END;
+ type
+ ListExt = pointer to record (A.List) end;
- VAR
+ var
intVar: INTEGER;
w: B.T;
x: B1.T;
y: A.Nested;
list: A.List;
- matrix: ARRAY 2, 3 OF INTEGER;
+ matrix: array 2, 3 of INTEGER;
x0: B.P0;
x1: B1.P1;
t: B1.T;
p: B1.P1;
p1: ListExt;
-BEGIN
+begin
ASSERT(A.boolConst);
ASSERT(A.charConst = CHR(22H));
ASSERT(A.intConst = 1);
ASSERT(T7Modules.b);
ASSERT(lib1M.b);
ASSERT(OBNC.b);
- p1 := NIL
-END T7Modules.
+ p1 := nil
+end T7Modules.
All text after a module should be ignored
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE Local;
+module Local;
- TYPE
- T* = RECORD f*: INTEGER END;
+ type
+ T* = record f*: INTEGER end;
- VAR
+ var
x*: INTEGER;
- PROCEDURE P*;
- END P;
+ procedure P*;
+ end P;
-END Local.
+end Local.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE libE;
+module libE;
- IMPORT Local;
+ import Local;
- CONST b* = TRUE;
+ const b* = true;
- VAR
+ var
x: Local.T;
-BEGIN
+begin
x.f := 0
-END libE.
+end libE.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE Local;
+module Local;
- TYPE
- T* = RECORD f*: INTEGER END;
+ type
+ T* = record f*: INTEGER end;
- VAR
+ var
x*: INTEGER;
- PROCEDURE P*;
- END P;
+ procedure P*;
+ end P;
-END Local.
+end Local.
OBNC 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
+MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with OBNC. If not, see <http://www.gnu.org/licenses/>.*)
-MODULE lib1M;
+module lib1M;
- IMPORT Local;
+ import Local;
- CONST b* = TRUE;
+ const b* = true;
- VAR
+ var
x: Local.T;
-BEGIN
+begin
x.f := 0
-END lib1M.
+end lib1M.
-MODULE ExportedFeatures; (**documentation...*)
+module ExportedFeatures; (**documentation...*)
- IMPORT F := Files, Out;
+ import F := Files, Out;
- CONST
+ const
s* = "s* = 'foo'; (**"; (**(*"foo"*)*)
(*s* = "s* = 'foo'; (**"; (**(*"foo"*)*)*)*)
t = 37;
- TYPE
+ type
T0 = INTEGER;
(*documentation...*)
- T* = RECORD
- f*: RECORD (**documentation...*)
+ T* = record
+ f*: record (**documentation...*)
g: INTEGER;
h*: INTEGER
- END;
+ end;
g: REAL
- END;
+ end;
- T1* = RECORD (T) (*documentation...*)
+ T1* = record (T) (*documentation...*)
h: INTEGER
- END;
+ end;
- T2 = RECORD
+ T2 = record
(*f*: INTEGER*)
- END;
+ end;
- VAR
+ var
x*, y: T; (**documentation...*)
z, u*: F.File;
- PROCEDURE P*(x: INTEGER;
+ procedure P*(x: INTEGER;
y: REAL;
z: BYTE);
(**documentation,
documentation...*)
- END P;
+ end P;
- PROCEDURE Q;
+ procedure Q;
(*documentation...*)
- END Q;
+ end Q;
- PROCEDURE R*((**in/out*) VAR x: INTEGER; (**out*) VAR y: REAL; (*out*) VAR z: BYTE);
+ procedure R*((**in/out*) var x: INTEGER; (**out*) var y: REAL; (*out*) var z: BYTE);
(**documentation...*)
- END R;
+ end R;
-END ExportedFeatures.
+end ExportedFeatures.
-MODULE NoExportedFeatures;
+module NoExportedFeatures;
- IMPORT M := Math;
+ import M := Math;
- CONST
+ const
alpha = M.pi; (*documentation*)
- TYPE
+ type
Int = INTEGER;
- VAR
+ var
x: INTEGER;
- PROCEDURE P;
- END P;
+ procedure P;
+ end P;
-END NoExportedFeatures.
+end NoExportedFeatures.
projects / proto / obnc.git / commitdiff